module Morley.Util.CLI
(
maybeAddDefault
, outputOption
, HasCLReader (..)
, mkCLOptionParser
, mkCLOptionParserExt
, mkCLArgumentParser
, mkCLArgumentParserExt
, mkCommandParser
, namedParser
, eitherReader
, readerError
, integralReader
) where
import Data.Bits (Bits)
import Data.Text.Manipulate (toSpinal)
import Fmt (Buildable, pretty)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Options.Applicative
(eitherReader, help, long, metavar, option, readerError, showDefaultWith, strOption, value)
import qualified Options.Applicative as Opt
import Morley.Util.Instances ()
import Morley.Util.Named
maybeAddDefault :: Opt.HasValue f => (a -> String) -> Maybe a -> Opt.Mod f a
maybeAddDefault :: (a -> String) -> Maybe a -> Mod f a
maybeAddDefault a -> String
printer = Mod f a -> (a -> Mod f a) -> Maybe a -> Mod f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod f a
forall a. Monoid a => a
mempty a -> Mod f a
addDefault
where
addDefault :: a -> Mod f a
addDefault a
v = a -> Mod f a
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value a
v Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> (a -> String) -> Mod f a
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith a -> String
printer
outputOption :: Opt.Parser (Maybe FilePath)
outputOption :: Parser (Maybe String)
outputOption = Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Write output to the given file. If not specified, stdout is used."
class HasCLReader a where
getReader :: Opt.ReadM a
getMetavar :: String
instance HasCLReader Natural where
getReader :: ReadM Natural
getReader = ReadM Natural
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Word64 where
getReader :: ReadM Word64
getReader = ReadM Word64
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Word32 where
getReader :: ReadM Word32
getReader = ReadM Word32
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Word16 where
getReader :: ReadM Word16
getReader = ReadM Word16
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Word8 where
getReader :: ReadM Word8
getReader = ReadM Word8
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Word where
getReader :: ReadM Word
getReader = ReadM Word
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"NATURAL NUMBER"
instance HasCLReader Integer where
getReader :: ReadM Integer
getReader = ReadM Integer
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Int64 where
getReader :: ReadM Int64
getReader = ReadM Int64
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Int32 where
getReader :: ReadM Int32
getReader = ReadM Int32
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Int16 where
getReader :: ReadM Int16
getReader = ReadM Int16
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Int8 where
getReader :: ReadM Int8
getReader = ReadM Int8
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Int where
getReader :: ReadM Int
getReader = ReadM Int
forall a. (Integral a, Bits a) => ReadM a
integralReader
getMetavar :: String
getMetavar = String
"INTEGER"
instance HasCLReader Text where
getReader :: ReadM Text
getReader = ReadM Text
forall s. IsString s => ReadM s
Opt.str
getMetavar :: String
getMetavar = String
"STRING"
instance HasCLReader String where
getReader :: ReadM String
getReader = ReadM String
forall s. IsString s => ReadM s
Opt.str
getMetavar :: String
getMetavar = String
"STRING"
integralReader :: (Integral a, Bits a) => Opt.ReadM a
integralReader :: ReadM a
integralReader = do
Integer
int <- Read Integer => ReadM Integer
forall a. Read a => ReadM a
Opt.auto @Integer
Integer -> Maybe a
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
fromIntegralMaybe Integer
int
Maybe a -> (Maybe a -> ReadM a) -> ReadM a
forall a b. a -> (a -> b) -> b
& ReadM a -> (a -> ReadM a) -> Maybe a -> ReadM a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadM a
forall a. String -> ReadM a
readerError String
errorMsg) a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
errorMsg :: String
errorMsg = String
"failed to parse command-line numeric argument due to overflow/underflow"
mkCLOptionParser ::
forall a. (Buildable a, HasCLReader a)
=> Maybe a
-> "name" :! String
-> "help" :! String
-> Opt.Parser a
mkCLOptionParser :: Maybe a -> ("name" :! String) -> ("help" :! String) -> Parser a
mkCLOptionParser Maybe a
defValue "name" :! String
name "help" :! String
hInfo =
Maybe a
-> ("name" :! String)
-> ("help" :! String)
-> [Mod OptionFields a]
-> Parser a
forall a.
(Buildable a, HasCLReader a) =>
Maybe a
-> ("name" :! String)
-> ("help" :! String)
-> [Mod OptionFields a]
-> Parser a
mkCLOptionParserExt Maybe a
defValue "name" :! String
name "help" :! String
hInfo []
mkCLOptionParserExt ::
forall a. (Buildable a, HasCLReader a)
=> Maybe a
-> "name" :! String
-> "help" :! String
-> [Opt.Mod Opt.OptionFields a]
-> Opt.Parser a
mkCLOptionParserExt :: Maybe a
-> ("name" :! String)
-> ("help" :! String)
-> [Mod OptionFields a]
-> Parser a
mkCLOptionParserExt Maybe a
defValue (N String
name) (N String
hInfo) [Mod OptionFields a]
mods =
ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
forall a. HasCLReader a => ReadM a
getReader (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat ([Mod OptionFields a] -> Mod OptionFields a)
-> [Mod OptionFields a] -> Mod OptionFields a
forall a b. (a -> b) -> a -> b
$
String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (HasCLReader a => String
forall a. HasCLReader a => String
getMetavar @a) Mod OptionFields a -> [Mod OptionFields a] -> [Mod OptionFields a]
forall a. a -> [a] -> [a]
:
String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
name Mod OptionFields a -> [Mod OptionFields a] -> [Mod OptionFields a]
forall a. a -> [a] -> [a]
:
String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
help String
hInfo Mod OptionFields a -> [Mod OptionFields a] -> [Mod OptionFields a]
forall a. a -> [a] -> [a]
:
(a -> String) -> Maybe a -> Mod OptionFields a
forall (f :: * -> *) a.
HasValue f =>
(a -> String) -> Maybe a -> Mod f a
maybeAddDefault a -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Maybe a
defValue Mod OptionFields a -> [Mod OptionFields a] -> [Mod OptionFields a]
forall a. a -> [a] -> [a]
:
[Mod OptionFields a]
mods
mkCLArgumentParser ::
forall a. (Buildable a, HasCLReader a)
=> Maybe a
-> "help" :! String
-> Opt.Parser a
mkCLArgumentParser :: Maybe a -> ("help" :! String) -> Parser a
mkCLArgumentParser Maybe a
defValue "help" :! String
hInfo = Maybe a -> ("help" :! String) -> [Mod ArgumentFields a] -> Parser a
forall a.
(Buildable a, HasCLReader a) =>
Maybe a -> ("help" :! String) -> [Mod ArgumentFields a] -> Parser a
mkCLArgumentParserExt Maybe a
defValue "help" :! String
hInfo []
mkCLArgumentParserExt ::
forall a. (Buildable a, HasCLReader a)
=> Maybe a
-> "help" :! String
-> [Opt.Mod Opt.ArgumentFields a]
-> Opt.Parser a
mkCLArgumentParserExt :: Maybe a -> ("help" :! String) -> [Mod ArgumentFields a] -> Parser a
mkCLArgumentParserExt Maybe a
defValue (N String
hInfo) [Mod ArgumentFields a]
mods =
ReadM a -> Mod ArgumentFields a -> Parser a
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opt.argument ReadM a
forall a. HasCLReader a => ReadM a
getReader (Mod ArgumentFields a -> Parser a)
-> Mod ArgumentFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields a] -> Mod ArgumentFields a
forall a. Monoid a => [a] -> a
mconcat ([Mod ArgumentFields a] -> Mod ArgumentFields a)
-> [Mod ArgumentFields a] -> Mod ArgumentFields a
forall a b. (a -> b) -> a -> b
$
String -> Mod ArgumentFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (HasCLReader a => String
forall a. HasCLReader a => String
getMetavar @a) Mod ArgumentFields a
-> [Mod ArgumentFields a] -> [Mod ArgumentFields a]
forall a. a -> [a] -> [a]
:
String -> Mod ArgumentFields a
forall (f :: * -> *) a. String -> Mod f a
help String
hInfo Mod ArgumentFields a
-> [Mod ArgumentFields a] -> [Mod ArgumentFields a]
forall a. a -> [a] -> [a]
:
(a -> String) -> Maybe a -> Mod ArgumentFields a
forall (f :: * -> *) a.
HasValue f =>
(a -> String) -> Maybe a -> Mod f a
maybeAddDefault a -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Maybe a
defValue Mod ArgumentFields a
-> [Mod ArgumentFields a] -> [Mod ArgumentFields a]
forall a. a -> [a] -> [a]
:
[Mod ArgumentFields a]
mods
mkCommandParser :: String -> Opt.Parser a -> String -> Opt.Mod Opt.CommandFields a
mkCommandParser :: String -> Parser a -> String -> Mod CommandFields a
mkCommandParser String
commandName Parser a
parser String
desc =
String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
commandName (ParserInfo a -> Mod CommandFields a)
-> ParserInfo a -> Mod CommandFields a
forall a b. (a -> b) -> a -> b
$
Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser (a -> a)
forall a. Parser (a -> a)
Opt.helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$
String -> InfoMod a
forall a. String -> InfoMod a
Opt.progDesc String
desc
namedParser ::
forall (a :: Type) (name :: Symbol).
(Buildable a, HasCLReader a, KnownSymbol name)
=> Maybe a
-> String
-> Opt.Parser (name :! a)
namedParser :: Maybe a -> String -> Parser (name :! a)
namedParser Maybe a
defValue String
hInfo =
ReadM (name :! a)
-> Mod OptionFields (name :! a) -> Parser (name :! a)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((Name name
forall (name :: Symbol). Name name
Name @name) Name name -> ReadM a -> ReadM (name :! a)
forall (m :: * -> *) (name :: Symbol) a.
Functor m =>
Name name -> m a -> m (NamedF Identity a name)
<:!> ReadM a
forall a. HasCLReader a => ReadM a
getReader) (Mod OptionFields (name :! a) -> Parser (name :! a))
-> Mod OptionFields (name :! a) -> Parser (name :! a)
forall a b. (a -> b) -> a -> b
$
[Mod OptionFields (name :! a)] -> Mod OptionFields (name :! a)
forall a. Monoid a => [a] -> a
mconcat
[ String -> Mod OptionFields (name :! a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toSpinal (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
name)
, String -> Mod OptionFields (name :! a)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (HasCLReader a => String
forall a. HasCLReader a => String
getMetavar @a)
, String -> Mod OptionFields (name :! a)
forall (f :: * -> *) a. String -> Mod f a
help String
hInfo
, ((name :! a) -> String)
-> Maybe (name :! a) -> Mod OptionFields (name :! a)
forall (f :: * -> *) a.
HasValue f =>
(a -> String) -> Maybe a -> Mod f a
maybeAddDefault (name :! a) -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Name name
forall (name :: Symbol). Name name
Name @name Name name -> Maybe a -> Maybe (name :! a)
forall (m :: * -> *) (name :: Symbol) a.
Functor m =>
Name name -> m a -> m (NamedF Identity a name)
<:!> Maybe a
defValue)
]
where
name :: String
name = Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)