diff --git a/Command.hs b/Command.hs index 9c908b8004..d9e94a2f36 100644 --- a/Command.hs +++ b/Command.hs @@ -65,12 +65,22 @@ data Command = Command { cmdusesrepo :: Bool } +{- Most commands operate on files in a git repo. -} repoCommand :: String -> String -> [CommandSeek] -> String -> Command repoCommand n p s d = Command n p s d True +{- Others can run anywhere. -} standaloneCommand :: String -> String -> [CommandSeek] -> String -> Command standaloneCommand n p s d = Command n p s d False +{- For start and perform stages to indicate what step to run next. -} +next :: a -> Annex (Maybe a) +next a = return $ Just a + +{- Or to indicate nothing needs to be done. -} +stop :: Annex (Maybe a) +stop = return Nothing + {- Prepares a list of actions to run to perform a command, based on - the parameters passed to it. -} prepCommand :: Command -> [String] -> Annex [Annex Bool] diff --git a/Command/Add.hs b/Command/Add.hs index b532ab045d..29a1518e84 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -34,19 +34,19 @@ start :: CommandStartBackendFile start pair@(file, _) = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file if (isSymbolicLink s) || (not $ isRegularFile s) - then return Nothing + then stop else do showStart "add" file - return $ Just $ perform pair + next $ perform pair perform :: BackendFile -> CommandPerform perform (file, backend) = do stored <- Backend.storeFileKey file backend case stored of - Nothing -> return Nothing + Nothing -> stop Just (key, _) -> do moveAnnex key file - return $ Just $ cleanup file key + next $ cleanup file key cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 476d73cfbb..d8dbff03af 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -25,4 +25,4 @@ start = do g <- Annex.gitRepo u <- getUUID g liftIO $ putStrLn $ "annex.uuid=" ++ u - return Nothing + stop diff --git a/Command/Describe.hs b/Command/Describe.hs index 9e98a81437..dcabef7fbf 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -29,9 +29,9 @@ start params = notBareRepo $ do showStart "describe" name u <- Remote.nameToUUID name - return $ Just $ perform u description + next $ perform u description perform :: UUID -> String -> CommandPerform perform u description = do describeUUID u description - return $ Just $ Command.Init.cleanup + next $ Command.Init.cleanup diff --git a/Command/Drop.hs b/Command/Drop.hs index 52b724e62b..05c956fddf 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -29,11 +29,11 @@ seek = [withAttrFilesInGit "annex.numcopies" start] start :: CommandStartAttrFile start (file, attr) = isAnnexed file $ \(key, backend) -> do inbackend <- Backend.hasKey key - if not inbackend - then return Nothing - else do + if inbackend + then do showStart "drop" file - return $ Just $ perform key backend numcopies + next $ perform key backend numcopies + else stop where numcopies = readMaybe attr :: Maybe Int @@ -41,8 +41,8 @@ perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform perform key backend numcopies = do success <- Backend.removeKey backend key numcopies if success - then return $ Just $ cleanup key - else return Nothing + then next $ cleanup key + else stop cleanup :: Key -> CommandCleanup cleanup key = do diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 4c6f1ab2e1..780fe0adf0 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -26,20 +26,19 @@ start key = do present <- inAnnex key force <- Annex.getState Annex.force if not present - then return Nothing + then stop else if not force then error "dropkey is can cause data loss; use --force if you're sure you want to do this" else do showStart "dropkey" (show key) - return $ Just $ perform key + next $ perform key perform :: Key -> CommandPerform perform key = do removeAnnex key - return $ Just $ cleanup key + next $ cleanup key cleanup :: Key -> CommandCleanup cleanup key = do logStatus key ValueMissing return True - diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index b129235e1d..861c78c905 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -49,13 +49,13 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search , (unusedtmp, performOther gitAnnexTmpLocation) ] where - search [] = return Nothing + search [] = stop search ((m, a):rest) = do case M.lookup s m of Nothing -> search rest Just key -> do showStart "dropunused" s - return $ Just $ a key + next $ a key perform :: Key -> CommandPerform perform key = do @@ -64,7 +64,7 @@ perform key = do Just name -> do r <- Remote.byName name showNote $ "from " ++ Remote.name r ++ "..." - return $ Just $ Command.Move.fromCleanup r True key + next $ Command.Move.fromCleanup r True key _ -> do backend <- keyBackend key Command.Drop.perform key backend (Just 0) -- force drop @@ -75,7 +75,7 @@ performOther filespec key = do let f = filespec g key e <- liftIO $ doesFileExist f when e $ liftIO $ removeFile f - return $ Just $ return True + next $ return True readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog prefix = do diff --git a/Command/Find.hs b/Command/Find.hs index 6a6ae29787..eecf3cd7da 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -25,4 +25,4 @@ start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do exists <- inAnnex key when exists $ liftIO $ putStrLn file - return Nothing + stop diff --git a/Command/Fix.hs b/Command/Fix.hs index d898ce517d..60627e9df0 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -30,17 +30,17 @@ start file = isAnnexed file $ \(key, _) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file if link == l - then return Nothing + then stop else do showStart "fix" file - return $ Just $ perform file link + next $ perform file link perform :: FilePath -> FilePath -> CommandPerform perform file link = do liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file - return $ Just $ cleanup file + next $ cleanup file cleanup :: FilePath -> CommandCleanup cleanup file = do diff --git a/Command/FromKey.hs b/Command/FromKey.hs index eadaa13e1f..ca61094eb4 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -34,7 +34,7 @@ start file = notBareRepo $ do unless inbackend $ error $ "key ("++keyName key++") is not present in backend" showStart "fromkey" file - return $ Just $ perform file + next $ perform file perform :: FilePath -> CommandPerform perform file = do @@ -42,7 +42,7 @@ perform file = do link <- calcGitLink file key liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createSymbolicLink link file - return $ Just $ cleanup file + next $ cleanup file cleanup :: FilePath -> CommandCleanup cleanup file = do diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 20ef2c8083..adfd702de7 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -31,7 +31,7 @@ seek = [withAttrFilesInGit "annex.numcopies" start] start :: CommandStartAttrFile start (file, attr) = notBareRepo $ isAnnexed file $ \(key, backend) -> do showStart "fsck" file - return $ Just $ perform key file backend numcopies + next $ perform key file backend numcopies where numcopies = readMaybe attr :: Maybe Int @@ -42,8 +42,8 @@ perform key file backend numcopies = do locationlogok <- verifyLocationLog key file backendok <- Backend.fsckKey backend key (Just file) numcopies if locationlogok && backendok - then return $ Just $ return True - else return Nothing + then next $ return True + else stop {- Checks that the location log reflects the current status of the key, in this repository only. -} diff --git a/Command/Get.hs b/Command/Get.hs index 0463dccb05..90c0540960 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -25,15 +25,14 @@ start :: CommandStartString start file = isAnnexed file $ \(key, backend) -> do inannex <- inAnnex key if inannex - then return Nothing + then stop else do showStart "get" file - return $ Just $ perform key backend + next $ perform key backend perform :: Key -> Backend Annex -> CommandPerform perform key backend = do ok <- getViaTmp key (Backend.retrieveKeyFile backend key) if ok - then return $ Just $ return True -- no cleanup needed - else return Nothing - + then next $ return True -- no cleanup needed + else stop diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index a7e2ecff60..b5b59ccf7d 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -24,5 +24,5 @@ start :: CommandStartKey start key = do present <- inAnnex key if present - then return Nothing + then stop else liftIO $ exitFailure diff --git a/Command/Init.hs b/Command/Init.hs index cca2e8faef..668b5c87d6 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -35,7 +35,7 @@ start description = do when (null description) $ error "please specify a description of this repository\n" showStart "init" description - return $ Just $ perform description + next $ perform description perform :: String -> CommandPerform perform description = do @@ -48,12 +48,12 @@ perform description = do "This is a bare repository, so its description cannot be committed.\n" ++ "To record the description, run this command in a clone of this repository:\n" ++ " git annex describe " ++ show u ++ " " ++ show description ++ "\n\n" - return $ Just $ return True + next $ return True else do describeUUID u description liftIO $ gitAttributesWrite g gitPreCommitHookWrite g - return $ Just cleanup + next cleanup cleanup :: CommandCleanup cleanup = do diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 4c2fc3a078..eda50ee5de 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -39,7 +39,7 @@ start params = notBareRepo $ do t <- findType fullconfig showStart "initremote" name - return $ Just $ perform t u $ M.union config c + next $ perform t u $ M.union config c where ws = words params @@ -49,7 +49,7 @@ start params = notBareRepo $ do perform :: RemoteClass.RemoteType Annex -> UUID -> RemoteClass.RemoteConfig -> CommandPerform perform t u c = do c' <- RemoteClass.setup t u c - return $ Just $ cleanup u c' + next $ cleanup u c' cleanup :: UUID -> RemoteClass.RemoteConfig -> CommandCleanup cleanup u c = do diff --git a/Command/Lock.hs b/Command/Lock.hs index cdbc560194..1ae4882272 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -26,7 +26,7 @@ seek = [withFilesUnlocked start] start :: CommandStartBackendFile start (file, _) = do showStart "lock" file - return $ Just $ perform file + next $ perform file perform :: FilePath -> CommandPerform perform file = do @@ -36,4 +36,4 @@ perform file = do liftIO $ Git.run g "reset" [Params "-q --", File file] -- checkout the symlink liftIO $ Git.run g "checkout" [Param "--", File file] - return $ Just $ return True -- no cleanup needed + next $ return True -- no cleanup needed diff --git a/Command/Map.hs b/Command/Map.hs index 2325c87e14..3c94fc75b5 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -45,7 +45,7 @@ start = do showLongNote $ "running: dot -Tx11 " ++ file showProgress r <- liftIO $ boolSystem "dot" [Param "-Tx11", File file] - return $ Just $ return $ Just $ return r + next $ next $ return r where file = "map.dot" diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 0d21fcbdf9..35855d5270 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -35,9 +35,8 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do if (newbackend /= oldbackend || upgradable) && exists then do showStart "migrate" file - return $ Just $ perform file key newbackend - else - return Nothing + next $ perform file key newbackend + else stop where choosebackend Nothing = do backends <- Backend.list @@ -55,7 +54,7 @@ perform file oldkey newbackend = do let src = gitAnnexLocation g oldkey stored <- Backend.storeFileKey src $ Just newbackend case stored of - Nothing -> return Nothing + Nothing -> stop Just (newkey, _) -> do ok <- getViaTmpUnchecked newkey $ \t -> do -- Make a hard link to the old backend's @@ -68,5 +67,5 @@ perform file oldkey newbackend = do then do -- Update symlink to use the new key. liftIO $ removeFile file - return $ Just $ Command.Add.cleanup file newkey - else return Nothing + next $ Command.Add.cleanup file newkey + else stop diff --git a/Command/Move.hs b/Command/Move.hs index 476bf866a0..623003e47a 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -73,10 +73,10 @@ toStart dest move file = isAnnexed file $ \(key, _) -> do u <- getUUID g ishere <- inAnnex key if not ishere || u == Remote.uuid dest - then return Nothing -- not here, so nothing to do + then stop -- not here, so nothing to do else do showAction move file - return $ Just $ toPerform dest move key + next $ toPerform dest move key toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform toPerform dest move key = do -- Checking the remote is expensive, so not done in the start step. @@ -92,14 +92,14 @@ toPerform dest move key = do case isthere of Left err -> do showNote $ show err - return Nothing + stop Right False -> do showNote $ "to " ++ Remote.name dest ++ "..." ok <- Remote.storeKey dest key if ok - then return $ Just $ toCleanup dest move key - else return Nothing -- failed - Right True -> return $ Just $ toCleanup dest move key + then next $ toCleanup dest move key + else stop -- failed + Right True -> next $ toCleanup dest move key toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup toCleanup dest move key = do remoteHasKey dest key True @@ -119,21 +119,21 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do u <- getUUID g (remotes, _) <- Remote.keyPossibilities key if (u == Remote.uuid src) || (null $ filter (== src) remotes) - then return Nothing + then stop else do showAction move file - return $ Just $ fromPerform src move key + next $ fromPerform src move key fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform fromPerform src move key = do ishere <- inAnnex key if ishere - then return $ Just $ fromCleanup src move key + then next $ fromCleanup src move key else do showNote $ "from " ++ Remote.name src ++ "..." ok <- getViaTmp key $ Remote.retrieveKeyFile src key if ok - then return $ Just $ fromCleanup src move key - else return Nothing -- fail + then next $ fromCleanup src move key + else stop -- fail fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup fromCleanup src True key = do ok <- Remote.removeKey src key diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 1db40f75fa..d7f2487137 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -27,13 +27,13 @@ seek = [withFilesToBeCommitted Command.Fix.start, withFilesUnlockedToBeCommitted start] start :: CommandStartBackendFile -start pair = return $ Just $ perform pair +start pair = next $ perform pair perform :: BackendFile -> CommandPerform perform pair@(file, _) = do ok <- doCommand $ Command.Add.start pair if ok - then return $ Just $ cleanup file + then next $ cleanup file else error $ "failed to add " ++ file ++ "; canceling commit" cleanup :: FilePath -> CommandCleanup diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index e64d418f83..fc1bcbbcdc 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -24,9 +24,9 @@ start :: CommandStartString start name = notBareRepo $ do showStart "semitrust" name u <- Remote.nameToUUID name - return $ Just $ perform u + next $ perform u perform :: UUID -> CommandPerform perform uuid = do trustSet uuid SemiTrusted - return $ Just $ return True + next $ return True diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 6f6078e4ba..dbad148b25 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -26,7 +26,7 @@ seek = [withTempFile start] start :: CommandStartString start file = do showStart "setkey" file - return $ Just $ perform file + next $ perform file perform :: FilePath -> CommandPerform perform file = do @@ -40,7 +40,7 @@ perform file = do boolSystem "mv" [File file, File dest] else return True if ok - then return $ Just $ cleanup + then next cleanup else error "mv failed!" cleanup :: CommandCleanup diff --git a/Command/Trust.hs b/Command/Trust.hs index 05505cd045..ef03828c23 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -24,9 +24,9 @@ start :: CommandStartString start name = notBareRepo $ do showStart "trust" name u <- Remote.nameToUUID name - return $ Just $ perform u + next $ perform u perform :: UUID -> CommandPerform perform uuid = do trustSet uuid Trusted - return $ Just $ return True + next $ return True diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 94db500c68..0a5381d562 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -43,16 +43,16 @@ start file = isAnnexed file $ \(key, backend) -> do Annex.changeState $ \s -> s { Annex.force = True } showStart "unannex" file - return $ Just $ perform file key backend - else return Nothing + next $ perform file key backend + else stop perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file key backend = do -- force backend to always remove ok <- Backend.removeKey backend key (Just 0) if ok - then return $ Just $ cleanup file key - else return Nothing + then next $ cleanup file key + else stop cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do diff --git a/Command/Uninit.hs b/Command/Uninit.hs index ee0cbde6b3..d3d7ac3398 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -30,7 +30,7 @@ seek = [withFilesInGit Command.Unannex.start, withNothing start] start :: CommandStartNothing start = do showStart "uninit" "" - return $ Just $ perform + next perform perform :: CommandPerform perform = do @@ -39,7 +39,7 @@ perform = do gitPreCommitHookUnWrite g liftIO $ gitAttributesUnWrite g - return $ Just $ return True + next $ return True gitPreCommitHookUnWrite :: Git.Repo -> Annex () gitPreCommitHookUnWrite repo = do diff --git a/Command/Unlock.hs b/Command/Unlock.hs index bf593e1e99..d65579ec73 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -34,7 +34,7 @@ seek = [withFilesInGit start] start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do showStart "unlock" file - return $ Just $ perform file key + next $ perform file key perform :: FilePath -> Key -> CommandPerform perform dest key = do @@ -52,5 +52,5 @@ perform dest key = do if ok then do liftIO $ allowWrite dest - return $ Just $ return True + next $ return True else error "copy failed!" diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 311ec6eeb7..ebe9c31b3b 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -24,9 +24,9 @@ start :: CommandStartString start name = notBareRepo $ do showStart "untrust" name u <- Remote.nameToUUID name - return $ Just $ perform u + next $ perform u perform :: UUID -> CommandPerform perform uuid = do trustSet uuid UnTrusted - return $ Just $ return True + next $ return True diff --git a/Command/Unused.hs b/Command/Unused.hs index 67f10581d6..7570dfe90a 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -37,7 +37,7 @@ seek = [withNothing start] start :: CommandStartNothing start = notBareRepo $ do showStart "unused" "" - return $ Just perform + next perform perform :: CommandPerform perform = do @@ -47,7 +47,7 @@ perform = do r <- Remote.byName name checkRemoteUnused r _ -> checkUnused - return $ Just $ return True + next $ return True checkUnused :: Annex () checkUnused = do diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 880a5324f7..b3c0468039 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -24,4 +24,4 @@ start = do showStart "upgrade" "" r <- upgrade checkVersion - return $ Just $ return $ Just $ return r + next $ next $ return r diff --git a/Command/Version.hs b/Command/Version.hs index 2b294c80be..755b95acca 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -28,6 +28,6 @@ start = do liftIO $ putStrLn $ "default repository version: " ++ defaultVersion liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions - return Nothing + stop where vs l = join " " l diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 599df44676..2e0fa15f6f 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -26,7 +26,7 @@ seek = [withFilesInGit start] start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do showStart "whereis" file - return $ Just $ perform key + next $ perform key perform :: Key -> CommandPerform perform key = do @@ -35,12 +35,12 @@ perform key = do let num = length uuids showNote $ show num ++ " " ++ copiesplural num if null $ uuids - then return Nothing + then stop else do pp <- prettyPrintUUIDs uuids showLongNote $ pp showProgress - return $ Just $ return True + next $ return True where copiesplural 1 = "copy" copiesplural _ = "copies"