diff options
| -rw-r--r-- | Annex/Branch.hs | 6 | ||||
| -rw-r--r-- | CmdLine.hs | 2 | ||||
| -rw-r--r-- | Command/Fsck.hs | 2 | ||||
| -rw-r--r-- | Logs/Trust.hs | 18 | ||||
| -rw-r--r-- | Remote.hs | 2 | ||||
| -rw-r--r-- | Seek.hs | 17 | ||||
| -rw-r--r-- | Upgrade.hs | 14 | ||||
| -rw-r--r-- | git-union-merge.hs | 6 |
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. -} @@ -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 @@ -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 |