wip

2 files changed, 68 insertions, 46 deletions

diff --git a/Command/Drop.hs b/Command/Drop.hs
index a93dac595..b569491bb 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -19,50 +19,68 @@ import Annex.NumCopies
 import Annex.Content
 import Annex.Wanted
 import Annex.Notification
+import Git.Types (RemoteName)
 
 import qualified Data.Set as S
+import Options.Applicative hiding (command)
 
 cmd :: Command
-cmd = withOptions (dropOptions) $ 
-	command "drop" SectionCommon
-		"indicate content of files not currently wanted"
-		paramPaths (withParams seek)
-
-dropOptions :: [Option]
-dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
-
-dropFromOption :: Option
-dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
-
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	from <- getOptionField dropFromOption Remote.byNameWithUUID
-	auto <- getOptionFlag autoOption
-	withKeyOptions auto
-		(startKeys auto from)
-		(withFilesInGit $ whenAnnexed $ start auto from)
-		ps
-
-start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
-start auto from file key = start' auto from key (Just file)
-
-start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
-start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
-	stopUnless want $
-		case from of
-			Nothing -> startLocal afile numcopies key Nothing
-			Just remote -> do
-				u <- getUUID
-				if Remote.uuid remote == u
-					then startLocal afile numcopies key Nothing
-					else startRemote afile numcopies key remote
-  where
-	want
-		| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
-		| otherwise = return True
-
-startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
-startKeys auto from key = start' auto from key Nothing
+cmd = command "drop" SectionCommon
+	"indicate content of files not currently wanted"
+	paramPaths (seek <$$> optParser)
+
+data DropOptions = DropOptions
+	{ dropFiles :: CmdParams
+	, dropFrom :: Maybe RemoteName
+	, autoMode :: Bool
+	, keyOptions :: KeyOptions
+	}
+
+-- TODO: annexedMatchingOptions
+
+optParser :: CmdParamsDesc -> Parser DropOptions
+optParser desc = DropOptions
+	<$> cmdParams desc
+	<*> parseDropFromOption
+	<*> parseAutoOption
+	<*> parseKeyOptions False
+
+parseDropFromOption :: Parser (Maybe RemoteName)
+parseDropFromOption = finalOpt $ strOption
+        ( long "from"
+        <> short 'f'
+	<> metavar paramRemote
+        <> help "drop content from a remote"
+	)
+
+seek :: DropOptions -> CommandSeek
+seek o = withKeyOptions (keyOptions o) (autoMode o)
+	(startKeys o)
+	(withFilesInGit $ whenAnnexed $ start o)
+	(dropFiles o)
+
+start :: DropOptions -> FilePath -> Key -> CommandStart
+start o file key = start' o key (Just file)
+
+start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
+start' o key afile = do
+	from <- Remote.byNameWithUUID (dropFrom o)
+	checkDropAuto (autoMode o) from afile key $ \numcopies ->
+		stopUnless (want from) $
+			case from of
+				Nothing -> startLocal afile numcopies key Nothing
+				Just remote -> do
+					u <- getUUID
+					if Remote.uuid remote == u
+						then startLocal afile numcopies key Nothing
+						else startRemote afile numcopies key remote
+	  where
+		want from
+			| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
+			| otherwise = return True
+
+startKeys :: DropOptions -> Key -> CommandStart
+startKeys o key = start' o key Nothing
 
 startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
 startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
@@ -166,10 +184,10 @@ requiredContent = do
 {- In auto mode, only runs the action if there are enough
  - copies on other semitrusted repositories. -}
 checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
+checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
   where
 	go numcopies
-		| auto = do
+		| automode = do
 			locs <- Remote.keyLocations key
 			uuid <- getUUID
 			let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index c2a819e9d..486b686d5 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -34,6 +34,7 @@ import Types.CleanupActions
 import Utility.HumanTime
 import Utility.CopyFile
 import Git.FilePath
+import Git.Types (RemoteName)
 import Utility.PID
 import qualified Database.Fsck as FsckDb
 
@@ -42,15 +43,17 @@ import System.Posix.Types (EpochTime)
 import Options.Applicative hiding (command)
 
 cmd :: Command
-cmd = command "fsck" SectionMaintenance "check for problems"
+cmd = command "fsck" SectionMaintenance
+	"find and fix problems"
 	paramPaths (seek <$$> optParser)
 
 data FsckOptions = FsckOptions
 	{ fsckFiles :: CmdParams
-	, fsckFromOption :: Maybe String
+	, fsckFromOption :: Maybe RemoteName
 	, startIncrementalOption :: Bool
 	, moreIncrementalOption :: Bool
 	, incrementalScheduleOption :: Maybe Duration
+	, keyOptions :: KeyOptions
 	}
 
 optParser :: CmdParamsDesc -> Parser FsckOptions
@@ -77,15 +80,16 @@ optParser desc = FsckOptions
 		<> metavar paramTime
 		<> help "schedule incremental fscking"
 		))
+	<*> parseKeyOptions False
 
--- TODO: keyOptions, annexedMatchingOptions
+-- TODO: annexedMatchingOptions
 
 seek :: FsckOptions -> CommandSeek
 seek o = do
 	from <- Remote.byNameWithUUID (fsckFromOption o)
 	u <- maybe getUUID (pure . Remote.uuid) from
 	i <- getIncremental u o
-	withKeyOptions False
+	withKeyOptions (keyOptions o) False
 		(\k -> startKey i k =<< getNumCopies)
 		(withFilesInGit $ whenAnnexed $ start from i)
 		(fsckFiles o)