diff options
| -rw-r--r-- | Annex.hs | 33 | ||||
| -rw-r--r-- | Checks.hs | 13 | ||||
| -rw-r--r-- | Command/Copy.hs | 12 | ||||
| -rw-r--r-- | Command/Drop.hs | 13 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 7 | ||||
| -rw-r--r-- | Command/Find.hs | 19 | ||||
| -rw-r--r-- | Command/Get.hs | 11 | ||||
| -rw-r--r-- | Command/Move.hs | 21 | ||||
| -rw-r--r-- | Command/Unused.hs | 9 | ||||
| -rw-r--r-- | GitAnnex.hs | 8 | ||||
| -rw-r--r-- | Options.hs | 19 | ||||
| -rw-r--r-- | Seek.hs | 9 | ||||
| -rw-r--r-- | Usage.hs | 2 |
13 files changed, 104 insertions, 72 deletions
@@ -17,6 +17,10 @@ module Annex ( eval, getState, changeState, + setFlag, + setField, + getFlag, + getField, gitRepo, inRepo, fromRepo, @@ -38,7 +42,6 @@ import Types.BranchState import Types.TrustLevel import Types.UUID import qualified Utility.Matcher -import qualified Utility.Format import qualified Data.Map as M -- git-annex's monad @@ -76,17 +79,16 @@ data AnnexState = AnnexState , force :: Bool , fast :: Bool , auto :: Bool - , format :: Maybe Utility.Format.Format , branchstate :: BranchState , catfilehandle :: Maybe CatFileHandle , forcebackend :: Maybe String , forcenumcopies :: Maybe Int - , toremote :: Maybe String - , fromremote :: Maybe String , limit :: Matcher (FilePath -> Annex Bool) , forcetrust :: [(UUID, TrustLevel)] , trustmap :: Maybe TrustMap , ciphers :: M.Map EncryptedCipher Cipher + , flags :: M.Map String Bool + , fields :: M.Map String String } newState :: Git.Repo -> AnnexState @@ -99,17 +101,16 @@ newState gitrepo = AnnexState , force = False , fast = False , auto = False - , format = Nothing , branchstate = startBranchState , catfilehandle = Nothing , forcebackend = Nothing , forcenumcopies = Nothing - , toremote = Nothing - , fromremote = Nothing , limit = Left [] , forcetrust = [] , trustmap = Nothing , ciphers = M.empty + , flags = M.empty + , fields = M.empty } {- Create and returns an Annex state object for the specified git repo. -} @@ -134,6 +135,24 @@ getState = gets changeState :: (AnnexState -> AnnexState) -> Annex () changeState = modify +{- Sets a flag to True -} +setFlag :: String -> Annex () +setFlag flag = changeState $ \s -> + s { flags = M.insert flag True $ flags s } + +{- Sets a field to a value -} +setField :: String -> String -> Annex () +setField field value = changeState $ \s -> + s { fields = M.insert field value $ fields s } + +{- Checks if a flag was set. -} +getFlag :: String -> Annex Bool +getFlag flag = fromMaybe False . M.lookup flag <$> getState flags + +{- Gets the value of a field. -} +getField :: String -> Annex (Maybe String) +getField field = M.lookup field <$> getState fields + {- Returns the annex's git repository. -} gitRepo :: Annex Git.Repo gitRepo = getState repo @@ -13,24 +13,13 @@ module Checks where import Common.Annex import Types.Command import Init -import qualified Annex commonChecks :: [CommandCheck] -commonChecks = [fromOpt, toOpt, repoExists] +commonChecks = [repoExists] repoExists :: CommandCheck repoExists = CommandCheck 0 ensureInitialized -fromOpt :: CommandCheck -fromOpt = CommandCheck 1 $ do - v <- Annex.getState Annex.fromremote - unless (isNothing v) $ error "cannot use --from with this command" - -toOpt :: CommandCheck -toOpt = CommandCheck 2 $ do - v <- Annex.getState Annex.toremote - unless (isNothing v) $ error "cannot use --to with this command" - dontCheck :: CommandCheck -> Command -> Command dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c diff --git a/Command/Copy.hs b/Command/Copy.hs index 77beb4b4f..d789d41f6 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -12,15 +12,15 @@ import Command import qualified Command.Move def :: [Command] -def = [dontCheck toOpt $ dontCheck fromOpt $ - command "copy" paramPaths seek +def = [withOptions Command.Move.options $ command "copy" paramPaths seek "copy content of files to/from another repository"] seek :: [CommandSeek] -seek = [withNumCopies $ \n -> whenAnnexed $ start n] +seek = [withField "to" id $ \to -> withField "from" id $ \from -> + withNumCopies $ \n -> whenAnnexed $ start to from n] -- A copy is just a move that does not delete the source file. -- However, --auto mode avoids unnecessary copies. -start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart -start numcopies file (key, backend) = autoCopies key (<) numcopies $ - Command.Move.start False file (key, backend) +start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart +start to from numcopies file (key, backend) = autoCopies key (<) numcopies $ + Command.Move.start to from False file (key, backend) diff --git a/Command/Drop.hs b/Command/Drop.hs index 89e7c8e42..f76951f08 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -18,15 +18,18 @@ import Annex.Content import Config def :: [Command] -def = [dontCheck fromOpt $ command "drop" paramPaths seek +def = [withOptions [fromOption] $ command "drop" paramPaths seek "indicate content of files not currently wanted"] +fromOption :: Option +fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote" + seek :: [CommandSeek] -seek = [withNumCopies $ \n -> whenAnnexed $ start n] +seek = [withField "from" id $ \from -> withNumCopies $ \n -> + whenAnnexed $ start from n] -start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart -start numcopies file (key, _) = autoCopies key (>) numcopies $ do - from <- Annex.getState Annex.fromremote +start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart +start from numcopies file (key, _) = autoCopies key (>) numcopies $ do case from of Nothing -> startLocal file numcopies key Just name -> do diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 244f378d9..fd3e84fe5 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -20,8 +20,9 @@ import Types.Key type UnusedMap = M.Map String Key def :: [Command] -def = [dontCheck fromOpt $ command "dropunused" (paramRepeating paramNumber) - seek "drop unused file content"] +def = [withOptions [Command.Drop.fromOption] $ + command "dropunused" (paramRepeating paramNumber) + seek "drop unused file content"] seek :: [CommandSeek] seek = [withUnusedMaps] @@ -50,7 +51,7 @@ start (unused, unusedbad, unusedtmp) s = search next $ a key perform :: Key -> CommandPerform -perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote +perform key = maybe droplocal dropremote =<< Annex.getField "from" where dropremote name = do r <- Remote.byName name diff --git a/Command/Find.hs b/Command/Find.hs index c86db5fa6..eb0267c14 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -23,20 +23,25 @@ def = [withOptions [formatOption, print0Option] $ command "find" paramPaths seek "lists available files"] print0Option :: Option -print0Option = Option [] ["print0"] (NoArg $ setFormat "${file}\0") +print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0") "terminate output with null" +formatOption :: Option +formatOption = fieldOption [] "format" paramFormat "control format of output" + seek :: [CommandSeek] -seek = [withFilesInGit $ whenAnnexed start] +seek = [withField "format" formatconverter $ \f -> + withFilesInGit $ whenAnnexed $ start f] + where + formatconverter = maybe Nothing (Just . Utility.Format.gen) -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart +start format file (key, _) = do -- only files inAnnex are shown, unless the user has requested -- others via a limit whenM (liftM2 (||) limited (inAnnex key)) $ - unlessM (showFullJSON vars) $ do - f <- Annex.getState Annex.format - case f of + unlessM (showFullJSON vars) $ + case format of Nothing -> liftIO $ putStrLn file Just formatter -> liftIO $ putStr $ Utility.Format.format formatter $ diff --git a/Command/Get.hs b/Command/Get.hs index f2b70baeb..4a50fe3fe 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -9,22 +9,21 @@ module Command.Get where import Common.Annex import Command -import qualified Annex import qualified Remote import Annex.Content import qualified Command.Move def :: [Command] -def = [dontCheck fromOpt $ command "get" paramPaths seek +def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek "make content of annexed files available"] seek :: [CommandSeek] -seek = [withNumCopies $ \n -> whenAnnexed $ start n] +seek = [withField "from" id $ \from -> withNumCopies $ \n -> + whenAnnexed $ start from n] -start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart -start numcopies file (key, _) = stopUnless (not <$> inAnnex key) $ +start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart +start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $ autoCopies key (<) numcopies $ do - from <- Annex.getState Annex.fromremote case from of Nothing -> go $ perform key Just name -> do diff --git a/Command/Move.hs b/Command/Move.hs index bd1490b0c..66a0c1660 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -16,18 +16,25 @@ import qualified Remote import Annex.UUID def :: [Command] -def = [dontCheck toOpt $ dontCheck fromOpt $ - command "move" paramPaths seek +def = [withOptions options $ command "move" paramPaths seek "move content of files to/from another repository"] +fromOption :: Option +fromOption = fieldOption ['f'] "from" paramRemote "source remote" + +toOption :: Option +toOption = fieldOption ['t'] "to" paramRemote "destination remote" + +options :: [Option] +options = [fromOption, toOption] + seek :: [CommandSeek] -seek = [withFilesInGit $ whenAnnexed $ start True] +seek = [withField "to" id $ \to -> withField "from" id $ \from -> + withFilesInGit $ whenAnnexed $ start to from True] -start :: Bool -> FilePath -> (Key, Backend) -> CommandStart -start move file (key, _) = do +start :: Maybe String -> Maybe String -> Bool -> FilePath -> (Key, Backend) -> CommandStart +start to from move file (key, _) = do noAuto - to <- Annex.getState Annex.toremote - from <- Annex.getState Annex.fromremote case (from, to) of (Nothing, Nothing) -> error "specify either --from or --to" (Nothing, Just name) -> do diff --git a/Command/Unused.hs b/Command/Unused.hs index 8d45c51cb..59efe64c8 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -30,16 +30,19 @@ import qualified Annex.Branch import Annex.CatFile def :: [Command] -def = [dontCheck fromOpt $ command "unused" paramNothing seek +def = [withOptions [fromOption] $ command "unused" paramNothing seek "look for unused file content"] +fromOption :: Option +fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content" + seek :: [CommandSeek] -seek = [withNothing start] +seek = [withNothing $ start] {- Finds unused content in the annex. -} start :: CommandStart start = do - from <- Annex.getState Annex.fromremote + from <- Annex.getField "from" let (name, action) = case from of Nothing -> (".", checkUnused) Just "." -> (".", checkUnused) diff --git a/GitAnnex.hs b/GitAnnex.hs index 3ce451810..8af1d5d59 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -94,11 +94,7 @@ cmds = concat options :: [Option] options = commonOptions ++ - [ Option ['t'] ["to"] (ReqArg setto paramRemote) - "specify to where to transfer content" - , Option ['f'] ["from"] (ReqArg setfrom paramRemote) - "specify from where to transfer content" - , Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber) + [ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber) "override default number of copies" , Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote) "override trust setting" @@ -120,8 +116,6 @@ options = commonOptions ++ "skip files not using a key-value backend" ] ++ matcherOptions where - setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v } - setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v } setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v } setgitconfig :: String -> Annex () setgitconfig v = do diff --git a/Options.hs b/Options.hs index fa008d064..56f0bc0ee 100644 --- a/Options.hs +++ b/Options.hs @@ -8,8 +8,8 @@ module Options ( commonOptions, matcherOptions, - formatOption, - setFormat, + flagOption, + fieldOption, ArgDescr(..), Option, OptDescr(..), @@ -23,7 +23,6 @@ import qualified Annex import Limit import Types.Option import Usage -import qualified Utility.Format commonOptions :: [Option] commonOptions = @@ -65,10 +64,12 @@ matcherOptions = longopt o = Option [] [o] $ NoArg $ addToken o shortopt o = Option o [] $ NoArg $ addToken o -formatOption :: Option -formatOption = Option [] ["format"] (ReqArg setFormat paramFormat) - "control format of output" +{- An option that sets a flag. -} +flagOption :: String -> String -> String -> Option +flagOption short flag description = + Option short [flag] (NoArg (Annex.setFlag flag)) description -setFormat :: String -> Annex () -setFormat v = Annex.changeState $ \s -> - s { Annex.format = Just $ Utility.Format.gen v } +{- An option that sets a field. -} +fieldOption :: String -> String -> String -> String -> Option +fieldOption short field paramdesc description = + Option short [field] (ReqArg (Annex.setField field) paramdesc) description @@ -87,6 +87,15 @@ withKeys a params = return $ map (a . parse) params where parse p = fromMaybe (error "bad key") $ readKey p +{- Modifies a seek action using the value of a field, which is fed into + - a conversion function, and then is passed into the seek action. + - This ensures that the conversion function only runs once. + -} +withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek +withField field converter a ps = do + f <- converter <$> Annex.getField field + a f ps + withNothing :: CommandStart -> CommandSeek withNothing a [] = return [a] withNothing _ _ = error "This command takes no parameters." @@ -66,6 +66,8 @@ paramGlob :: String paramGlob = "GLOB" paramName :: String paramName = "NAME" +paramValue :: String +paramValue = "VALUE" paramUUID :: String paramUUID = "UUID" paramType :: String |