{-| Integrated parser library created for tonatona meta application framework.
  It can construct system configuration from environment variables, command line arguments, and any IO values depends on them.
  See details for @example/Main.hs@.
-}

module TonaParser
  (
  -- * Run parser
    Parser
  , withConfig
  -- * Construct primitive parsers
  , optionalVal
  , requiredVal
  , optionalEnum
  , requiredEnum
  , liftWith
  , Source
  , module System.Envy
  , Description
  , (.||)
  , envVar
  , argLong
  -- * Modify parsers
  , modify
  , defParserMods
  , ParserMods
  , cmdLineLongMods
  , envVarMods
  ) where

import RIO
import qualified RIO.List as List
import qualified RIO.Map as Map

import Control.Monad (ap)
import Data.Typeable (typeOf, typeRep)
import Say (sayString)
import System.Environment (getArgs, getEnvironment)
import System.Envy (Var(fromVar, toVar))



-- Types

{-| Main type representing how to construct system configuration.
 -}
newtype Parser a = Parser
  { forall a.
Parser a -> Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
runParser :: Bool -> Config -> (Bool -> a -> IO ()) -> IO () }

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
p = forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
conf Bool -> b -> IO ()
action ->
    forall a.
Parser a -> Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
runParser Parser a
p Bool
b Config
conf (\Bool
b' -> Bool -> b -> IO ()
action Bool
b' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative Parser where
  pure :: a -> Parser a
  pure :: forall a. a -> Parser a
pure a
a = forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
_ Bool -> a -> IO ()
action -> Bool -> a -> IO ()
action Bool
b a
a

  <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Parser where
  (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  Parser a
p >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k = forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
conf Bool -> b -> IO ()
action ->
    forall a.
Parser a -> Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
runParser Parser a
p Bool
b Config
conf forall a b. (a -> b) -> a -> b
$ \Bool
b' a
x ->
      forall a.
Parser a -> Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
runParser (a -> Parser b
k a
x) Bool
b' Config
conf Bool -> b -> IO ()
action

instance MonadIO Parser where
  liftIO :: forall a. IO a -> Parser a
  liftIO :: forall a. IO a -> Parser a
liftIO IO a
ma = forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
_ Bool -> a -> IO ()
action -> Bool -> a -> IO ()
action Bool
b forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
ma


-- Operators


modify :: ParserMods -> Parser a -> Parser a
modify :: forall a. ParserMods -> Parser a -> Parser a
modify ParserMods
mods (Parser Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
parserFunc) =
  forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
oldConfig ->
    let newConfig :: Config
newConfig =
          Config
oldConfig
            { confParserMods :: ParserMods
confParserMods = Config -> ParserMods
confParserMods Config
oldConfig forall a. Semigroup a => a -> a -> a
<> ParserMods
mods
            }
    in Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
parserFunc Bool
b Config
newConfig

withConfig :: Parser a -> (a -> IO ()) -> IO ()
withConfig :: forall a. Parser a -> (a -> IO ()) -> IO ()
withConfig Parser a
parser a -> IO ()
action = do
  Map String String
envVars <- IO (Map String String)
getEnvVars
  [(String, String)]
cmdLineArgs <- IO [(String, String)]
getCmdLineArgs
  [String]
args <- IO [String]
getArgs
  let isHelp :: Bool
isHelp = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"--help", String
"-h"]) [String]
args) forall a. Ord a => a -> a -> Bool
> Int
0
  forall a.
Parser a
-> Bool
-> Map String String
-> [(String, String)]
-> (a -> IO ())
-> IO ()
parse Parser a
parser Bool
isHelp Map String String
envVars [(String, String)]
cmdLineArgs a -> IO ()
action

parse ::
     Parser a
  -> Bool
  -> Map String String -- ^ Environment variables.
  -> [(String, String)] -- ^ Command line arguments and values.
  -> (a -> IO ())
  -> IO ()
