diff options
Diffstat (limited to 'Git/CheckAttr.hs')
| -rw-r--r-- | Git/CheckAttr.hs | 56 |
1 files changed, 40 insertions, 16 deletions
diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index 5c747a951..669a9c54e 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -1,6 +1,6 @@ {- git check-attr interface - - - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,20 +12,44 @@ import Git import Git.Command import qualified Git.Version -{- Efficiently looks up a gitattributes value for each file in a list. -} -lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)] -lookup attr files repo = do +type CheckAttrHandle = (PipeHandle, Handle, Handle, [Attr], String) + +type Attr = String + +{- Starts git check-attr running to look up the specified gitattributes + - values and return a handle. -} +checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle +checkAttrStart attrs repo = do cwd <- getCurrentDirectory - (_, r) <- pipeBoth "git" (toCommand params) $ - join "\0" $ input cwd - return $ zip files $ map attrvalue $ lines r + (pid, from, to) <- hPipeBoth "git" $ toCommand $ + gitCommandLine params repo + return (pid, from, to, attrs, cwd) where - params = gitCommandLine - [ Param "check-attr" - , Param attr - , Params "-z --stdin" - ] repo + params = + [ Param "check-attr" ] + ++ map Param attrs ++ + [ Params "-z --stdin" ] +{- Stops git check-attr. -} +checkAttrStop :: CheckAttrHandle -> IO () +checkAttrStop (pid, from, to, _, _) = do + hClose to + hClose from + forceSuccess pid + +{- Gets an attribute of a file. -} +checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String +checkAttr (_, from, to, attrs, cwd) want file = do + hPutStr to $ file' ++ "\0" + hFlush to + pairs <- forM attrs $ \attr -> do + l <- hGetLine from + return (attr, attrvalue attr l) + let vals = map snd $ filter (\(attr, _) -> attr == want) pairs + case vals of + [v] -> return v + _ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file + where {- Before git 1.7.7, git check-attr worked best with - absolute filenames; using them worked around some bugs - with relative filenames. @@ -34,10 +58,10 @@ lookup attr files repo = do - filenames, and the bugs that necessitated them were fixed, - so use relative filenames. -} oldgit = Git.Version.older "1.7.7" - input cwd - | oldgit = map (absPathFrom cwd) files - | otherwise = map (relPathDirToFile cwd . absPathFrom cwd) files - attrvalue l = end bits !! 0 + file' + | oldgit = absPathFrom cwd file + | otherwise = relPathDirToFile cwd $ absPathFrom cwd file + attrvalue attr l = end bits !! 0 where bits = split sep l sep = ": " ++ attr ++ ": " |