From 6a88c7c1015bd08239d300c36f702bd970fe3fd5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 8 Jul 2015 16:58:54 -0400
Subject: [PATCH] converted fsck's options to optparse-applicative
Global options and seeking and key options are still to be done.
---
CmdLine.hs | 9 ++++--
Command.hs | 24 ++++++++++-----
Command/Fsck.hs | 80 +++++++++++++++++++++++++++---------------------
Types/Command.hs | 4 ++-
4 files changed, 72 insertions(+), 45 deletions(-)
diff --git a/CmdLine.hs b/CmdLine.hs
index 82c9b42896..89f9964b76 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -75,8 +75,13 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
parseCmd :: CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v)
parseCmd allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs
where
- pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds) O.idm
- mkcommand c = O.command (cmdname c) (O.info (mkparser c) O.idm)
+ pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds)
+ ( O.fullDesc
+ <> O.progDesc "hiya"
+ <> O.header "ook - aaa"
+ )
+ mkcommand c = O.command (cmdname c) $ O.info (mkparser c)
+ (O.fullDesc <> O.progDesc (cmddesc c))
mkparser c = (,)
<$> pure c
<*> getparser c
diff --git a/Command.hs b/Command.hs
index ec8ffadd9f..e72bd1660a 100644
--- a/Command.hs
+++ b/Command.hs
@@ -1,6 +1,6 @@
{- git-annex command infrastructure
-
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -8,6 +8,8 @@
module Command (
command,
withParams,
+ cmdParams,
+ finalOpt,
noRepo,
noCommit,
noMessages,
@@ -36,16 +38,24 @@ import CmdLine.GitAnnex.Options as ReExported
import qualified Options.Applicative as O
{- Generates a normal Command -}
-command :: String -> CommandSection -> String -> String -> (String -> CommandParser) -> Command
+command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command
command name section desc paramdesc mkparser =
Command [] commonChecks False False name paramdesc
section desc (mkparser paramdesc) Nothing
-{- Option parser that takes all non-option params as-is. -}
-withParams :: (CmdParams -> v) -> String -> O.Parser v
-withParams mkseek paramdesc = mkseek <$> O.many cmdparams
- where
- cmdparams = O.argument O.str (O.metavar paramdesc)
+{- Simple option parser that takes all non-option params as-is. -}
+withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v
+withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc
+
+{- Parser that accepts all non-option params. -}
+cmdParams :: CmdParamsDesc -> O.Parser CmdParams
+cmdParams paramdesc = O.many (O.argument O.str (O.metavar paramdesc))
+
+{- Makes an option parser that is normally required be optional;
+ - its switch can be given zero or more times, and the last one
+ - given will be used. -}
+finalOpt :: O.Parser a -> O.Parser (Maybe a)
+finalOpt = lastMaybe <$$> O.many
{- Indicates that a command doesn't need to commit any changes to
- the git-annex branch. -}
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 29ef010328..c2a819e9d8 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -39,42 +39,56 @@ import qualified Database.Fsck as FsckDb
import Data.Time.Clock.POSIX
import System.Posix.Types (EpochTime)
+import Options.Applicative hiding (command)
cmd :: Command
-cmd = withOptions fsckOptions $
- command "fsck" SectionMaintenance "check for problems"
- paramPaths (withParams seek)
+cmd = command "fsck" SectionMaintenance "check for problems"
+ paramPaths (seek <$$> optParser)
-fsckFromOption :: Option
-fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"
+data FsckOptions = FsckOptions
+ { fsckFiles :: CmdParams
+ , fsckFromOption :: Maybe String
+ , startIncrementalOption :: Bool
+ , moreIncrementalOption :: Bool
+ , incrementalScheduleOption :: Maybe Duration
+ }
-startIncrementalOption :: Option
-startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"
+optParser :: CmdParamsDesc -> Parser FsckOptions
+optParser desc = FsckOptions
+ <$> cmdParams desc
+ <*> finalOpt (strOption
+ ( long "from"
+ <> short 'f'
+ <> metavar paramRemote
+ <> help "check remote"
+ ))
+ <*> switch
+ ( long "incremental"
+ <> short 'S'
+ <> help "start an incremental fsck"
+ )
+ <*> switch
+ ( long "more"
+ <> short 'm'
+ <> help "continue an incremental fsck"
+ )
+ <*> finalOpt (option (str >>= parseDuration)
+ ( long "incremental-schedule"
+ <> metavar paramTime
+ <> help "schedule incremental fscking"
+ ))
-moreIncrementalOption :: Option
-moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"
+-- TODO: keyOptions, annexedMatchingOptions
-incrementalScheduleOption :: Option
-incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime
- "schedule incremental fscking"
-
-fsckOptions :: [Option]
-fsckOptions =
- [ fsckFromOption
- , startIncrementalOption
- , moreIncrementalOption
- , incrementalScheduleOption
- ] ++ keyOptions ++ annexedMatchingOptions
-
-seek :: CmdParams -> CommandSeek
-seek ps = do
- from <- getOptionField fsckFromOption Remote.byNameWithUUID
+seek :: FsckOptions -> CommandSeek
+seek o = do
+ from <- Remote.byNameWithUUID (fsckFromOption o)
u <- maybe getUUID (pure . Remote.uuid) from
- i <- getIncremental u
+ i <- getIncremental u o
withKeyOptions False
(\k -> startKey i k =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
- ps
+ (fsckFiles o)
withFsckDb i FsckDb.closeDb
void $ tryIO $ recordActivity Fsck u
@@ -498,13 +512,10 @@ getStartTime u = do
data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental
-getIncremental :: UUID -> Annex Incremental
-getIncremental u = do
- i <- maybe (return False) (checkschedule . parseDuration)
- =<< Annex.getField (optionName incrementalScheduleOption)
- starti <- getOptionFlag startIncrementalOption
- morei <- getOptionFlag moreIncrementalOption
- case (i, starti, morei) of
+getIncremental :: UUID -> FsckOptions -> Annex Incremental
+getIncremental u o = do
+ i <- maybe (return False) checkschedule (incrementalScheduleOption o)
+ case (i, startIncrementalOption o, moreIncrementalOption o) of
(False, False, False) -> return NonIncremental
(False, True, False) -> startIncremental
(False ,False, True) -> contIncremental
@@ -521,8 +532,7 @@ getIncremental u = do
)
contIncremental = ContIncremental <$> FsckDb.openDb u
- checkschedule Nothing = error "bad --incremental-schedule value"
- checkschedule (Just delta) = do
+ checkschedule delta = do
Annex.addCleanup FsckCleanup $ do
v <- getStartTime u
case v of
diff --git a/Types/Command.hs b/Types/Command.hs
index 99920e6577..acd662bf3f 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -43,7 +43,7 @@ data Command = Command
, cmdnocommit :: Bool -- don't commit journalled state changes
, cmdnomessages :: Bool -- don't output normal messages
, cmdname :: String
- , cmdparamdesc :: String -- description of params for usage
+ , cmdparamdesc :: CmdParamsDesc -- description of params for usage
, cmdsection :: CommandSection
, cmddesc :: String -- description of command for usage
, cmdparser :: CommandParser -- command line parser
@@ -54,6 +54,8 @@ data Command = Command
- are parsed. -}
type CmdParams = [String]
+type CmdParamsDesc = String
+
{- CommandCheck functions can be compared using their unique id. -}
instance Eq CommandCheck where
a == b = idCheck a == idCheck b