parse :: forall a.
Parser a
-> Bool
-> Map String String
-> [(String, String)]
-> (a -> IO ())
-> IO ()
parse (Parser Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
parserFunc) Bool
isHelp Map String String
envVars [(String, String)]
cmdLineArgs a -> IO ()
action =
  Bool -> Config -> (Bool -> a -> IO ()) -> IO ()
parserFunc Bool
isHelp Config
conf forall a b. (a -> b) -> a -> b
$ \Bool
b a
a ->
    if Bool
b
      then do
        forall (m :: * -> *). MonadIO m => String -> m ()
sayString forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [ String
"Display this help and exit"
          , String
"    Default: False"
          , String
"    Type: Bool"
          , String
"    Command line option: -h"
          , String
"    Command line option: --help"
          ]
      else a -> IO ()
action a
a
  where
    conf :: Config
conf =
        Config
          { confCmdLineArgs :: [(String, String)]
confCmdLineArgs = [(String, String)]
cmdLineArgs
          , confEnvVars :: Map String String
confEnvVars = Map String String
envVars
          , confParserMods :: ParserMods
confParserMods = ParserMods
defParserMods
          }


getEnvVars :: IO (Map String String)
getEnvVars :: IO (Map String String)
getEnvVars = do
  [(String, String)]
environment <- IO [(String, String)]
getEnvironment
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
environment

-- TODO: Handle short-hands options.
getCmdLineArgs :: IO [(String, String)]
getCmdLineArgs :: IO [(String, String)]
getCmdLineArgs = do
  [String]
args <- IO [String]
getArgs
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [String] -> [(String, String)]
parseArgs [String]
args

{-|
  >>> parseArgs ["--bool", "--foo", "bar", "-v"]
  [("bool",""),("foo","bar")]
-}
parseArgs :: [String] -> [(String, String)]
parseArgs :: [String] -> [(String, String)]
parseArgs [] = []
parseArgs [(Char
'-':Char
'-':String
key)] = [(String
key, String
"")]
parseArgs ((Char
'-':Char
'-':String
key):ls :: [String]
ls@((Char
'-':String
_):[String]
_)) = (String
key, String
"") forall a. a -> [a] -> [a]
: [String] -> [(String, String)]
parseArgs [String]
ls
parseArgs ((Char
'-':Char
'-':String
key):String
val:[String]
ls) = (String
key, String
val) forall a. a -> [a] -> [a]
: [String] -> [(String, String)]
parseArgs [String]
ls
parseArgs ((Char
'-':String
_):[String]
ls) = [String] -> [(String, String)]
parseArgs [String]
ls
parseArgs (String
_:[String]
ls) = [String] -> [(String, String)]
parseArgs [String]
ls

{-| A 'Parser' constructor for required values.
-}
requiredVal :: Var a => Description -> Source -> Parser a
requiredVal :: forall a. Var a => Description -> Source -> Parser a
requiredVal Description
desc Source
srcs = do
  Maybe a
ma <- forall a.
Var a =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybe forall a. Maybe a
Nothing Description
desc Source
srcs
  forall a. Description -> Maybe a -> Parser a
handleRequired Description
desc Maybe a
ma

{-| A 'Parser' constructor for optional values.
-}
optionalVal :: Var a => Description -> Source -> a -> Parser a
optionalVal :: forall a. Var a => Description -> Source -> a -> Parser a
optionalVal Description
desc Source
srcs a
df = do
  Maybe a
ma <- forall a.
Var a =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybe (forall a. a -> Maybe a
Just a
df) Description
desc Source
srcs
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
df) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
ma

{-| A 'Parser' constructor for required values.
-}
requiredEnum :: (Var a, Enum a, Bounded a) => Description -> Source -> Parser a
requiredEnum :: forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> Parser a
requiredEnum Description
desc Source
srcs = do
  Maybe a
ma <- forall a.
(Var a, Enum a, Bounded a) =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybeEnum forall a. Maybe a
Nothing Description
desc Source
srcs
  forall a. Description -> Maybe a -> Parser a
