Ref ByteString conversion done
Test suite passes.
This commit is contained in:
parent
6c81e0c8f1
commit
c0cd07c36b
22 changed files with 72 additions and 47 deletions
|
@ -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"
|
||||
|
||||
|
|
|
@ -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 = []
|
||||
}
|
||||
|
|
|
@ -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]"
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue