module Options.Applicative.Simple
( module Options.Applicative.Simple
, module Options.Applicative
) where
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Either
import Control.Monad.Trans.Writer
import Data.Monoid
import Data.Version
import Development.GitRev (gitDirty, gitHash)
import Language.Haskell.TH (Q,Exp)
import qualified Language.Haskell.TH.Syntax as TH
import Options.Applicative
import System.Environment
simpleOptions
:: String
-> String
-> String
-> Parser a
-> EitherT b (Writer (Mod CommandFields b)) ()
-> IO (a,b)
simpleOptions versionString h pd globalParser commandParser =
do args <- getArgs
case execParserPure (prefs idm) parser args of
Failure _ | null args -> withArgs ["--help"] (execParser parser)
parseResult -> handleParseResult parseResult
where parser = info (helpOption <*> versionOption <*> config) desc
desc = fullDesc <> header h <> progDesc pd
helpOption =
abortOption ShowHelpText $
long "help" <>
help "Show this help text"
versionOption =
infoOption
versionString
(long "version" <>
help "Show version")
config =
(,) <$> globalParser <*>
case runWriter (runEitherT commandParser) of
(Right (),d) -> subparser d
(Left b,_) -> pure b
simpleVersion :: Version -> Q Exp
simpleVersion version =
[|concat ["Version "
,$(TH.lift $ showVersion version)
,", Git revision "
,$gitHash
,if $gitDirty
then " (dirty)"
else ""]|]
addCommand :: String
-> String
-> (a -> b)
-> Parser a
-> EitherT b (Writer (Mod CommandFields b)) ()
addCommand cmd title constr inner =
lift (tell (command cmd
(info (constr <$> inner)
(progDesc title))))