handleRequired Description
desc Maybe a
ma

{-| A 'Parser' constructor for optional values.
-}
optionalEnum :: (Var a, Enum a, Bounded a) => Description -> Source -> a -> Parser a
optionalEnum :: forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> a -> Parser a
optionalEnum Description
desc Source
srcs a
df = do
  Maybe a
ma <- forall a.
(Var a, Enum a, Bounded a) =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybeEnum (forall a. a -> Maybe a
Just a
df) Description
desc Source
srcs
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
df) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
ma

handleRequired :: Description -> Maybe a -> Parser a
handleRequired :: forall a. Description -> Maybe a -> Parser a
handleRequired Description
_ (Just a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
handleRequired Description
desc Maybe a
Nothing =
  forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
isHelp Config
_ Bool -> a -> IO ()
action ->
    if Bool
isHelp
      then Bool -> a -> IO ()
action Bool
isHelp forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"unreachable"
      else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
           String
"No required configuration for \"" forall a. Semigroup a => a -> a -> a
<> Description -> String
unDescription Description
desc forall a. Semigroup a => a -> a -> a
<> String
"\"\n" forall a. Semigroup a => a -> a -> a
<>
           String
"Try with '--help' option for more information."

{-| A `Parser` constructor from @cont@.
-}
liftWith :: ((a -> IO ()) -> IO ()) -> Parser a
liftWith :: forall a. ((a -> IO ()) -> IO ()) -> Parser a
liftWith (a -> IO ()) -> IO ()
cont = forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
b Config
_ Bool -> a -> IO ()
action -> (a -> IO ()) -> IO ()
cont (Bool -> a -> IO ()
action Bool
b)

fieldMaybe :: forall a. (Var a) => Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybe :: forall a.
Var a =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybe Maybe a
mdef Description
desc Source
source =
  forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
isHelp Config
conf Bool -> Maybe a -> IO ()
action -> do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isHelp forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *). MonadIO m => String -> m ()
sayString forall a b. (a -> b) -> a -> b
$ forall a.
Var a =>
Maybe a -> ParserMods -> Description -> Source -> String
helpLine Maybe a
mdef (Config -> ParserMods
confParserMods Config
conf) Description
desc Source
source
    Bool -> Maybe a -> IO ()
action Bool
isHelp forall a b. (a -> b) -> a -> b
$ forall a.
Var a =>
Bool -> Config -> Description -> Source -> Maybe a
fieldMaybeVal Bool
isHelp Config
conf Description
desc Source
source


fieldMaybeVal ::
     forall a. (Var a)
  => Bool
  -> Config
  -> Description
  -> Source
  -> Maybe a
fieldMaybeVal :: forall a.
Var a =>
Bool -> Config -> Description -> Source -> Maybe a
fieldMaybeVal Bool
isHelp Config
conf Description
desc (Source [InnerSource]
srcs) = do
  String
val <- Config -> [InnerSource] -> Maybe String
findValInSrc Config
conf [InnerSource]
srcs
  let v :: String
v =
        case (forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)), String
val) of
          (String
"Bool", String
"") -> String
"True"
          (String
"Bool", String
"true") -> String
"True"
          (String
"Bool", String
"false") -> String
"False"
          (String, String)
_ -> String
val
  case forall a. Var a => String -> Maybe a
fromVar String
v of
    Maybe a
Nothing ->
      if Bool
isHelp
        then forall a. Maybe a
Nothing
        else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
             String
"Invalid type of value for \"" forall a. Semigroup a => a -> a -> a
<> Description -> String
unDescription Description
desc forall a. Semigroup a => a -> a -> a
<> String
"\".\n" forall a. Semigroup a => a -> a -> a
<>
             String
"Try with '--help' option for more information."
    Maybe a
a -> Maybe a
a

