2011-12-13 19:22:43 +00:00
|
|
|
{- git check-attr interface
|
|
|
|
-
|
|
|
|
- Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Git.CheckAttr where
|
|
|
|
|
|
|
|
import System.Exit
|
|
|
|
|
|
|
|
import Common
|
|
|
|
import Git
|
2011-12-14 19:56:11 +00:00
|
|
|
import Git.Command
|
2011-12-13 19:22:43 +00:00
|
|
|
import qualified Git.Filename
|
2011-12-22 18:59:25 +00:00
|
|
|
import qualified Git.Version
|
2011-12-13 19:22:43 +00:00
|
|
|
|
|
|
|
{- Efficiently looks up a gitattributes value for each file in a list. -}
|
|
|
|
lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
|
|
|
|
lookup attr files repo = do
|
|
|
|
cwd <- getCurrentDirectory
|
|
|
|
(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
|
|
|
|
_ <- forkProcess $ do
|
|
|
|
hClose fromh
|
2011-12-22 18:59:25 +00:00
|
|
|
hPutStr toh $ join "\0" $ input cwd
|
2011-12-13 19:22:43 +00:00
|
|
|
hClose toh
|
|
|
|
exitSuccess
|
|
|
|
hClose toh
|
2011-12-22 18:59:25 +00:00
|
|
|
output cwd . lines <$> hGetContents fromh
|
2011-12-13 19:22:43 +00:00
|
|
|
where
|
|
|
|
params = gitCommandLine
|
|
|
|
[ Param "check-attr"
|
|
|
|
, Param attr
|
|
|
|
, Params "-z --stdin"
|
|
|
|
] repo
|
2011-12-22 18:59:25 +00:00
|
|
|
|
|
|
|
{- 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"
|
|
|
|
input cwd
|
|
|
|
| oldgit = map (absPathFrom cwd) files
|
|
|
|
| otherwise = map (relPathDirToFile cwd . absPathFrom cwd) files
|
|
|
|
output cwd
|
|
|
|
| oldgit = map (torel cwd . topair)
|
|
|
|
| otherwise = map topair
|
|
|
|
|
2011-12-15 22:11:42 +00:00
|
|
|
topair l = (Git.Filename.decode file, value)
|
2011-12-13 19:22:43 +00:00
|
|
|
where
|
2011-12-15 22:11:42 +00:00
|
|
|
file = join sep $ beginning bits
|
|
|
|
value = end bits !! 0
|
2011-12-13 19:22:43 +00:00
|
|
|
bits = split sep l
|
|
|
|
sep = ": " ++ attr ++ ": "
|
2011-12-22 18:59:25 +00:00
|
|
|
|
|
|
|
torel cwd (file, value) = (relfile, value)
|
|
|
|
where
|
|
|
|
relfile
|
|
|
|
| startswith cwd' file = drop (length cwd') file
|
|
|
|
| otherwise = relPathDirToFile top' file
|
|
|
|
top = workTree repo
|
|
|
|
cwd' = cwd ++ "/"
|
|
|
|
top' = top ++ "/"
|