aboutsummaryrefslogtreecommitdiff
path: root/Annex/AdjustedBranch.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-11-15 16:55:38 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-11-15 16:59:32 -0400
commit4888bd597e34dce996fd581bb417ce017099171b (patch)
tree8b97f6807b5528be6b00c8d21038057ca097ec29 /Annex/AdjustedBranch.hs
parent01c524779136a688abf312e721abce41d2dd109c (diff)
enable LambdaCase and convert around 10% of places that could use it
Needs ghc 7.6.1, so minimum base version increased slightly. All builds are well above this version of ghc, and debian oldstable is as well. Code that could use lambdacase can be found by running: git grep -B 1 'case ' | less and searching in less for "<-" This commit was sponsored by andrea rota.
Diffstat (limited to 'Annex/AdjustedBranch.hs')
-rw-r--r--Annex/AdjustedBranch.hs93
1 files changed, 40 insertions, 53 deletions
diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
index 9eedf06f5..1ffc54f66 100644
--- a/Annex/AdjustedBranch.hs
+++ b/Annex/AdjustedBranch.hs
@@ -80,9 +80,8 @@ adjustTreeItem UnlockAdjustment = ifSymlink adjustToPointer noAdjust
adjustTreeItem LockAdjustment = ifSymlink noAdjust adjustToSymlink
adjustTreeItem FixAdjustment = ifSymlink adjustToSymlink noAdjust
adjustTreeItem UnFixAdjustment = ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust
-adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) -> do
- mk <- catKey s
- case mk of
+adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) ->
+ catKey s >>= \case
Just k -> ifM (inAnnex k)
( return (Just ti)
, return Nothing
@@ -99,29 +98,25 @@ noAdjust :: TreeItem -> Annex (Maybe TreeItem)
noAdjust = return . Just
adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)
-adjustToPointer ti@(TreeItem f _m s) = do
- mk <- catKey s
- case mk of
- Just k -> do
- Database.Keys.addAssociatedFile k f
- Just . TreeItem f (fromBlobType FileBlob)
- <$> hashPointerFile k
- Nothing -> return (Just ti)
+adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case
+ Just k -> do
+ Database.Keys.addAssociatedFile k f
+ Just . TreeItem f (fromBlobType FileBlob)
+ <$> hashPointerFile k
+ Nothing -> return (Just ti)
adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)
adjustToSymlink = adjustToSymlink' gitAnnexLink
adjustToSymlink' :: (FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath) -> TreeItem -> Annex (Maybe TreeItem)
-adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = do
- mk <- catKey s
- case mk of
- Just k -> do
- absf <- inRepo $ \r -> absPath $
- fromTopFilePath f r
- linktarget <- calcRepo $ gitannexlink absf k
- Just . TreeItem f (fromBlobType SymlinkBlob)
- <$> hashSymlink linktarget
- Nothing -> return (Just ti)
+adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case
+ Just k -> do
+ absf <- inRepo $ \r -> absPath $
+ fromTopFilePath f r
+ linktarget <- calcRepo $ gitannexlink absf k
+ Just . TreeItem f (fromBlobType SymlinkBlob)
+ <$> hashSymlink linktarget
+ Nothing -> return (Just ti)
type OrigBranch = Branch
newtype AdjBranch = AdjBranch { adjBranch :: Branch }
@@ -438,11 +433,9 @@ updateAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commi
return True
reparent _ _ Nothing = return False
- getcurrentcommit = do
- v <- inRepo Git.Branch.currentUnsafe
- case v of
- Nothing -> return Nothing
- Just c -> catCommit c
+ getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case
+ Nothing -> return Nothing
+ Just c -> catCommit c
{- Check for any commits present on the adjusted branch that have not yet
- been propigated to the basis branch, and propigate them to the basis
@@ -463,23 +456,19 @@ propigateAdjustedCommits'
-> Adjustment
-> CommitsPrevented
-> Annex (Maybe Sha, Annex ())
-propigateAdjustedCommits' origbranch adj _commitsprevented = do
- ov <- inRepo $ Git.Ref.sha basis
- case ov of
- Just origsha -> do
- cv <- catCommit currbranch
- case cv of
- Just currcommit -> do
- v <- newcommits >>= go origsha False
- case v of
- Left e -> do
- warning e
- return (Nothing, return ())
- Right newparent -> return
- ( Just newparent
- , rebase currcommit newparent
- )
- Nothing -> return (Nothing, return ())
+propigateAdjustedCommits' origbranch adj _commitsprevented =
+ inRepo (Git.Ref.sha basis) >>= \case
+ Just origsha -> catCommit currbranch >>= \case
+ Just currcommit ->
+ newcommits >>= go origsha False >>= \case
+ Left e -> do
+ warning e
+ return (Nothing, return ())
+ Right newparent -> return
+ ( Just newparent
+ , rebase currcommit newparent
+ )
+ Nothing -> return (Nothing, return ())
Nothing -> return (Nothing, return ())
where
(BasisBranch basis) = basisBranch adjbranch
@@ -492,18 +481,16 @@ propigateAdjustedCommits' origbranch adj _commitsprevented = do
setBasisBranch (BasisBranch basis) parent
inRepo $ Git.Branch.update' origbranch parent
return (Right parent)
- go parent pastadjcommit (sha:l) = do
- mc <- catCommit sha
- case mc of
- Just c
- | commitMessage c == adjustedBranchCommitMessage ->
- go parent True l
- | pastadjcommit -> do
- v <- reverseAdjustedCommit parent adj (sha, c) origbranch
- case v of
+ go parent pastadjcommit (sha:l) = catCommit sha >>= \case
+ Just c
+ | commitMessage c == adjustedBranchCommitMessage ->
+ go parent True l
+ | pastadjcommit ->
+ reverseAdjustedCommit parent adj (sha, c) origbranch
+ >>= \case
Left e -> return (Left e)
Right commit -> go commit pastadjcommit l
- _ -> go parent pastadjcommit l
+ _ -> go parent pastadjcommit l
rebase currcommit newparent = do
-- Reuse the current adjusted tree, and reparent it
-- on top of the newparent.