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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidValue -> InvalidValue -> Bool
$c/= :: InvalidValue -> InvalidValue -> Bool
== :: InvalidValue -> InvalidValue -> Bool
$c== :: InvalidValue -> InvalidValue -> Bool
Eq, Int -> InvalidValue -> ShowS
[InvalidValue] -> ShowS
InvalidValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidValue] -> ShowS
$cshowList :: [InvalidValue] -> ShowS
show :: InvalidValue -> String
$cshow :: InvalidValue -> String
showsPrec :: Int -> InvalidValue -> ShowS
$cshowsPrec :: Int -> 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall config.
Option config
-> ([InvalidValue], config) -> ([InvalidValue], config)
f 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 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 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
env of
  Maybe String
Nothing -> forall a b. b -> Either a b
Right config
config
  Just String
value -> case forall config. Option config -> OptionSetter config
optionSetter Option config
option of
    NoArg config -> config
setter -> case String
value of
      String
"yes" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ config -> config
setter config
config
      String
_ -> forall {b}. Either InvalidValue b
invalidValue
    Flag Bool -> config -> config
setter -> case String
value of
      String
"yes" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> config -> config
setter Bool
True config
config
      String
"no" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> config -> config
setter Bool
False config
config
      String
_ -> forall {b}. Either InvalidValue b
invalidValue
    OptArg String
_ Maybe String -> config -> Maybe config
setter -> case Maybe String -> config -> Maybe config
setter (forall a. a -> Maybe a
Just String
value) config
config of
      Just config
c -> forall a b. b -> Either a b
Right config
c
      Maybe config
Nothing -> 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 -> forall a b. b -> Either a b
Right config
c
      Maybe config
Nothing -> forall {b}. Either InvalidValue b
invalidValue
    where
      invalidValue :: Either InvalidValue b
invalidValue = forall a b. a -> Either a b
Left (String -> String -> InvalidValue
InvalidValue String
name String
value)
  where
    name :: String
name = 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 forall a. [a] -> [a] -> [a]
++ Char
'_' forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f (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