diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-07-09 15:23:14 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-07-09 15:23:14 -0400 |
commit | 87896574f32be5aa1636facc494faeab34cd0845 (patch) | |
tree | e3fe7c3572007aaa29eddd1f6ea2aebc07e40c3c /CmdLine | |
parent | 80603339ea4e8b93ef456e706ca8c4efeef341f8 (diff) |
converted copy and move
Got a little tricky..
Diffstat (limited to 'CmdLine')
-rw-r--r-- | CmdLine/GitAnnex.hs | 14 | ||||
-rw-r--r-- | CmdLine/GitAnnex/Options.hs | 59 |
2 files changed, 55 insertions, 18 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 5e37a885a..fc323a49b 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -15,15 +15,14 @@ import Command import Utility.Env import Annex.Ssh +import qualified Command.Help import qualified Command.Add import qualified Command.Unannex -import qualified Command.Fsck -{- -import qualified Command.Help import qualified Command.Drop import qualified Command.Move import qualified Command.Copy import qualified Command.Get +import qualified Command.Fsck import qualified Command.LookupKey import qualified Command.ContentLocation import qualified Command.ExamineKey @@ -117,18 +116,16 @@ import qualified Command.TestRemote #ifdef WITH_EKG import System.Remote.Monitoring #endif --} cmds :: [Command] cmds = - [ Command.Add.cmd - , Command.Fsck.cmd -{- - , Command.Help.cmd + [ Command.Help.cmd + , Command.Add.cmd , Command.Get.cmd , Command.Drop.cmd , Command.Move.cmd , Command.Copy.cmd + , Command.Fsck.cmd , Command.Unlock.cmd , Command.Unlock.editcmd , Command.Lock.cmd @@ -221,7 +218,6 @@ cmds = , Command.FuzzTest.cmd , Command.TestRemote.cmd #endif --} ] run :: [String] -> IO () diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 02cbcdcfe..fb1b81acf 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE FlexibleInstances #-} + module CmdLine.GitAnnex.Options where import System.Console.GetOpt @@ -54,6 +56,54 @@ gitAnnexOptions = commonOptions ++ >>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }) >>= Annex.changeGitRepo +-- Some values cannot be fully parsed without performing an action. +-- The action may be expensive, so it's best to call finishParse on such a +-- value before using getParsed repeatedly. +data DeferredParse a = DeferredParse (Annex a) | ReadyParse a + +class DeferredParseClass a where + finishParse :: a -> Annex a + +getParsed :: DeferredParse a -> Annex a +getParsed (DeferredParse a) = a +getParsed (ReadyParse a) = pure a + +instance DeferredParseClass (DeferredParse a) where + finishParse (DeferredParse a) = ReadyParse <$> a + finishParse (ReadyParse a) = pure (ReadyParse a) + +instance DeferredParseClass (Maybe (DeferredParse a)) where + finishParse Nothing = pure Nothing + finishParse (Just v) = Just <$> finishParse v + +parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote) +parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p + +data FromToOptions + = FromRemote (DeferredParse Remote) + | ToRemote (DeferredParse Remote) + +instance DeferredParseClass FromToOptions where + finishParse (FromRemote v) = FromRemote <$> finishParse v + finishParse (ToRemote v) = ToRemote <$> finishParse v + +parseFromToOptions :: Parser FromToOptions +parseFromToOptions = + (FromRemote <$> parseFromOption) + <|> (ToRemote <$> parseToOption) + +parseFromOption :: Parser (DeferredParse Remote) +parseFromOption = parseRemoteOption $ strOption + ( long "from" <> short 'f' <> metavar paramRemote + <> help "source remote" + ) + +parseToOption :: Parser (DeferredParse Remote) +parseToOption = parseRemoteOption $ strOption + ( long "to" <> short 't' <> metavar paramRemote + <> help "destination remote" + ) + -- Options for acting on keys, rather than work tree files. data KeyOptions = WantAllKeys @@ -150,15 +200,6 @@ combiningOptions = longopt o = Option [] [o] $ NoArg $ Limit.addToken o shortopt o = Option o [] $ NoArg $ Limit.addToken o -fromOption :: Option -fromOption = fieldOption ['f'] "from" paramRemote "source remote" - -toOption :: Option -toOption = fieldOption ['t'] "to" paramRemote "destination remote" - -fromToOptions :: [Option] -fromToOptions = [fromOption, toOption] - jsonOption :: Option jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput)) "enable JSON output" |