remove Read instance for Ref

Removed instance, got it all to build using fromRef. (With a few things
that really need to show something using a ref for debugging stubbed out.)

Then added back Read instance, and made Logs.View use it for serialization.
This changes the view log format.
This commit is contained in:
Joey Hess 2014-02-19 01:09:17 -04:00
parent eb7b8747f9
commit 4e0be2792b
32 changed files with 101 additions and 104 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

1
Git.hs
View file

@ -13,6 +13,7 @@
module Git (
Repo(..),
Ref(..),
fromRef,
Branch,
Sha,
Tag,

View file

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

View file

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

View file

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

View file

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

View file

@ -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.) -}

View file

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

View file

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

View file

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

View file

@ -18,5 +18,5 @@ get b = mapMaybe extractSha . lines <$$> pipeReadStrict
[ Param "log"
, Param "-g"
, Param "--format=%H"
, Param (show b)
, Param (fromRef b)
]

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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