{-|
This library provides a thin layer on optparse-applicative
argument and option parsing, using @Parser (IO ())@,
applying commands directly to their argument parsing.

A few option Mod functions are also provided.
-}

module SimpleCmdArgs
  (simpleCmdArgs,
   simpleCmdArgs',
   simpleCmdArgsWithMods,
   -- * Subcommands
   Subcommand(..),
   subcommands,
   -- * Option and arg helpers
   strArg,
   switchWith,
   flagWith,
   flagWith',
   switchMods,
   strOptionWith,
   optionWith,
   optionMods,
   strOptionalWith,
   optionalWith,
   optionalMods,
   argumentWith,
   -- * Re-exports from optparse-applicative
   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

-- | Parser executor (allows interspersed args and options)
--
-- > simpleCmdArgs (Just version) "summary" "program description" $ myCommand <$> myOptParser <*> myargsParser
simpleCmdArgs ::
  Maybe Version
  -- ^ version string
  -> String
  -- ^ header
  -> String
  -- ^ program description
  -> Parser (IO ())
  -- ^ commands
  -> 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

-- | Parser executor without interspersing options and args
--
-- > simpleCmdArgs' Nothing "summary" "program description" $ myCommand <$> myOptParser <*> myargsParser
simpleCmdArgs'
  :: Maybe Version
  -- ^ version string
  -> String
  -- ^ header
  -> String
  -- ^ program description
  -> Parser (IO ())
  -- ^ commands
  -> 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

-- | Generic parser executor with explicit info modifiers
--
-- @since 0.1.1
simpleCmdArgsWithMods ::
  Maybe Version -- ^ version string
  -> InfoMod (IO ()) -- ^ modifiers
  -> Parser (IO ()) -- ^ commands
  -> 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")

-- | > Subcommand "command" "help description text" $ myCommand <$> optParser
data Subcommand =
  Subcommand String String (Parser (IO ()))

subCmdName :: Subcommand -> String
subCmdName :: Subcommand -> String
subCmdName (Subcommand String
n String
_ Parser (IO ())
_) = String
n

-- | equality by command name
--
-- @since 0.1.5
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

-- | comparison by command name
--
-- @since 0.1.5
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)

-- | Create a list of @Subcommand@ that can be run by @simpleCmdArgs@
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

-- | A string arg parser with a METAVAR for help
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)

-- | switch with Mods
--
-- > switchWith 'o' "option" "help description"
--
-- @since 0.1.1
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)

-- | flag with Mods
--
-- > flagWith offVal onVal 'f' "flag" "help description"
--
-- @since 0.1.2
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)

-- | flag' with Mods
--
-- > flagWith' val 'f' "flag" "help description"
--
-- @since 0.1.2
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)

-- | @Mod@s for a switch.
--
-- > switchMods 'o' "option" "help description"
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

-- | strOption with Mods
--
-- > strOptionWith 'o' "option" "METAVAR" "help description"
--
-- @since 0.1.1
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)

-- | option with Mods
--
-- > optionWith auto 'o' "option" "METAVAR" "help description"
--
-- @since 0.1.1
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)

-- | @Mod@s for a mandatory option.
--
-- > optionMods 'o' "option" "METAVAR" "help description"
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

-- | strOptional with Mods
--
-- > strOptionalWith 'o' "option" "METAVAR" "help description" default
--
-- @since 0.1.1
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)

-- | optional option with Mods, includes a default value.
--
-- > optionalWith auto 'o' "option" "METAVAR" "help description" default
--
-- @since 0.1.1
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)

-- | @Mod@s for an optional option: includes a default value.
--
-- > optionalMods 'o' "option" "METAVAR" "help description" default
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

-- | argument with METAVAR
--
-- > argumentWith auto "METAVAR"
--
-- @since 0.1.1
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)