helpLine :: forall a. (Var a) => Maybe a -> ParserMods -> Description -> Source -> String
helpLine :: forall a.
Var a =>
Maybe a -> ParserMods -> Description -> Source -> String
helpLine Maybe a
mdef ParserMods
mods (Description String
desc) (Source [InnerSource]
srcs) =
  [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
    String
desc forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
indent Int
4)
      (forall a. Var a => Maybe a -> String
helpDefault Maybe a
mdef forall a. a -> [a] -> [a]
: forall {k} (a :: k). Typeable a => Proxy a -> String
helpType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (ParserMods -> InnerSource -> String
helpSource ParserMods
mods) [InnerSource]
srcs)

indent :: Int -> String -> String
indent :: Int -> String -> String
indent Int
n String
str =
  forall a. Int -> a -> [a]
replicate Int
n Char
' ' forall a. Semigroup a => a -> a -> a
<> String
str

helpType :: forall a. Typeable a => Proxy a -> String
helpType :: forall {k} (a :: k). Typeable a => Proxy a -> String
helpType Proxy a
p = String
"Type: " forall a. Semigroup a => a -> a -> a
<> case forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p) of
  String
"[Char]" -> String
"String"
  String
"ByteString" -> String
"String"
  String
"Text" -> String
"String"
  String
a -> String
a

helpDefault :: Var a => Maybe a -> String
helpDefault :: forall a. Var a => Maybe a -> String
helpDefault a :: Maybe a
a@Maybe a
Nothing = case forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf Maybe a
a) of
  String
"Bool" -> String
"Default: False"
  String
_ -> String
"Required"
helpDefault (Just a
def) = String
"Default: " forall a. Semigroup a => a -> a -> a
<> forall a. Var a => a -> String
toVar a
def

helpSource :: ParserMods -> InnerSource -> String
helpSource :: ParserMods -> InnerSource -> String
helpSource ParserMods {String -> String
envVarMods :: String -> String
envVarMods :: ParserMods -> String -> String
envVarMods} (EnvVar String
str) =
  String
"Environment variable: " forall a. Semigroup a => a -> a -> a
<> String -> String
envVarMods String
str
helpSource ParserMods {String -> String
cmdLineLongMods :: String -> String
cmdLineLongMods :: ParserMods -> String -> String
cmdLineLongMods} (ArgLong String
str) =
  String
"Command line option: --" forall a. Semigroup a => a -> a -> a
<> String -> String
cmdLineLongMods String
str
helpSource ParserMods {Char -> Char
cmdLineShortMods :: ParserMods -> Char -> Char
cmdLineShortMods :: Char -> Char
cmdLineShortMods} (ArgShort Char
c) =
  String
"Command line option: -" forall a. Semigroup a => a -> a -> a
<> [Char -> Char
cmdLineShortMods Char
c]

fieldMaybeEnum :: (Var a, Enum a, Bounded a) => Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybeEnum :: forall a.
(Var a, Enum a, Bounded a) =>
Maybe a -> Description -> Source -> Parser (Maybe a)
fieldMaybeEnum Maybe a
mdef Description
desc Source
source =
  forall a.
(Bool -> Config -> (Bool -> a -> IO ()) -> IO ()) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Bool
isHelp Config
conf Bool -> Maybe a -> IO ()
action -> do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isHelp forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *). MonadIO m => String -> m ()
sayString forall a b. (a -> b) -> a -> b
$ forall a.
(Var a, Enum a, Bounded a) =>
Maybe a -> ParserMods -> Description -> Source -> String
helpLineEnum Maybe a
mdef (Config -> ParserMods
confParserMods Config
conf) Description
desc Source
source
    Bool -> Maybe a -> IO ()
action Bool
isHelp forall a b. (a -> b) -> a -> b
$ forall a.
Var a =>
Bool -> Config -> Description -> Source -> Maybe a
fieldMaybeVal Bool
isHelp Config
conf Description
desc Source
source

