{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module System.Environment.FromEnv
(
FromEnv (..)
, defaultEnvOpts
, FromEnvOptions ( optsFieldLabelModifier )
, GFromEnv (..)
, FromEnvError (..)
) where
import Control.Applicative (liftA2)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List (intercalate)
import GHC.Generics
import System.Environment (lookupEnv)
import Text.Casing (screamingSnake)
import System.Environment.FromEnv.TryParse
class FromEnv a where
fromEnv :: (MonadIO m) => m (Either FromEnvError a)
default fromEnv :: (MonadIO m, Generic a, GFromEnv' (Rep a)) => m (Either FromEnvError a)
fromEnv = forall a (m :: * -> *).
(GFromEnv a, MonadIO m) =>
FromEnvOptions -> m (Either FromEnvError a)
gFromEnv FromEnvOptions
defaultEnvOpts
instance (FromEnv a, FromEnv b) => FromEnv (a, b) where
fromEnv :: forall (m :: * -> *). MonadIO m => m (Either FromEnvError (a, b))
fromEnv = do
(Either FromEnvError a, Either FromEnvError b)
t <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromEnv a, MonadIO m) =>
m (Either FromEnvError a)
fromEnv forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(FromEnv a, MonadIO m) =>
m (Either FromEnvError a)
fromEnv
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Either FromEnvError a, Either FromEnvError b)
t of
(Left FromEnvError
e1, Left FromEnvError
e2) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [FromEnvError] -> FromEnvError
AggregateError [FromEnvError
e1, FromEnvError
e2]
(Left FromEnvError
e, Right b
_) -> forall a b. a -> Either a b
Left FromEnvError
e
(Right a
_, Left FromEnvError
e) -> forall a b. a -> Either a b
Left FromEnvError
e
(Right a
a, Right b
b) -> forall a b. b -> Either a b
Right (a
a, b
b)
instance (FromEnv a, FromEnv b, FromEnv c) => FromEnv (a, b, c) where
fromEnv :: forall (m :: * -> *).
MonadIO m =>
m (Either FromEnvError (a, b, c))
fromEnv = do
(Either FromEnvError a, Either FromEnvError b,
Either FromEnvError c)
t <- (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromEnv a, MonadIO m) =>
m (Either FromEnvError a)
fromEnv forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(FromEnv a, MonadIO m) =>
m (Either FromEnvError a)
fromEnv forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(FromEnv a, MonadIO m) =>
m (Either FromEnvError a)
fromEnv
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Either FromEnvError a, Either FromEnvError b,
Either FromEnvError c)
t of
(Left FromEnvError
e1, Left FromEnvError
e2, Left FromEnvError
e3) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [FromEnvError] -> FromEnvError
AggregateError [FromEnvError
e1, FromEnvError
e2, FromEnvError
e3]
(Left FromEnvError
e1, Left FromEnvError
e2, Right c
_) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [FromEnvError] -> FromEnvError
AggregateError [FromEnvError
e1, FromEnvError
e2]
(Right a
_, Left FromEnvError
e1, Left FromEnvError
e2) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [FromEnvError] -> FromEnvError
AggregateError [FromEnvError
e1, FromEnvError
e2]
(Left FromEnvError
e1, Right b
_, Left FromEnvError
e2) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [FromEnvError] -> FromEnvError
AggregateError [FromEnvError
e1, FromEnvError
e2]
(Left FromEnvError
e, Right b
_, Right c
_) -> forall a b. a -> Either a b
Left FromEnvError
e
(Right a
_, Left FromEnvError
e, Right c
_) -> forall a b. a -> Either a b
Left FromEnvError
e
(Right a
_, Right b
_, Left FromEnvError
e) -> forall a b. a -> Either a b
Left FromEnvError
e
(Right a
a, Right b
b, Right c
c) -> forall a b. b -> Either a b
Right (a
a, b
b, c
c)
type FieldLabelModifier = String -> String
newtype FromEnvOptions = FromEnvOptions
{ FromEnvOptions -> FieldLabelModifier
optsFieldLabelModifier :: FieldLabelModifier
}
defaultEnvOpts :: FromEnvOptions
defaultEnvOpts :: FromEnvOptions
defaultEnvOpts = FromEnvOptions
{ optsFieldLabelModifier :: FieldLabelModifier
optsFieldLabelModifier = FieldLabelModifier
screamingSnake
}
class GFromEnv a where
gFromEnv :: (MonadIO m) => FromEnvOptions -> m (Either FromEnvError a)
default gFromEnv :: (MonadIO m, Generic a, GFromEnv' (Rep a)) => FromEnvOptions -> m (Either FromEnvError a)
gFromEnv FromEnvOptions
opts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(GFromEnv' f, MonadIO m) =>
FromEnvOptions -> m (Either FromEnvError (f a))
gFromEnv' FromEnvOptions
opts
instance (Generic a, GFromEnv' (Rep a)) => GFromEnv a
class GFromEnv' f where
gFromEnv' :: (MonadIO m) => FromEnvOptions -> m (Either FromEnvError (f a))
instance {-# OVERLAPPING #-} GFromEnv' f => GFromEnv' (M1 i c f) where
gFromEnv' :: forall (m :: * -> *) a.
MonadIO m =>
FromEnvOptions -> m (Either FromEnvError (M1 i c f a))
gFromEnv' FromEnvOptions
converter = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(GFromEnv' f, MonadIO m) =>
FromEnvOptions -> m (Either FromEnvError (f a))
gFromEnv' FromEnvOptions
converter
instance (GFromEnv' f, GFromEnv' g) => GFromEnv' (f :*: g) where
gFromEnv' :: forall (m :: * -> *) a.
MonadIO m =>
FromEnvOptions -> m (Either FromEnvError ((:*:) f g a))
gFromEnv' FromEnvOptions
opts = do
Either FromEnvError (f a)
f' <- forall (f :: * -> *) (m :: * -> *) a.
(GFromEnv' f, MonadIO m) =>
FromEnvOptions -> m (Either FromEnvError (f a))
gFromEnv' @f FromEnvOptions
opts
Either FromEnvError (g a)
g' <- forall (f :: * -> *) (m :: * -> *) a.
(GFromEnv' f, MonadIO m) =>
FromEnvOptions -> m (Either FromEnvError (f a))
gFromEnv' @g FromEnvOptions
opts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) Either FromEnvError (f a)
f' Either FromEnvError (g a)
g'
instance {-# OVERLAPPING #-} (Selector s, TryParse a) => GFromEnv' (M1 S s (K1 i a)) where
gFromEnv' :: forall (m :: * -> *) a.
MonadIO m =>
FromEnvOptions -> m (Either FromEnvError (M1 S s (K1 i a) a))
gFromEnv' FromEnvOptions
opts = do
let m :: M1 i s f a
m :: forall (f :: * -> *). M1 i s f a
m = forall a. HasCallStack => a
undefined
name :: String
name = FromEnvOptions -> FieldLabelModifier
optsFieldLabelModifier FromEnvOptions
opts forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName forall (f :: * -> *). M1 i s f a
m
Maybe String
envValue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
name
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
String
v <- forall b a. b -> Maybe a -> Either b a
maybeToEither (String -> FromEnvError
UnsetVariable String
name) Maybe String
envValue
a
r <- forall b a. b -> Maybe a -> Either b a
maybeToEither (String -> String -> FromEnvError
FailedToParse String
name String
v) (forall a. TryParse a => String -> Maybe a
tryParse String
v)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall a b. (a -> b) -> a -> b
$ a
r
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: forall b a. b -> Maybe a -> Either b a
maybeToEither b
_ (Just a
a) = forall a b. b -> Either a b
Right a
a
maybeToEither b
b Maybe a
Nothing = forall a b. a -> Either a b
Left b
b
data FromEnvError
= UnsetVariable String
| FailedToParse String String
| AggregateError [FromEnvError]
deriving FromEnvError -> FromEnvError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromEnvError -> FromEnvError -> Bool
$c/= :: FromEnvError -> FromEnvError -> Bool
== :: FromEnvError -> FromEnvError -> Bool
$c== :: FromEnvError -> FromEnvError -> Bool
Eq
instance Show FromEnvError where
show :: FromEnvError -> String
show (UnsetVariable String
fieldName) =
String
"The field " forall a. Semigroup a => a -> a -> a
<> String
fieldName forall a. Semigroup a => a -> a -> a
<> String
" was unset in the environment"
show (FailedToParse String
fieldName String
envValue) =
String
"Failed to parse the field " forall a. Semigroup a => a -> a -> a
<> String
fieldName forall a. Semigroup a => a -> a -> a
<> String
" from the value " forall a. Semigroup a => a -> a -> a
<> String
envValue
show (AggregateError [FromEnvError]
errors) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [FromEnvError]
errors)