{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
module PFile.CLI.Switch
( parserInfo
, parser
, Options (..)
) where
import Options.Applicative
( Parser
, ParserInfo
, argument
, completer
, fullDesc
, header
, help
, helper
, info
, listIOCompleter
, long
, metavar
, progDesc
, short
, str
, switch
)
import qualified PFile.Completion as Completion
import Protolude
parserInfo :: ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Options
parser Parser Options -> Parser (Options -> Options) -> Parser Options
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options -> Options)
forall a. Parser (a -> a)
helper)
(InfoMod Options -> ParserInfo Options)
-> InfoMod Options -> ParserInfo Options
forall a b. (a -> b) -> a -> b
$ InfoMod Options
forall a. InfoMod a
fullDesc
InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
header String
"pfile switch - switch to PROFILE"
InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
progDesc String
description
where
description :: String
description
= String
"Switch to PROFILE. The current profile is unlinked first (links"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" pointing at current profile's entries are removed) and then the"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" PROFILE is linked (links pointing at PROFILE profile's entries are"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" made). If the current profile was not set yet, the first step is"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" skipped. `pfile switch` could be reverted with `pfile unpack`."
parser :: Parser Options
parser :: Parser Options
parser = do
Bool
forceRemoveOccupied <- Mod FlagFields Bool -> Parser Bool
switch
(Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force-remove-occupied"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Force remove of paths occupying current/PROFILE profile's link paths"
Text
nextProfileName <- ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str
(Mod ArgumentFields Text -> Parser Text)
-> Mod ArgumentFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PROFILE"
Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (IO [String] -> Completer
listIOCompleter IO [String]
Completion.profileNames)
pure Options {Bool
Text
forceRemoveOccupied :: Bool
nextProfileName :: Text
forceRemoveOccupied :: Bool
nextProfileName :: Text
..}
data Options
= Options
{ Options -> Bool
forceRemoveOccupied :: !Bool
, Options -> Text
nextProfileName :: !Text
}