use Alternative for parsing KeyOptions

2 files changed, 36 insertions, 49 deletions

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index f95ab08ff..02cbcdcfe 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -55,47 +55,38 @@ gitAnnexOptions = commonOptions ++
 		>>= Annex.changeGitRepo
 
 -- Options for acting on keys, rather than work tree files.
-data KeyOptions = KeyOptions
-	{ wantAllKeys :: Bool
-	, wantUnusedKeys :: Bool
-	, wantIncompleteKeys :: Bool
-	, wantSpecificKey :: Maybe Key
-	}
+data KeyOptions
+	= WantAllKeys
+	| WantUnusedKeys
+	| WantSpecificKey Key
+	| WantIncompleteKeys
 
 parseKeyOptions :: Bool -> Parser KeyOptions
-parseKeyOptions allowincomplete = KeyOptions
-	<$> parseAllKeysOption
-	<*> parseUnusedKeysOption
-	<*> (if allowincomplete then parseIncompleteOption else pure False)
-	<*> parseSpecificKeyOption
-
-parseAllKeysOption :: Parser Bool
-parseAllKeysOption = switch
-	( long "all" <> short 'A'
-	<> help "operate on all versions of all files"
-	)
-
-parseUnusedKeysOption :: Parser Bool
-parseUnusedKeysOption = switch
-	( long "unused" <> short 'U'
-	<> help "operate on files found by last run of git-annex unused"
-	)
-
-parseSpecificKeyOption :: Parser (Maybe Key)
-parseSpecificKeyOption = optional $ option (str >>= parseKey)
-	( long "key" <> metavar paramKey
-	<> help "operate on specified key"
-	)
+parseKeyOptions allowincomplete = if allowincomplete
+	then base
+		<|> flag' WantIncompleteKeys
+			( long "incomplete"
+			<> help "resume previous downloads"
+			)
+	else base
+  where
+	base =
+		flag' WantAllKeys
+			( long "all" <> short 'A'
+			<> help "operate on all versions of all files"
+			)
+		<|> flag' WantUnusedKeys
+			( long "unused" <> short 'U'
+			<> help "operate on files found by last run of git-annex unused"
+			)
+		<|> (WantSpecificKey <$> option (str >>= parseKey)
+			( long "key" <> metavar paramKey
+			<> help "operate on specified key"
+			))
 
 parseKey :: Monad m => String -> m Key
 parseKey = maybe (fail "invalid key") return . file2key
 
-parseIncompleteOption :: Parser Bool
-parseIncompleteOption = switch
-	( long "incomplete"
-	<> help "resume previous downloads"
-	)
-
 -- Options to match properties of annexed files.
 annexedMatchingOptions :: [Option]
 annexedMatchingOptions = concat
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 1d6708191..b40e0d17a 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -172,7 +172,7 @@ withNothing _ _ = error "This command takes no parameters."
  -
  - Otherwise falls back to a regular CommandSeek action on
  - whatever params were passed. -}
-withKeyOptions :: KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions :: Maybe KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
 withKeyOptions ko auto keyaction = withKeyOptions' ko auto $ \getkeys -> do
 	matcher <- Limit.getMatcher
 	seekActions $ map (process matcher) <$> getkeys
@@ -182,25 +182,21 @@ withKeyOptions ko auto keyaction = withKeyOptions' ko auto $ \getkeys -> do
 		, return Nothing
 		)
 
-withKeyOptions' :: KeyOptions -> Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions' :: Maybe KeyOptions -> Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
 withKeyOptions' ko auto keyaction fallbackaction params = do
 	bare <- fromRepo Git.repoIsLocalBare
-	let allkeys = wantAllKeys ko
-	let unused = wantUnusedKeys ko
-	let incomplete = wantIncompleteKeys ko
-	let specifickey = wantSpecificKey ko
 	when (auto && bare) $
 		error "Cannot use --auto in a bare repository"
-	case	(allkeys, unused, incomplete, null params, specifickey) of
-		(False  , False , False     , True       , Nothing)
+	case (null params, ko) of
+		(True, Nothing)
 			| bare -> go auto loggedKeys
 			| otherwise -> fallbackaction params
-		(False  , False , False     , _          , Nothing) -> fallbackaction params
-		(True   , False , False     , True       , Nothing) -> go auto loggedKeys
-		(False  , True  , False     , True       , Nothing) -> go auto unusedKeys'
-		(False  , False , True      , True       , Nothing) -> go auto incompletekeys
-		(False  , False , False     , True       , Just k) -> go auto $ return [k]
-		_ -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
+		(False, Nothing) -> fallbackaction params
+		(True, Just WantAllKeys) -> go auto loggedKeys
+		(True, Just WantUnusedKeys) -> go auto unusedKeys'
+		(True, Just (WantSpecificKey k)) -> go auto $ return [k]
+		(True, Just WantIncompleteKeys) -> go auto incompletekeys
+		(False, Just _) -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
   where
 	go True _ = error "Cannot use --auto with --all or --unused or --key or --incomplete"
 	go False getkeys = keyaction getkeys