converted copy and move

Got a little tricky..
This commit is contained in:
Joey Hess 2015-07-09 15:23:14 -04:00
parent 032e6485fa
commit 8ad927dbc6
8 changed files with 136 additions and 81 deletions

View file

@ -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 ()

View file

@ -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"