1 files changed, 71 insertions, 65 deletions

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 8988100b8..0e0c49d78 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -40,40 +40,57 @@ import qualified Database.Fsck as FsckDb
 import Data.Time.Clock.POSIX
 import System.Posix.Types (EpochTime)
 
-cmd :: [Command]
-cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
-	SectionMaintenance "check for problems"]
-
-fsckFromOption :: Option
-fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"
-
-startIncrementalOption :: Option
-startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"
-
-moreIncrementalOption :: Option
-moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"
-
-incrementalScheduleOption :: Option
-incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime
-	"schedule incremental fscking"
-
-fsckOptions :: [Option]
-fsckOptions = 
-	[ fsckFromOption
-	, startIncrementalOption
-	, moreIncrementalOption
-	, incrementalScheduleOption
-	] ++ keyOptions ++ annexedMatchingOptions
-
-seek :: CommandSeek
-seek ps = do
-	from <- getOptionField fsckFromOption Remote.byNameWithUUID
+cmd :: Command
+cmd = withGlobalOptions annexedMatchingOptions $
+	command "fsck" SectionMaintenance
+		"find and fix problems"
+		paramPaths (seek <$$> optParser)
+
+data FsckOptions = FsckOptions
+	{ fsckFiles :: CmdParams
+	, fsckFromOption :: Maybe (DeferredParse Remote)
+	, incrementalOpt :: Maybe IncrementalOpt
+	, keyOptions :: Maybe KeyOptions
+	}
+
+data IncrementalOpt
+	= StartIncrementalO
+	| MoreIncrementalO
+	| ScheduleIncrementalO Duration
+
+optParser :: CmdParamsDesc -> Parser FsckOptions
+optParser desc = FsckOptions
+	<$> cmdParams desc
+	<*> optional (parseRemoteOption $ strOption 
+		( long "from" <> short 'f' <> metavar paramRemote 
+		<> help "check remote"
+		))
+	<*> optional parseincremental
+	<*> optional (parseKeyOptions False)
+  where
+	parseincremental =
+		flag' StartIncrementalO
+			( long "incremental" <> short 'S'
+			<> help "start an incremental fsck"
+			)
+		<|> flag' MoreIncrementalO
+			( long "more" <> short 'm'
+			<> help "continue an incremental fsck"
+			)
+		<|> (ScheduleIncrementalO <$> option (str >>= parseDuration)
+			( long "incremental-schedule" <> metavar paramTime
+			<> help "schedule incremental fscking"
+			))
+
+seek :: FsckOptions -> CommandSeek
+seek o = do
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (fsckFromOption o)
 	u <- maybe getUUID (pure . Remote.uuid) from
-	i <- getIncremental u
-	withKeyOptions False
+	i <- prepIncremental u (incrementalOpt o)
+	withKeyOptions (keyOptions o) False
 		(\k -> startKey i k =<< getNumCopies)
 		(withFilesInGit $ whenAnnexed $ start from i)
-		ps
+		(fsckFiles o)
 	withFsckDb i FsckDb.closeDb
 	void $ tryIO $ recordActivity Fsck u
 
@@ -497,37 +514,26 @@ 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
-		(False, False, False) -> return NonIncremental
-		(False, True, False) -> startIncremental
-		(False ,False, True) -> contIncremental
-		(True, False, False) ->
-			maybe startIncremental (const contIncremental)
-				=<< getStartTime u
-		_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"
-  where
-	startIncremental = do
-		recordStartTime u
-		ifM (FsckDb.newPass u)
-			( StartIncremental <$> FsckDb.openDb u
-			, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
-			)
-	contIncremental = ContIncremental <$> FsckDb.openDb u
-
-	checkschedule Nothing = error "bad --incremental-schedule value"
-	checkschedule (Just delta) = do
-		Annex.addCleanup FsckCleanup $ do
-			v <- getStartTime u
-			case v of
-				Nothing -> noop
-				Just started -> do
-					now <- liftIO getPOSIXTime
-					when (now - realToFrac started >= durationToPOSIXTime delta) $
-						resetStartTime u
-		return True
+prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental
+prepIncremental _ Nothing = pure NonIncremental
+prepIncremental u (Just StartIncrementalO) = do
+	recordStartTime u
+	ifM (FsckDb.newPass u)
+		( StartIncremental <$> FsckDb.openDb u
+		, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
+		)
+prepIncremental u (Just MoreIncrementalO) =
+	ContIncremental <$> FsckDb.openDb u
+prepIncremental u (Just (ScheduleIncrementalO delta)) = do
+	Annex.addCleanup FsckCleanup $ do
+		v <- getStartTime u
+		case v of
+			Nothing -> noop
+			Just started -> do
+				now <- liftIO getPOSIXTime
+				when (now - realToFrac started >= durationToPOSIXTime delta) $
+					resetStartTime u
+	started <- getStartTime u
+	prepIncremental u $ Just $ case started of
+		Nothing -> StartIncrementalO
+		Just _ -> MoreIncrementalO