summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Branch.hs6
-rw-r--r--CmdLine.hs2
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Logs/Trust.hs18
-rw-r--r--Remote.hs2
-rw-r--r--Seek.hs17
-rw-r--r--Upgrade.hs14
-rw-r--r--git-union-merge.hs6
8 files changed, 26 insertions, 41 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 8f07b7aa2..a653a4995 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -68,15 +68,15 @@ create = do
return ()
{- Returns the ref of the branch, creating it first if necessary. -}
-getBranch :: Annex (Git.Ref)
-getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha
+getBranch :: Annex Git.Ref
+getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
where
go True = do
inRepo $ Git.Command.run "branch"
[Param $ show name, Param $ show originname]
fromMaybe (error $ "failed to create " ++ show name)
<$> branchsha
- go False = withIndex' True $ do
+ go False = withIndex' True $
inRepo $ Git.Branch.commit "branch created" fullname []
use sha = do
setIndexSha sha
diff --git a/CmdLine.hs b/CmdLine.hs
index 6ac0b423f..68157a01a 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -47,7 +47,7 @@ dispatch args cmds commonoptions header getgitrepo = do
- the Command being run, and the remaining parameters for the command. -}
parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params)
parseCmd argv cmds commonoptions header
- | name == Nothing = err "missing command"
+ | isNothing name = err "missing command"
| null matches = err $ "unknown command " ++ fromJust name
| otherwise = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) args
where
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 61107ebe1..680828748 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -52,7 +52,7 @@ withBarePresentKeys a params = isBareRepo >>= go
go True = do
unless (null params) $
error "fsck should be run without parameters in a bare repository"
- prepStart a loggedKeys
+ map a <$> loggedKeys
startBare :: Key -> CommandStart
startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 4dd728a8b..1a6716d17 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -1,6 +1,6 @@
-{- git-annex trust
+{- git-annex trust log
-
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -76,14 +76,12 @@ trustMap = do
where
configuredtrust r =
maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$>
- (convert <$> getTrustLevel (Types.Remote.repo r))
- convert :: Maybe String -> Maybe TrustLevel
- convert Nothing = Nothing
- convert (Just s)
- | s == "trusted" = Just Trusted
- | s == "untrusted" = Just UnTrusted
- | s == "semitrusted" = Just SemiTrusted
- | otherwise = Nothing
+ maybe Nothing convert <$>
+ getTrustLevel (Types.Remote.repo r)
+ convert "trusted" = Just Trusted
+ convert "untrusted" = Just UnTrusted
+ convert "semitrusted" = Just SemiTrusted
+ convert _ = Nothing
{- The trust.log used to only list trusted repos, without a field for the
- trust status, which is why this defaults to Trusted. -}
diff --git a/Remote.hs b/Remote.hs
index 3caf5555b..7feb84d61 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -200,7 +200,7 @@ showTriedRemotes :: [Remote] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++
- (join ", " $ map name remotes)
+ join ", " (map name remotes)
forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = do
diff --git a/Seek.hs b/Seek.hs
index bf0770f40..8e935c90c 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -23,9 +23,7 @@ import qualified Limit
import qualified Option
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
-seekHelper a params = do
- g <- gitRepo
- liftIO $ runPreserveOrder (`a` g) params
+seekHelper a params = inRepo $ \g -> runPreserveOrder (`a` g) params
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
@@ -41,9 +39,8 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
go (file, v) = a (readMaybe v) file
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
-withBackendFilesInGit a params = do
- files <- seekHelper LsFiles.inRepo params
- prepBackendPairs a files
+withBackendFilesInGit a params =
+ prepBackendPairs a =<< seekHelper LsFiles.inRepo params
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
withFilesNotInGit a params = do
@@ -118,18 +115,12 @@ prepBackendPairs a fs = prepFilteredGen a snd (chooseBackends fs)
prepFilteredGen :: (b -> CommandStart) -> (b -> FilePath) -> Annex [b] -> Annex [CommandStart]
prepFilteredGen a d fs = do
matcher <- Limit.getMatcher
- prepStart (proc matcher) fs
+ map (proc matcher) <$> fs
where
proc matcher v = do
let f = d v
ok <- matcher f
if ok then a v else return Nothing
-{- Generates a list of CommandStart actions that will be run to perform a
- - command, using a list (ie of files) coming from an action. The list
- - will be produced and consumed lazily. -}
-prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
-prepStart a = liftM (map a)
-
notSymlink :: FilePath -> IO Bool
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
diff --git a/Upgrade.hs b/Upgrade.hs
index 8b2e939dd..44ca6323e 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -13,12 +13,10 @@ import qualified Upgrade.V0
import qualified Upgrade.V1
import qualified Upgrade.V2
-{- Uses the annex.version git config setting to automate upgrades. -}
upgrade :: Annex Bool
-upgrade = do
- version <- getVersion
- case version of
- Just "0" -> Upgrade.V0.upgrade
- Just "1" -> Upgrade.V1.upgrade
- Just "2" -> Upgrade.V2.upgrade
- _ -> return True
+upgrade = go =<< getVersion
+ where
+ go (Just "0") = Upgrade.V0.upgrade
+ go (Just "1") = Upgrade.V1.upgrade
+ go (Just "2") = Upgrade.V2.upgrade
+ go _ = return True
diff --git a/git-union-merge.hs b/git-union-merge.hs
index 6fd19c8da..e439c4665 100644
--- a/git-union-merge.hs
+++ b/git-union-merge.hs
@@ -28,9 +28,7 @@ setup :: Git.Repo -> IO ()
setup = cleanup -- idempotency
cleanup :: Git.Repo -> IO ()
-cleanup g = do
- e' <- doesFileExist (tmpIndex g)
- when e' $ removeFile (tmpIndex g)
+cleanup g = whenM (doesFileExist $ tmpIndex g) $ removeFile $ tmpIndex g
parseArgs :: IO [String]
parseArgs = do
@@ -43,7 +41,7 @@ main :: IO ()
main = do
[aref, bref, newref] <- map Git.Ref <$> parseArgs
g <- Git.Config.read =<< Git.Construct.fromCwd
- _ <- Git.Index.override (tmpIndex g)
+ _ <- Git.Index.override $ tmpIndex g
setup g
Git.UnionMerge.merge aref bref g
_ <- Git.Branch.commit "union merge" newref [aref, bref] g