Ref ByteString conversion done

Test suite passes.
This commit is contained in:
Joey Hess 2020-04-07 17:41:09 -04:00
parent 6c81e0c8f1
commit c0cd07c36b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
22 changed files with 72 additions and 47 deletions

View file

@ -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"

View file

@ -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 = []
}

View file

@ -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]"

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"]

View file

@ -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