diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 1f1daecbc9..24f60b260d 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} module Annex.AdjustedBranch ( Adjustment(..), @@ -61,6 +61,7 @@ import qualified Database.Keys import Config import qualified Data.Map as M +import qualified Data.ByteString as S -- How to perform various adjustments to a TreeItem. class AdjustTreeItem t where @@ -128,7 +129,7 @@ newtype BasisBranch = BasisBranch Ref -- refs/basis/adjusted/master(unlocked). basisBranch :: AdjBranch -> BasisBranch basisBranch (AdjBranch adjbranch) = BasisBranch $ - Ref ("refs/basis/" ++ fromRef (Git.Ref.base adjbranch)) + Ref ("refs/basis/" <> fromRef' (Git.Ref.base adjbranch)) getAdjustment :: Branch -> Maybe Adjustment getAdjustment = fmap fst . adjustedToOriginal @@ -405,7 +406,8 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm <||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode) if merged then do - !mergecommit <- liftIO $ extractSha <$> readFile (tmpgit "HEAD") + !mergecommit <- liftIO $ extractSha + <$> S.readFile (tmpgit "HEAD") -- This is run after the commit lock is dropped. return $ postmerge mergecommit else return $ return False diff --git a/Annex/AdjustedBranch/Name.hs b/Annex/AdjustedBranch/Name.hs index 5987662b9a..d997e72309 100644 --- a/Annex/AdjustedBranch/Name.hs +++ b/Annex/AdjustedBranch/Name.hs @@ -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 ')') diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 91d0276daa..5870b6ad21 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.Branch ( fullname, name, @@ -29,7 +31,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 @@ -55,7 +59,7 @@ import qualified Git.LsTree import Git.LsTree (lsTreeParams) import qualified Git.HashObject import Annex.HashObject -import Git.Types (Ref(..), fromRef, RefDate, TreeItemType(..)) +import Git.Types (Ref(..), fromRef, fromRef', RefDate, TreeItemType(..)) import Git.FilePath import Annex.CatFile import Annex.Perms @@ -77,11 +81,11 @@ name = Git.Ref "git-annex" {- Fully qualified name of the branch. -} fullname :: Git.Ref -fullname = Git.Ref $ "refs/heads/" ++ fromRef name +fullname = Git.Ref $ "refs/heads/" <> fromRef' name {- Branch's name in origin. -} originname :: Git.Ref -originname = Git.Ref $ "origin/" ++ fromRef name +originname = Git.Ref $ "origin/" <> fromRef' name {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool @@ -327,9 +331,9 @@ commitIndex' jl branchref message basemessage retrynum parents = do where -- look for "parent ref" lines and return the refs commitparents = map (Git.Ref . snd) . filter isparent . - map (toassoc . decodeBL) . L.split newline + map (toassoc . L.toStrict) . L.split newline newline = fromIntegral (ord '\n') - toassoc = separate (== ' ') + toassoc = separate' (== (fromIntegral (ord ' '))) isparent (k,_) = k == "parent" {- The race can be detected by checking the commit's @@ -438,8 +442,8 @@ forceUpdateIndex jl branchref = do needUpdateIndex :: Git.Ref -> Annex Bool needUpdateIndex branchref = do f <- fromRepo gitAnnexIndexStatus - committedref <- Git.Ref . firstLine <$> - liftIO (catchDefaultIO "" $ readFileStrict f) + committedref <- Git.Ref . firstLine' <$> + liftIO (catchDefaultIO mempty $ B.readFile f) return (committedref /= branchref) {- Record that the branch's index has been updated to correspond to a @@ -621,11 +625,12 @@ ignoreRefs rs = do unlines $ map fromRef $ S.elems s getIgnoredRefs :: Annex (S.Set Git.Sha) -getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content +getIgnoredRefs = + S.fromList . mapMaybe Git.Sha.extractSha . B8.lines <$> content where content = do f <- fromRepo gitAnnexIgnoredRefs - liftIO $ catchDefaultIO "" $ readFile f + liftIO $ catchDefaultIO mempty $ B.readFile f addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex () addMergedRefs [] = return () @@ -643,11 +648,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, diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 786a193e55..3fb9d1ef1b 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -1,6 +1,6 @@ {- Waiting for changed git refs - - - Copyright 2014-216 Joey Hess + - Copyright 2014-2016 Joey Hess - - 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. diff --git a/Annex/Export.hs b/Annex/Export.hs index 16786476de..0d2ff65235 100644 --- a/Annex/Export.hs +++ b/Annex/Export.hs @@ -14,7 +14,6 @@ import Types.Key import qualified Git import qualified Types.Remote as Remote import Messages -import Utility.FileSystemEncoding import Control.Applicative import Data.Maybe @@ -34,7 +33,7 @@ exportKey sha = mk <$> catKey sha where mk (Just k) = AnnexKey k mk Nothing = GitKey $ mkKey $ \k -> k - { keyName = encodeBS $ Git.fromRef sha + { keyName = Git.fromRef' sha , keyVariety = SHA1Key (HasExt False) , keySize = Nothing , keyMtime = Nothing diff --git a/Annex/Import.hs b/Annex/Import.hs index e346ff210e..9d21a27aff 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -122,7 +122,9 @@ buildImportCommit remote importtreeconfig importcommitconfig importable = Nothing -> pure committedtree Just dir -> let subtreeref = Ref $ - fromRef committedtree ++ ":" ++ fromRawFilePath (getTopFilePath dir) + fromRef' committedtree + <> ":" + <> getTopFilePath dir in fromMaybe emptyTree <$> inRepo (Git.Ref.tree subtreeref) updateexportdb importedtree diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index b2368dba14..cde24cdb74 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.TaggedPush where import Annex.Common @@ -16,6 +18,8 @@ import qualified Git.Command import qualified Git.Branch import Utility.Base64 +import qualified Data.ByteString as S + {- Converts a git branch into a branch that is tagged with a UUID, typically - the UUID of the repo that will be pushing it, and possibly with other - information. @@ -31,11 +35,11 @@ import Utility.Base64 - refs, per git-check-ref-format. -} toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref -toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes +toTaggedBranch u info b = Git.Ref $ S.intercalate "/" $ catMaybes [ Just "refs/synced" , Just $ fromUUID u - , toB64 <$> info - , Just $ Git.fromRef $ Git.Ref.base b + , toB64' . encodeBS <$> info + , Just $ Git.fromRef' $ Git.Ref.base b ] fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String) diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index ac9435122a..49c3956f10 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -109,6 +109,6 @@ isAnnexBranch f = n `isSuffixOf` f n = '/' : Git.fromRef Annex.Branch.name fileToBranch :: FilePath -> Git.Ref -fileToBranch f = Git.Ref $ "refs" base +fileToBranch f = Git.Ref $ encodeBS' $ "refs" base where base = Prelude.last $ split "/refs/" f diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 80523b5e55..0956f59ba5 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -330,7 +330,7 @@ addLink :: FilePath -> FilePath -> Maybe Key -> Assistant (Maybe Change) addLink file link mk = do debug ["add symlink", file] liftAnnex $ do - v <- catObjectDetails $ Ref $ ':':file + v <- catObjectDetails $ Ref $ encodeBS' $ ':':file case v of Just (currlink, sha, _type) | s2w8 link == L.unpack currlink -> diff --git a/Command/Export.hs b/Command/Export.hs index f66c512d25..97c9014f51 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -37,6 +37,7 @@ import Utility.Tmp import Utility.Metered import Utility.Matcher +import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import Control.Concurrent @@ -112,7 +113,7 @@ getExportCommit r treeish return (fmap (tb, ) commitsha) | otherwise = return Nothing where - baseref = Ref $ takeWhile (/= ':') $ fromRef $ + baseref = Ref $ S8.takeWhile (/= ':') $ fromRef' $ Git.Ref.removeBase refsheads treeish refsheads = "refs/heads" diff --git a/Command/FindRef.hs b/Command/FindRef.hs index eb74928f4c..27dfcbe07a 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -22,6 +22,6 @@ seek o = Find.seek o' where o' = o { Find.keyOptions = Just $ WantBranchKeys $ - map Git.Ref (Find.findThese o) + map (Git.Ref . encodeBS') (Find.findThese o) , Find.findThese = [] } diff --git a/Command/Import.hs b/Command/Import.hs index 5447df5bff..5d1c87c320 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -66,7 +66,7 @@ optParser desc = do [bs] -> let (branch, subdir) = separate (== ':') bs in RemoteImportOptions r - (Ref branch) + (Ref (encodeBS' branch)) (if null subdir then Nothing else Just subdir) _ -> giveup "expected BRANCH[:SUBDIR]" diff --git a/Command/Info.hs b/Command/Info.hs index 3448ee6ef2..7df42fa39a 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -181,7 +181,7 @@ dirInfo o dir = showCustom (unwords ["info", dir]) $ do treeishInfo :: InfoOptions -> String -> Annex () treeishInfo o t = do - mi <- getTreeStatInfo o (Git.Ref t) + mi <- getTreeStatInfo o (Git.Ref (encodeBS' t)) case mi of Nothing -> noInfo t Just i -> showCustom (unwords ["info", t]) $ do diff --git a/Command/Log.hs b/Command/Log.hs index 5597bfbf47..b2a7ea7e12 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -264,7 +264,8 @@ parseGitRawLog config = parse epoch parseRawChangeLine :: String -> Maybe (Git.Ref, Git.Ref) parseRawChangeLine = go . words where - go (_:_:oldsha:newsha:_) = Just (Git.Ref oldsha, Git.Ref newsha) + go (_:_:oldsha:newsha:_) = + Just (Git.Ref (encodeBS oldsha), Git.Ref (encodeBS newsha)) go _ = Nothing parseTimeStamp :: String -> POSIXTime diff --git a/Command/Merge.hs b/Command/Merge.hs index fe1119dc8a..ed075ad876 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -26,7 +26,7 @@ seek [] = do commandAction mergeSyncedBranch seek bs = do prepMerge - forM_ bs (commandAction . mergeBranch . Git.Ref) + forM_ bs (commandAction . mergeBranch . Git.Ref . encodeBS') mergeAnnexBranch :: CommandStart mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index e3d9829be8..10f5f98901 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -13,6 +13,8 @@ import Git.Sha import qualified Git.Branch import Annex.AutoMerge +import qualified Data.ByteString as S + cmd :: Command cmd = command "resolvemerge" SectionPlumbing "resolve merge conflicts" @@ -27,7 +29,7 @@ start = starting "resolvemerge" (ActionItemOther Nothing) $ do d <- fromRawFilePath <$> fromRepo Git.localGitDir let merge_head = d "MERGE_HEAD" them <- fromMaybe (error nomergehead) . extractSha - <$> liftIO (readFile merge_head) + <$> liftIO (S.readFile merge_head) ifM (resolveMerge (Just us) them False) ( do void $ commitResolvedMerge Git.Branch.ManualCommit diff --git a/Command/Sync.hs b/Command/Sync.hs index 49ec61cb52..42afe518a9 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -72,6 +72,8 @@ import Utility.Process.Transcript import Control.Concurrent.MVar import qualified Data.Map as M +import qualified Data.ByteString as S +import Data.Char cmd :: Command cmd = withGlobalOptions [jobsOption] $ @@ -444,11 +446,11 @@ importRemote o mergeconfig remote currbranch | otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of Nothing -> noop Just tb -> do - let (b, s) = separate (== ':') (Git.fromRef tb) + let (b, p) = separate' (== (fromIntegral (ord ':'))) (Git.fromRef' tb) let branch = Git.Ref b - let subdir = if null s + let subdir = if S.null p then Nothing - else Just (asTopFilePath (toRawFilePath s)) + else Just (asTopFilePath p) Command.Import.seekRemote remote branch subdir void $ mergeRemote remote currbranch mergeconfig o where diff --git a/Command/Uninit.hs b/Command/Uninit.hs index c64d4aa2dc..db7d25a7a8 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -35,7 +35,7 @@ check = do whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ giveup "can only run uninit from the top of the git repository" where - current_branch = Git.Ref . Prelude.head . lines . decodeBS' <$> revhead + current_branch = Git.Ref . encodeBS' . Prelude.head . lines . decodeBS' <$> revhead revhead = inRepo $ Git.Command.pipeReadStrict [Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] diff --git a/Command/Unused.hs b/Command/Unused.hs index b68452d5c8..4b2de82597 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -5,12 +5,10 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} module Command.Unused where -import qualified Data.Map as M - import Command import Logs.Unused import Annex.Content @@ -37,6 +35,11 @@ import Annex.BloomFilter import qualified Database.Keys import Annex.InodeSentinal +import qualified Data.Map as M +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import Data.Char + cmd :: Command cmd = command "unused" SectionMaintenance "look for unused file content" paramNothing (seek <$$> optParser) @@ -221,8 +224,7 @@ withKeysReferenced' mdir initial a = do withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex () withKeysReferencedDiffGitRefs refspec a = do - rs <- relevantrefs . decodeBS' - <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) + rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha) =<< inRepo Git.Branch.currentUnsafe let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs @@ -233,12 +235,12 @@ withKeysReferencedDiffGitRefs refspec a = do where relevantrefs = map (\(r, h) -> (Git.Ref r, Git.Ref h)) . filter ourbranches . - map (separate (== ' ')) . - lines + map (separate' (== (fromIntegral (ord ' ')))) . + S8.lines nubRefs = nubBy (\(x, _) (y, _) -> x == y) - ourbranchend = '/' : Git.fromRef Annex.Branch.name - ourbranches (_, b) = not (ourbranchend `isSuffixOf` b) - && not ("refs/synced/" `isPrefixOf` b) + ourbranchend = S.cons (fromIntegral (ord '/')) (Git.fromRef' Annex.Branch.name) + ourbranches (_, b) = not (ourbranchend `S.isSuffixOf` b) + && not ("refs/synced/" `S.isPrefixOf` b) && not (is_branchView (Git.Ref b)) getreflog rs = inRepo $ Git.RefLog.getMulti rs diff --git a/Database/Keys.hs b/Database/Keys.hs index b1650b286c..25954ba71a 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -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 diff --git a/Database/Types.hs b/Database/Types.hs index ac6aad2748..561972284a 100644 --- a/Database/Types.hs +++ b/Database/Types.hs @@ -28,6 +28,7 @@ import Foreign.C.Types import Key import Utility.InodeCache import Utility.FileSize +import Utility.FileSystemEncoding import Git.Types import Types.UUID import Types.Import @@ -94,10 +95,10 @@ newtype SSha = SSha String deriving (Eq, Show) toSSha :: Sha -> SSha -toSSha (Ref s) = SSha s +toSSha (Ref s) = SSha (decodeBS' s) fromSSha :: SSha -> Ref -fromSSha (SSha s) = Ref s +fromSSha (SSha s) = Ref (encodeBS' s) instance PersistField SSha where toPersistValue (SSha b) = toPersistValue b 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/Branch.hs b/Git/Branch.hs index 699fbf50e1..fcae905f64 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -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 diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 980d289840..68850f075c 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -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 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 ' ') diff --git a/Git/Command.hs b/Git/Command.hs index eb20af2dc9..15157a08a5 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -81,11 +81,16 @@ pipeReadStrict' reader params repo = assertLocal repo $ {- Runs a git command, feeding it an input, and returning its output, - which is expected to be fairly small, since it's all read into memory - strictly. -} -pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO String +pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO S.ByteString pipeWriteRead params writer repo = assertLocal repo $ writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) - (gitEnv repo) writer (Just adjusthandle) + (gitEnv repo) writer' where + writer' = case writer of + Nothing -> Nothing + Just a -> Just $ \h -> do + adjusthandle h + a h adjusthandle h = hSetNewlineMode h noNewlineTranslation {- Runs a git command, feeding it input on a handle with an action. -} diff --git a/Git/Credential.hs b/Git/Credential.hs index 9465d27963..2f926b0323 100644 --- a/Git/Credential.hs +++ b/Git/Credential.hs @@ -58,7 +58,7 @@ urlCredential = Credential . M.singleton "url" runCredential :: String -> Credential -> Repo -> IO Credential runCredential action input r = - parseCredential <$> pipeWriteRead + parseCredential . decodeBS <$> pipeWriteRead [ Param "credential" , Param action ] diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index bfd1a7a1bc..c566de3fd3 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. -} @@ -17,7 +17,9 @@ module Git.DiffTree ( commitDiff, ) 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 +29,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 +92,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 +103,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 66a015994e..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) = - encodeBS' (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/Fsck.hs b/Git/Fsck.hs index 6f33e11991..69a9e9f81e 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -139,7 +139,8 @@ isMissing s r = either (const True) (const False) <$> tryIO dump ] r findShas :: [String] -> [Sha] -findShas = catMaybes . map extractSha . concat . map words . filter wanted +findShas = catMaybes . map (extractSha . encodeBS') + . concat . map words . filter wanted where wanted l = not ("dangling " `isPrefixOf` l) diff --git a/Git/HashObject.hs b/Git/HashObject.hs index 3787c9cb57..bcad9a1109 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -18,6 +18,7 @@ import qualified Utility.CoProcess as CoProcess import Utility.Tmp import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder @@ -39,7 +40,7 @@ hashFile :: HashObjectHandle -> FilePath -> IO Sha hashFile h file = CoProcess.query h send receive where send to = hPutStrLn to =<< absPath file - receive from = getSha "hash-object" $ hGetLine from + receive from = getSha "hash-object" $ S8.hGetLine from class HashableBlob t where hashableBlobToHandle :: Handle -> t -> IO () diff --git a/Git/History.hs b/Git/History.hs index 6706497317..1b7127229b 100644 --- a/Git/History.hs +++ b/Git/History.hs @@ -15,6 +15,9 @@ import Git.Command import Git.Sha import qualified Data.Set as S +import qualified Data.ByteString.Lazy as L +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) @@ -53,8 +56,9 @@ getHistoryToDepth n commit r = do !h <- fmap (truncateHistoryToDepth n) . build Nothing . map parsehistorycommit - . lines - <$> hGetContents inh + . map L.toStrict + . L8.lines + <$> L.hGetContents inh hClose inh void $ waitForProcess pid return h @@ -93,7 +97,7 @@ getHistoryToDepth n commit r = do , Param "--format=%T %H %P" ] - parsehistorycommit l = case map extractSha (splitc ' ' l) of + parsehistorycommit l = case map extractSha (B8.split ' ' l) of (Just t:Just c:ps) -> Just $ ( HistoryCommit { historyCommit = c diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 31a74d4283..830b5f5bfe 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -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. -} @@ -284,7 +285,7 @@ parseUnmerged s then Nothing else do treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype) - sha <- extractSha rawsha + sha <- extractSha (encodeBS' rawsha) return $ InternalUnmerged (stage == 2) (toRawFilePath file) (Just treeitemtype) (Just sha) _ -> Nothing diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 5175c39024..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) diff --git a/Git/Objects.hs b/Git/Objects.hs index c9ede4da9a..6a240875e0 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -26,7 +26,7 @@ listPackFiles r = filter (".pack" `isSuffixOf`) listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $ - mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories) + mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories) <$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r) looseObjectFile :: Repo -> Sha -> FilePath diff --git a/Git/Ref.hs b/Git/Ref.hs index 621e328f27..104a1db715 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" @@ -25,7 +26,7 @@ headFile :: Repo -> FilePath headFile r = fromRawFilePath (localGitDir r) "HEAD" setHeadRef :: Ref -> Repo -> IO () -setHeadRef ref r = writeFile (headFile r) ("ref: " ++ fromRef ref) +setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref) {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String @@ -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. -} @@ -154,13 +160,17 @@ delete oldvalue ref = run - The ref may be something like a branch name, and it could contain - ":subdir" if a subtree is wanted. -} tree :: Ref -> Repo -> IO (Maybe Sha) -tree (Ref ref) = extractSha . decodeBS <$$> pipeReadStrict - [ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ] +tree (Ref ref) = extractSha <$$> pipeReadStrict + [ Param "rev-parse" + , Param "--verify" + , Param "--quiet" + , Param (decodeBS' ref') + ] where - ref' = if ":" `isInfixOf` ref + ref' = if ":" `S.isInfixOf` ref then ref -- de-reference commit objects to the tree - else ref ++ ":" + else ref <> ":" {- Checks if a String is a legal git ref name. - diff --git a/Git/RefLog.hs b/Git/RefLog.hs index 7ba8713af7..b98833c391 100644 --- a/Git/RefLog.hs +++ b/Git/RefLog.hs @@ -12,6 +12,9 @@ import Git import Git.Command import Git.Sha +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 + {- Gets the reflog for a given branch. -} get :: Branch -> Repo -> IO [Sha] get b = getMulti [b] @@ -21,7 +24,7 @@ getMulti :: [Branch] -> Repo -> IO [Sha] getMulti bs = get' (map (Param . fromRef) bs) get' :: [CommandParam] -> Repo -> IO [Sha] -get' ps = mapMaybe extractSha . lines . decodeBS <$$> pipeReadStrict ps' +get' ps = mapMaybe (extractSha . S.copy) . S8.lines <$$> pipeReadStrict ps' where ps' = catMaybes [ Just $ Param "log" diff --git a/Git/Repair.hs b/Git/Repair.hs index 10ea6a8ddc..f7a91ca0fe 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -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]) diff --git a/Git/Sha.hs b/Git/Sha.hs index 24fe546192..a66c34ee2c 100644 --- a/Git/Sha.hs +++ b/Git/Sha.hs @@ -5,31 +5,43 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Git.Sha where import Common import Git.Types +import qualified Data.ByteString as S +import Data.Char + {- Runs an action that causes a git subcommand to emit a Sha, and strips - any trailing newline, returning the sha. -} -getSha :: String -> IO String -> IO Sha +getSha :: String -> IO S.ByteString -> IO Sha getSha subcommand a = maybe bad return =<< extractSha <$> a where bad = error $ "failed to read sha from git " ++ subcommand -{- Extracts the Sha from a string. There can be a trailing newline after - - it, but nothing else. -} -extractSha :: String -> Maybe Sha +{- Extracts the Sha from a ByteString. + - + - There can be a trailing newline after it, but nothing else. + -} +extractSha :: S.ByteString -> Maybe Sha extractSha s | len `elem` shaSizes = val s - | len - 1 `elem` shaSizes && length s' == len - 1 = val s' + | len - 1 `elem` shaSizes && S.length s' == len - 1 = val s' | otherwise = Nothing where - len = length s - s' = firstLine s + len = S.length s + s' = firstLine' s val v - | all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v + | S.all validinsha v = Just $ Ref v | otherwise = Nothing + validinsha w = or + [ w >= 48 && w <= 57 -- 0-9 + , w >= 97 && w <= 102 -- a-f + , w >= 65 && w <= 70 -- A-F + ] {- Sizes of git shas. -} shaSizes :: [Int] @@ -41,7 +53,9 @@ shaSizes = {- Git plumbing often uses a all 0 sha to represent things like a - deleted file. -} nullShas :: [Sha] -nullShas = map (\n -> Ref (replicate n '0')) shaSizes +nullShas = map (\n -> Ref (S.replicate n zero)) shaSizes + where + zero = fromIntegral (ord '0') {- Sha to provide to git plumbing when deleting a file. - diff --git a/Git/Tree.hs b/Git/Tree.hs index 9627ae9690..491314fff5 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -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 diff --git a/Git/Types.hs b/Git/Types.hs index 9c2754a7d3..6e4558d8fd 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -81,11 +81,14 @@ instance IsString ConfigValue where type RemoteName = String {- A git ref. Can be a sha1, or a branch or tag name. -} -newtype Ref = Ref String +newtype Ref = Ref S.ByteString deriving (Eq, Ord, Read, Show) fromRef :: Ref -> String -fromRef (Ref s) = s +fromRef = decodeBS' . fromRef' + +fromRef' :: Ref -> S.ByteString +fromRef' (Ref s) = s {- Aliases for Ref. -} type Branch = Ref diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index 2100f1dcf9..2cf103dd9d 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -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. diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 68dc8b7097..f0331d5c1f 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -75,14 +75,14 @@ lsTree (Ref x) repo streamer = do mapM_ streamer s void $ cleanup where - params = map Param ["ls-tree", "-z", "-r", "--full-tree", x] + params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x] lsSubTree :: Ref -> FilePath -> Repo -> Streamer lsSubTree (Ref x) p repo streamer = do (s, cleanup) <- pipeNullSplit params repo mapM_ streamer s void $ cleanup where - params = map Param ["ls-tree", "-z", "-r", "--full-tree", x, p] + params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x, p] {- Generates a line suitable to be fed into update-index, to add - a given file with a given sha. -} @@ -90,7 +90,7 @@ updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> L.ByteString updateIndexLine sha treeitemtype file = L.fromStrict $ fmtTreeItemType treeitemtype <> " blob " - <> encodeBS (fromRef sha) + <> fromRef' sha <> "\t" <> indexPath file @@ -108,7 +108,7 @@ unstageFile file repo = do unstageFile' :: TopFilePath -> Streamer unstageFile' p = pureStreamer $ L.fromStrict $ "0 " - <> encodeBS' (fromRef deleteSha) + <> fromRef' deleteSha <> "\t" <> indexPath p diff --git a/Logs/Export.hs b/Logs/Export.hs index aadd1b9c4a..586c789e86 100644 --- a/Logs/Export.hs +++ b/Logs/Export.hs @@ -158,12 +158,12 @@ buildExported exported = go (exportedTreeish exported : incompleteExportedTreeis where go [] = mempty go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ] - rref r = byteString (encodeBS' (Git.fromRef r)) + rref = byteString . Git.fromRef' exportedParser :: A.Parser Exported exportedParser = Exported <$> refparser <*> many refparser where - refparser = (Git.Ref . decodeBS <$> A8.takeWhile1 (/= ' ') ) + refparser = (Git.Ref <$> A8.takeWhile1 (/= ' ') ) <* ((const () <$> A8.char ' ') <|> A.endOfInput) logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index 73f6d4c6c0..1f188ed08f 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -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 () diff --git a/Logs/View.hs b/Logs/View.hs index b14d065166..ea28f29b55 100644 --- a/Logs/View.hs +++ b/Logs/View.hs @@ -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 diff --git a/Test.hs b/Test.hs index 29f891dc4e..04d36424e9 100644 --- a/Test.hs +++ b/Test.hs @@ -1664,7 +1664,7 @@ test_add_subdirs = intmpclonerepo $ do unlessM (hasUnlockedFiles <$> getTestMode) $ do git_annex "sync" [] @? "sync failed" l <- annexeval $ Utility.FileSystemEncoding.decodeBL - <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") + <$> Annex.CatFile.catObject (Git.Types.Ref (encodeBS "HEAD:dir/foo")) "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) createDirectory "dir2" diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 91c8701811..35e9ad91c7 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -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 ) diff --git a/Types/RefSpec.hs b/Types/RefSpec.hs index 8479a69a6b..0f3dded9d9 100644 --- a/Types/RefSpec.hs +++ b/Types/RefSpec.hs @@ -32,7 +32,7 @@ parseRefSpec v = case partitionEithers (map mk $ splitc ':' v) of mk ('+':s) | any (`elem` s) "*?" = Right $ AddMatching $ compileGlob s CaseSensative - | otherwise = Right $ AddRef $ Ref s + | otherwise = Right $ AddRef $ Ref $ encodeBS s mk ('-':s) = Right $ RemoveMatching $ compileGlob s CaseSensative mk "reflog" = Right AddRefLog mk s = Left $ "bad refspec item \"" ++ s ++ "\" (expected + or - prefix)" diff --git a/Types/View.hs b/Types/View.hs index 1185afd982..5b3f9d906d 100644 --- a/Types/View.hs +++ b/Types/View.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Types.View where import Annex.Common diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 4a70a05d1a..24d92e4ffc 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -92,7 +92,8 @@ logFiles dir = return . filter (".log" `isSuffixOf`) push :: Annex () push = do - origin_master <- inRepo $ Git.Ref.exists $ Git.Ref "origin/master" + origin_master <- inRepo $ Git.Ref.exists $ + Git.Ref $ encodeBS' "origin/master" origin_gitannex <- Annex.Branch.hasOrigin case (origin_master, origin_gitannex) of (_, True) -> do diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index 1fcf8c4eeb..9af32e79ce 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -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 () 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') diff --git a/Utility/Process.hs b/Utility/Process.hs index af3a5f4f62..e7142b9ecb 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -1,7 +1,7 @@ {- System.Process enhancements, including additional ways of running - processes, and logging. - - - Copyright 2012-2015 Joey Hess + - Copyright 2012-2020 Joey Hess - - License: BSD-2-clause -} @@ -53,6 +53,7 @@ import System.Log.Logger import Control.Concurrent import qualified Control.Exception as E import Control.Monad +import qualified Data.ByteString as S type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a @@ -85,25 +86,20 @@ writeReadProcessEnv -> [String] -> Maybe [(String, String)] -> (Maybe (Handle -> IO ())) - -> (Maybe (Handle -> IO ())) - -> IO String -writeReadProcessEnv cmd args environ writestdin adjusthandle = do + -> IO S.ByteString +writeReadProcessEnv cmd args environ writestdin = do (Just inh, Just outh, _, pid) <- createProcess p - maybe (return ()) (\a -> a inh) adjusthandle - maybe (return ()) (\a -> a outh) adjusthandle - -- fork off a thread to start consuming the output - output <- hGetContents outh outMVar <- newEmptyMVar - _ <- forkIO $ E.evaluate (length output) >> putMVar outMVar () + _ <- forkIO $ putMVar outMVar =<< S.hGetContents outh -- now write and flush any input maybe (return ()) (\a -> a inh >> hFlush inh) writestdin hClose inh -- done with stdin -- wait on the output - takeMVar outMVar + output <- takeMVar outMVar hClose outh -- wait on the process diff --git a/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn b/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn index 6434c4de3d..8b9f79c2da 100644 --- a/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn +++ b/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn @@ -3,3 +3,9 @@ to contain a ByteString, rather than a String, would eliminate a fromRawFilePath that uses about 1% of runtime. [[!tag confirmed]] + +> Well, I did the conversion. Running that command does not seem to have +> sped up by any appreciable amount. But, I did notice several places where +> using ByteString is certainly more efficient. It may just be that it +> doesn't matter if git-annex is IO bound etc. Still, glad I did it. +> [[done]] --[[Joey]]