module Turtle.Options
(
Parser
, ArgName(..)
, CommandName(..)
, ShortName
, Description(..)
, HelpMessage(..)
, switch
, optText
, optInt
, optInteger
, optDouble
, optPath
, optRead
, opt
, argText
, argInt
, argInteger
, argDouble
, argPath
, argRead
, arg
, subcommand
, options
) where
import Data.Monoid
import Data.Foldable
import Data.String (IsString)
import Text.Read (readMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Optional
import Control.Applicative
import Control.Monad.IO.Class
import Filesystem.Path.CurrentOS (FilePath, fromText)
import Options.Applicative (Parser)
import qualified Options.Applicative as Opts
import qualified Options.Applicative.Types as Opts
import Prelude hiding (FilePath)
options :: MonadIO io => Description -> Parser a -> io a
options desc parser = liftIO
$ Opts.execParser
$ Opts.info (Opts.helper <*> parser)
(Opts.header (Text.unpack (getDescription desc)))
newtype ArgName = ArgName { getArgName :: Text }
deriving (IsString)
type ShortName = Char
newtype CommandName = CommandName { getCommandName :: Text }
deriving (IsString)
newtype Description = Description { getDescription :: Text }
deriving (IsString)
newtype HelpMessage = HelpMessage { getHelpMessage :: Text }
deriving (IsString)
switch
:: ArgName
-> ShortName
-> Optional HelpMessage
-> Parser Bool
switch argName c helpMessage
= Opts.switch
$ (Opts.long . Text.unpack . getArgName) argName
<> Opts.short c
<> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage
opt :: (Text -> Maybe a)
-> ArgName
-> ShortName
-> Optional HelpMessage
-> Parser a
opt argParse argName c helpMessage
= Opts.option (argParseToReadM argParse)
$ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName)))
<> Opts.long (Text.unpack (getArgName argName))
<> Opts.short c
<> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage
optRead :: Read a => ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead = opt (readMaybe . Text.unpack)
optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int
optInt = optRead
optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer
optInteger = optRead
optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double
optDouble = optRead
optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text
optText = opt Just
optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath
optPath argName short msg = fmap fromText (optText argName short msg)
arg :: (Text -> Maybe a)
-> ArgName
-> Optional HelpMessage
-> Parser a
arg argParse argName helpMessage
= Opts.argument (argParseToReadM argParse)
$ Opts.metavar (Text.unpack (Text.toUpper (getArgName argName)))
<> foldMap (Opts.help . Text.unpack . getHelpMessage) helpMessage
argRead :: Read a => ArgName -> Optional HelpMessage -> Parser a
argRead = arg (readMaybe . Text.unpack)
argInt :: ArgName -> Optional HelpMessage -> Parser Int
argInt = argRead
argInteger :: ArgName -> Optional HelpMessage -> Parser Integer
argInteger = argRead
argDouble :: ArgName -> Optional HelpMessage -> Parser Double
argDouble = argRead
argText :: ArgName -> Optional HelpMessage -> Parser Text
argText = arg Just
argPath :: ArgName -> Optional HelpMessage -> Parser FilePath
argPath argName msg = fmap fromText (argText argName msg)
argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a
argParseToReadM f = do
s <- Opts.readerAsk
case f (Text.pack s) of
Just a -> return a
Nothing -> Opts.readerAbort Opts.ShowHelpText
subcommand :: CommandName -> Description -> Parser a -> Parser a
subcommand cmdName desc p =
Opts.subparser (Opts.command name info <> Opts.metavar name)
where
name = Text.unpack (getCommandName cmdName)
info = Opts.info
(Opts.helper <*> p)
(Opts.header (Text.unpack (getDescription desc)))