module Optima
(
params,
Params,
param,
Param,
value,
flag,
switch,
Value,
explicitlyParsed,
implicitlyParsed,
Default,
explicitlyRepresented,
showable,
defaultless,
ValueFormat,
formattedByEnum,
unformatted,
)
where
import Optima.Prelude
import qualified Data.Text as Text
import qualified Data.Attoparsec.Text as Attoparsec
import qualified Options.Applicative as Optparse
import qualified Attoparsec.Data as Attoparsec
import qualified Text.Builder as TextBuilder
newtype Params a = Params (Optparse.Parser a)
newtype Param a = Param (Maybe Char -> Text -> Optparse.Parser a)
newtype ProductParam a = ProductParam (Text -> Optparse.Parser a)
newtype Value a = Value (Attoparsec.Parser a)
data Default a = SpecifiedDefault a Text | UnspecifiedDefault
data ValueFormat a = EnumValueFormat [TextBuilder.Builder] | UnspecifiedFormat
deriving instance Functor Params
deriving instance Applicative Params
deriving instance Alternative Params
deriving instance Functor Param
deriving instance Functor Value
deriving instance Applicative Value
deriving instance Alternative Value
deriving instance Monad Value
deriving instance MonadPlus Value
deriving instance MonadFail Value
deriving instance Functor Default
deriving instance Functor ValueFormat
params :: Text -> Params a -> IO a
params description (Params parser) =
Optparse.execParser (Optparse.info (Optparse.helper <*> parser) mods)
where
mods = Optparse.fullDesc <> Optparse.progDesc (Text.unpack description)
param :: Maybe Char -> Text -> Param a -> Params a
param shortName longName (Param parser) = Params (parser shortName longName)
value :: Text -> Default a -> ValueFormat a -> Value a -> Param a
value description def format (Value attoparsecParser) =
Param (\ shortName longName -> Optparse.option readM (mods shortName longName))
where
readM = Optparse.eitherReader (Attoparsec.parseOnly attoparsecParser . Text.pack)
mods shortName longName =
longParamName longName <>
foldMap Optparse.short shortName <>
paramHelp description format <>
defaultValue def
flag :: Text -> Param ()
flag description =
Param (\ shortName longName ->
Optparse.flag' ()
(longParamName longName <> foldMap Optparse.short shortName <> paramHelp description UnspecifiedFormat))
switch :: Text -> Param Bool
switch description =
Param (\ shortName longName ->
Optparse.switch
(longParamName longName <> foldMap Optparse.short shortName <> paramHelp description UnspecifiedFormat))
explicitlyParsed :: Attoparsec.Parser a -> Value a
explicitlyParsed = Value
implicitlyParsed :: Attoparsec.LenientParser a => Value a
implicitlyParsed = Value Attoparsec.lenientParser
explicitlyRepresented :: a -> Text -> Default a
explicitlyRepresented value representation = SpecifiedDefault value representation
showable :: Show a => a -> Default a
showable a = SpecifiedDefault a (Text.pack (show a))
defaultless :: Default a
defaultless = UnspecifiedDefault
formattedByEnum :: (Bounded a, Enum a, Show a) => ValueFormat a
formattedByEnum = let
values = enumFromTo minBound (asTypeOf maxBound (descriptionToA description))
descriptionToA = undefined :: ValueFormat a -> a
description = EnumValueFormat (fmap (TextBuilder.string . show) values)
in description
unformatted :: ValueFormat a
unformatted = UnspecifiedFormat
buildValueFormat :: ValueFormat a -> TextBuilder.Builder
buildValueFormat = \ case
EnumValueFormat values -> "(" <> TextBuilder.intercalate ", " values <> ")"
UnspecifiedFormat -> mempty
buildHelp :: Text -> ValueFormat a -> TextBuilder.Builder
buildHelp description valueFormat =
TextBuilder.intercalate (TextBuilder.char ' ')
(notNull (TextBuilder.text description) <> notNull (buildValueFormat valueFormat))
where
notNull :: TextBuilder.Builder -> [TextBuilder.Builder]
notNull = validate (not . TextBuilder.null)
renderIfNotEmpty :: TextBuilder.Builder -> Maybe Text
renderIfNotEmpty = fmap TextBuilder.run . validate (not . TextBuilder.null)
paramHelp :: Text -> ValueFormat a -> Optparse.Mod f a
paramHelp description format =
foldMap (Optparse.help . Text.unpack) (renderIfNotEmpty (buildHelp description format))
defaultValue :: Optparse.HasValue f => Default a -> Optparse.Mod f a
defaultValue = \ case
SpecifiedDefault a text -> Optparse.value a <> Optparse.showDefaultWith (const (Text.unpack text))
UnspecifiedDefault -> mempty
longParamName :: Optparse.HasName f => Text -> Optparse.Mod f a
longParamName name =
maybe mempty (Optparse.long . Text.unpack) (validate (not . Text.null) name)