]> dgit.raspbian.org Git - git-annex.git/commitdiff
ByteString Ref continued
authorJoey Hess <joeyh@joeyh.name>
Tue, 7 Apr 2020 17:27:11 +0000 (13:27 -0400)
committerJoey Hess <joeyh@joeyh.name>
Tue, 7 Apr 2020 17:27:11 +0000 (13:27 -0400)
Several nice speed wins I think.

At 340/633 files converted.

16 files changed:
Annex/AdjustedBranch/Name.hs
Annex/Branch.hs
Annex/ChangedRefs.hs
Database/Keys.hs
Git/Branch.hs
Git/CatFile.hs
Git/History.hs
Git/LsFiles.hs
Git/Repair.hs
Git/Tree.hs
Git/UnionMerge.hs
Logs/FsckResults.hs
Logs/View.hs
Types/GitConfig.hs
Types/View.hs
Upgrade/V5/Direct.hs

index 5987662b9a13c080ea60444bf5a5bb919afc3a8a..d997e72309a86b334ea9e922bed693fdac7abc90 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Annex.AdjustedBranch.Name (
        originalToAdjusted,
        adjustedToOriginal,
@@ -18,14 +20,15 @@ import qualified Git.Ref
 import Utility.Misc
 
 import Control.Applicative
-import Data.List
+import Data.Char
+import qualified Data.ByteString as S
 
-adjustedBranchPrefix :: String
+adjustedBranchPrefix :: S.ByteString
 adjustedBranchPrefix = "refs/heads/adjusted/"
 
 class SerializeAdjustment t where
-       serializeAdjustment :: t -> String
-       deserializeAdjustment :: String -> Maybe t
+       serializeAdjustment :: t -> S.ByteString
+       deserializeAdjustment :: S.ByteString -> Maybe t
 
 instance SerializeAdjustment Adjustment where
        serializeAdjustment (LinkAdjustment l) =
@@ -33,7 +36,7 @@ instance SerializeAdjustment Adjustment where
        serializeAdjustment (PresenceAdjustment p Nothing) =
                serializeAdjustment p
        serializeAdjustment (PresenceAdjustment p (Just l)) = 
-               serializeAdjustment p ++ "-" ++ serializeAdjustment l
+               serializeAdjustment p <> "-" <> serializeAdjustment l
        deserializeAdjustment s = 
                (LinkAdjustment <$> deserializeAdjustment s)
                        <|>
@@ -41,7 +44,7 @@ instance SerializeAdjustment Adjustment where
                        <|>
                (PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)
          where
-               (s1, s2) = separate (== '-') s
+               (s1, s2) = separate' (== (fromIntegral (ord '-'))) s
 
 instance SerializeAdjustment LinkAdjustment where
        serializeAdjustment UnlockAdjustment = "unlocked"
@@ -65,19 +68,21 @@ newtype AdjBranch = AdjBranch { adjBranch :: Branch }
 
 originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
 originalToAdjusted orig adj = AdjBranch $ Ref $
-       adjustedBranchPrefix ++ base ++ '(' : serializeAdjustment adj ++ ")"
+       adjustedBranchPrefix <> base <> "(" <> serializeAdjustment adj <> ")"
   where
-       base = fromRef (Git.Ref.base orig)
+       base = fromRef' (Git.Ref.base orig)
 
 type OrigBranch = Branch
 
 adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
 adjustedToOriginal b
-       | adjustedBranchPrefix `isPrefixOf` bs = do
-               let (base, as) = separate (== '(') (drop prefixlen bs)
-               adj <- deserializeAdjustment (takeWhile (/= ')') as)
+       | adjustedBranchPrefix `S.isPrefixOf` bs = do
+               let (base, as) = separate' (== openparen) (S.drop prefixlen bs)
+               adj <- deserializeAdjustment (S.takeWhile (/= closeparen) as)
                Just (adj, Git.Ref.branchRef (Ref base))
        | otherwise = Nothing
   where
-       bs = fromRef b
-       prefixlen = length adjustedBranchPrefix
+       bs = fromRef' b
+       prefixlen = S.length adjustedBranchPrefix
+       openparen = fromIntegral (ord '(')
+       closeparen = fromIntegral (ord ')')
index 91d0276daafa4f09a9ed628fb33ec8d93030defd..f4b5ce1a1f85be16247a7501842f6d0ba12a682e 100644 (file)
@@ -29,7 +29,9 @@ module Annex.Branch (
        withIndex,
 ) where
 
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Char8 as B8
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Function
@@ -643,11 +645,11 @@ getMergedRefs = S.fromList . map fst <$> getMergedRefs'
 getMergedRefs' :: Annex [(Git.Sha, Git.Branch)]
 getMergedRefs' = do
        f <- fromRepo gitAnnexMergedRefs
-       s <- liftIO $ catchDefaultIO "" $ readFile f
-       return $ map parse $ lines s
+       s <- liftIO $ catchDefaultIO mempty $ B.readFile f
+       return $ map parse $ B8.lines s
   where
        parse l = 
-               let (s, b) = separate (== '\t') l
+               let (s, b) = separate' (== (fromIntegral (ord '\t'))) l
                in (Ref s, Ref b)
 
 {- Grafts a treeish into the branch at the specified location,
index 786a193e555a60d886d3aa0f7e9d3857b0b130d0..3fb9d1ef1bef7667f228ea5a146a009fb043f4de 100644 (file)
@@ -1,6 +1,6 @@
 {- Waiting for changed git refs
  -
- - Copyright 2014-216 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -24,13 +24,14 @@ import qualified Utility.SimpleProtocol as Proto
 import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TBMChan
+import qualified Data.ByteString as S
 
 newtype ChangedRefs = ChangedRefs [Git.Ref]
        deriving (Show)
 
 instance Proto.Serializable ChangedRefs where
        serialize (ChangedRefs l) = unwords $ map Git.fromRef l
-       deserialize = Just . ChangedRefs . map Git.Ref . words
+       deserialize = Just . ChangedRefs . map (Git.Ref . encodeBS) . words
 
 data ChangedRefsHandle = ChangedRefsHandle DirWatcherHandle (TBMChan Git.Sha)
 
@@ -97,7 +98,7 @@ notifyHook chan reffile _
        | ".lock" `isSuffixOf` reffile = noop
        | otherwise = void $ do
                sha <- catchDefaultIO Nothing $
-                       extractSha <$> readFile reffile
+                       extractSha <$> S.readFile reffile
                -- When the channel is full, there is probably no reader
                -- running, or ref changes have been occuring very fast,
                -- so it's ok to not write the change to it.
index b1650b286c2a82ea701d72003cc6080e2a714792..25954ba71a7fd2fcce24512366829dae4f902caf 100644 (file)
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Database.Keys (
        DbHandle,
@@ -44,6 +45,7 @@ import Git.Types
 import Git.Index
 
 import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
 import qualified System.FilePath.ByteString as P
 
 {- Runs an action that reads from the database.
@@ -237,8 +239,8 @@ reconcileStaged qh = do
                Nothing -> noop
   where
        go cur indexcache = do
-               (l, cleanup) <- inRepo $ pipeNullSplit diff
-               changed <- procdiff (map decodeBL' l) False
+               (l, cleanup) <- inRepo $ pipeNullSplit' diff
+               changed <- procdiff l False
                void $ liftIO cleanup
                -- Flush database changes immediately
                -- so other processes can see them.
@@ -278,15 +280,16 @@ reconcileStaged qh = do
                , Param "--no-ext-diff"
                ]
        
-       procdiff (info:file:rest) changed = case words info of
-               ((':':_srcmode):dstmode:_srcsha:dstsha:_change:[])
-                       -- Only want files, not symlinks
-                       | dstmode /= decodeBS' (fmtTreeItemType TreeSymlink) -> do
-                               maybe noop (reconcile (asTopFilePath (toRawFilePath file)))
-                                       =<< catKey (Ref dstsha)
-                               procdiff rest True
-                       | otherwise -> procdiff rest changed
-               _ -> return changed -- parse failed
+       procdiff (info:file:rest) changed
+               | ":" `S.isPrefixOf` info = case S8.words info of
+                       (_colonsrcmode:dstmode:_srcsha:dstsha:_change:[])
+                               -- Only want files, not symlinks
+                               | dstmode /= fmtTreeItemType TreeSymlink -> do
+                                       maybe noop (reconcile (asTopFilePath file))
+                                               =<< catKey (Ref dstsha)
+                                       procdiff rest True
+                               | otherwise -> procdiff rest changed
+                       _ -> return changed -- parse failed
        procdiff _ changed = return changed
 
        -- Note that database writes done in here will not necessarily 
index 699fbf50e14ce2b76dd6b7edacc2dbd3d7ffe705..fcae905f64f86a59a7b4daef25163d327f207f46 100644 (file)
@@ -18,6 +18,7 @@ import qualified Git.Config
 import qualified Git.Ref
 
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
 
 {- The currently checked out branch.
  -
@@ -39,25 +40,27 @@ current r = do
 
 {- The current branch, which may not really exist yet. -}
 currentUnsafe :: Repo -> IO (Maybe Branch)
-currentUnsafe r = parse . firstLine'
-       <$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r
+currentUnsafe r = parse . firstLine' <$> pipeReadStrict
+       [ Param "symbolic-ref"
+       , Param "-q"
+       , Param $ fromRef Git.Ref.headRef
+       ] r
   where
        parse b
                | B.null b = Nothing
-               | otherwise = Just $ Git.Ref $ decodeBS b
+               | otherwise = Just $ Git.Ref b
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
 changed :: Branch -> Branch -> Repo -> IO Bool
 changed origbranch newbranch repo
        | origbranch == newbranch = return False
-       | otherwise = not . null
+       | otherwise = not . B.null
                <$> changed' origbranch newbranch [Param "-n1"] repo
   where
 
-changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
-changed' origbranch newbranch extraps repo =
-       decodeBS <$> pipeReadStrict ps repo
+changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO B.ByteString
+changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
   where
        ps =
                [ Param "log"
@@ -68,7 +71,7 @@ changed' origbranch newbranch extraps repo =
 {- Lists commits that are in the second branch and not in the first branch. -}
 changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha]
 changedCommits origbranch newbranch extraps repo = 
-       catMaybes . map extractSha . lines
+       catMaybes . map extractSha . B8.lines
                <$> changed' origbranch newbranch extraps repo
        
 {- Check if it's possible to fast-forward from the old
@@ -163,8 +166,7 @@ commitCommand' runner commitmode ps = runner $
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
-       tree <- getSha "write-tree" $
-               decodeBS' <$> pipeReadStrict [Param "write-tree"] repo
+       tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
        ifM (cancommit tree)
                ( do
                        sha <- commitTree commitmode message parentrefs tree repo
index 980d289840e0c5e8d0884bfaa83cb7a5234e8b7a..68850f075c35bd10043c79b811776266849fe9d5 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.CatFile (
        CatFileHandle,
        catFileStart,
@@ -22,7 +24,6 @@ module Git.CatFile (
 import System.IO
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Map as M
 import Data.String
 import Data.Char
@@ -69,11 +70,11 @@ catFileStop h = do
 {- Reads a file from a specified branch. -}
 catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString
 catFile h branch file = catObject h $ Ref $
-       fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
+       fromRef' branch <> ":" <> toInternalGitPath file
 
 catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
 catFileDetails h branch file = catObjectDetails h $ Ref $
-       fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
+       fromRef' branch <> ":" <> toInternalGitPath file
 
 {- Uses a running git cat-file read the content of an object.
  - Objects that do not exist will have "" returned. -}
@@ -148,7 +149,7 @@ parseResp object l
        | " missing" `isSuffixOf` l -- less expensive than full check
                && l == fromRef object ++ " missing" = Just DNE
        | otherwise = case words l of
-               [sha, objtype, size] -> case extractSha sha of
+               [sha, objtype, size] -> case extractSha (encodeBS sha) of
                        Just sha' -> case (readObjectType (encodeBS objtype), reads size) of
                                (Just t, [(bytes, "")]) -> 
                                        Just $ ParsedResp sha' bytes t
@@ -218,39 +219,39 @@ catTree h treeref = go <$> catObjectDetails h treeref
 catCommit :: CatFileHandle -> Ref -> IO (Maybe Commit)
 catCommit h commitref = go <$> catObjectDetails h commitref
   where
-       go (Just (b, _, CommitObject)) = parseCommit b
+       go (Just (b, _, CommitObject)) = parseCommit (L.toStrict b)
        go _ = Nothing
 
-parseCommit :: L.ByteString -> Maybe Commit
+parseCommit :: S.ByteString -> Maybe Commit
 parseCommit b = Commit
-       <$> (extractSha . L8.unpack =<< field "tree")
-       <*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))
+       <$> (extractSha =<< field "tree")
+       <*> Just (maybe [] (mapMaybe extractSha) (fields "parent"))
        <*> (parsemetadata <$> field "author")
        <*> (parsemetadata <$> field "committer")
-       <*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
+       <*> Just (decodeBS $ S.intercalate (S.singleton nl) message)
   where
        field n = headMaybe =<< fields n
        fields n = M.lookup (fromString n) fieldmap
        fieldmap = M.fromListWith (++) ((map breakfield) header)
        breakfield l =
-               let (k, sp_v) = L.break (== sp) l
-               in (k, [L.drop 1 sp_v])
-       (header, message) = separate L.null ls
-       ls = L.split nl b
+               let (k, sp_v) = S.break (== sp) l
+               in (k, [S.drop 1 sp_v])
+       (header, message) = separate S.null ls
+       ls = S.split nl b
 
        -- author and committer lines have the form: "name <email> date"
        -- The email is always present, even if empty "<>"
        parsemetadata l = CommitMetaData
-               { commitName = whenset $ L.init name_sp
+               { commitName = whenset $ S.init name_sp
                , commitEmail = whenset email
-               , commitDate = whenset $ L.drop 2 gt_sp_date
+               , commitDate = whenset $ S.drop 2 gt_sp_date
                }
          where
-               (name_sp, rest) = L.break (== lt) l
-               (email, gt_sp_date) = L.break (== gt) (L.drop 1 rest)
+               (name_sp, rest) = S.break (== lt) l
+               (email, gt_sp_date) = S.break (== gt) (S.drop 1 rest)
                whenset v
-                       | L.null v = Nothing
-                       | otherwise = Just (L8.unpack v)
+                       | S.null v = Nothing
+                       | otherwise = Just (decodeBS v)
 
        nl = fromIntegral (ord '\n')
        sp = fromIntegral (ord ' ')
index 5c202c9b5c524a81d0daa1d03b99db77b32398da..1b7127229bf27b492001888cf5ed75ec530b94ef 100644 (file)
@@ -16,8 +16,8 @@ import Git.Sha
 
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy.Char8 as L8
 
 data History t = History t (S.Set (History t))
        deriving (Show, Eq, Ord)
@@ -56,8 +56,8 @@ getHistoryToDepth n commit r = do
        !h <- fmap (truncateHistoryToDepth n) 
                . build Nothing 
                . map parsehistorycommit
-               . map B.copy
-               . B8.lines
+               . map L.toStrict
+               . L8.lines
                <$> L.hGetContents inh
        hClose inh
        void $ waitForProcess pid
@@ -97,7 +97,7 @@ getHistoryToDepth n commit r = do
                , Param "--format=%T %H %P"
                ]
        
-       parsehistorycommit l = case map extractSha (S8.split ' ' l) of
+       parsehistorycommit l = case map extractSha (B8.split ' ' l) of
                (Just t:Just c:ps) -> Just $ 
                        ( HistoryCommit
                                { historyCommit = c
index 2291e9c42aaebcc5bc399d5bc39f56fbd5b0fb13..830b5f5bfeee412f992e63171094b954440d778c 100644 (file)
@@ -36,9 +36,10 @@ import Utility.InodeCache
 import Utility.TimeStamp
 
 import Numeric
+import Data.Char
 import System.Posix.Types
 import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
 
 {- It's only safe to use git ls-files on the current repo, not on a remote.
  -
@@ -81,7 +82,7 @@ inRepo' ps l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo
 {- Files that are checked into the index or have been committed to a
  - branch. -}
 inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
-inRepoOrBranch (Ref b) = inRepo' [Param $ "--with-tree=" ++ b]
+inRepoOrBranch b = inRepo' [Param $ "--with-tree=" ++ fromRef b]
 
 {- Scans for files at the specified locations that are not checked into git. -}
 notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
@@ -189,21 +190,21 @@ stagedDetails = stagedDetails' []
  - contents. -}
 stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = guardSafeForLsFiles repo $ do
-       (ls, cleanup) <- pipeNullSplit params repo
+       (ls, cleanup) <- pipeNullSplit' params repo
        return (map parseStagedDetails ls, cleanup)
   where
        params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
                Param "--" : map (File . fromRawFilePath) l
 
-parseStagedDetails :: L.ByteString -> StagedDetails
+parseStagedDetails :: S.ByteString -> StagedDetails
 parseStagedDetails s
-       | null file = (L.toStrict s, Nothing, Nothing)
-       | otherwise = (toRawFilePath file, extractSha sha, readmode mode)
+       | S.null file = (s, Nothing, Nothing)
+       | otherwise = (file, extractSha sha, readmode mode)
   where
-       (metadata, file) = separate (== '\t') (decodeBL' s)
-       (mode, metadata') = separate (== ' ') metadata
-       (sha, _) = separate (== ' ') metadata'
-       readmode = fst <$$> headMaybe . readOct
+       (metadata, file) = separate' (== fromIntegral (ord '\t')) s
+       (mode, metadata') = separate' (== fromIntegral (ord ' ')) metadata
+       (sha, _) = separate' (== fromIntegral (ord ' ')) metadata'
+       readmode = fst <$$> headMaybe . readOct . decodeBS'
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
index 10ea6a8ddc1a9eb2cab17d5d1d7c08d428866821..f7a91ca0fee8c47635e52d6f3daa3d5486ffd32e 100644 (file)
@@ -232,7 +232,7 @@ getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) </> "refs")
 getAllRefs' :: FilePath -> IO [Ref]
 getAllRefs' refdir = do
        let topsegs = length (splitPath refdir) - 1
-       let toref = Ref . joinPath . drop topsegs . splitPath
+       let toref = Ref . encodeBS' . joinPath . drop topsegs . splitPath
        map toref <$> dirContentsRecursive refdir
 
 explodePackedRefsFile :: Repo -> IO ()
@@ -257,8 +257,8 @@ packedRefsFile r = fromRawFilePath (localGitDir r) </> "packed-refs"
 parsePacked :: String -> Maybe (Sha, Ref)
 parsePacked l = case words l of
        (sha:ref:[])
-               | isJust (extractSha sha) && Ref.legal True ref ->
-                       Just (Ref sha, Ref ref)
+               | isJust (extractSha (encodeBS' sha)) && Ref.legal True ref ->
+                       Just (Ref (encodeBS' sha), Ref (encodeBS' ref))
        _ -> Nothing
 
 {- git-branch -d cannot be used to remove a branch that is directly
@@ -279,13 +279,13 @@ findUncorruptedCommit missing goodcommits branch r = do
        if ok
                then return (Just branch, goodcommits')
                else do
-                       (ls, cleanup) <- pipeNullSplit
+                       (ls, cleanup) <- pipeNullSplit'
                                [ Param "log"
                                , Param "-z"
                                , Param "--format=%H"
                                , Param (fromRef branch)
                                ] r
-                       let branchshas = catMaybes $ map (extractSha . decodeBL) ls
+                       let branchshas = catMaybes $ map extractSha ls
                        reflogshas <- RefLog.get branch r
                        -- XXX Could try a bit harder here, and look
                        -- for uncorrupted old commits in branches in the
@@ -328,8 +328,8 @@ verifyCommit missing goodcommits commit r
   where
        parse l = case words l of
                (commitsha:treesha:[]) -> (,)
-                       <$> extractSha commitsha
-                       <*> extractSha treesha
+                       <$> extractSha (encodeBS' commitsha)
+                       <*> extractSha (encodeBS' treesha)
                _ -> Nothing
        check [] = return True
        check ((c, t):rest)
@@ -448,7 +448,8 @@ preRepair g = do
                void $ tryIO $ allowWrite f
   where
        headfile = fromRawFilePath (localGitDir g) </> "HEAD"
-       validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s)
+       validhead s = "ref: refs/" `isPrefixOf` s
+               || isJust (extractSha (encodeBS' s))
 
 {- Put it all together. -}
 runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
index 9627ae969041a1838350e7bb2e31a6ceab5724a3..491314fff59f234c07481434179505634336bcff 100644 (file)
@@ -38,6 +38,7 @@ import System.Posix.Types
 import Control.Monad.IO.Class
 import qualified Data.Set as S
 import qualified Data.Map as M
+import qualified Data.ByteString.Char8 as S8
 
 newtype Tree = Tree [TreeContent]
        deriving (Show)
@@ -106,7 +107,7 @@ mkTree (MkTreeHandle cp) l = CoProcess.query cp send receive
                        NewSubTree _ _ -> error "recordSubTree internal error; unexpected NewSubTree"
                        TreeCommit f fm s -> mkTreeOutput fm CommitObject s f
                hPutStr h "\NUL" -- signal end of tree to --batch
-       receive h = getSha "mktree" (hGetLine h)
+       receive h = getSha "mktree" (S8.hGetLine h)
 
 treeMode :: FileMode
 treeMode = 0o040000
index 2100f1dcf9e86d65d2669c60810660e69e00ee13..2cf103dd9d1217785d288299e464c96cf5097b0a 100644 (file)
@@ -10,8 +10,10 @@ module Git.UnionMerge (
        mergeIndex
 ) where
 
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString.Char8 as S8
 import qualified Data.Set as S
 
 import Common
@@ -54,13 +56,13 @@ mergeIndex hashhandle ch repo bs = forM_ bs $ \b ->
 
 {- For merging two trees. -}
 mergeTrees :: Ref -> Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
-mergeTrees (Ref x) (Ref y) hashhandle ch = doMerge hashhandle ch
-       ("diff-tree":diffOpts ++ [x, y, "--"])
+mergeTrees x y hashhandle ch = doMerge hashhandle ch
+       ("diff-tree":diffOpts ++ [fromRef x, fromRef y, "--"])
 
 {- For merging a single tree into the index. -}
 mergeTreeIndex :: Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
-mergeTreeIndex (Ref r) hashhandle ch = doMerge hashhandle ch $
-       "diff-index" : diffOpts ++ ["--cached", r, "--"]
+mergeTreeIndex r hashhandle ch = doMerge hashhandle ch $
+       "diff-index" : diffOpts ++ ["--cached", fromRef r, "--"]
 
 diffOpts :: [String]
 diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
@@ -69,19 +71,19 @@ diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
  - using git to get a raw diff. -}
 doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer
 doMerge hashhandle ch differ repo streamer = do
-       (diff, cleanup) <- pipeNullSplit (map Param differ) repo
+       (diff, cleanup) <- pipeNullSplit' (map Param differ) repo
        go diff
        void $ cleanup
   where
        go [] = noop
-       go (info:file:rest) = mergeFile (decodeBL' info) (L.toStrict file) hashhandle ch >>=
+       go (info:file:rest) = mergeFile info file hashhandle ch >>=
                maybe (go rest) (\l -> streamer l >> go rest)
        go (_:[]) = error $ "parse error " ++ show differ
 
 {- Given an info line from a git raw diff, and the filename, generates
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
-mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
+mergeFile :: S.ByteString -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
 mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
        [] -> return Nothing
        (sha:[]) -> use sha
@@ -89,7 +91,7 @@ mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, R
                =<< either return (hashBlob hashhandle . L8.unlines)
                =<< calcMerge . zip shas <$> mapM getcontents shas
   where
-       [_colonmode, _bmode, asha, bsha, _status] = words info
+       [_colonmode, _bmode, asha, bsha, _status] = S8.words info
        use sha = return $ Just $
                updateIndexLine sha TreeFile $ asTopFilePath file
        -- Get file and split into lines to union merge.
index 73f6d4c6c0bc8049f50b5c021c166c283b39e20b..1f188ed08faeb1894ec15d0d2cb2097571c3407c 100644 (file)
@@ -43,7 +43,7 @@ readFsckResults u = do
        deserialize ("truncated":ls) = deserialize' ls True
        deserialize ls = deserialize' ls False
        deserialize' ls t =
-               let s = S.fromList $ map Ref ls
+               let s = S.fromList $ map (Ref . encodeBS') ls
                in if S.null s then FsckFailed else FsckFoundMissing s t
 
 clearFsckResults :: UUID -> Annex ()
index b14d065166314a5dacdf67cf82b25554a540c0be..ea28f29b556ffb332e5c2b8bedee87567b04e268 100644 (file)
@@ -9,6 +9,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Logs.View (
        currentView,
        setView,
@@ -31,6 +33,7 @@ import Logs.File
 import qualified Data.Text as T
 import qualified Data.Set as S
 import Data.Char
+import qualified Data.ByteString as B
 
 setView :: View -> Annex ()
 setView v = do
@@ -54,11 +57,11 @@ recentViews = do
 currentView :: Annex (Maybe View)
 currentView = go =<< inRepo Git.Branch.current
   where
-       go (Just b) | branchViewPrefix `isPrefixOf` fromRef b =
+       go (Just b) | branchViewPrefix `B.isPrefixOf` fromRef' b =
                headMaybe . filter (\v -> branchView v == b) <$> recentViews
        go _ = return Nothing
 
-branchViewPrefix :: String
+branchViewPrefix :: B.ByteString
 branchViewPrefix = "refs/heads/views"
 
 {- Generates a git branch name for a View.
@@ -68,10 +71,11 @@ branchViewPrefix = "refs/heads/views"
  -}
 branchView :: View -> Git.Branch
 branchView view
-       | null name = Git.Ref branchViewPrefix
-       | otherwise = Git.Ref $ branchViewPrefix ++ "/" ++ name
+       | B.null name = Git.Ref branchViewPrefix
+       | otherwise = Git.Ref $ branchViewPrefix <> "/" <> name
   where
-       name = intercalate ";" $ map branchcomp (viewComponents view)
+       name = encodeBS' $
+               intercalate ";" $ map branchcomp (viewComponents view)
        branchcomp c
                | viewVisible c = branchcomp' c
                | otherwise = "(" ++ branchcomp' c ++ ")"
@@ -92,7 +96,7 @@ branchView view
 is_branchView :: Git.Branch -> Bool
 is_branchView (Ref b)
        | b == branchViewPrefix = True
-       | otherwise = (branchViewPrefix ++ "/") `isPrefixOf` b
+       | otherwise = (branchViewPrefix <> "/") `B.isPrefixOf` b
 
 prop_branchView_legal :: View -> Bool
 prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
index 91c87018116ddbe53f4243e71815bbbaf4d78834..35e9ad91c79a6636dd1a0e18116db1a8d914785e 100644 (file)
@@ -343,7 +343,7 @@ extractRemoteGitConfig r remotename = do
                , remoteAnnexReadOnly = getbool "readonly" False
                , remoteAnnexCheckUUID = getbool "checkuuid" True
                , remoteAnnexVerify = getbool "verify" True
-               , remoteAnnexTrackingBranch = Git.Ref <$>
+               , remoteAnnexTrackingBranch = Git.Ref . encodeBS <$>
                        ( notempty (getmaybe "tracking-branch")
                        <|> notempty (getmaybe "export-tracking") -- old name
                        )
index 1185afd98208218e9beb15c3dcff3f2e43c6874f..5b3f9d906df972744b1c7ad125cf41f2ae27b011 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Types.View where
 
 import Annex.Common
index 1fcf8c4eebe0d7af792510c5fe4ae541ebd041aa..9af32e79ce74d69f70df2ec4b94720ace6770884 100644 (file)
@@ -59,7 +59,7 @@ setIndirect = do
 fromDirectBranch :: Ref -> Ref
 fromDirectBranch directhead = case splitc '/' $ fromRef directhead of
        ("refs":"heads":"annex":"direct":rest) -> 
-               Ref $ "refs/heads/" ++ intercalate "/" rest
+               Ref $ encodeBS' $ "refs/heads/" ++ intercalate "/" rest
        _ -> directhead
 
 switchHEADBack :: Annex ()