summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-12-13 15:22:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-12-13 15:24:23 -0400
commit9db8ec210f8491de78cd7e83b94c50ead8049e72 (patch)
tree539d2a49f1599fdd4855570d046f710809062a8e
parent25b2cc4148e4cc8f7435cdbcf4b124cc317c1305 (diff)
split out two more Git modules
-rw-r--r--Backend.hs3
-rw-r--r--Git.hs113
-rw-r--r--Git/CheckAttr.hs44
-rw-r--r--Git/Filename.hs84
-rw-r--r--Git/LsTree.hs3
-rw-r--r--Seek.hs3
-rw-r--r--git-union-merge.hs3
-rw-r--r--test.hs3
8 files changed, 139 insertions, 117 deletions
diff --git a/Backend.hs b/Backend.hs
index c7cb57440..38f0629f4 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -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
diff --git a/Git.hs b/Git.hs
index 36b83c65b..0280acedc 100644
--- a/Git.hs
+++ b/Git.hs
@@ -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)
diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs
new file mode 100644
index 000000000..e9269b1ed
--- /dev/null
+++ b/Git/CheckAttr.hs
@@ -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 ++ ": "
diff --git a/Git/Filename.hs b/Git/Filename.hs
new file mode 100644
index 000000000..69f36d086
--- /dev/null
+++ b/Git/Filename.hs
@@ -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)
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 8aa16a308..342a125eb 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -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>
diff --git a/Seek.hs b/Seek.hs
index 1430ebabd..28c6ffc00 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -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
diff --git a/git-union-merge.hs b/git-union-merge.hs
index eeb694401..f67414bdd 100644
--- a/git-union-merge.hs
+++ b/git-union-merge.hs
@@ -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
diff --git a/test.hs b/test.hs
index 14994865f..1ce9d103d 100644
--- a/test.hs
+++ b/test.hs
@@ -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