Attoparsec parser for diff-tree.
Changed fromRef back to producing a String, to avoid needing to convert
every use of it. However, this does mean I'm going to miss some
opportunities where fromRef is used and the result converted back to a
ByteString. Would be worth revisiting that at some point maybe.
Repo(..),
Ref(..),
fromRef,
+ fromRef',
Branch,
Sha,
Tag,
{- git diff-tree interface
-
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
) where
import Numeric
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Attoparsec.ByteString.Lazy as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
import Common
import Git
import Git.DiffTreeItem
import qualified Git.Filename
import qualified Git.Ref
+import Utility.Attoparsec
{- Checks if the DiffTreeItem modifies a file with a given name
- or under a directory by that name. -}
getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
getdiff command params repo = do
(diff, cleanup) <- pipeNullSplit ps repo
- return (parseDiffRaw (map decodeBL diff), cleanup)
+ return (parseDiffRaw diff, cleanup)
where
ps =
command :
params
{- Parses --raw output used by diff-tree and git-log. -}
-parseDiffRaw :: [String] -> [DiffTreeItem]
+parseDiffRaw :: [L.ByteString] -> [DiffTreeItem]
parseDiffRaw l = go l
where
go [] = []
- go (info:f:rest) = mk info f : go rest
- go (s:[]) = error $ "diff-tree parse error near \"" ++ s ++ "\""
-
- mk info f = DiffTreeItem
- { srcmode = readmode srcm
- , dstmode = readmode dstm
- , srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha
- , dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha
- , status = s
- , file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode $ toRawFilePath f
- }
- where
- readmode = fst . Prelude.head . readOct
-
- -- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
- (srcm, past_srcm) = splitAt 7 $ drop 1 info
- (dstm, past_dstm) = splitAt 7 past_srcm
- (ssha, past_ssha) = separate (== ' ') past_dstm
- (dsha, s) = separate (== ' ') past_ssha
+ go (info:f:rest) = case A.parse (parserDiffRaw (L.toStrict f)) info of
+ A.Done _ r -> r : go rest
+ A.Fail _ _ err -> error $ "diff-tree parse error: " ++ err
+ go (s:[]) = error $ "diff-tree parse error near \"" ++ decodeBL' s ++ "\""
+
+-- :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
+parserDiffRaw :: RawFilePath -> A.Parser DiffTreeItem
+parserDiffRaw f = DiffTreeItem
+ <$ A8.char ':'
+ <*> octal
+ <* A8.char ' '
+ <*> octal
+ <* A8.char ' '
+ <*> (maybe (fail "bad srcsha") return . extractSha =<< nextword)
+ <* A8.char ' '
+ <*> (maybe (fail "bad dstsha") return . extractSha =<< nextword)
+ <* A8.char ' '
+ <*> A.takeByteString
+ <*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
+ where
+ nextword = A8.takeTill (== ' ')
) where
import System.Posix.Types
+import qualified Data.ByteString as S
import Git.FilePath
import Git.Types
, dstmode :: FileMode
, srcsha :: Sha -- null sha if file was added
, dstsha :: Sha -- null sha if file was deleted
- , status :: String
+ , status :: S.ByteString
, file :: TopFilePath
} deriving Show
{- Git uses the branch:file form to refer to a BranchFilePath -}
descBranchFilePath :: BranchFilePath -> S.ByteString
descBranchFilePath (BranchFilePath b f) =
- fromRef b <> ":" <> getTopFilePath f
+ fromRef' b <> ":" <> getTopFilePath f
{- Path to a TopFilePath, within the provided git repo. -}
fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
<*> A8.takeTill (== ' ')
<* A8.char ' '
-- sha
- <*> (Ref . decodeBS' <$> A8.takeTill (== '\t'))
+ <*> (Ref <$> A8.takeTill (== '\t'))
<* A8.char '\t'
-- file
<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)
formatLsTree ti = unwords
[ showOct (mode ti) ""
, decodeBS (typeobj ti)
- , decodeBS' (fromRef (sha ti))
+ , fromRef (sha ti)
, fromRawFilePath (getTopFilePath (file ti))
]
looseObjectFile :: Repo -> Sha -> FilePath
looseObjectFile r sha = objectsDir r </> prefix </> rest
where
- (prefix, rest) = splitAt 2 (decodeBS' (fromRef sha))
+ (prefix, rest) = splitAt 2 (fromRef sha)
listAlternates :: Repo -> IO [FilePath]
listAlternates r = catchDefaultIO [] (lines <$> readFile alternatesfile)
import Data.Char (chr, ord)
import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
headRef :: Ref
headRef = Ref "HEAD"
{- Removes a directory such as "refs/heads/master" from a
- fully qualified ref. Any ref not starting with it is left as-is. -}
removeBase :: String -> Ref -> Ref
-removeBase dir (Ref r)
- | prefix `isPrefixOf` r = Ref (drop (length prefix) r)
- | otherwise = Ref r
+removeBase dir r
+ | prefix `isPrefixOf` rs = Ref $ encodeBS $ drop (length prefix) rs
+ | otherwise = r
where
+ rs = fromRef r
prefix = case end dir of
['/'] -> dir
_ -> dir ++ "/"
- refs/heads/master, yields a version of that ref under the directory,
- such as refs/remotes/origin/master. -}
underBase :: String -> Ref -> Ref
-underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r)
+underBase dir r = Ref $ encodeBS' $ dir ++ "/" ++ fromRef (base r)
{- Convert a branch such as "master" into a fully qualified ref. -}
branchRef :: Branch -> Ref
- of a repo.
-}
fileRef :: RawFilePath -> Ref
-fileRef f = Ref $ ":./" ++ fromRawFilePath f
+fileRef f = Ref $ ":./" <> f
{- Converts a Ref to refer to the content of the Ref on a given date. -}
dateRef :: Ref -> RefDate -> Ref
-dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d
+dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS' d
{- A Ref that can be used to refer to a file in the repository as it
- appears in a given Ref. -}
fileFromRef :: Ref -> RawFilePath -> Ref
-fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
+fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr)
{- Checks if a ref exists. -}
exists :: Ref -> Repo -> IO Bool
exists ref = runBool
- [Param "show-ref", Param "--verify", Param "-q", Param $ fromRef ref]
+ [ Param "show-ref"
+ , Param "--verify"
+ , Param "-q"
+ , Param $ fromRef ref
+ ]
{- The file used to record a ref. (Git also stores some refs in a
- packed-refs file.) -}
]
process s
| S.null s = Nothing
- | otherwise = Just $ Ref $ decodeBS' $ firstLine' s
+ | otherwise = Just $ Ref $ firstLine' s
headSha :: Repo -> IO (Maybe Sha)
headSha = sha headRef
{- List of (shas, branches) matching a given ref or refs. -}
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matching refs repo = matching' (map fromRef refs) repo
+matching = matching' []
{- Includes HEAD in the output, if asked for it. -}
matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
+matchingWithHEAD = matching' [Param "--head"]
-{- List of (shas, branches) matching a given ref spec. -}
-matching' :: [String] -> Repo -> IO [(Sha, Branch)]
-matching' ps repo = map gen . lines . decodeBS' <$>
- pipeReadStrict (Param "show-ref" : map Param ps) repo
+matching' :: [CommandParam] -> [Ref] -> Repo -> IO [(Sha, Branch)]
+matching' ps rs repo = map gen . S8.lines <$>
+ pipeReadStrict (Param "show-ref" : ps ++ rps) repo
where
- gen l = let (r, b) = separate (== ' ') l
+ gen l = let (r, b) = separate' (== fromIntegral (ord ' ')) l
in (Ref r, Ref b)
+ rps = map (Param . fromRef) rs
{- List of (shas, branches) matching a given ref.
- Duplicate shas are filtered out. -}
{- List of all refs. -}
list :: Repo -> IO [(Sha, Ref)]
-list = matching' []
+list = matching' [] []
{- Deletes a ref. This can delete refs that are not branches,
- which git branch --delete refuses to delete. -}
delete oldvalue ref = run
[ Param "update-ref"
, Param "-d"
- , Param $ decodeBS' (fromRef ref)
- , Param $ decodeBS' (fromRef oldvalue)
+ , Param $ fromRef ref
+ , Param $ fromRef oldvalue
]
{- Gets the sha of the tree a ref uses.
{- Gets reflogs for multiple branches. -}
getMulti :: [Branch] -> Repo -> IO [Sha]
-getMulti bs = get' (map (Param . decodeBS' . fromRef) bs)
+getMulti bs = get' (map (Param . fromRef) bs)
get' :: [CommandParam] -> Repo -> IO [Sha]
get' ps = mapMaybe (extractSha . S.copy) . S8.lines <$$> pipeReadStrict ps'
newtype Ref = Ref S.ByteString
deriving (Eq, Ord, Read, Show)
-fromRef :: Ref -> S.ByteString
-fromRef (Ref s) = s
+fromRef :: Ref -> String
+fromRef = decodeBS' . fromRef'
+
+fromRef' :: Ref -> S.ByteString
+fromRef' (Ref s) = s
{- Aliases for Ref. -}
type Branch = Ref
updateIndexLine sha treeitemtype file = L.fromStrict $
fmtTreeItemType treeitemtype
<> " blob "
- <> fromRef sha
+ <> fromRef' sha
<> "\t"
<> indexPath file
unstageFile' :: TopFilePath -> Streamer
unstageFile' p = pureStreamer $ L.fromStrict $
"0 "
- <> fromRef deleteSha
+ <> fromRef' deleteSha
<> "\t"
<> indexPath p
go c [] = return (reverse c)
go c (AddRef r : rest) = go (r:c) rest
go c (AddMatching g : rest) =
- let add = filter (matchGlob g . decodeBS' . fromRef) rs
+ let add = filter (matchGlob g . fromRef) rs
in go (add ++ c) rest
go c (AddRefLog : rest) = do
reflog <- getreflog
go (reflog ++ c) rest
go c (RemoveMatching g : rest) =
- go (filter (not . matchGlob g . decodeBS' . fromRef) c) rest
+ go (filter (not . matchGlob g . fromRef) c) rest
hGetContentsStrict,
readFileStrict,
separate,
+ separate',
firstLine,
firstLine',
segment,
| null b = r
| otherwise = (a, tail b)
+separate' :: (Word8 -> Bool) -> S.ByteString -> (S.ByteString, S.ByteString)
+separate' c l = unbreak $ S.break c l
+ where
+ unbreak r@(a, b)
+ | S.null b = r
+ | otherwise = (a, S.tail b)
+
{- Breaks out the first line. -}
firstLine :: String -> String
firstLine = takeWhile (/= '\n')
projects / git-annex.git / commitdiff