split out two more Git modules

This commit is contained in:
Joey Hess 2011-12-13 15:22:43 -04:00
parent 25b2cc4148
commit 9db8ec210f
8 changed files with 139 additions and 117 deletions

View file

@ -22,6 +22,7 @@ import System.Posix.Files
import Common.Annex
import qualified Git
import qualified Git.Config
import qualified Git.CheckAttr
import qualified Annex
import Types.Key
import qualified Types.Backend as B
@ -103,7 +104,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile]
chooseBackends fs = Annex.getState Annex.forcebackend >>= go
where
go Nothing = do
pairs <- inRepo $ Git.checkAttr "annex.backend" fs
pairs <- inRepo $ Git.CheckAttr.lookup "annex.backend" fs
return $ map (\(f,b) -> (maybeLookupBackendName b, f)) pairs
go (Just _) = do
l <- orderedList

113
Git.hs
View file

@ -45,25 +45,16 @@ module Git (
repoRemoteName,
repoRemoteNameSet,
repoRemoteNameFromKey,
checkAttr,
decodeGitFile,
encodeGitFile,
reap,
useIndex,
getSha,
shaSize,
assertLocal,
prop_idempotent_deencode
) where
import qualified Data.Map as M hiding (map, split)
import qualified Data.Map as M
import Network.URI
import Data.Char
import Data.Word (Word8)
import Codec.Binary.UTF8.String (encode)
import Text.Printf
import System.Exit
import System.Posix.Env (setEnv, unsetEnv, getEnv)
import qualified Data.ByteString.Lazy.Char8 as L
@ -360,105 +351,3 @@ configTrue s = map toLower s == "true"
{- Access to raw config Map -}
configMap :: Repo -> M.Map String String
configMap = config
{- Efficiently looks up a gitattributes value for each file in a list. -}
checkAttr :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
checkAttr attr files repo = do
-- git check-attr needs relative filenames input; it will choke
-- on some absolute filenames. This also means it will output
-- all relative filenames.
cwd <- getCurrentDirectory
let relfiles = map (relPathDirToFile cwd . absPathFrom cwd) files
(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
_ <- forkProcess $ do
hClose fromh
hPutStr toh $ join "\0" relfiles
hClose toh
exitSuccess
hClose toh
(map topair . lines) <$> hGetContents fromh
where
params = gitCommandLine
[ Param "check-attr"
, Param attr
, Params "-z --stdin"
] repo
topair l = (file, value)
where
file = decodeGitFile $ join sep $ take end bits
value = bits !! end
end = length bits - 1
bits = split sep l
sep = ": " ++ attr ++ ": "
{- Some git commands output encoded filenames. Decode that (annoyingly
- complex) encoding. -}
decodeGitFile :: String -> FilePath
decodeGitFile [] = []
decodeGitFile f@(c:s)
-- encoded strings will be inside double quotes
| c == '"' = unescape ("", middle)
| otherwise = f
where
e = '\\'
middle = init s
unescape (b, []) = b
-- look for escapes starting with '\'
unescape (b, v) = b ++ beginning ++ unescape (decode rest)
where
pair = span (/= e) v
beginning = fst pair
rest = snd pair
isescape x = x == e
-- \NNN is an octal encoded character
decode (x:n1:n2:n3:rest)
| isescape x && alloctal = (fromoctal, rest)
where
alloctal = isOctDigit n1 &&
isOctDigit n2 &&
isOctDigit n3
fromoctal = [chr $ readoctal [n1, n2, n3]]
readoctal o = read $ "0o" ++ o :: Int
-- \C is used for a few special characters
decode (x:nc:rest)
| isescape x = ([echar nc], rest)
where
echar 'a' = '\a'
echar 'b' = '\b'
echar 'f' = '\f'
echar 'n' = '\n'
echar 'r' = '\r'
echar 't' = '\t'
echar 'v' = '\v'
echar a = a
decode n = ("", n)
{- Should not need to use this, except for testing decodeGitFile. -}
encodeGitFile :: FilePath -> String
encodeGitFile s = foldl (++) "\"" (map echar s) ++ "\""
where
e c = '\\' : [c]
echar '\a' = e 'a'
echar '\b' = e 'b'
echar '\f' = e 'f'
echar '\n' = e 'n'
echar '\r' = e 'r'
echar '\t' = e 't'
echar '\v' = e 'v'
echar '\\' = e '\\'
echar '"' = e '"'
echar x
| ord x < 0x20 = e_num x -- low ascii
| ord x >= 256 = e_utf x
| ord x > 0x7E = e_num x -- high ascii
| otherwise = [x] -- printable ascii
where
showoctal i = '\\' : printf "%03o" i
e_num c = showoctal $ ord c
-- unicode character is decomposed to
-- Word8s and each is shown in octal
e_utf c = showoctal =<< (encode [c] :: [Word8])
{- for quickcheck -}
prop_idempotent_deencode :: String -> Bool
prop_idempotent_deencode s = s == decodeGitFile (encodeGitFile s)

44
Git/CheckAttr.hs Normal file
View file

@ -0,0 +1,44 @@
{- 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
import qualified Git.Filename
{- Efficiently looks up a gitattributes value for each file in a list. -}
lookup :: String -> [FilePath] -> Repo -> IO [(FilePath, String)]
lookup attr files repo = do
-- git check-attr needs relative filenames input; it will choke
-- on some absolute filenames. This also means it will output
-- all relative filenames.
cwd <- getCurrentDirectory
let relfiles = map (relPathDirToFile cwd . absPathFrom cwd) files
(_, fromh, toh) <- hPipeBoth "git" (toCommand params)
_ <- forkProcess $ do
hClose fromh
hPutStr toh $ join "\0" relfiles
hClose toh
exitSuccess
hClose toh
(map topair . lines) <$> hGetContents fromh
where
params = gitCommandLine
[ Param "check-attr"
, Param attr
, Params "-z --stdin"
] repo
topair l = (file, value)
where
file = Git.Filename.decode $ join sep $ take end bits
value = bits !! end
end = length bits - 1
bits = split sep l
sep = ": " ++ attr ++ ": "

84
Git/Filename.hs Normal file
View file

@ -0,0 +1,84 @@
{- Some git commands output encoded filenames, in a rather annoyingly complex
- C-style encoding.
-
- Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Git.Filename where
import qualified Codec.Binary.UTF8.String
import Data.Char
import Data.Word (Word8)
import Text.Printf
decode :: String -> FilePath
decode [] = []
decode f@(c:s)
-- encoded strings will be inside double quotes
| c == '"' = unescape ("", middle)
| otherwise = f
where
e = '\\'
middle = init s
unescape (b, []) = b
-- look for escapes starting with '\'
unescape (b, v) = b ++ beginning ++ unescape (handle rest)
where
pair = span (/= e) v
beginning = fst pair
rest = snd pair
isescape x = x == e
-- \NNN is an octal encoded character
handle (x:n1:n2:n3:rest)
| isescape x && alloctal = (fromoctal, rest)
where
alloctal = isOctDigit n1 &&
isOctDigit n2 &&
isOctDigit n3
fromoctal = [chr $ readoctal [n1, n2, n3]]
readoctal o = read $ "0o" ++ o :: Int
-- \C is used for a few special characters
handle (x:nc:rest)
| isescape x = ([echar nc], rest)
where
echar 'a' = '\a'
echar 'b' = '\b'
echar 'f' = '\f'
echar 'n' = '\n'
echar 'r' = '\r'
echar 't' = '\t'
echar 'v' = '\v'
echar a = a
handle n = ("", n)
{- Should not need to use this, except for testing decode. -}
encode :: FilePath -> String
encode s = foldl (++) "\"" (map echar s) ++ "\""
where
e c = '\\' : [c]
echar '\a' = e 'a'
echar '\b' = e 'b'
echar '\f' = e 'f'
echar '\n' = e 'n'
echar '\r' = e 'r'
echar '\t' = e 't'
echar '\v' = e 'v'
echar '\\' = e '\\'
echar '"' = e '"'
echar x
| ord x < 0x20 = e_num x -- low ascii
| ord x >= 256 = e_utf x
| ord x > 0x7E = e_num x -- high ascii
| otherwise = [x] -- printable ascii
where
showoctal i = '\\' : printf "%03o" i
e_num c = showoctal $ ord c
-- unicode character is decomposed to
-- Word8s and each is shown in octal
e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
{- for quickcheck -}
prop_idempotent_deencode :: String -> Bool
prop_idempotent_deencode s = s == decode (encode s)

View file

@ -17,6 +17,7 @@ import System.Posix.Types
import qualified Data.ByteString.Lazy.Char8 as L
import Git
import qualified Git.Filename
import Utility.SafeCommand
data TreeItem = TreeItem
@ -38,7 +39,7 @@ parseLsTree l = TreeItem
{ mode = fst $ head $ readOct $ L.unpack m
, typeobj = L.unpack t
, sha = L.unpack s
, file = decodeGitFile $ L.unpack f
, file = Git.Filename.decode $ L.unpack f
}
where
-- l = <mode> SP <type> SP <sha> TAB <file>

View file

@ -18,6 +18,7 @@ import Backend
import qualified Annex
import qualified Git
import qualified Git.LsFiles as LsFiles
import qualified Git.CheckAttr
import qualified Limit
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
@ -31,7 +32,7 @@ withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
withAttrFilesInGit attr a params = do
files <- seekHelper LsFiles.inRepo params
prepFilteredGen a fst $ inRepo $ Git.checkAttr attr files
prepFilteredGen a fst $ inRepo $ Git.CheckAttr.lookup attr files
withNumCopies :: (Maybe Int -> FilePath -> CommandStart) -> CommandSeek
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params

View file

@ -11,6 +11,7 @@ import Common
import qualified Git.UnionMerge
import qualified Git.Config
import qualified Git.Construct
import qualified Git.Branch
import qualified Git
header :: String
@ -44,5 +45,5 @@ main = do
_ <- Git.useIndex (tmpIndex g)
setup g
Git.UnionMerge.merge aref bref g
_ <- Git.commit "union merge" newref [aref, bref] g
_ <- Git.Branch.commit "union merge" newref [aref, bref] g
cleanup g

View file

@ -27,6 +27,7 @@ import qualified Backend
import qualified Git
import qualified Git.Config
import qualified Git.Construct
import qualified Git.Filename
import qualified Locations
import qualified Types.Backend
import qualified Types
@ -69,7 +70,7 @@ propigate (Counts { errors = e , failures = f }, _)
quickcheck :: Test
quickcheck = TestLabel "quickcheck" $ TestList
[ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode
[ qctest "prop_idempotent_deencode" Git.Filename.prop_idempotent_deencode
, qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
, qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show
, qctest "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape