From d5d82599375169866b1bebe98fc5ebd7f27c959e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 Apr 2020 11:54:27 -0400 Subject: [PATCH] ByteString Ref continued 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. --- Git.hs | 1 + Git/DiffTree.hs | 48 +++++++++++++++++++++++++-------------------- Git/DiffTreeItem.hs | 3 ++- Git/FilePath.hs | 2 +- Git/LsTree.hs | 4 ++-- Git/Objects.hs | 2 +- Git/Ref.hs | 44 +++++++++++++++++++++++------------------ Git/RefLog.hs | 2 +- Git/Types.hs | 7 +++++-- Git/UpdateIndex.hs | 4 ++-- Types/RefSpec.hs | 4 ++-- Utility/Misc.hs | 8 ++++++++ 12 files changed, 77 insertions(+), 52 deletions(-) diff --git a/Git.hs b/Git.hs index 87a8d19720..d33345ed3f 100644 --- a/Git.hs +++ b/Git.hs @@ -14,6 +14,7 @@ module Git ( Repo(..), Ref(..), fromRef, + fromRef', Branch, Sha, Tag, diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index bfd1a7a1bc..6e69a91a70 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -1,6 +1,6 @@ {- git diff-tree interface - - - Copyright 2012 Joey Hess + - Copyright 2012-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -18,6 +18,9 @@ module Git.DiffTree ( ) 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 @@ -27,6 +30,7 @@ import Git.FilePath 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. -} @@ -89,7 +93,7 @@ commitDiff ref = getdiff (Param "show") 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 : @@ -100,26 +104,28 @@ getdiff command params repo = do 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 ++ "\"" + 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 ++ "\"" - 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 = : SP SP SP SP - (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 +-- : SP SP SP SP +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 (== ' ') diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs index 4034e5ecfb..090ad3e008 100644 --- a/Git/DiffTreeItem.hs +++ b/Git/DiffTreeItem.hs @@ -10,6 +10,7 @@ module Git.DiffTreeItem ( ) where import System.Posix.Types +import qualified Data.ByteString as S import Git.FilePath import Git.Types @@ -19,6 +20,6 @@ data DiffTreeItem = DiffTreeItem , 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 diff --git a/Git/FilePath.hs b/Git/FilePath.hs index ea9cceaa87..d31b421a5a 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -50,7 +50,7 @@ data BranchFilePath = BranchFilePath Ref TopFilePath {- 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 diff --git a/Git/LsTree.hs b/Git/LsTree.hs index ac059bbdff..ead501f0dc 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -96,7 +96,7 @@ parserLsTree = TreeItem <*> A8.takeTill (== ' ') <* A8.char ' ' -- sha - <*> (Ref . decodeBS' <$> A8.takeTill (== '\t')) + <*> (Ref <$> A8.takeTill (== '\t')) <* A8.char '\t' -- file <*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString) @@ -106,6 +106,6 @@ formatLsTree :: TreeItem -> String formatLsTree ti = unwords [ showOct (mode ti) "" , decodeBS (typeobj ti) - , decodeBS' (fromRef (sha ti)) + , fromRef (sha ti) , fromRawFilePath (getTopFilePath (file ti)) ] diff --git a/Git/Objects.hs b/Git/Objects.hs index 6f76886f5f..6a240875e0 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -32,7 +32,7 @@ listLooseObjectShas r = catchDefaultIO [] $ 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) diff --git a/Git/Ref.hs b/Git/Ref.hs index 433f423b9c..33922d1e30 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -17,6 +17,7 @@ import Git.Types import Data.Char (chr, ord) import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 headRef :: Ref headRef = Ref "HEAD" @@ -41,10 +42,11 @@ base = removeBase "refs/heads/" . removeBase "refs/remotes/" {- 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 ++ "/" @@ -53,7 +55,7 @@ removeBase dir (Ref r) - 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 @@ -66,21 +68,25 @@ branchRef = underBase "refs/heads" - 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.) -} @@ -107,26 +113,26 @@ sha branch repo = process <$> showref repo ] 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. -} @@ -137,7 +143,7 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo {- 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. -} @@ -145,8 +151,8 @@ delete :: Sha -> Ref -> Repo -> IO () 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. diff --git a/Git/RefLog.hs b/Git/RefLog.hs index e8fe6a2217..b98833c391 100644 --- a/Git/RefLog.hs +++ b/Git/RefLog.hs @@ -21,7 +21,7 @@ get b = getMulti [b] {- 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' diff --git a/Git/Types.hs b/Git/Types.hs index 84238c7c4e..6e4558d8fd 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -84,8 +84,11 @@ type RemoteName = String 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 diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 59d08437de..f0331d5c1f 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -90,7 +90,7 @@ updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> L.ByteString updateIndexLine sha treeitemtype file = L.fromStrict $ fmtTreeItemType treeitemtype <> " blob " - <> fromRef sha + <> fromRef' sha <> "\t" <> indexPath file @@ -108,7 +108,7 @@ unstageFile file repo = do unstageFile' :: TopFilePath -> Streamer unstageFile' p = pureStreamer $ L.fromStrict $ "0 " - <> fromRef deleteSha + <> fromRef' deleteSha <> "\t" <> indexPath p diff --git a/Types/RefSpec.hs b/Types/RefSpec.hs index 1028ed5233..0f3dded9d9 100644 --- a/Types/RefSpec.hs +++ b/Types/RefSpec.hs @@ -43,10 +43,10 @@ applyRefSpec refspec rs getreflog = go [] refspec 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 diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 2f1766ec23..01ae178d85 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -11,6 +11,7 @@ module Utility.Misc ( hGetContentsStrict, readFileStrict, separate, + separate', firstLine, firstLine', segment, @@ -54,6 +55,13 @@ separate c l = unbreak $ break c l | 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')