{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
module System.Environment.FromEnv
(
  -- * Core class
    FromEnv (..)
  -- * Options
  , defaultEnvOpts
  , FromEnvOptions ( optsFieldLabelModifier )
  -- * Generic parsing class
  , GFromEnv (..)
  -- * Errors
  , 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 for things that can be created from environment variables.
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)

-- | Try to convert a field name into an environment variable name.
type FieldLabelModifier = String -> String

-- | Options to specify how to construct your datatype from environment variables.
-- Options can be set using record update syntax and 'defaultEnvOpts'.
newtype FromEnvOptions = FromEnvOptions
  { FromEnvOptions -> FieldLabelModifier
optsFieldLabelModifier :: FieldLabelModifier
  -- ^ Function to map from a field name to an environment variable name.
  }

-- | Default 'FromEnvOptions':
--
-- The default options will try to read a field name fieldName from an
-- environment variables FIELD_NAME, as this is the most common naming
-- convention for environment variables.
--
-- If you want different behavior, see 'gFromEnv'.
--
-- @
-- 'FromEnvOptions'
-- { 'optsFieldLabelModifier' = Just . 'Text.Casing.screamingSnake'
-- }
-- @
defaultEnvOpts :: FromEnvOptions
defaultEnvOpts :: FromEnvOptions
defaultEnvOpts = FromEnvOptions
  { optsFieldLabelModifier :: FieldLabelModifier
optsFieldLabelModifier =  FieldLabelModifier
screamingSnake
  }

class GFromEnv a where
  -- | Try to construct a value from environment variables.
  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
    -- ^ A field was unset in the environment
    | FailedToParse String String
    -- ^ Failed to parse a given field from an environment variable
    | AggregateError [FromEnvError]
    -- ^ There was more than one error.
    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)