67 lines
		
	
	
	
		
			1.9 KiB
			
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			67 lines
		
	
	
	
		
			1.9 KiB
			
		
	
	
	
		
			Haskell
		
	
	
	
	
	
{- git check-attr interface
 | 
						|
 -
 | 
						|
 - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
 | 
						|
 -
 | 
						|
 - Licensed under the GNU GPL version 3 or higher.
 | 
						|
 -}
 | 
						|
 | 
						|
module Git.CheckAttr where
 | 
						|
 | 
						|
import Common
 | 
						|
import Git
 | 
						|
import Git.Command
 | 
						|
import qualified Git.Version
 | 
						|
import qualified Utility.CoProcess as CoProcess
 | 
						|
 | 
						|
type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], String)
 | 
						|
 | 
						|
type Attr = String
 | 
						|
 | 
						|
{- Starts git check-attr running to look up the specified gitattributes
 | 
						|
 - values and returns a handle.  -}
 | 
						|
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
 | 
						|
checkAttrStart attrs repo = do
 | 
						|
	cwd <- getCurrentDirectory
 | 
						|
	h <- gitCoProcessStart params repo
 | 
						|
	return (h, attrs, cwd)
 | 
						|
  where
 | 
						|
	params =
 | 
						|
		[ Param "check-attr" 
 | 
						|
		, Params "-z --stdin"
 | 
						|
		] ++ map Param attrs ++
 | 
						|
		[ Param "--" ]
 | 
						|
 | 
						|
checkAttrStop :: CheckAttrHandle -> IO ()
 | 
						|
checkAttrStop (h, _, _) = CoProcess.stop h
 | 
						|
 | 
						|
{- Gets an attribute of a file. -}
 | 
						|
checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String
 | 
						|
checkAttr (h, attrs, cwd) want file = do
 | 
						|
	pairs <- CoProcess.query h send receive
 | 
						|
	let vals = map snd $ filter (\(attr, _) -> attr == want) pairs
 | 
						|
	case vals of
 | 
						|
		[v] -> return v
 | 
						|
		_ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file
 | 
						|
  where
 | 
						|
	send to = do
 | 
						|
		fileEncoding to
 | 
						|
		hPutStr to $ file' ++ "\0"
 | 
						|
	receive from = forM attrs $ \attr -> do
 | 
						|
		fileEncoding from
 | 
						|
		l <- hGetLine from
 | 
						|
		return (attr, attrvalue attr l)
 | 
						|
	{- Before git 1.7.7, git check-attr worked best with
 | 
						|
	 - absolute filenames; using them worked around some bugs
 | 
						|
	 - with relative filenames.
 | 
						|
	 - 
 | 
						|
	 - With newer git, git check-attr chokes on some absolute
 | 
						|
	 - filenames, and the bugs that necessitated them were fixed,
 | 
						|
	 - so use relative filenames. -}
 | 
						|
	oldgit = Git.Version.older "1.7.7"
 | 
						|
	file'
 | 
						|
		| oldgit = absPathFrom cwd file
 | 
						|
		| otherwise = relPathDirToFile cwd $ absPathFrom cwd file
 | 
						|
	attrvalue attr l = end bits !! 0
 | 
						|
	  where
 | 
						|
		bits = split sep l
 | 
						|
		sep = ": " ++ attr ++ ": "
 |