{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Turtle.Options
(
Parser
, ArgName(..)
, CommandName(..)
, ShortName
, Description(..)
, HelpMessage(..)
, switch
, optText
, optLine
, optInt
, optInteger
, optDouble
, optPath
, optRead
, opt
, argText
, argLine
, argInt
, argInteger
, argDouble
, argPath
, argRead
, arg
, subcommand
, subcommandGroup
, options
, optionsExt
) where
import Data.Monoid
import Data.Foldable
import Data.String (IsString)
import Text.Read (readMaybe)
import Data.Text (Text)
import Data.Optional
import Control.Applicative
import Control.Monad.IO.Class
import Options.Applicative (Parser)
import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, renderCompact)
import Turtle.Line (Line)
import qualified Data.Text as Text
import qualified Options.Applicative as Opts
import qualified Options.Applicative.Types as Opts
import qualified Turtle.Line
options :: MonadIO io => Description -> Parser a -> io a
options :: forall (io :: * -> *) a.
MonadIO io =>
Description -> Parser a -> io a
options Description
desc Parser a
parser = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. (a -> b) -> a -> b
$ forall a. ParserPrefs -> ParserInfo a -> IO a
Opts.customExecParser (PrefsMod -> ParserPrefs
Opts.prefs PrefsMod
prefs)
forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (forall a. Parser (a -> a)
Opts.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser)
(forall a. Maybe Doc -> InfoMod a
Opts.headerDoc (forall a. a -> Maybe a
Just (Description -> Doc
getDescription Description
desc)))
where
prefs :: Opts.PrefsMod
#if MIN_VERSION_optparse_applicative(0,13,0)
prefs :: PrefsMod
prefs = PrefsMod
Opts.showHelpOnError forall a. Semigroup a => a -> a -> a
<> PrefsMod
Opts.showHelpOnEmpty
#else
prefs = Opts.showHelpOnError
#endif
optionsExt :: MonadIO io => Header -> Footer -> Description -> Version -> Parser a -> io a
optionsExt :: forall (io :: * -> *) a.
MonadIO io =>
Header -> Footer -> Description -> Version -> Parser a -> io a
optionsExt Header
header Footer
footer Description
desc Version
version Parser a
parser = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. (a -> b) -> a -> b
$ forall a. ParserPrefs -> ParserInfo a -> IO a
Opts.customExecParser (PrefsMod -> ParserPrefs
Opts.prefs PrefsMod
prefs)
forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (forall a. Parser (a -> a)
Opts.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
versionOption forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser)
(forall a. Maybe Doc -> InfoMod a
Opts.headerDoc (forall a. a -> Maybe a
Just (Header -> Doc
getHeader Header
header)) forall a. Semigroup a => a -> a -> a
<>
forall a. Maybe Doc -> InfoMod a
Opts.footerDoc (forall a. a -> Maybe a
Just (Footer -> Doc
getFooter Footer
footer)) forall a. Semigroup a => a -> a -> a
<>
forall a. Maybe Doc -> InfoMod a
Opts.progDescDoc (forall a. a -> Maybe a
Just (Description -> Doc
getDescription Description
desc)))
where
versionOption :: Parser (a -> a)
versionOption =
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
Opts.infoOption
(Version -> String
Text.unpack Version
version)
(forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"version" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Show version")
prefs :: Opts.PrefsMod
#if MIN_VERSION_optparse_applicative(0,13,0)
prefs :: PrefsMod
prefs = PrefsMod
Opts.showHelpOnError forall a. Semigroup a => a -> a -> a
<> PrefsMod
Opts.showHelpOnEmpty
#else
prefs = Opts.showHelpOnError
#endif
newtype ArgName = ArgName { ArgName -> Version
getArgName :: Text }
deriving (String -> ArgName
forall a. (String -> a) -> IsString a
fromString :: String -> ArgName
$cfromString :: String -> ArgName
IsString)
type ShortName = Char
newtype CommandName = CommandName { CommandName -> Version
getCommandName :: Text }
deriving (String -> CommandName
forall a. (String -> a) -> IsString a
fromString :: String -> CommandName
$cfromString :: String -> CommandName
IsString)
newtype Description = Description { Description -> Doc
getDescription :: Doc }
deriving (String -> Description
forall a. (String -> a) -> IsString a
fromString :: String -> Description
$cfromString :: String -> Description
IsString)
newtype = { :: Doc }
deriving (String -> Header
forall a. (String -> a) -> IsString a
fromString :: String -> Header
$cfromString :: String -> Header
IsString)
newtype = Fotter { :: Doc }
deriving (String -> Footer
forall a. (String -> a) -> IsString a
fromString :: String -> Footer
$cfromString :: String -> Footer
IsString)
type Version = Text
newtype HelpMessage = HelpMessage { HelpMessage -> Version
getHelpMessage :: Text }
deriving (String -> HelpMessage
forall a. (String -> a) -> IsString a
fromString :: String -> HelpMessage
$cfromString :: String -> HelpMessage
IsString)
switch
:: ArgName
-> ShortName
-> Optional HelpMessage
-> Parser Bool
switch :: ArgName -> ShortName -> Optional HelpMessage -> Parser Bool
switch ArgName
argName ShortName
c Optional HelpMessage
helpMessage
= Mod FlagFields Bool -> Parser Bool
Opts.switch
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgName -> Version
getArgName) ArgName
argName
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => ShortName -> Mod f a
Opts.short ShortName
c
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. String -> Mod f a
Opts.help forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. HelpMessage -> Version
getHelpMessage) Optional HelpMessage
helpMessage
opt :: (Text -> Maybe a)
-> ArgName
-> ShortName
-> Optional HelpMessage
-> Parser a
opt :: forall a.
(Version -> Maybe a)
-> ArgName -> ShortName -> Optional HelpMessage -> Parser a
opt Version -> Maybe a
argParse ArgName
argName ShortName
c Optional HelpMessage
helpMessage
= forall a. ReadM a -> Mod OptionFields a -> Parser a
Opts.option (forall a. (Version -> Maybe a) -> ReadM a
argParseToReadM Version -> Maybe a
argParse)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar (Version -> String
Text.unpack (Version -> Version
Text.toUpper (ArgName -> Version
getArgName ArgName
argName)))
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long (Version -> String
Text.unpack (ArgName -> Version
getArgName ArgName
argName))
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => ShortName -> Mod f a
Opts.short ShortName
c
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. String -> Mod f a
Opts.help forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. HelpMessage -> Version
getHelpMessage) Optional HelpMessage
helpMessage
optRead :: Read a => ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead :: forall a.
Read a =>
ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead = forall a.
(Version -> Maybe a)
-> ArgName -> ShortName -> Optional HelpMessage -> Parser a
opt (forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack)
optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int
optInt :: ArgName -> ShortName -> Optional HelpMessage -> Parser Int
optInt = forall a.
Read a =>
ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead
optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer
optInteger :: ArgName -> ShortName -> Optional HelpMessage -> Parser Integer
optInteger = forall a.
Read a =>
ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead
optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double
optDouble :: ArgName -> ShortName -> Optional HelpMessage -> Parser Double
optDouble = forall a.
Read a =>
ArgName -> ShortName -> Optional HelpMessage -> Parser a
optRead
optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text
optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Version
optText = forall a.
(Version -> Maybe a)
-> ArgName -> ShortName -> Optional HelpMessage -> Parser a
opt forall a. a -> Maybe a
Just
optLine :: ArgName -> ShortName -> Optional HelpMessage -> Parser Line
optLine :: ArgName -> ShortName -> Optional HelpMessage -> Parser Line
optLine = forall a.
(Version -> Maybe a)
-> ArgName -> ShortName -> Optional HelpMessage -> Parser a
opt Version -> Maybe Line
Turtle.Line.textToLine
optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath
optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser String
optPath ArgName
argName ShortName
short Optional HelpMessage
msg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> String
Text.unpack (ArgName -> ShortName -> Optional HelpMessage -> Parser Version
optText ArgName
argName ShortName
short Optional HelpMessage
msg)
arg :: (Text -> Maybe a)
-> ArgName
-> Optional HelpMessage
-> Parser a
arg :: forall a.
(Version -> Maybe a) -> ArgName -> Optional HelpMessage -> Parser a
arg Version -> Maybe a
argParse ArgName
argName Optional HelpMessage
helpMessage
= forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opts.argument (forall a. (Version -> Maybe a) -> ReadM a
argParseToReadM Version -> Maybe a
argParse)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar (Version -> String
Text.unpack (Version -> Version
Text.toUpper (ArgName -> Version
getArgName ArgName
argName)))
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. String -> Mod f a
Opts.help forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. HelpMessage -> Version
getHelpMessage) Optional HelpMessage
helpMessage
argRead :: Read a => ArgName -> Optional HelpMessage -> Parser a
argRead :: forall a. Read a => ArgName -> Optional HelpMessage -> Parser a
argRead = forall a.
(Version -> Maybe a) -> ArgName -> Optional HelpMessage -> Parser a
arg (forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Text.unpack)
argInt :: ArgName -> Optional HelpMessage -> Parser Int
argInt :: ArgName -> Optional HelpMessage -> Parser Int
argInt = forall a. Read a => ArgName -> Optional HelpMessage -> Parser a
argRead
argInteger :: ArgName -> Optional HelpMessage -> Parser Integer
argInteger :: ArgName -> Optional HelpMessage -> Parser Integer
argInteger = forall a. Read a => ArgName -> Optional HelpMessage -> Parser a
argRead
argDouble :: ArgName -> Optional HelpMessage -> Parser Double
argDouble :: ArgName -> Optional HelpMessage -> Parser Double
argDouble = forall a. Read a => ArgName -> Optional HelpMessage -> Parser a
argRead
argText :: ArgName -> Optional HelpMessage -> Parser Text
argText :: ArgName -> Optional HelpMessage -> Parser Version
argText = forall a.
(Version -> Maybe a) -> ArgName -> Optional HelpMessage -> Parser a
arg forall a. a -> Maybe a
Just
argLine :: ArgName -> Optional HelpMessage -> Parser Line
argLine :: ArgName -> Optional HelpMessage -> Parser Line
argLine = forall a.
(Version -> Maybe a) -> ArgName -> Optional HelpMessage -> Parser a
arg Version -> Maybe Line
Turtle.Line.textToLine
argPath :: ArgName -> Optional HelpMessage -> Parser FilePath
argPath :: ArgName -> Optional HelpMessage -> Parser String
argPath ArgName
argName Optional HelpMessage
msg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> String
Text.unpack (ArgName -> Optional HelpMessage -> Parser Version
argText ArgName
argName Optional HelpMessage
msg)
argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a
argParseToReadM :: forall a. (Version -> Maybe a) -> ReadM a
argParseToReadM Version -> Maybe a
f = do
String
s <- ReadM String
Opts.readerAsk
case Version -> Maybe a
f (String -> Version
Text.pack String
s) of
Just a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> forall a. ParseError -> ReadM a
Opts.readerAbort (Maybe String -> ParseError
Opts.ShowHelpText forall a. Maybe a
Nothing)
subcommand :: CommandName -> Description -> Parser a -> Parser a
subcommand :: forall a. CommandName -> Description -> Parser a -> Parser a
subcommand CommandName
cmdName Description
desc Parser a
p =
forall a. Mod CommandFields a -> Parser a
Opts.hsubparser (forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
name ParserInfo a
info forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
name)
where
name :: String
name = Version -> String
Text.unpack (CommandName -> Version
getCommandName CommandName
cmdName)
info :: ParserInfo a
info = forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info Parser a
p (forall a. Maybe Doc -> InfoMod a
Opts.progDescDoc (forall a. a -> Maybe a
Just (Description -> Doc
getDescription Description
desc)))
subcommandGroup :: forall a. Description -> [(CommandName, Description, Parser a)] -> Parser a
subcommandGroup :: forall a.
Description -> [(CommandName, Description, Parser a)] -> Parser a
subcommandGroup Description
name [(CommandName, Description, Parser a)]
cmds =
forall a. Mod CommandFields a -> Parser a
Opts.hsubparser (forall a. String -> Mod CommandFields a
Opts.commandGroup String
name' forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CommandName, Description, Parser a) -> Mod CommandFields a
f [(CommandName, Description, Parser a)]
cmds forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
metavar)
where
f :: (CommandName, Description, Parser a) -> Opts.Mod Opts.CommandFields a
f :: (CommandName, Description, Parser a) -> Mod CommandFields a
f (CommandName
cmdName, Description
desc, Parser a
p) =
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command
(Version -> String
Text.unpack (CommandName -> Version
getCommandName CommandName
cmdName))
(forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info Parser a
p (forall a. Maybe Doc -> InfoMod a
Opts.progDescDoc (forall a. a -> Maybe a
Just (Description -> Doc
getDescription Description
desc))))
metavar :: String
metavar :: String
metavar = Version -> String
Text.unpack (Version -> [Version] -> Version
Text.intercalate Version
" | " (forall a b. (a -> b) -> [a] -> [b]
map (CommandName, Description, Parser a) -> Version
g [(CommandName, Description, Parser a)]
cmds))
where
g :: (CommandName, Description, Parser a) -> Text
g :: (CommandName, Description, Parser a) -> Version
g (CommandName
cmdName, Description
_, Parser a
_) = CommandName -> Version
getCommandName CommandName
cmdName
name' :: String
name' :: String
name' = SimpleDoc -> ShowS
displayS (Doc -> SimpleDoc
renderCompact (Description -> Doc
getDescription Description
name)) String
""