module GetOpt.Declarative.Environment (
  InvalidValue(..)
, parseEnvironmentOptions
, parseEnvironmentOption
) where

import           Prelude ()
import           Test.Hspec.Core.Compat
import           Data.Char

import           GetOpt.Declarative.Types

data InvalidValue = InvalidValue String String
  deriving (InvalidValue -> InvalidValue -> Bool
(InvalidValue -> InvalidValue -> Bool)
-> (InvalidValue -> InvalidValue -> Bool) -> Eq InvalidValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidValue -> InvalidValue -> Bool
== :: InvalidValue -> InvalidValue -> Bool
$c/= :: InvalidValue -> InvalidValue -> Bool
/= :: InvalidValue -> InvalidValue -> Bool
Eq, Int -> InvalidValue -> ShowS
[InvalidValue] -> ShowS
InvalidValue -> String
(Int -> InvalidValue -> ShowS)
-> (InvalidValue -> String)
-> ([InvalidValue] -> ShowS)
-> Show InvalidValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidValue -> ShowS
showsPrec :: Int -> InvalidValue -> ShowS
$cshow :: InvalidValue -> String
show :: InvalidValue -> String
$cshowList :: [InvalidValue] -> ShowS
showList :: [InvalidValue] -> ShowS
Show)

parseEnvironmentOptions :: String -> [(String, String)] -> config -> [Option config] -> ([InvalidValue], config)
parseEnvironmentOptions :: forall config.
String
-> [(String, String)]
-> config
-> [Option config]
-> ([InvalidValue], config)
parseEnvironmentOptions String
prefix [(String, String)]
env = (Option config
 -> ([InvalidValue], config) -> ([InvalidValue], config))
-> ([InvalidValue], config)
-> [Option config]
-> ([InvalidValue], config)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Option config
-> ([InvalidValue], config) -> ([InvalidValue], config)
forall config.
Option config
-> ([InvalidValue], config) -> ([InvalidValue], config)
f (([InvalidValue], config)
 -> [Option config] -> ([InvalidValue], config))
-> (config -> ([InvalidValue], config))
-> config
-> [Option config]
-> ([InvalidValue], config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) []
  where
    f :: Option config -> ([InvalidValue], config) -> ([InvalidValue], config)
    f :: forall config.
Option config
-> ([InvalidValue], config) -> ([InvalidValue], config)
f Option config
option ([InvalidValue]
errs, config
config) = case String
-> [(String, String)]
-> config
-> Option config
-> Either InvalidValue config
forall config.
String
-> [(String, String)]
-> config
-> Option config
-> Either InvalidValue config
parseEnvironmentOption String
prefix [(String, String)]
env config
config Option config
option of
        Left InvalidValue
err -> (InvalidValue
err InvalidValue -> [InvalidValue] -> [InvalidValue]
forall a. a -> [a] -> [a]
: [InvalidValue]
errs, config
config)
        Right config
c -> ([InvalidValue]
errs, config
c)

parseEnvironmentOption :: String -> [(String, String)] -> config -> Option config -> Either InvalidValue config
parseEnvironmentOption :: forall config.
String
-> [(String, String)]
-> config
-> Option config
-> Either InvalidValue config
parseEnvironmentOption String
prefix [(String, String)]
env config
config Option config
option = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
env of
  Maybe String
Nothing -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right config
config
  Just String
value -> case Option config -> OptionSetter config
forall config. Option config -> OptionSetter config
optionSetter Option config
option of
    NoArg config -> config
setter -> case String
value of
      String
"yes" -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right (config -> Either InvalidValue config)
-> config -> Either InvalidValue config
forall a b. (a -> b) -> a -> b
$ config -> config
setter config
config
      String
_ -> Either InvalidValue config
forall {b}. Either InvalidValue b
invalidValue
    Flag Bool -> config -> config
setter -> case String
value of
      String
"yes" -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right (config -> Either InvalidValue config)
-> config -> Either InvalidValue config
forall a b. (a -> b) -> a -> b
$ Bool -> config -> config
setter Bool
True config
config
      String
"no" -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right (config -> Either InvalidValue config)
-> config -> Either InvalidValue config
forall a b. (a -> b) -> a -> b
$ Bool -> config -> config
setter Bool
False config
config
      String
_ -> Either InvalidValue config
forall {b}. Either InvalidValue b
invalidValue
    OptArg String
_ Maybe String -> config -> Maybe config
setter -> case Maybe String -> config -> Maybe config
setter (String -> Maybe String
forall a. a -> Maybe a
Just String
value) config
config of
      Just config
c -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right config
c
      Maybe config
Nothing -> Either InvalidValue config
forall {b}. Either InvalidValue b
invalidValue
    Arg String
_ String -> config -> Maybe config
setter -> case String -> config -> Maybe config
setter String
value config
config of
      Just config
c -> config -> Either InvalidValue config
forall a b. b -> Either a b
Right config
c
      Maybe config
Nothing -> Either InvalidValue config
forall {b}. Either InvalidValue b
invalidValue
    where
      invalidValue :: Either InvalidValue b
invalidValue = InvalidValue -> Either InvalidValue b
forall a b. a -> Either a b
Left (String -> String -> InvalidValue
InvalidValue String
name String
value)
  where
    name :: String
name = String -> Option config -> String
forall config. String -> Option config -> String
envVarName String
prefix Option config
option

envVarName :: String -> Option config -> String
envVarName :: forall config. String -> Option config -> String
envVarName String
prefix Option config
option = String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f (Option config -> String
forall config. Option config -> String
optionName Option config
option)
  where
    f :: Char -> Char
f Char
c = case Char
c of
      Char
'-' -> Char
'_'
      Char
_ -> Char -> Char
toUpper Char
c