{-# LANGUAGE CPP #-}
module SimpleCmdArgs
(simpleCmdArgs,
simpleCmdArgs',
simpleCmdArgsWithMods,
Subcommand(..),
subcommands,
strArg,
switchWith,
switchLongWith,
flagWith,
flagWith',
flagLongWith,
flagLongWith',
switchMods,
switchLongMods,
strOptionWith,
strOptionLongWith,
optionWith,
optionLongWith,
optionMods,
optionLongMods,
strOptionalWith,
strOptionalLongWith,
optionalWith,
optionalLongWith,
optionalMods,
optionalLongMods,
argumentWith,
Parser,
ReadM,
auto,
many,
eitherReader,
maybeReader,
optional,
some,
str,
(<|>),
#if !MIN_VERSION_base(4,8,0)
(<$>), (<*>)
#endif
)
where
#if !MIN_VERSION_base(4,13,0)
import Control.Applicative ((<|>),
#if !MIN_VERSION_base(4,8,0)
(<$>), (<*>)
#endif
)
#endif
import Control.Monad (join)
import Data.List (nub)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat)
#endif
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif
import Data.Version
import Debug.Trace (trace)
import Options.Applicative
simpleCmdArgs ::
Maybe Version
-> String
-> String
-> Parser (IO ())
-> IO ()
simpleCmdArgs :: Maybe Version -> String -> String -> Parser (IO ()) -> IO ()
simpleCmdArgs Maybe Version
mversion String
h String
pd =
Maybe Version -> InfoMod (IO ()) -> Parser (IO ()) -> IO ()
simpleCmdArgsWithMods Maybe Version
mversion InfoMod (IO ())
forall a. InfoMod a
mods
where
mods :: InfoMod a
mods = InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
header String
h InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
pd
simpleCmdArgs'
:: Maybe Version
-> String
-> String
-> Parser (IO ())
-> IO ()
simpleCmdArgs' :: Maybe Version -> String -> String -> Parser (IO ()) -> IO ()
simpleCmdArgs' Maybe Version
mversion String
h String
pd =
Maybe Version -> InfoMod (IO ()) -> Parser (IO ()) -> IO ()
simpleCmdArgsWithMods Maybe Version
mversion InfoMod (IO ())
forall a. InfoMod a
mods
where
mods :: InfoMod a
mods = InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
header String
h InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
pd InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> InfoMod a
forall a. InfoMod a
noIntersperse
simpleCmdArgsWithMods ::
Maybe Version
-> InfoMod (IO ())
-> Parser (IO ())
-> IO ()
simpleCmdArgsWithMods :: Maybe Version -> InfoMod (IO ()) -> Parser (IO ()) -> IO ()
simpleCmdArgsWithMods Maybe Version
mversion InfoMod (IO ())
mods Parser (IO ())
cmdsParser = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
ParserPrefs -> ParserInfo (IO ()) -> IO (IO ())
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty)
(case Maybe Version
mversion of
(Just Version
version) -> Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ((IO () -> IO ()) -> IO () -> IO ())
forall a. Parser (a -> a)
helper Parser ((IO () -> IO ()) -> IO () -> IO ())
-> Parser (IO () -> IO ()) -> Parser (IO () -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> Parser (IO () -> IO ())
forall a. Version -> Parser (a -> a)
versionOption Version
version Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmdsParser) InfoMod (IO ())
mods
Maybe Version
Nothing -> Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmdsParser) InfoMod (IO ())
mods)
where
versionOption :: Version -> Parser (a -> a)
versionOption Version
ver =
String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> String
showVersion Version
ver) (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")
data Subcommand =
Subcommand String String (Parser (IO ()))
subCmdName :: Subcommand -> String
subCmdName :: Subcommand -> String
subCmdName (Subcommand String
n String
_ Parser (IO ())
_) = String
n
instance Eq Subcommand where
Subcommand
c1 == :: Subcommand -> Subcommand -> Bool
== Subcommand
c2 = Subcommand -> String
subCmdName Subcommand
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Subcommand -> String
subCmdName Subcommand
c2
instance Ord Subcommand where
compare :: Subcommand -> Subcommand -> Ordering
compare Subcommand
c1 Subcommand
c2 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Subcommand -> String
subCmdName Subcommand
c1) (Subcommand -> String
subCmdName Subcommand
c2)
subcommands :: [Subcommand] -> Parser (IO ())
subcommands :: [Subcommand] -> Parser (IO ())
subcommands = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> ([Subcommand] -> Mod CommandFields (IO ()))
-> [Subcommand]
-> Parser (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mod CommandFields (IO ())] -> Mod CommandFields (IO ())
forall a. Monoid a => [a] -> a
mconcat ([Mod CommandFields (IO ())] -> Mod CommandFields (IO ()))
-> ([Subcommand] -> [Mod CommandFields (IO ())])
-> [Subcommand]
-> Mod CommandFields (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subcommand -> Mod CommandFields (IO ()))
-> [Subcommand] -> [Mod CommandFields (IO ())]
forall a b. (a -> b) -> [a] -> [b]
map Subcommand -> Mod CommandFields (IO ())
cmdToParse ([Subcommand] -> [Mod CommandFields (IO ())])
-> ([Subcommand] -> [Subcommand])
-> [Subcommand]
-> [Mod CommandFields (IO ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Subcommand] -> [Subcommand]
warnIfDuplicates
where
cmdToParse :: Subcommand -> Mod CommandFields (IO ())
cmdToParse (Subcommand String
name String
cmddesc Parser (IO ())
cmdparse) =
String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
name (Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser (IO ())
cmdparse (String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
cmddesc))
warnIfDuplicates :: [Subcommand] -> [Subcommand]
warnIfDuplicates :: [Subcommand] -> [Subcommand]
warnIfDuplicates [Subcommand]
subcmds =
if Bool
dups then String -> [Subcommand] -> [Subcommand]
forall a. String -> a -> a
trace String
"duplicate subcommand found" [Subcommand]
subcmds else [Subcommand]
subcmds
where
dups :: Bool
dups = [Subcommand] -> [Subcommand]
forall a. Eq a => [a] -> [a]
nub [Subcommand]
subcmds [Subcommand] -> [Subcommand] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Subcommand]
subcmds
strArg :: String -> Parser String
strArg :: String -> Parser String
strArg String
var = Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
var)
switchWith :: Char -> String -> String -> Parser Bool
switchWith :: Char -> String -> String -> Parser Bool
switchWith Char
s String
l String
h =
Mod FlagFields Bool -> Parser Bool
switch (Char -> String -> String -> Mod FlagFields Bool
forall (f :: * -> *) a.
HasName f =>
Char -> String -> String -> Mod f a
switchMods Char
s String
l String
h)
switchLongWith :: String -> String -> Parser Bool
switchLongWith :: String -> String -> Parser Bool
switchLongWith String
l String
h =
Mod FlagFields Bool -> Parser Bool
switch (String -> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> String -> Mod f a
switchLongMods String
l String
h)
flagWith :: a -> a -> Char -> String -> String -> Parser a
flagWith :: a -> a -> Char -> String -> String -> Parser a
flagWith a
off a
on Char
s String
l String
h =
a -> a -> Mod FlagFields a -> Parser a
forall a. a -> a -> Mod FlagFields a -> Parser a
flag a
off a
on (Char -> String -> String -> Mod FlagFields a
forall (f :: * -> *) a.
HasName f =>
Char -> String -> String -> Mod f a
switchMods Char
s String
l String
h)
flagWith' :: a -> Char -> String -> String -> Parser a
flagWith' :: a -> Char -> String -> String -> Parser a
flagWith' a
val Char
s String
l String
h =
a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag' a
val (Char -> String -> String -> Mod FlagFields a
forall (f :: * -> *) a.
HasName f =>
Char -> String -> String -> Mod f a
switchMods Char
s String
l String
h)
flagLongWith :: a -> a -> String -> String -> Parser a
flagLongWith :: a -> a -> String -> String -> Parser a
flagLongWith a
off a
on String
l String
h =
a -> a -> Mod FlagFields a -> Parser a
forall a. a -> a -> Mod FlagFields a -> Parser a
flag a
off a
on (String -> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> String -> Mod f a
switchLongMods String
l String
h)
flagLongWith' :: a -> String -> String -> Parser a
flagLongWith' :: a -> String -> String -> Parser a
flagLongWith' a
val String
l String
h =
a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag' a
val (String -> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> String -> Mod f a
switchLongMods String
l String
h)
switchMods :: HasName f =>
Char -> String -> String -> Mod f a
switchMods :: Char -> String -> String -> Mod f a
switchMods Char
s String
l String
h =
Char -> Mod f a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
s Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h
switchLongMods :: HasName f =>
String -> String -> Mod f a
switchLongMods :: String -> String -> Mod f a
switchLongMods String
l String
h =
String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h
strOptionWith :: Char -> String -> String -> String -> Parser String
strOptionWith :: Char -> String -> String -> String -> Parser String
strOptionWith Char
s String
l String
meta String
h =
Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> String -> String -> String -> Mod OptionFields String
forall (f :: * -> *) a.
(HasMetavar f, HasName f) =>
Char -> String -> String -> String -> Mod f a
optionMods Char
s String
l String
meta String
h)
strOptionLongWith :: String -> String -> String -> Parser String
strOptionLongWith :: String -> String -> String -> Parser String
strOptionLongWith String
l String
meta String
h =
Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> String -> String -> Mod OptionFields String
forall (f :: * -> *) a.
(HasMetavar f, HasName f) =>
String -> String -> String -> Mod f a
optionLongMods String
l String
meta String
h)
optionWith :: ReadM a -> Char -> String -> String -> String -> Parser a
optionWith :: ReadM a -> Char -> String -> String -> String -> Parser a
optionWith ReadM a
r Char
s String
l String
meta String
h =
ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r (Char -> String -> String -> String -> Mod OptionFields a
forall (f :: * -> *) a.
(HasMetavar f, HasName f) =>
Char -> String -> String -> String -> Mod f a
optionMods Char
s String
l String
meta String
h)
optionLongWith :: ReadM a -> String -> String -> String -> Parser a
optionLongWith :: ReadM a -> String -> String -> String -> Parser a
optionLongWith ReadM a
r String
l String
meta String
h =
ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r (String -> String -> String -> Mod OptionFields a
forall (f :: * -> *) a.
(HasMetavar f, HasName f) =>
String -> String -> String -> Mod f a
optionLongMods String
l String
meta String
h)
optionMods :: (HasMetavar f, HasName f) =>
Char -> String -> String -> String -> Mod f a
optionMods :: Char -> String -> String -> String -> Mod f a
optionMods Char
s String
l String
meta String
h =
Char -> Mod f a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
s Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
meta Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h
optionLongMods :: (HasMetavar f, HasName f) =>
String -> String -> String -> Mod f a
optionLongMods :: String -> String -> String -> Mod f a
optionLongMods String
l String
meta String
h =
String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
meta Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h
strOptionalWith :: Char -> String -> String -> String -> String -> Parser String
strOptionalWith :: Char -> String -> String -> String -> String -> Parser String
strOptionalWith Char
s String
l String
meta String
h String
d =
Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char
-> String -> String -> String -> String -> Mod OptionFields String
forall (f :: * -> *) a.
(HasMetavar f, HasName f, HasValue f) =>
Char -> String -> String -> String -> a -> Mod f a
optionalMods Char
s String
l String
meta String
h String
d)
optionalWith :: ReadM a -> Char -> String -> String -> String -> a -> Parser a
optionalWith :: ReadM a -> Char -> String -> String -> String -> a -> Parser a
optionalWith ReadM a
r Char
s String
l String
meta String
h a
d =
ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r (Char -> String -> String -> String -> a -> Mod OptionFields a
forall (f :: * -> *) a.
(HasMetavar f, HasName f, HasValue f) =>
Char -> String -> String -> String -> a -> Mod f a
optionalMods Char
s String
l String
meta String
h a
d)
strOptionalLongWith :: String -> String -> String -> String -> Parser String
strOptionalLongWith :: String -> String -> String -> String -> Parser String
strOptionalLongWith String
l String
meta String
h String
d =
Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> String -> String -> String -> Mod OptionFields String
forall (f :: * -> *) a.
(HasMetavar f, HasName f, HasValue f) =>
String -> String -> String -> a -> Mod f a
optionalLongMods String
l String
meta (String
h String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" [default: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
d String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]") String
d)
optionalLongWith :: ReadM a -> String -> String -> String -> a -> Parser a
optionalLongWith :: ReadM a -> String -> String -> String -> a -> Parser a
optionalLongWith ReadM a
r String
l String
meta String
h a
d =
ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r (String -> String -> String -> a -> Mod OptionFields a
forall (f :: * -> *) a.
(HasMetavar f, HasName f, HasValue f) =>
String -> String -> String -> a -> Mod f a
optionalLongMods String
l String
meta String
h a
d)
optionalMods :: (HasMetavar f, HasName f, HasValue f) =>
Char -> String -> String -> String -> a -> Mod f a
optionalMods :: Char -> String -> String -> String -> a -> Mod f a
optionalMods Char
s String
l String
meta String
h a
d =
Char -> Mod f a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
s Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
meta Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> a -> Mod f a
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value a
d
optionalLongMods :: (HasMetavar f, HasName f, HasValue f) =>
String -> String -> String -> a -> Mod f a
optionalLongMods :: String -> String -> String -> a -> Mod f a
optionalLongMods String
l String
meta String
h a
d =
String -> Mod f a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
l Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
meta Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
h Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> a -> Mod f a
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value a
d
argumentWith :: ReadM a -> String -> Parser a
argumentWith :: ReadM a -> String -> Parser a
argumentWith ReadM a
r String
meta =
ReadM a -> Mod ArgumentFields a -> Parser a
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM a
r (String -> Mod ArgumentFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
meta)