helpLineEnum :: forall a. (Var a, Enum a, Bounded a) => Maybe a -> ParserMods -> Description -> Source -> String
helpLineEnum :: forall a.
(Var a, Enum a, Bounded a) =>
Maybe a -> ParserMods -> Description -> Source -> String
helpLineEnum Maybe a
mdef ParserMods
mods (Description String
desc) (Source [InnerSource]
srcs) =
  [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
    String
desc forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
indent Int
4)
      (forall a. Var a => Maybe a -> String
helpDefault Maybe a
mdef forall a. a -> [a] -> [a]
: forall {k} (a :: k). Typeable a => Proxy a -> String
helpType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Semigroup a => a -> a -> a
<> forall a. (Var a, Enum a, Bounded a) => Proxy a -> String
helpEnum (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (ParserMods -> InnerSource -> String
helpSource ParserMods
mods) [InnerSource]
srcs)

helpEnum :: forall a. (Var a, Enum a, Bounded a) => Proxy a -> String
helpEnum :: forall a. (Var a, Enum a, Bounded a) => Proxy a -> String
helpEnum Proxy a
_ = if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
enums forall a. Ord a => a -> a -> Bool
<= Int
8)
  then String
" (" forall a. Semigroup a => a -> a -> a
<> (forall a. [a] -> [[a]] -> [a]
List.intercalate String
"|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Var a => a -> String
toVar) [a]
enums forall a. Semigroup a => a -> a -> a
<> String
")"
  else String
""
  where
    enums :: [a]
enums = [(forall a. Bounded a => a
minBound :: a)..forall a. Bounded a => a
maxBound]

findValInSrc :: Config -> [InnerSource] -> Maybe String
findValInSrc :: Config -> [InnerSource] -> Maybe String
findValInSrc Config
conf [InnerSource]
srcs = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Config -> InnerSource -> Maybe String
findValInSrcs Config
conf) [InnerSource]
srcs

findValInSrcs :: Config -> InnerSource -> Maybe String
findValInSrcs :: Config -> InnerSource -> Maybe String
findValInSrcs Config
conf InnerSource
innerSource =
  let cmdLineArgs :: [(String, String)]
cmdLineArgs = Config -> [(String, String)]
confCmdLineArgs Config
conf
      envVars :: Map String String
envVars = Config -> Map String String
confEnvVars Config
conf
      mods :: ParserMods
mods = Config -> ParserMods
confParserMods Config
conf
      longMods :: String -> String
longMods = ParserMods -> String -> String
cmdLineLongMods ParserMods
mods
      shortMods :: Char -> Char
shortMods = ParserMods -> Char -> Char
cmdLineShortMods ParserMods
mods
      envMods :: String -> String
envMods = ParserMods -> String -> String
envVarMods ParserMods
mods
  in
  case InnerSource
innerSource of
    ArgLong String
str -> [(String, String)] -> (String -> String) -> String -> Maybe String
findValInCmdLineLong [(String, String)]
cmdLineArgs String -> String
longMods String
str
    ArgShort Char
ch -> [(String, String)] -> (Char -> Char) -> Char -> Maybe String
findValInCmdLineShort [(String, String)]
cmdLineArgs Char -> Char
shortMods Char
ch
    EnvVar String
var -> Map String String -> (String -> String) -> String -> Maybe String
findValInEnvVar Map String String
envVars String -> String
envMods String
var

findValInCmdLineLong
  :: [(String, String)]
  -> (String -> String)
  -> String
  -> Maybe String
findValInCmdLineLong :: [(String, String)] -> (String -> String) -> String -> Maybe String
findValInCmdLineLong [(String, String)]
args String -> String
modFunc String
str =
  let modifiedVal :: String
modifiedVal = String -> String
modFunc String
str
  in forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
modifiedVal [(String, String)]
args

findValInCmdLineShort
  :: [(String, String)]
  -> (Char -> Char)
  -> Char
  -> Maybe String
