From 35145202d2e463569989b710ab5b87f6d9a8fdc1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 15 Sep 2011 16:50:49 -0400 Subject: remove command type definitions These were a mistake, they make the type signatures harder to read and less flexible. The CommandSeek, CommandStart, CommandPerform, and CommandCleanup types were a good idea, but composing them with the parameters expected is going too far. --- Command.hs | 39 ++++++++++++++------------------------- Command/Add.hs | 6 +++--- Command/AddUrl.hs | 2 +- Command/ConfigList.hs | 2 +- Command/Describe.hs | 2 +- Command/DropKey.hs | 2 +- Command/DropUnused.hs | 2 +- Command/Find.hs | 2 +- Command/Fix.hs | 2 +- Command/FromKey.hs | 2 +- Command/InAnnex.hs | 3 ++- Command/Init.hs | 2 +- Command/InitRemote.hs | 2 +- Command/Lock.hs | 2 +- Command/Map.hs | 2 +- Command/Merge.hs | 2 +- Command/Migrate.hs | 2 +- Command/Move.hs | 6 +++--- Command/PreCommit.hs | 4 ++-- Command/RecvKey.hs | 3 ++- Command/Semitrust.hs | 2 +- Command/SendKey.hs | 3 ++- Command/SetKey.hs | 2 +- Command/Status.hs | 2 +- Command/Trust.hs | 2 +- Command/Unannex.hs | 2 +- Command/Uninit.hs | 4 ++-- Command/Unlock.hs | 2 +- Command/Untrust.hs | 2 +- Command/Unused.hs | 2 +- Command/Upgrade.hs | 2 +- Command/Version.hs | 2 +- Command/Whereis.hs | 2 +- 33 files changed, 55 insertions(+), 63 deletions(-) diff --git a/Command.hs b/Command.hs index 05b215ec2..6bd451a7e 100644 --- a/Command.hs +++ b/Command.hs @@ -48,19 +48,8 @@ type CommandPerform = Annex (Maybe CommandCleanup) {- 3. The cleanup stage is run only if the perform stage succeeds, and it - returns the overall success/fail of the command. -} type CommandCleanup = Annex Bool -{- Some helper functions are used to build up CommandSeek and CommandStart - - functions. -} -type CommandSeekStrings = CommandStartString -> CommandSeek -type CommandStartString = String -> CommandStart -type CommandSeekWords = CommandStartWords -> CommandSeek -type CommandStartWords = [String] -> CommandStart -type CommandSeekKeys = CommandStartKey -> CommandSeek -type CommandStartKey = Key -> CommandStart + type BackendFile = (FilePath, Maybe (Backend Annex)) -type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek -type CommandStartBackendFile = BackendFile -> CommandStart -type CommandSeekNothing = CommandStart -> CommandSeek -type CommandStartNothing = CommandStart data Command = Command { cmdusesrepo :: Bool, @@ -121,7 +110,7 @@ notBareRepo a = do {- These functions find appropriate files or other things based on a user's parameters, and run a specified action on them. -} -withFilesInGit :: CommandSeekStrings +withFilesInGit :: (String -> CommandStart) -> CommandSeek withFilesInGit a params = do repo <- Annex.gitRepo files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params @@ -138,13 +127,13 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params go (file, v) = do let numcopies = readMaybe v a file numcopies -withBackendFilesInGit :: CommandSeekBackendFiles +withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek withBackendFilesInGit a params = do repo <- Annex.gitRepo files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params files' <- filterFiles files backendPairs a files' -withFilesMissing :: CommandSeekStrings +withFilesMissing :: (String -> CommandStart) -> CommandSeek withFilesMissing a params = do files <- liftIO $ filterM missing params liftM (map a) $ filterFiles files @@ -152,27 +141,27 @@ withFilesMissing a params = do missing f = do e <- doesFileExist f return $ not e -withFilesNotInGit :: CommandSeekBackendFiles +withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek withFilesNotInGit a params = do repo <- Annex.gitRepo force <- Annex.getState Annex.force newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params newfiles' <- filterFiles newfiles backendPairs a newfiles' -withWords :: CommandSeekWords +withWords :: ([String] -> CommandStart) -> CommandSeek withWords a params = return [a params] -withStrings :: CommandSeekStrings +withStrings :: (String -> CommandStart) -> CommandSeek withStrings a params = return $ map a params -withFilesToBeCommitted :: CommandSeekStrings +withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek withFilesToBeCommitted a params = do repo <- Annex.gitRepo tocommit <- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params liftM (map a) $ filterFiles tocommit -withFilesUnlocked :: CommandSeekBackendFiles +withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged -withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles +withFilesUnlockedToBeCommitted :: (BackendFile -> CommandStart) -> CommandSeek withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged -withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles +withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek withFilesUnlocked' typechanged a params = do -- unlocked files have changed type from a symlink to a regular file repo <- Annex.gitRepo @@ -181,15 +170,15 @@ withFilesUnlocked' typechanged a params = do map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles unlockedfiles' <- filterFiles unlockedfiles backendPairs a unlockedfiles' -withKeys :: CommandSeekKeys +withKeys :: (Key -> CommandStart) -> CommandSeek withKeys a params = return $ map (a . parse) params where parse p = fromMaybe (error "bad key") $ readKey p -withNothing :: CommandSeekNothing +withNothing :: CommandStart -> CommandSeek withNothing a [] = return [a] withNothing _ _ = error "This command takes no parameters." -backendPairs :: CommandSeekBackendFiles +backendPairs :: (BackendFile -> CommandStart) -> CommandSeek backendPairs a files = map a <$> Backend.chooseBackends files {- Filter out files those matching the exclude glob pattern, diff --git a/Command/Add.hs b/Command/Add.hs index f6dfd2da4..c6ab4d0ad 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -38,14 +38,14 @@ seek = [withFilesNotInGit start, withFilesUnlocked start] {- The add subcommand annexes a file, storing it in a backend, and then - moving it into the annex directory and setting up the symlink pointing - to its content. -} -start :: CommandStartBackendFile -start pair@(file, _) = notAnnexed file $ do +start :: BackendFile -> CommandStart +start p@(file, _) = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file if isSymbolicLink s || not (isRegularFile s) then stop else do showStart "add" file - next $ perform pair + next $ perform p perform :: BackendFile -> CommandPerform perform (file, backend) = do diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index c78569ffc..1fae358b2 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -34,7 +34,7 @@ command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek seek :: [CommandSeek] seek = [withStrings start] -start :: CommandStartString +start :: String -> CommandStart start s = do let u = parseURI s case u of diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 1b1bb3c34..3de26c892 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -20,7 +20,7 @@ command = [repoCommand "configlist" paramNothing seek seek :: [CommandSeek] seek = [withNothing start] -start :: CommandStartNothing +start :: CommandStart start = do g <- Annex.gitRepo u <- getUUID g diff --git a/Command/Describe.hs b/Command/Describe.hs index 453e4ebaf..8d2f9071b 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -19,7 +19,7 @@ command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do let (name, description) = case ws of diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 16a3e35d6..b9938585e 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -21,7 +21,7 @@ command = [repoCommand "dropkey" (paramRepeating paramKey) seek seek :: [CommandSeek] seek = [withKeys start] -start :: CommandStartKey +start :: Key -> CommandStart start key = do present <- inAnnex key force <- Annex.getState Annex.force diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 4ad2aa85b..90fea050e 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -41,7 +41,7 @@ withUnusedMaps params = do unusedtmp <- readUnusedLog "tmp" return $ map (start (unused, unusedbad, unusedtmp)) params -start :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString +start :: (UnusedMap, UnusedMap, UnusedMap) -> FilePath -> CommandStart start (unused, unusedbad, unusedtmp) s = notBareRepo $ search [ (unused, perform) , (unusedbad, performOther gitAnnexBadLocation) diff --git a/Command/Find.hs b/Command/Find.hs index 0ff68b7ed..51849f6b8 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -20,7 +20,7 @@ seek :: [CommandSeek] seek = [withFilesInGit start] {- Output a list of files. -} -start :: CommandStartString +start :: FilePath -> CommandStart start file = isAnnexed file $ \(key, _) -> do whenM (inAnnex key) $ liftIO $ putStrLn file stop diff --git a/Command/Fix.hs b/Command/Fix.hs index 0044052e9..481da52f2 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -26,7 +26,7 @@ seek :: [CommandSeek] seek = [withFilesInGit start] {- Fixes the symlink to an annexed file. -} -start :: CommandStartString +start :: FilePath -> CommandStart start file = isAnnexed file $ \(key, _) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 89c3f4e91..9ff126a45 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -27,7 +27,7 @@ command = [repoCommand "fromkey" paramPath seek seek :: [CommandSeek] seek = [withFilesMissing start] -start :: CommandStartString +start :: FilePath -> CommandStart start file = notBareRepo $ do key <- cmdlineKey inbackend <- inAnnex key diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 24f7162ac..713492c2f 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -12,6 +12,7 @@ import System.Exit import Command import Content +import Types command :: [Command] command = [repoCommand "inannex" (paramRepeating paramKey) seek @@ -20,7 +21,7 @@ command = [repoCommand "inannex" (paramRepeating paramKey) seek seek :: [CommandSeek] seek = [withKeys start] -start :: CommandStartKey +start :: Key -> CommandStart start key = do present <- inAnnex key if present diff --git a/Command/Init.hs b/Command/Init.hs index 6ba7df682..2351763a9 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -20,7 +20,7 @@ command = [standaloneCommand "init" paramDesc seek seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do showStart "init" description next $ perform description diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 9859308e5..671f945d2 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -30,7 +30,7 @@ command = [repoCommand "initremote" seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do when (null ws) needname diff --git a/Command/Lock.hs b/Command/Lock.hs index 07721e937..1c9a747f4 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -22,7 +22,7 @@ seek :: [CommandSeek] seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start] {- Undo unlock -} -start :: CommandStartBackendFile +start :: BackendFile -> CommandStart start (file, _) = do showStart "lock" file next $ perform file diff --git a/Command/Map.hs b/Command/Map.hs index ef8e04d90..7e23da774 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -34,7 +34,7 @@ command = [repoCommand "map" paramNothing seek "generate map of repositories"] seek :: [CommandSeek] seek = [withNothing start] -start :: CommandStartNothing +start :: CommandStart start = do g <- Annex.gitRepo rs <- spider g diff --git a/Command/Merge.hs b/Command/Merge.hs index faaef906b..832cde512 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -18,7 +18,7 @@ command = [repoCommand "merge" paramNothing seek seek :: [CommandSeek] seek = [withNothing start] -start :: CommandStartNothing +start :: CommandStart start = do showStart "merge" "." next perform diff --git a/Command/Migrate.hs b/Command/Migrate.hs index ec570acb7..69fe61e1d 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -31,7 +31,7 @@ command = [repoCommand "migrate" paramPaths seek seek :: [CommandSeek] seek = [withBackendFilesInGit start] -start :: CommandStartBackendFile +start :: BackendFile -> CommandStart start (file, b) = isAnnexed file $ \(key, oldbackend) -> do exists <- inAnnex key newbackend <- choosebackend b diff --git a/Command/Move.hs b/Command/Move.hs index f4310a2b8..15dae3938 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -31,7 +31,7 @@ seek = [withFilesInGit $ start True] - - This only operates on the cached file content; it does not involve - moving data in the key-value backend. -} -start :: Bool -> CommandStartString +start :: Bool -> FilePath -> CommandStart start move file = do noAuto to <- Annex.getState Annex.toremote @@ -74,7 +74,7 @@ remoteHasKey remote key present = do - A file's content can be moved even if there are insufficient copies to - allow it to be dropped. -} -toStart :: Remote.Remote Annex -> Bool -> CommandStartString +toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart toStart dest move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g @@ -124,7 +124,7 @@ toCleanup dest move key = do - If the current repository already has the content, it is still removed - from the remote. -} -fromStart :: Remote.Remote Annex -> Bool -> CommandStartString +fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart fromStart src move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 6884a4787..bcc1c943e 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -20,8 +20,8 @@ seek :: [CommandSeek] seek = [withFilesToBeCommitted Command.Fix.start, withFilesUnlockedToBeCommitted start] -start :: CommandStartBackendFile -start pair = next $ perform pair +start :: BackendFile -> CommandStart +start p = next $ perform p perform :: BackendFile -> CommandPerform perform pair@(file, _) = do diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index be6163558..33792e5b6 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -15,6 +15,7 @@ import CmdLine import Content import Utility.RsyncFile import Utility.Conditional +import Types command :: [Command] command = [repoCommand "recvkey" paramKey seek @@ -23,7 +24,7 @@ command = [repoCommand "recvkey" paramKey seek seek :: [CommandSeek] seek = [withKeys start] -start :: CommandStartKey +start :: Key -> CommandStart start key = do whenM (inAnnex key) $ error "key is already present in annex" diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index b467861bf..3b12bb747 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -20,7 +20,7 @@ command = [repoCommand "semitrust" (paramRepeating paramRemote) seek seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do let name = unwords ws showStart "semitrust" name diff --git a/Command/SendKey.hs b/Command/SendKey.hs index f676ae947..98d257338 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -17,6 +17,7 @@ import Content import Utility.RsyncFile import Utility.Conditional import Messages +import Types command :: [Command] command = [repoCommand "sendkey" paramKey seek @@ -25,7 +26,7 @@ command = [repoCommand "sendkey" paramKey seek seek :: [CommandSeek] seek = [withKeys start] -start :: CommandStartKey +start :: Key -> CommandStart start key = do g <- Annex.gitRepo let file = gitAnnexLocation g key diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 2f6f9ea9e..c03c5d044 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -23,7 +23,7 @@ seek :: [CommandSeek] seek = [withStrings start] {- Sets cached content for a key. -} -start :: CommandStartString +start :: FilePath -> CommandStart start file = do showStart "setkey" file next $ perform file diff --git a/Command/Status.hs b/Command/Status.hs index 5c82744b1..76659a75e 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -74,7 +74,7 @@ slowstats = , backend_usage ] -start :: CommandStartNothing +start :: CommandStart start = do fast <- Annex.getState Annex.fast let todo = if fast then faststats else faststats ++ slowstats diff --git a/Command/Trust.hs b/Command/Trust.hs index 41eb17ccd..5e25b519b 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -20,7 +20,7 @@ command = [repoCommand "trust" (paramRepeating paramRemote) seek seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do let name = unwords ws showStart "trust" name diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 748da4066..3dedd007e 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -33,7 +33,7 @@ seek :: [CommandSeek] seek = [withFilesInGit start] {- The unannex subcommand undoes an add. -} -start :: CommandStartString +start :: FilePath -> CommandStart start file = isAnnexed file $ \(key, _) -> do ishere <- inAnnex key if ishere diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 4c70ec80c..ce1266542 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -28,7 +28,7 @@ command = [repoCommand "uninit" paramPaths seek seek :: [CommandSeek] seek = [withFilesInGit startUnannex, withNothing start] -startUnannex :: CommandStartString +startUnannex :: FilePath -> CommandStart startUnannex file = do -- Force fast mode before running unannex. This way, if multiple -- files link to a key, it will be left in the annex and hardlinked @@ -36,7 +36,7 @@ startUnannex file = do Annex.changeState $ \s -> s { Annex.fast = True } Command.Unannex.start file -start :: CommandStartNothing +start :: CommandStart start = next perform perform :: CommandPerform diff --git a/Command/Unlock.hs b/Command/Unlock.hs index ba6d02387..5817e8f22 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -31,7 +31,7 @@ seek = [withFilesInGit start] {- The unlock subcommand replaces the symlink with a copy of the file's - content. -} -start :: CommandStartString +start :: FilePath -> CommandStart start file = isAnnexed file $ \(key, _) -> do showStart "unlock" file next $ perform file key diff --git a/Command/Untrust.hs b/Command/Untrust.hs index ea2320800..9f7e52198 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -20,7 +20,7 @@ command = [repoCommand "untrust" (paramRepeating paramRemote) seek seek :: [CommandSeek] seek = [withWords start] -start :: CommandStartWords +start :: [String] -> CommandStart start ws = do let name = unwords ws showStart "untrust" name diff --git a/Command/Unused.hs b/Command/Unused.hs index 960b2e1df..535b9b33e 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -37,7 +37,7 @@ seek :: [CommandSeek] seek = [withNothing start] {- Finds unused content in the annex. -} -start :: CommandStartNothing +start :: CommandStart start = notBareRepo $ do from <- Annex.getState Annex.fromremote let (name, action) = case from of diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index b79b13cd3..5d9ed92fa 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -19,7 +19,7 @@ command = [standaloneCommand "upgrade" paramNothing seek seek :: [CommandSeek] seek = [withNothing start] -start :: CommandStartNothing +start :: CommandStart start = do showStart "upgrade" "." r <- upgrade diff --git a/Command/Version.hs b/Command/Version.hs index 1ff829a22..af547949c 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -21,7 +21,7 @@ command = [standaloneCommand "version" paramNothing seek "show version info"] seek :: [CommandSeek] seek = [withNothing start] -start :: CommandStartNothing +start :: CommandStart start = do liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion v <- getVersion diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 7d0ab188c..a414428f7 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -23,7 +23,7 @@ command = [repoCommand "whereis" paramPaths seek seek :: [CommandSeek] seek = [withFilesInGit start] -start :: CommandStartString +start :: FilePath -> CommandStart start file = isAnnexed file $ \(key, _) -> do showStart "whereis" file next $ perform key -- cgit v1.2.3