diff options
author | Joey Hess <joey@kitenet.net> | 2010-11-01 17:12:58 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-11-01 17:12:58 -0400 |
commit | 15e7d5913757ca8a76cbd83b3626a463fdea1767 (patch) | |
tree | f7ad0fdae66cdf4fbb2cc08049ed805fb77bedb5 | |
parent | fefaa5cc486cc435aa720a1fea29974c1ae17c4a (diff) |
rework complete
-rw-r--r-- | Commands.hs | 75 |
1 files changed, 48 insertions, 27 deletions
diff --git a/Commands.hs b/Commands.hs index 9a41e21b7..99de9bbc8 100644 --- a/Commands.hs +++ b/Commands.hs @@ -119,28 +119,31 @@ usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs {- Prepares a set of actions to run to perform a subcommand, based on - the parameters passed to it. -} prepSubCmd :: SubCommand -> Git.Repo -> [String] -> IO [Annex Bool] -prepSubCmd SubCommand { subcmdname = name, subcmdparse = parse, - subcmddesc = _ } repo params = do +prepSubCmd SubCommand { subcmdparse = parse } repo params = do list <- parse params repo :: IO [SubCmdStart] - return map (\a -> doSubCmd name a) list + return $ map (\a -> doSubCmd a) list -{- Runs a subcommand through the perform and cleanup stages -} -doSubCmd :: String -> SubCmdPerform -> SubCmdCleanup -doSubCmd cmdname perform = do - p <- perform - case (p) of - Nothing -> do - showEndFail - return False - Just cleanup -> do - c <- cleanup - if (c) - then do - showEndOk - return True - else do +{- Runs a subcommand through the start, perform and cleanup stages -} +doSubCmd :: SubCmdStart -> SubCmdCleanup +doSubCmd start = do + s <- start + case (s) of + Nothing -> return True + Just perform -> do + p <- perform + case (p) of + Nothing -> do showEndFail return False + Just cleanup -> do + c <- cleanup + if (c) + then do + showEndOk + return True + else do + showEndFail + return False {- These functions parse a user's parameters into a list of SubCmdStart actions to perform. -} @@ -209,7 +212,9 @@ addStart file = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) then return Nothing - else return $ Just $ addPerform file + else do + showStart "add" file + return $ Just $ addPerform file addPerform :: FilePath -> SubCmdPerform addPerform file = do stored <- Backend.storeFileKey file @@ -231,6 +236,7 @@ addCleanup file key = do {- The unannex subcommand undoes an add. -} unannexStart :: FilePath -> SubCmdStart unannexStart file = isAnnexed file $ \(key, backend) -> do + showStart "unannex" file return $ Just $ unannexPerform file key backend unannexPerform :: FilePath -> Key -> Backend -> SubCmdPerform unannexPerform file key backend = do @@ -258,7 +264,9 @@ getStart file = isAnnexed file $ \(key, backend) -> do inannex <- inAnnex key if (inannex) then return Nothing - else return $ Just $ getPerform key backend + else do + showStart "get" file + return $ Just $ getPerform key backend getPerform :: Key -> Backend -> SubCmdPerform getPerform key backend = do ok <- getViaTmp key (Backend.retrieveKeyFile backend key) @@ -273,7 +281,9 @@ dropStart file = isAnnexed file $ \(key, backend) -> do inbackend <- Backend.hasKey key if (not inbackend) then return Nothing - else return $ Just $ dropPerform key backend + else do + showStart "drop" file + return $ Just $ dropPerform key backend dropPerform :: Key -> Backend -> SubCmdPerform dropPerform key backend = do success <- Backend.removeKey backend key @@ -303,7 +313,9 @@ dropKeyStart keyname = do then return Nothing else if (not force) then error "dropkey is can cause data loss; use --force if you're sure you want to do this" - else return $ Just $ dropKeyPerform key + else do + showStart "dropkey" keyname + return $ Just $ dropKeyPerform key dropKeyPerform :: Key -> SubCmdPerform dropKeyPerform key = do g <- Annex.gitRepo @@ -322,6 +334,7 @@ setKeyStart tmpfile = do when (null keyname) $ error "please specify the key with --key" backends <- Backend.list let key = genKey (backends !! 0) keyname + showStart "setkey" tmpfile return $ Just $ setKeyPerform tmpfile key setKeyPerform :: FilePath -> Key -> SubCmdPerform setKeyPerform tmpfile key = do @@ -343,7 +356,9 @@ fixStart file = isAnnexed file $ \(key, _) -> do l <- liftIO $ readSymbolicLink file if (link == l) then return Nothing - else return $ Just $ fixPerform file link + else do + showStart "fix" file + return $ Just $ fixPerform file link fixPerform :: FilePath -> FilePath -> SubCmdPerform fixPerform file link = do liftIO $ createDirectoryIfMissing True (parentDir file) @@ -360,6 +375,7 @@ initStart :: String -> SubCmdStart initStart description = do when (null description) $ error $ "please specify a description of this repository\n" ++ usage + showStart "init" description return $ Just $ initPerform description initPerform :: String -> SubCmdPerform initPerform description = do @@ -388,6 +404,7 @@ fromKeyStart file = do inbackend <- Backend.hasKey key unless (inbackend) $ error $ "key ("++keyname++") is not present in backend" + showStart "fromkey" file return $ Just $ fromKeyPerform file key fromKeyPerform :: FilePath -> Key -> SubCmdPerform fromKeyPerform file key = do @@ -430,7 +447,9 @@ moveToStart file = isAnnexed file $ \(key, _) -> do ishere <- inAnnex key if (not ishere) then return Nothing -- not here, so nothing to do - else return $ Just $ moveToPerform key + else do + showStart "move" file + return $ Just $ moveToPerform key moveToPerform :: Key -> SubCmdPerform moveToPerform key = do -- checking the remote is expensive, so not done in the start step @@ -477,9 +496,11 @@ moveFromStart :: FilePath -> SubCmdStart moveFromStart file = isAnnexed file $ \(key, _) -> do remote <- Remotes.commandLineRemote l <- Remotes.keyPossibilities key - if (not $ null $ filter (\r -> Remotes.same r remote) l) - then return $ Just $ moveFromPerform key - else return Nothing + if (null $ filter (\r -> Remotes.same r remote) l) + then return Nothing + else do + showStart "move" file + return $ Just $ moveFromPerform key moveFromPerform :: Key -> SubCmdPerform moveFromPerform key = do remote <- Remotes.commandLineRemote |