findValInCmdLineShort :: [(String, String)] -> (Char -> Char) -> Char -> Maybe String
findValInCmdLineShort [(String, String)]
args Char -> Char
modFunc Char
ch =
  let modifiedVal :: Char
modifiedVal = Char -> Char
modFunc Char
ch
  in forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char
modifiedVal] [(String, String)]
args

findValInEnvVar
  :: Map String String
  -> (String -> String)
  -> String
  -> Maybe String
findValInEnvVar :: Map String String -> (String -> String) -> String -> Maybe String
findValInEnvVar Map String String
args String -> String
modFunc String
var =
  let modifiedVal :: String
modifiedVal = String -> String
modFunc String
var
  in forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
modifiedVal Map String String
args

data Config = Config
  { Config -> [(String, String)]
confCmdLineArgs :: [(String, String)]
  , Config -> Map String String
confEnvVars :: Map String String
  , Config -> ParserMods
confParserMods :: ParserMods
  }

data ParserMods = ParserMods
  { ParserMods -> String -> String
cmdLineLongMods :: String -> String
  , ParserMods -> Char -> Char
cmdLineShortMods :: Char -> Char
  , ParserMods -> String -> String
envVarMods :: String -> String
  }

instance Semigroup ParserMods where
  ParserMods String -> String
a Char -> Char
b String -> String
c <> :: ParserMods -> ParserMods -> ParserMods
<> ParserMods String -> String
a' Char -> Char
b' String -> String
c' =
    (String -> String)
-> (Char -> Char) -> (String -> String) -> ParserMods
ParserMods (String -> String
a' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
a) (Char -> Char
b' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
b) (String -> String
c' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
c)

instance Monoid ParserMods where
  mappend :: ParserMods -> ParserMods -> ParserMods
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: ParserMods
mempty = (String -> String)
-> (Char -> Char) -> (String -> String) -> ParserMods
ParserMods forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id

defParserMods :: ParserMods
defParserMods :: ParserMods
defParserMods = forall a. Monoid a => a
mempty

data InnerSource
  = EnvVar String
  | ArgLong String
  | ArgShort Char

newtype Source = Source { Source -> [InnerSource]
_unSource :: [InnerSource] }

(.||) :: Source -> Source -> Source
.|| :: Source -> Source -> Source
(.||) (Source [InnerSource]
a) (Source [InnerSource]
b) = [InnerSource] -> Source
Source ([InnerSource]
a forall a. [a] -> [a] -> [a]
++ [InnerSource]
b)

newtype Description = Description { Description -> String
unDescription :: String }
  deriving (Int -> Description -> String -> String
[Description] -> String -> String
Description -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Description] -> String -> String
$cshowList :: [Description] -> String -> String
show :: Description -> String
$cshow :: Description -> String
showsPrec :: Int -> Description -> String -> String
$cshowsPrec :: Int -> Description -> String -> String
Show, Description -> Description -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c== :: Description -> Description -> Bool
Eq, ReadPrec [Description]
ReadPrec Description
Int -> ReadS Description
ReadS [Description]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Description]
$creadListPrec :: ReadPrec [Description]
readPrec :: ReadPrec Description
$creadPrec :: ReadPrec Description
readList :: ReadS [Description]
$creadList :: ReadS [Description]
readsPrec :: Int -> ReadS Description
$creadsPrec :: Int -> ReadS Description
Read, String -> Description
forall a. (String -> a) -> IsString a
fromString :: String -> Description
$cfromString :: String -> Description
IsString)

envVar :: String -> Source
envVar :: String -> Source
envVar String
name =
  [InnerSource] -> Source
Source [String -> InnerSource
EnvVar String
name]

argLong :: String -> Source
argLong :: String -> Source
argLong String
name = [InnerSource] -> Source
Source [String -> InnerSource
ArgLong String
name]

-- argShort :: Char -> Source
-- argShort name = Source [ArgShort name]