aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Branch.hs16
-rw-r--r--Annex/Direct.hs6
-rw-r--r--Annex/TaggedPush.hs6
-rw-r--r--Annex/View.hs2
-rw-r--r--Assistant/Threads/Merger.hs8
-rw-r--r--Assistant/Types/NetMessager.hs4
-rw-r--r--Assistant/XMPP.hs3
-rw-r--r--Command/Log.hs2
-rw-r--r--Command/Repair.hs2
-rw-r--r--Command/Sync.hs10
-rw-r--r--Command/Uninit.hs4
-rw-r--r--Command/Unused.hs2
-rw-r--r--Command/VPop.hs3
-rw-r--r--Command/View.hs2
-rw-r--r--Git.hs1
-rw-r--r--Git/Branch.hs20
-rw-r--r--Git/CatFile.hs8
-rw-r--r--Git/DiffTree.hs6
-rw-r--r--Git/Fsck.hs2
-rw-r--r--Git/LsTree.hs4
-rw-r--r--Git/Merge.hs4
-rw-r--r--Git/Objects.hs2
-rw-r--r--Git/Ref.hs20
-rw-r--r--Git/RefLog.hs2
-rw-r--r--Git/Repair.hs24
-rw-r--r--Git/Types.hs6
-rw-r--r--Git/UpdateIndex.hs4
-rw-r--r--Logs/FsckResults.hs2
-rw-r--r--Logs/View.hs17
-rw-r--r--Remote/GCrypt.hs2
-rw-r--r--Types/View.hs6
-rw-r--r--Upgrade/V2.hs5
32 files changed, 101 insertions, 104 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index fe505a048..94c4c029c 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -58,11 +58,11 @@ name = Git.Ref "git-annex"
{- Fully qualified name of the branch. -}
fullname :: Git.Ref
-fullname = Git.Ref $ "refs/heads/" ++ show name
+fullname = Git.Ref $ "refs/heads/" ++ fromRef name
{- Branch's name in origin. -}
originname :: Git.Ref
-originname = Git.Ref $ "origin/" ++ show name
+originname = Git.Ref $ "origin/" ++ fromRef name
{- Does origin/git-annex exist? -}
hasOrigin :: Annex Bool
@@ -87,8 +87,8 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
where
go True = do
inRepo $ Git.Command.run
- [Param "branch", Param $ show name, Param $ show originname]
- fromMaybe (error $ "failed to create " ++ show name)
+ [Param "branch", Param $ fromRef name, Param $ fromRef originname]
+ fromMaybe (error $ "failed to create " ++ fromRef name)
<$> branchsha
go False = withIndex' True $
inRepo $ Git.Branch.commitAlways "branch created" fullname []
@@ -154,7 +154,7 @@ updateTo pairs = do
then "update"
else "merging " ++
unwords (map Git.Ref.describe branches) ++
- " into " ++ show name
+ " into " ++ fromRef name
localtransitions <- parseTransitionsStrictly "local"
<$> getLocal transitionsLog
unless (null branches) $ do
@@ -291,7 +291,7 @@ files = do
branchFiles :: Annex [FilePath]
branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie
[ Params "ls-tree --name-only -r -z"
- , Param $ show fullname
+ , Param $ fromRef fullname
]
{- Populates the branch's index file with the current branch contents.
@@ -368,7 +368,7 @@ needUpdateIndex branchref = do
setIndexSha :: Git.Ref -> Annex ()
setIndexSha ref = do
f <- fromRepo gitAnnexIndexStatus
- liftIO $ writeFile f $ show ref ++ "\n"
+ liftIO $ writeFile f $ fromRef ref ++ "\n"
setAnnexFilePerm f
{- Stages the journal into the index and returns an action that will
@@ -442,7 +442,7 @@ ignoreRefs rs = do
let s = S.unions [old, S.fromList rs]
f <- fromRepo gitAnnexIgnoredRefs
replaceFile f $ \tmp -> liftIO $ writeFile tmp $
- unlines $ map show $ S.elems s
+ unlines $ map fromRef $ S.elems s
getIgnoredRefs :: Annex (S.Set Git.Ref)
getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 495ce0d60..4a23fcc6c 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -286,18 +286,18 @@ setDirect wantdirect = do
- this way things that show HEAD (eg shell prompts) will
- hopefully show just "master". -}
directBranch :: Ref -> Ref
-directBranch orighead = case split "/" $ show orighead of
+directBranch orighead = case split "/" $ fromRef orighead of
("refs":"heads":"annex":"direct":_) -> orighead
("refs":"heads":rest) ->
Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest
- _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead)
+ _ -> Ref $ "refs/heads/" ++ fromRef (Git.Ref.base orighead)
{- Converts a directBranch back to the original branch.
-
- Any other ref is left unchanged.
-}
fromDirectBranch :: Ref -> Ref
-fromDirectBranch directhead = case split "/" $ show directhead of
+fromDirectBranch directhead = case split "/" $ fromRef directhead of
("refs":"heads":"annex":"direct":rest) ->
Ref $ "refs/heads/" ++ intercalate "/" rest
_ -> directhead
diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs
index 039dc0e17..35fdf333c 100644
--- a/Annex/TaggedPush.hs
+++ b/Annex/TaggedPush.hs
@@ -35,11 +35,11 @@ toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes
[ Just "refs/synced"
, Just $ fromUUID u
, toB64 <$> info
- , Just $ show $ Git.Ref.base b
+ , Just $ Git.fromRef $ Git.Ref.base b
]
fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String)
-fromTaggedBranch b = case split "/" $ show b of
+fromTaggedBranch b = case split "/" $ Git.fromRef b of
("refs":"synced":u:info:_base) ->
Just (toUUID u, fromB64Maybe info)
("refs":"synced":u:_base) ->
@@ -58,4 +58,4 @@ taggedPush u info branch remote = Git.Command.runBool
, Param $ refspec branch
]
where
- refspec b = show b ++ ":" ++ show (toTaggedBranch u info b)
+ refspec b = Git.fromRef b ++ ":" ++ Git.fromRef (toTaggedBranch u info b)
diff --git a/Annex/View.hs b/Annex/View.hs
index d407ce4c9..cc2aad5b9 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -310,7 +310,7 @@ genViewBranch :: View -> Annex () -> Annex Git.Branch
genViewBranch view a = withIndex $ do
a
let branch = branchView view
- void $ inRepo $ Git.Branch.commit True (show branch) branch []
+ void $ inRepo $ Git.Branch.commit True (fromRef branch) branch []
return branch
{- Runs an action using the view index file.
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index 3f4fcb0cc..8c406990a 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -80,8 +80,8 @@ onChange file
mergecurrent (Just current)
| equivBranches changedbranch current = do
debug
- [ "merging", show changedbranch
- , "into", show current
+ [ "merging", Git.fromRef changedbranch
+ , "into", Git.fromRef current
]
void $ liftAnnex $ Command.Sync.mergeFrom changedbranch
mergecurrent _ = noop
@@ -105,12 +105,12 @@ onChange file
equivBranches :: Git.Ref -> Git.Ref -> Bool
equivBranches x y = base x == base y
where
- base = takeFileName . show
+ base = takeFileName . Git.fromRef
isAnnexBranch :: FilePath -> Bool
isAnnexBranch f = n `isSuffixOf` f
where
- n = '/' : show Annex.Branch.name
+ n = '/' : Git.fromRef Annex.Branch.name
fileToBranch :: FilePath -> Git.Ref
fileToBranch f = Git.Ref $ "refs" </> base
diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs
index 0af262e9a..41ab4b272 100644
--- a/Assistant/Types/NetMessager.hs
+++ b/Assistant/Types/NetMessager.hs
@@ -32,7 +32,7 @@ data NetMessage
| PairingNotification PairStage ClientID UUID
-- used for git push over the network messager
| Pushing ClientID PushStage
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord, Show)
{- Something used to identify the client, or clients to send the message to. -}
type ClientID = Text
@@ -50,7 +50,7 @@ data PushStage
| SendPackOutput SequenceNum ByteString
-- sent when git receive-pack exits, with its exit code
| ReceivePackDone ExitCode
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord, Show)
{- A sequence number. Incremented by one per packet in a sequence,
- starting with 1 for the first packet. 0 means sequence numbers are
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index 09b7daf4e..e74705021 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -13,6 +13,7 @@ import Assistant.Common
import Assistant.Types.NetMessager
import Assistant.Pairing
import Git.Sha (extractSha)
+import Git
import Network.Protocol.XMPP hiding (Node)
import Data.Text (Text)
@@ -152,7 +153,7 @@ pushMessage = gitAnnexMessage . encode
where
encode (CanPush u shas) =
gitAnnexTag canPushAttr $ T.pack $ unwords $
- fromUUID u : map show shas
+ fromUUID u : map fromRef shas
encode (PushRequest u) =
gitAnnexTag pushRequestAttr $ T.pack $ fromUUID u
encode (StartingPush u) =
diff --git a/Command/Log.hs b/Command/Log.hs
index 1dd5aa51a..84583a93a 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -140,7 +140,7 @@ getLog key os = do
[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
, Param "--remove-empty"
] ++ os ++
- [ Param $ show Annex.Branch.fullname
+ [ Param $ Git.fromRef Annex.Branch.fullname
, Param "--"
, Param logfile
]
diff --git a/Command/Repair.hs b/Command/Repair.hs
index c87317685..56925d83d 100644
--- a/Command/Repair.hs
+++ b/Command/Repair.hs
@@ -81,4 +81,4 @@ trackingOrSyncBranch :: Ref -> Bool
trackingOrSyncBranch b = Git.Repair.isTrackingBranch b || isAnnexSyncBranch b
isAnnexSyncBranch :: Ref -> Bool
-isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` show b
+isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` fromRef b
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 90b9a6c79..f041b5d23 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -192,12 +192,12 @@ pushLocal (Just branch) = do
updateBranch :: Git.Ref -> Git.Repo -> IO ()
updateBranch syncbranch g =
- unlessM go $ error $ "failed to update " ++ show syncbranch
+ unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
where
go = Git.Command.runBool
[ Param "branch"
, Param "-f"
- , Param $ show $ Git.Ref.base syncbranch
+ , Param $ Git.fromRef $ Git.Ref.base syncbranch
] g
pullRemote :: Remote -> Maybe Git.Ref -> CommandStart
@@ -283,15 +283,15 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
, refspec branch
]
directpush = Git.Command.runQuiet $ pushparams
- [show $ Git.Ref.base $ fromDirectBranch branch]
+ [Git.fromRef $ Git.Ref.base $ fromDirectBranch branch]
pushparams branches =
[ Param "push"
, Param $ Remote.name remote
] ++ map Param branches
refspec b = concat
- [ show $ Git.Ref.base b
+ [ Git.fromRef $ Git.Ref.base b
, ":"
- , show $ Git.Ref.base $ syncBranch b
+ , Git.fromRef $ Git.Ref.base $ syncBranch b
]
commitAnnex :: CommandStart
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 3bf6dbe00..1c8d08689 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -24,7 +24,7 @@ check :: Annex ()
check = do
b <- current_branch
when (b == Annex.Branch.name) $ error $
- "cannot uninit when the " ++ show b ++ " branch is checked out"
+ "cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
top <- fromRepo Git.repoPath
cwd <- liftIO getCurrentDirectory
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $
@@ -77,7 +77,7 @@ finish = do
-- avoid normal shutdown
saveState False
inRepo $ Git.Command.run
- [Param "branch", Param "-D", Param $ show Annex.Branch.name]
+ [Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name]
liftIO exitSuccess
{- Keys that were moved out of the annex have a hard link still in the
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 312c26adf..d48956920 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -266,7 +266,7 @@ withKeysReferencedInGit a = do
map (separate (== ' ')) .
lines
nubRefs = map (Git.Ref . snd) . nubBy (\(x, _) (y, _) -> x == y)
- ourbranchend = '/' : show Annex.Branch.name
+ ourbranchend = '/' : Git.fromRef Annex.Branch.name
ourbranches (_, b) = not (ourbranchend `isSuffixOf` b)
&& not ("refs/synced/" `isPrefixOf` b)
addHead headRef refs = case headRef of
diff --git a/Command/VPop.hs b/Command/VPop.hs
index c95701580..baa52a98f 100644
--- a/Command/VPop.hs
+++ b/Command/VPop.hs
@@ -9,6 +9,7 @@ module Command.VPop where
import Common.Annex
import Command
+import qualified Git
import qualified Git.Command
import qualified Git.Ref
import Types.View
@@ -41,7 +42,7 @@ start ps = go =<< currentView
showOutput
inRepo $ Git.Command.runBool
[ Param "checkout"
- , Param $ show $ Git.Ref.base $
+ , Param $ Git.fromRef $ Git.Ref.base $
viewParentBranch v
]
sameparentbranch a b = viewParentBranch a == viewParentBranch b
diff --git a/Command/View.hs b/Command/View.hs
index 5c1742855..5895ba08f 100644
--- a/Command/View.hs
+++ b/Command/View.hs
@@ -73,7 +73,7 @@ checkoutViewBranch view mkbranch = do
showOutput
ok <- inRepo $ Git.Command.runBool
[ Param "checkout"
- , Param (show $ Git.Ref.base branch)
+ , Param (Git.fromRef $ Git.Ref.base branch)
]
when ok $ do
setView view
diff --git a/Git.hs b/Git.hs
index cad466853..55b44a925 100644
--- a/Git.hs
+++ b/Git.hs
@@ -13,6 +13,7 @@
module Git (
Repo(..),
Ref(..),
+ fromRef,
Branch,
Sha,
Tag,
diff --git a/Git/Branch.hs b/Git/Branch.hs
index 405fa108f..d182ceb39 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -28,7 +28,7 @@ current r = do
case v of
Nothing -> return Nothing
Just branch ->
- ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r)
+ ifM (null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r)
( return Nothing
, return v
)
@@ -36,7 +36,7 @@ current r = do
{- The current branch, which may not really exist yet. -}
currentUnsafe :: Repo -> IO (Maybe Git.Ref)
currentUnsafe r = parse . firstLine
- <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r
+ <$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r
where
parse l
| null l = Nothing
@@ -51,7 +51,7 @@ changed origbranch newbranch repo
where
diffs = pipeReadStrict
[ Param "log"
- , Param (show origbranch ++ ".." ++ show newbranch)
+ , Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
, Params "--oneline -n1"
] repo
@@ -74,7 +74,7 @@ fastForward branch (first:rest) repo =
where
no_ff = return False
do_ff to = do
- run [Param "update-ref", Param $ show branch, Param $ show to] repo
+ run [Param "update-ref", Param $ fromRef branch, Param $ fromRef to] repo
return True
findbest c [] = return $ Just c
findbest c (r:rs)
@@ -104,14 +104,14 @@ commit allowempty message branch parentrefs repo = do
ifM (cancommit tree)
( do
sha <- getSha "commit-tree" $ pipeWriteRead
- (map Param $ ["commit-tree", show tree] ++ ps)
+ (map Param $ ["commit-tree", fromRef tree] ++ ps)
(Just $ flip hPutStr message) repo
update branch sha repo
return $ Just sha
, return Nothing
)
where
- ps = concatMap (\r -> ["-p", show r]) parentrefs
+ ps = concatMap (\r -> ["-p", fromRef r]) parentrefs
cancommit tree
| allowempty = return True
| otherwise = case parentrefs of
@@ -130,8 +130,8 @@ forcePush b = "+" ++ b
update :: Branch -> Sha -> Repo -> IO ()
update branch sha = run
[ Param "update-ref"
- , Param $ show branch
- , Param $ show sha
+ , Param $ fromRef branch
+ , Param $ fromRef sha
]
{- Checks out a branch, creating it if necessary. -}
@@ -140,7 +140,7 @@ checkout branch = run
[ Param "checkout"
, Param "-q"
, Param "-B"
- , Param $ show $ Git.Ref.base branch
+ , Param $ fromRef $ Git.Ref.base branch
]
{- Removes a branch. -}
@@ -149,5 +149,5 @@ delete branch = run
[ Param "branch"
, Param "-q"
, Param "-D"
- , Param $ show $ Git.Ref.base branch
+ , Param $ fromRef $ Git.Ref.base branch
]
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index aee6bd19f..c8cb76d59 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -50,7 +50,7 @@ catFileStop (CatFileHandle p _) = CoProcess.stop p
{- Reads a file from a specified branch. -}
catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
catFile h branch file = catObject h $ Ref $
- show branch ++ ":" ++ 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. -}
@@ -60,7 +60,7 @@ catObject h object = maybe L.empty fst3 <$> catObjectDetails h object
catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType))
catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive
where
- query = show object
+ query = fromRef object
send to = hPutStrLn to query
receive from = do
header <- hGetLine from
@@ -72,8 +72,8 @@ catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive
_ -> dne
| otherwise -> dne
_
- | header == show object ++ " missing" -> dne
- | otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
+ | header == fromRef object ++ " missing" -> dne
+ | otherwise -> error $ "unknown response from git cat-file " ++ show (header, query)
readcontent objtype bytes from sha = do
content <- S.hGet from bytes
eatchar '\n' from
diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs
index c82cf78cd..9e4fef9d6 100644
--- a/Git/DiffTree.hs
+++ b/Git/DiffTree.hs
@@ -36,12 +36,12 @@ data DiffTreeItem = DiffTreeItem
{- Diffs two tree Refs. -}
diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)
diffTree src dst = getdiff (Param "diff-tree")
- [Param (show src), Param (show dst)]
+ [Param (fromRef src), Param (fromRef dst)]
{- Diffs two tree Refs, recursing into sub-trees -}
diffTreeRecursive :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)
diffTreeRecursive src dst = getdiff (Param "diff-tree")
- [Param "-r", Param (show src), Param (show dst)]
+ [Param "-r", Param (fromRef src), Param (fromRef dst)]
{- Diffs between a tree and the index. Does nothing if there is not yet a
- commit in the repository. -}
@@ -61,7 +61,7 @@ diffIndex' :: Ref -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
diffIndex' ref params repo =
ifM (Git.Ref.headExists repo)
( getdiff (Param "diff-index")
- ( params ++ [Param $ show ref] )
+ ( params ++ [Param $ fromRef ref] )
repo
, return ([], return True)
)
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 23d3a3558..e90683bc0 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -74,7 +74,7 @@ isMissing s r = either (const True) (const False) <$> tryIO dump
where
dump = runQuiet
[ Param "show"
- , Param (show s)
+ , Param (fromRef s)
] r
findShas :: Bool -> String -> [Sha]
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 956f9f5b4..6d3ca4813 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -38,13 +38,13 @@ lsTree t repo = map parseLsTree
<$> pipeNullSplitZombie (lsTreeParams t) repo
lsTreeParams :: Ref -> [CommandParam]
-lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ show t ]
+lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]
{- Lists specified files in a tree. -}
lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
where
- ps = [Params "ls-tree --full-tree -z --", File $ show t] ++ map File fs
+ ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs
{- Parses a line of ls-tree output.
- (The --long format is not currently supported.) -}
diff --git a/Git/Merge.hs b/Git/Merge.hs
index f5791274f..948e09e01 100644
--- a/Git/Merge.hs
+++ b/Git/Merge.hs
@@ -15,7 +15,7 @@ import Git.BuildVersion
{- Avoids recent git's interactive merge. -}
mergeNonInteractive :: Ref -> Repo -> IO Bool
mergeNonInteractive branch
- | older "1.7.7.6" = merge [Param $ show branch]
- | otherwise = merge [Param "--no-edit", Param $ show branch]
+ | older "1.7.7.6" = merge [Param $ fromRef branch]
+ | otherwise = merge [Param "--no-edit", Param $ fromRef branch]
where
merge ps = runBool $ Param "merge" : ps
diff --git a/Git/Objects.hs b/Git/Objects.hs
index bb492f558..516aa6d3e 100644
--- a/Git/Objects.hs
+++ b/Git/Objects.hs
@@ -32,4 +32,4 @@ listLooseObjectShas r = catchDefaultIO [] $
looseObjectFile :: Repo -> Sha -> FilePath
looseObjectFile r sha = objectsDir r </> prefix </> rest
where
- (prefix, rest) = splitAt 2 (show sha)
+ (prefix, rest) = splitAt 2 (fromRef sha)
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 88717ce47..3d0c68fb0 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -20,12 +20,12 @@ headRef = Ref "HEAD"
{- Converts a fully qualified git ref into a user-visible string. -}
describe :: Ref -> String
-describe = show . base
+describe = fromRef . base
{- Often git refs are fully qualified (eg: refs/heads/master).
- Converts such a fully qualified ref into a base ref (eg: master). -}
base :: Ref -> Ref
-base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show
+base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
where
remove prefix s
| prefix `isPrefixOf` s = drop (length prefix) s
@@ -35,13 +35,13 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show
- it under the directory. -}
under :: String -> Ref -> Ref
under dir r = Ref $ dir ++ "/" ++
- (reverse $ takeWhile (/= '/') $ reverse $ show r)
+ (reverse $ takeWhile (/= '/') $ reverse $ fromRef r)
{- Given a directory such as "refs/remotes/origin", and a ref such as
- 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 ++ "/" ++ show (base r)
+underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r)
{- A Ref that can be used to refer to a file in the repository, as staged
- in the index.
@@ -64,12 +64,12 @@ fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
{- Checks if a ref exists. -}
exists :: Ref -> Repo -> IO Bool
exists ref = runBool
- [Param "show-ref", Param "--verify", Param "-q", Param $ show 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.) -}
file :: Ref -> Repo -> FilePath
-file ref repo = localGitDir repo </> show ref
+file ref repo = localGitDir repo </> fromRef ref
{- Checks if HEAD exists. It generally will, except for in a repository
- that was just created. -}
@@ -84,17 +84,17 @@ sha branch repo = process <$> showref repo
where
showref = pipeReadStrict [Param "show-ref",
Param "--hash", -- get the hash
- Param $ show branch]
+ Param $ fromRef branch]
process [] = Nothing
process s = Just $ Ref $ firstLine s
{- List of (shas, branches) matching a given ref or refs. -}
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matching refs repo = matching' (map show refs) repo
+matching refs repo = matching' (map fromRef refs) repo
{- Includes HEAD in the output, if asked for it. -}
matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo
+matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
{- List of (shas, branches) matching a given ref or refs. -}
matching' :: [String] -> Repo -> IO [(Sha, Branch)]
@@ -114,7 +114,7 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo
{- Gets the sha of the tree a ref uses. -}
tree :: Ref -> Repo -> IO (Maybe Sha)
tree ref = extractSha <$$> pipeReadStrict
- [ Param "rev-parse", Param (show ref ++ ":") ]
+ [ Param "rev-parse", Param (fromRef ref ++ ":") ]
{- Checks if a String is a legal git ref name.
-
diff --git a/Git/RefLog.hs b/Git/RefLog.hs
index 3f41e8eaa..98c9d66ff 100644
--- a/Git/RefLog.hs
+++ b/Git/RefLog.hs
@@ -18,5 +18,5 @@ get b = mapMaybe extractSha . lines <$$> pipeReadStrict
[ Param "log"
, Param "-g"
, Param "--format=%H"
- , Param (show b)
+ , Param (fromRef b)
]
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 2c0983609..96da5ffe7 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -168,7 +168,7 @@ resetLocalBranches :: MissingObjects -> GoodCommits -> Repo -> IO ([Branch], [Br
resetLocalBranches missing goodcommits r =
go [] [] goodcommits =<< filter islocalbranch <$> getAllRefs r
where
- islocalbranch b = "refs/heads/" `isPrefixOf` show b
+ islocalbranch b = "refs/heads/" `isPrefixOf` fromRef b
go changed deleted gcs [] = return (changed, deleted, gcs)
go changed deleted gcs (b:bs) = do
(mc, gcs') <- findUncorruptedCommit missing gcs b r
@@ -185,12 +185,12 @@ resetLocalBranches missing goodcommits r =
nukeBranchRef b r
void $ runBool
[ Param "branch"
- , Param (show $ Ref.base b)
- , Param (show c)
+ , Param (fromRef $ Ref.base b)
+ , Param (fromRef c)
] r
isTrackingBranch :: Ref -> Bool
-isTrackingBranch b = "refs/remotes/" `isPrefixOf` show b
+isTrackingBranch b = "refs/remotes/" `isPrefixOf` fromRef b
{- To deal with missing objects that cannot be recovered, removes
- any branches (filtered by a predicate) that reference them
@@ -231,10 +231,10 @@ explodePackedRefsFile r = do
nukeFile f
where
makeref (sha, ref) = do
- let dest = localGitDir r </> show ref
+ let dest = localGitDir r </> fromRef ref
createDirectoryIfMissing True (parentDir dest)
unlessM (doesFileExist dest) $
- writeFile dest (show sha)
+ writeFile dest (fromRef sha)
packedRefsFile :: Repo -> FilePath
packedRefsFile r = localGitDir r </> "packed-refs"
@@ -249,7 +249,7 @@ parsePacked l = case words l of
{- git-branch -d cannot be used to remove a branch that is directly
- pointing to a corrupt commit. -}
nukeBranchRef :: Branch -> Repo -> IO ()
-nukeBranchRef b r = nukeFile $ localGitDir r </> show b
+nukeBranchRef b r = nukeFile $ localGitDir r </> fromRef b
{- Finds the most recent commit to a branch that does not need any
- of the missing objects. If the input branch is good as-is, returns it.
@@ -268,7 +268,7 @@ findUncorruptedCommit missing goodcommits branch r = do
[ Param "log"
, Param "-z"
, Param "--format=%H"
- , Param (show branch)
+ , Param (fromRef branch)
] r
let branchshas = catMaybes $ map extractSha ls
reflogshas <- RefLog.get branch r
@@ -297,7 +297,7 @@ verifyCommit missing goodcommits commit r
[ Param "log"
, Param "-z"
, Param "--format=%H %T"
- , Param (show commit)
+ , Param (fromRef commit)
] r
let committrees = map parse ls
if any isNothing committrees || null committrees
@@ -501,9 +501,9 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
, "remote tracking branches that referred to missing objects."
]
(resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g
- displayList (map show resetbranches)
+ displayList (map fromRef resetbranches)
"Reset these local branches to old versions before the missing objects were committed:"
- displayList (map show deletedbranches)
+ displayList (map fromRef deletedbranches)
"Deleted these local branches, which could not be recovered due to missing objects:"
deindexedfiles <- rewriteIndex g
displayList deindexedfiles
@@ -519,7 +519,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
Just curr -> when (any (== curr) modifiedbranches) $ do
putStrLn $ unwords
[ "You currently have"
- , show curr
+ , fromRef curr
, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!"
]
putStrLn "Successfully recovered repository!"
diff --git a/Git/Types.hs b/Git/Types.hs
index d805d8574..802922532 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -47,10 +47,10 @@ type RemoteName = String
{- A git ref. Can be a sha1, or a branch or tag name. -}
newtype Ref = Ref String
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Read, Show)
-instance Show Ref where
- show (Ref v) = v
+fromRef :: Ref -> String
+fromRef (Ref s) = s
{- Aliases for Ref. -}
type Branch = Ref
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 73beaba3a..6d1ff2548 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -79,7 +79,7 @@ lsTree (Ref x) repo streamer = do
- a given file with a given sha. -}
updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
updateIndexLine sha filetype file =
- show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
+ show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file
stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
stageFile sha filetype file repo = do
@@ -90,7 +90,7 @@ stageFile sha filetype file repo = do
unstageFile :: FilePath -> Repo -> IO Streamer
unstageFile file repo = do
p <- toTopFilePath file repo
- return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p
+ return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
{- A streamer that adds a symlink to the index. -}
stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs
index 8e776ec21..3538bdc40 100644
--- a/Logs/FsckResults.hs
+++ b/Logs/FsckResults.hs
@@ -31,7 +31,7 @@ writeFsckResults u fsckresults = do
store s logfile = do
createDirectoryIfMissing True (parentDir logfile)
liftIO $ viaTmp writeFile logfile $ serialize s
- serialize = unlines . map show . S.toList
+ serialize = unlines . map fromRef . S.toList
readFsckResults :: UUID -> Annex FsckResults
readFsckResults u = do
diff --git a/Logs/View.hs b/Logs/View.hs
index cb1e33125..47ce7c4c1 100644
--- a/Logs/View.hs
+++ b/Logs/View.hs
@@ -24,21 +24,12 @@ import Types.MetaData
import qualified Git
import qualified Git.Branch
import qualified Git.Ref
+import Git.Types
import Utility.Tmp
import qualified Data.Set as S
import Data.Char
-showLog :: View -> String
-showLog (View branch components) = show branch ++ " " ++ show components
-
-parseLog :: String -> Maybe View
-parseLog s =
- let (branch, components) = separate (== ' ') s
- in View
- <$> pure (Git.Ref branch)
- <*> readish components
-
setView :: View -> Annex ()
setView v = do
old <- take 99 . filter (/= v) <$> recentViews
@@ -47,7 +38,7 @@ setView v = do
writeViews :: [View] -> Annex ()
writeViews l = do
f <- fromRepo gitAnnexViewLog
- liftIO $ viaTmp writeFile f $ unlines $ map showLog l
+ liftIO $ viaTmp writeFile f $ unlines $ map show l
removeView :: View -> Annex ()
removeView v = writeViews =<< filter (/= v) <$> recentViews
@@ -55,7 +46,7 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews
recentViews :: Annex [View]
recentViews = do
f <- fromRepo gitAnnexViewLog
- liftIO $ mapMaybe parseLog . lines <$> catchDefaultIO [] (readFile f)
+ liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
{- Gets the currently checked out view, if there is one. -}
currentView :: Annex (Maybe View)
@@ -97,4 +88,4 @@ branchView view
| otherwise = map (\c -> if isAlphaNum c then c else '_') s
prop_branchView_legal :: View -> Bool
-prop_branchView_legal = Git.Ref.legal False . show . branchView
+prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index ed8fbf480..60c2df73e 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -177,7 +177,7 @@ gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
void $ inRepo $ Git.Command.runBool
[ Param "push"
, Param remotename
- , Param $ show Annex.Branch.fullname
+ , Param $ Git.fromRef Annex.Branch.fullname
]
g <- inRepo Git.Config.reRead
case Git.GCrypt.remoteRepoId g (Just remotename) of
diff --git a/Types/View.hs b/Types/View.hs
index f1759e0e0..7ef44db11 100644
--- a/Types/View.hs
+++ b/Types/View.hs
@@ -20,7 +20,7 @@ data View = View
{ viewParentBranch :: Git.Branch
, viewComponents :: [ViewComponent]
}
- deriving (Eq, Show)
+ deriving (Eq, Read, Show)
instance Arbitrary View where
arbitrary = View <$> pure (Git.Ref "master") <*> arbitrary
@@ -29,7 +29,7 @@ data ViewComponent = ViewComponent
{ viewField :: MetaField
, viewFilter :: ViewFilter
}
- deriving (Eq, Show, Read)
+ deriving (Eq, Read, Show)
instance Arbitrary ViewComponent where
arbitrary = ViewComponent <$> arbitrary <*> arbitrary
@@ -41,7 +41,7 @@ type MkFileView = FilePath -> FileView
data ViewFilter
= FilterValues (S.Set MetaValue)
| FilterGlob String
- deriving (Eq, Show, Read)
+ deriving (Eq, Read, Show)
instance Arbitrary ViewFilter where
arbitrary = do
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 42419b8ab..0672de8b6 100644
--- a/Upgrade/V2.hs
+++ b/Upgrade/V2.hs
@@ -106,7 +106,10 @@ push = do
showAction "pushing new git-annex branch to origin"
showOutput
inRepo $ Git.Command.run
- [Param "push", Param "origin", Param $ show Annex.Branch.name]
+ [ Param "push"
+ , Param "origin"
+ , Param $ Git.fromRef Annex.Branch.name
+ ]
_ -> do
-- no origin exists, so just let the user
-- know about the new branch
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-29 11:49:53 +0000