{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE KindSignatures             #-}
------------------------------------------------------------------------------
-- |
-- Module      : System.Envy
-- Copyright   : (c) David Johnson 2015
-- Maintainer  : djohnson.m@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- > {-# LANGUAGE DeriveGeneric #-}
-- >
-- > module Main ( main ) where
-- >
-- > import System.Envy
-- > import GHC.Generics
-- >
-- > data PGConfig = PGConfig {
-- >   pgHost :: String -- "PG_HOST"
-- > , pgPort :: Int    -- "PG_PORT"
-- > } deriving (Generic, Show)
-- >
-- > -- Default instance used if environment variable doesn't exist
-- > instance DefConfig PGConfig where
-- >   defConfig = PGConfig "localhost" 5432
-- >
-- > instance FromEnv PGConfig
-- > -- Generically produces the following body (no implementation needed if using Generics):
-- > -- fromEnv = PGConfig <$> envMaybe "PG_HOST" .!= "localhost"
-- > --                    <*> envMaybe "PG_PORT" .!= 5432
-- >
-- > main :: IO ()
-- > main =
-- >   print =<< do decodeEnv :: IO (Either String PGConfig)
-- >  -- PGConfig { pgHost = "custom-pg-url", pgPort = 5432 }
--
module System.Envy
       ( -- * Classes
         FromEnv (..)
       , GFromEnv (..)
       , ToEnv   (..)
       , Var     (..)
       , EnvList (..)
       , EnvVar  (..)
       , Parser  (..)
        -- * Functions
       , decodeEnv
       , decodeWithDefaults
       , decode
       , showEnv
       , setEnvironment
       , setEnvironment'
       , unsetEnvironment
       , unsetEnvironment'
       , makeEnv
       , env
       , envMaybe
       , (.=)
       , (.!=)
         -- * Utility Types
       , ReadShowVar (..)
         -- * Generics
       , DefConfig (..)
       , Option (..)
       , defOption
       , runEnv
       , gFromEnvCustom
       ) where
------------------------------------------------------------------------------
import           Control.Applicative
import           Control.Monad (MonadPlus)
import           Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Exception
import           Data.Functor.Identity
import           Data.Maybe
import           Data.Monoid
import           Data.Char
import           Data.Time
import           Data.Kind
import           GHC.Generics
import           Data.Typeable
import           System.Environment.Blank
import           Text.Read (readMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import           Data.Text (Text)
import           Data.Word
import           Data.Int
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as BL8
------------------------------------------------------------------------------
-- | Parser Monad for environment variable retrieval
newtype Parser a = Parser { forall a. Parser a -> ExceptT String IO a
runParser :: ExceptT String IO a }
  deriving ( (forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
$c<$ :: forall a b. a -> Parser b -> Parser a
<$ :: forall a b. a -> Parser b -> Parser a
Functor, Applicative Parser
Applicative Parser =>
(forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>> :: forall a b. Parser a -> Parser b -> Parser b
$creturn :: forall a. a -> Parser a
return :: forall a. a -> Parser a
Monad, Functor Parser
Functor Parser =>
(forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Parser a
pure :: forall a. a -> Parser a
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
$c*> :: forall a b. Parser a -> Parser b -> Parser b
*> :: forall a b. Parser a -> Parser b -> Parser b
$c<* :: forall a b. Parser a -> Parser b -> Parser a
<* :: forall a b. Parser a -> Parser b -> Parser a
Applicative, MonadError String
           , Monad Parser
Monad Parser => (forall a. IO a -> Parser a) -> MonadIO Parser
forall a. IO a -> Parser a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Parser a
liftIO :: forall a. IO a -> Parser a
MonadIO, Applicative Parser
Applicative Parser =>
(forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> (forall a. Parser a -> Parser [a])
-> (forall a. Parser a -> Parser [a])
-> Alternative Parser
forall a. Parser a
forall a. Parser a -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. Parser a
empty :: forall a. Parser a
$c<|> :: forall a. Parser a -> Parser a -> Parser a
<|> :: forall a. Parser a -> Parser a -> Parser a
$csome :: forall a. Parser a -> Parser [a]
some :: forall a. Parser a -> Parser [a]
$cmany :: forall a. Parser a -> Parser [a]
many :: forall a. Parser a -> Parser [a]
Alternative, Monad Parser
Alternative Parser
(Alternative Parser, Monad Parser) =>
(forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a) -> MonadPlus Parser
forall a. Parser a
forall a. Parser a -> Parser a -> Parser a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall a. Parser a
mzero :: forall a. Parser a
$cmplus :: forall a. Parser a -> Parser a -> Parser a
mplus :: forall a. Parser a -> Parser a -> Parser a
MonadPlus )

instance MonadFail Parser where
  fail :: forall a. String -> Parser a
fail = ExceptT String IO a -> Parser a
forall a. ExceptT String IO a -> Parser a
Parser (ExceptT String IO a -> Parser a)
-> (String -> ExceptT String IO a) -> String -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String IO a
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

------------------------------------------------------------------------------
-- | Variable type, smart constructor for handling environment variables.
data EnvVar = EnvVar {
  EnvVar -> String
variableName :: String,
  -- ^ The environment variable to set.
  EnvVar -> String
variableValue :: String
  -- ^ The value to assign this variable to.
  }
  deriving (Int -> EnvVar -> ShowS
[EnvVar] -> ShowS
EnvVar -> String
(Int -> EnvVar -> ShowS)
-> (EnvVar -> String) -> ([EnvVar] -> ShowS) -> Show EnvVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvVar -> ShowS
showsPrec :: Int -> EnvVar -> ShowS
$cshow :: EnvVar -> String
show :: EnvVar -> String
$cshowList :: [EnvVar] -> ShowS
showList :: [EnvVar] -> ShowS
Show, EnvVar -> EnvVar -> Bool
(EnvVar -> EnvVar -> Bool)
-> (EnvVar -> EnvVar -> Bool) -> Eq EnvVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvVar -> EnvVar -> Bool
== :: EnvVar -> EnvVar -> Bool
$c/= :: EnvVar -> EnvVar -> Bool
/= :: EnvVar -> EnvVar -> Bool
Eq)

------------------------------------------------------------------------------
-- | Executes `Parser`
evalParser :: Parser a -> IO (Either String a)
evalParser :: forall a. Parser a -> IO (Either String a)
evalParser = ExceptT String IO a -> IO (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO a -> IO (Either String a))
-> (Parser a -> ExceptT String IO a)
-> Parser a
-> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ExceptT String IO a
forall a. Parser a -> ExceptT String IO a
runParser

------------------------------------------------------------------------------
-- | For use with Generics, no `FromEnv` typeclass necessary
--
-- > getPgConfig :: IO (Either String ConnectInfo)
-- > getPgConfig = runEnv $ gFromEnvCustom defOption
runEnv :: Parser a -> IO (Either String a)
runEnv :: forall a. Parser a -> IO (Either String a)
runEnv = ExceptT String IO a -> IO (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO a -> IO (Either String a))
-> (Parser a -> ExceptT String IO a)
-> Parser a
-> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ExceptT String IO a
forall a. Parser a -> ExceptT String IO a
runParser

------------------------------------------------------------------------------
-- | Environment variable getter. Fails if the variable is not set or
-- fails to parse.
env :: Var a
    => String   -- ^ Key to look up.
    -> Parser a -- ^ Return a value of this type or throw an error.
env :: forall a. Var a => String -> Parser a
env String
key = do
  Maybe String
result <- IO (Maybe String) -> Parser (Maybe String)
forall a. IO a -> Parser a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
getEnv String
key)
  case Maybe String
result of
    Maybe String
Nothing -> String -> Parser a
forall a. String -> Parser a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Variable not found for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key
    Just String
dv ->
      case String -> Maybe a
forall a. Var a => String -> Maybe a
fromVar String
dv of
        Maybe a
Nothing -> String -> Parser a
forall a. String -> Parser a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ (String
"Parse failure: could not parse variable "
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" into type "
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (String -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf String
dv))
        Just a
x -> a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

------------------------------------------------------------------------------
-- | Environment variable getter returning `Maybe`
envMaybe :: Var a
         => String           -- ^ Key to look up.
         -> Parser (Maybe a) -- ^ Return `Nothing` if variable isn't set.
envMaybe :: forall a. Var a => String -> Parser (Maybe a)
envMaybe String
key = do
  Maybe String
val <- IO (Maybe String) -> Parser (Maybe String)
forall a. IO a -> Parser a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
getEnv String
key)
  Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Parser (Maybe a)) -> Maybe a -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ case Maybe String
val of
   Maybe String
Nothing -> Maybe a
forall a. Maybe a
Nothing
   Just String
x -> String -> Maybe a
forall a. Var a => String -> Maybe a
fromVar String
x

------------------------------------------------------------------------------
-- | For use with `envMaybe` for providing default arguments.
(.!=) :: Parser (Maybe a) -- ^ Parser that might fail.
      -> a                -- ^ Value to return if the parser fails.
      -> Parser a         -- ^ Parser that returns the default on failure.
.!= :: forall a. Parser (Maybe a) -> a -> Parser a
(.!=) Parser (Maybe a)
parser a
def  = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe a)
parser

------------------------------------------------------------------------------
-- | Infix environment variable setter
-- Smart constructor for producing types of `EnvVar`
(.=) :: Var a
     => String -- ^ The variable name to set.
     -> a      -- ^ Object to set in the environment.
     -> EnvVar -- ^ Mapping of Variable to Value.
.= :: forall a. Var a => String -> a -> EnvVar
(.=) String
variableName a
value = String -> String -> EnvVar
EnvVar String
variableName (a -> String
forall a. Var a => a -> String
toVar a
value)

------------------------------------------------------------------------------
-- | `FromEnv` Typeclass w/ Generic default implementation
class FromEnv a where
  fromEnv :: Maybe a -> Parser a
  default fromEnv :: (Generic a, GFromEnv (Rep a)) => Maybe a -> Parser a
  fromEnv Maybe a
oa = Option -> Maybe a -> Parser a
forall a.
(Generic a, GFromEnv (Rep a)) =>
Option -> Maybe a -> Parser a
gFromEnvCustom Option
defOption Maybe a
oa

------------------------------------------------------------------------------
-- | Meant for specifying a custom `Option` for environment retrieval
--
-- > instance FromEnv PGConfig where
-- >   fromEnv = gFromEnvCustom Option { dropPrefixCount = 8, customPrefix = "PG" }
gFromEnvCustom :: forall a. (Generic a, GFromEnv (Rep a))
               => Option
               -> Maybe a
               -> Parser a
gFromEnvCustom :: forall a.
(Generic a, GFromEnv (Rep a)) =>
Option -> Maybe a -> Parser a
gFromEnvCustom Option
opts Maybe a
oa = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Maybe (Rep a Any) -> Parser (Rep a Any)
forall a. Option -> Maybe (Rep a a) -> Parser (Rep a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a -> Rep a Any) -> Maybe a -> Maybe (Rep a Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
oa)

------------------------------------------------------------------------------
-- | `Generic` FromEnv
class GFromEnv f where
  gFromEnv :: Option -> Maybe (f a) ->  Parser (f a)

------------------------------------------------------------------------------
-- | Type class for objects which have a default configuration.
class DefConfig a where defConfig :: a

------------------------------------------------------------------------------
-- | For customizing environment variable generation
data Option = Option {
    Option -> Int
dropPrefixCount :: Int  -- ^ Applied first
  , Option -> String
customPrefix :: String  -- ^ Converted toUpper
  } deriving Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> String
show :: Option -> String
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show

------------------------------------------------------------------------------
-- | Default `Option` for field modification
defOption :: Option
defOption :: Option
defOption = Int -> String -> Option
Option Int
0 String
forall a. Monoid a => a
mempty

------------------------------------------------------------------------------
-- | Products
instance (GFromEnv a, GFromEnv b) => GFromEnv (a :*: b) where
  gFromEnv :: forall a. Option -> Maybe ((:*:) a b a) -> Parser ((:*:) a b a)
gFromEnv Option
opts Maybe ((:*:) a b a)
ox = let (Maybe (a a)
oa, Maybe (b a)
ob) = case Maybe ((:*:) a b a)
ox of
                                             (Just (a a
a :*: b a
b)) -> (a a -> Maybe (a a)
forall a. a -> Maybe a
Just a a
a, b a -> Maybe (b a)
forall a. a -> Maybe a
Just b a
b)
                                             Maybe ((:*:) a b a)
_ -> (Maybe (a a)
forall a. Maybe a
Nothing, Maybe (b a)
forall a. Maybe a
Nothing) in
                            (a a -> b a -> (:*:) a b a)
-> Parser (a a) -> Parser (b a) -> Parser ((:*:) a b a)
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (Option -> Maybe (a a) -> Parser (a a)
forall a. Option -> Maybe (a a) -> Parser (a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts Maybe (a a)
oa) (Option -> Maybe (b a) -> Parser (b a)
forall a. Option -> Maybe (b a) -> Parser (b a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts Maybe (b a)
ob)

------------------------------------------------------------------------------
-- | Don't absorb meta data
instance GFromEnv a => GFromEnv (C1 i a) where
  gFromEnv :: forall a. Option -> Maybe (C1 i a a) -> Parser (C1 i a a)
gFromEnv  Option
opts (Just (M1 a a
x))= a a -> C1 i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> C1 i a a) -> Parser (a a) -> Parser (C1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Maybe (a a) -> Parser (a a)
forall a. Option -> Maybe (a a) -> Parser (a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts (a a -> Maybe (a a)
forall a. a -> Maybe a
Just a a
x)
  gFromEnv  Option
opts            Maybe (C1 i a a)
_ = a a -> C1 i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> C1 i a a) -> Parser (a a) -> Parser (C1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Maybe (a a) -> Parser (a a)
forall a. Option -> Maybe (a a) -> Parser (a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts Maybe (a a)
forall a. Maybe a
Nothing

------------------------------------------------------------------------------
-- | Don't absorb meta data
instance GFromEnv a => GFromEnv (D1 i a) where
  gFromEnv :: forall a. Option -> Maybe (D1 i a a) -> Parser (D1 i a a)
gFromEnv Option
opts (Just (M1 a a
x)) = a a -> D1 i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> D1 i a a) -> Parser (a a) -> Parser (D1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Maybe (a a) -> Parser (a a)
forall a. Option -> Maybe (a a) -> Parser (a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts (a a -> Maybe (a a)
forall a. a -> Maybe a
Just a a
x)
  gFromEnv Option
opts             Maybe (D1 i a a)
_ = a a -> D1 i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> D1 i a a) -> Parser (a a) -> Parser (D1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option -> Maybe (a a) -> Parser (a a)
forall a. Option -> Maybe (a a) -> Parser (a a)
forall (f :: * -> *) a.
GFromEnv f =>
Option -> Maybe (f a) -> Parser (f a)
gFromEnv Option
opts Maybe (a a)
forall a. Maybe a
Nothing

------------------------------------------------------------------------------
-- | Construct a `Parser` from a `selName` and `DefConfig` record field
instance (Selector s, Var a) => GFromEnv (S1 s (K1 i a)) where
  gFromEnv :: forall a.
Option -> Maybe (S1 s (K1 i a) a) -> Parser (S1 s (K1 i a) a)
gFromEnv Option
opts Maybe (S1 s (K1 i a) a)
ox =
    let p :: Parser a
p = case Maybe (S1 s (K1 i a) a)
ox of
               Just (M1 (K1 a
def)) -> String -> Parser (Maybe a)
forall a. Var a => String -> Parser (Maybe a)
envMaybe String
envName Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def
               Maybe (S1 s (K1 i a) a)
_                  -> String -> Parser a
forall a. Var a => String -> Parser a
env String
envName in
    K1 i a a -> S1 s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> S1 s (K1 i a) a)
-> (a -> K1 i a a) -> a -> S1 s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> S1 s (K1 i a) a) -> Parser a -> Parser (S1 s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p
     where
      envName :: String
envName = Option -> ShowS
toEnvName Option
opts ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SelectorProxy s Proxy () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (SelectorProxy s Proxy ()
forall (s :: Meta) (f :: * -> *) a. SelectorProxy s f a
SelectorProxy :: SelectorProxy s Proxy ())

      toEnvName :: Option -> String -> String
      toEnvName :: Option -> ShowS
toEnvName Option{Int
String
dropPrefixCount :: Option -> Int
customPrefix :: Option -> String
dropPrefixCount :: Int
customPrefix :: String
..} String
xs =
        let name :: String
name = ShowS
snake (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
dropPrefixCount String
xs)
        in if String
customPrefix String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
forall a. Monoid a => a
mempty
             then String
name
             else (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
customPrefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

      applyFirst :: (Char -> Char) -> String -> String
      applyFirst :: (Char -> Char) -> ShowS
applyFirst Char -> Char
_ []     = []
      applyFirst Char -> Char
f [Char
x]    = [Char -> Char
f Char
x]
      applyFirst Char -> Char
f (Char
x:String
xs) = Char -> Char
f Char
xChar -> ShowS
forall a. a -> [a] -> [a]
: String
xs

      snakeCase :: String -> String
      snakeCase :: ShowS
snakeCase = ShowS
u ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
applyFirst Char -> Char
toLower
        where u :: ShowS
u []                 = []
              u (Char
x:String
xs) | Char -> Bool
isUpper Char
x = Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
snakeCase String
xs
                       | Bool
otherwise = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
u String
xs

      snake :: String -> String
      snake :: ShowS
snake = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
snakeCase

data SelectorProxy (s :: Meta) (f :: Type -> Type) a = SelectorProxy

------------------------------------------------------------------------------
-- | Type class for objects which can be converted to a set of
-- environment variable settings.
class ToEnv a where
  -- | Convert an object into a list of environment variable settings.
  toEnv :: a -> EnvList a

------------------------------------------------------------------------------
-- | List of environment variables. Captures a "phantom type" which
-- allows the type checker to detect the proper implementation of toEnv
-- to use.
data EnvList a = EnvList [EnvVar] deriving (Int -> EnvList a -> ShowS
[EnvList a] -> ShowS
EnvList a -> String
(Int -> EnvList a -> ShowS)
-> (EnvList a -> String)
-> ([EnvList a] -> ShowS)
-> Show (EnvList a)
forall a. Int -> EnvList a -> ShowS
forall a. [EnvList a] -> ShowS
forall a. EnvList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> EnvList a -> ShowS
showsPrec :: Int -> EnvList a -> ShowS
$cshow :: forall a. EnvList a -> String
show :: EnvList a -> String
$cshowList :: forall a. [EnvList a] -> ShowS
showList :: [EnvList a] -> ShowS
Show)

------------------------------------------------------------------------------
-- | Smart constructor, environment creation helper.
makeEnv :: [EnvVar] -> EnvList a
makeEnv :: forall a. [EnvVar] -> EnvList a
makeEnv = [EnvVar] -> EnvList a
forall a. [EnvVar] -> EnvList a
EnvList

------------------------------------------------------------------------------
-- | Class for converting to / from an environment variable
class Typeable a => Var a where
  -- | Convert a value into an environment variable.
  toVar   :: a -> String
  -- | Parse an environment variable.
  fromVar :: String -> Maybe a

------------------------------------------------------------------------------
instance Var Text where toVar :: Text -> String
toVar = Text -> String
T.unpack; fromVar :: String -> Maybe Text
fromVar = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance Var TL.Text where toVar :: Text -> String
toVar = Text -> String
TL.unpack; fromVar :: String -> Maybe Text
fromVar = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
instance Var BL8.ByteString where toVar :: ByteString -> String
toVar = ByteString -> String
BL8.unpack; fromVar :: String -> Maybe ByteString
fromVar = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BL8.pack
instance Var B8.ByteString where toVar :: ByteString -> String
toVar = ByteString -> String
B8.unpack; fromVar :: String -> Maybe ByteString
fromVar = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack
instance Var Int where toVar :: Int -> String
toVar = Int -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Int
fromVar = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe
instance Var Int8 where toVar :: Int8 -> String
toVar = Int8 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Int8
fromVar = String -> Maybe Int8
forall a. Read a => String -> Maybe a
readMaybe
instance Var Int16 where toVar :: Int16 -> String
toVar = Int16 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Int16
fromVar = String -> Maybe Int16
forall a. Read a => String -> Maybe a
readMaybe
instance Var Int32 where toVar :: Int32 -> String
toVar = Int32 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Int32
fromVar = String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe
instance Var Int64 where toVar :: Int64 -> String
toVar = Int64 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Int64
fromVar = String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe
instance Var Integer where toVar :: Integer -> String
toVar = Integer -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Integer
fromVar = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe
instance Var UTCTime where toVar :: UTCTime -> String
toVar = UTCTime -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe UTCTime
fromVar = String -> Maybe UTCTime
forall a. Read a => String -> Maybe a
readMaybe
instance Var Day where toVar :: Day -> String
toVar = Day -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Day
fromVar = String -> Maybe Day
forall a. Read a => String -> Maybe a
readMaybe
instance Var Word8 where toVar :: Word8 -> String
toVar = Word8 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Word8
fromVar = String -> Maybe Word8
forall a. Read a => String -> Maybe a
readMaybe
instance Var Bool where toVar :: Bool -> String
toVar = Bool -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Bool
fromVar = String -> Maybe Bool
forall a. Read a => String -> Maybe a
readMaybe
instance Var Double where toVar :: Double -> String
toVar = Double -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Double
fromVar = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe
instance Var Word16 where toVar :: Word16 -> String
toVar = Word16 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Word16
fromVar = String -> Maybe Word16
forall a. Read a => String -> Maybe a
readMaybe
instance Var Word32 where toVar :: Word32 -> String
toVar = Word32 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Word32
fromVar = String -> Maybe Word32
forall a. Read a => String -> Maybe a
readMaybe
instance Var Word64 where toVar :: Word64 -> String
toVar = Word64 -> String
forall a. Show a => a -> String
show; fromVar :: String -> Maybe Word64
fromVar = String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe
instance Var String where toVar :: ShowS
toVar = ShowS
forall a. a -> a
id; fromVar :: String -> Maybe String
fromVar = String -> Maybe String
forall a. a -> Maybe a
Just
instance Var () where toVar :: () -> String
toVar = String -> () -> String
forall a b. a -> b -> a
const String
"()"; fromVar :: String -> Maybe ()
fromVar = Maybe () -> String -> Maybe ()
forall a b. a -> b -> a
const (Maybe () -> String -> Maybe ()) -> Maybe () -> String -> Maybe ()
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
instance Var a => Var (Maybe a) where
  toVar :: Maybe a -> String
toVar = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" a -> String
forall a. Var a => a -> String
toVar
  fromVar :: String -> Maybe (Maybe a)
fromVar String
"" = Maybe (Maybe a)
forall a. Maybe a
Nothing
  fromVar  String
s = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe a
forall a. Var a => String -> Maybe a
fromVar String
s

------------------------------------------------------------------------------
deriving instance (Var a, Typeable a) => Var (Last a)
deriving instance (Var a, Typeable a) => Var (First a)
deriving instance (Var a, Typeable a) => Var (Identity a)

------------------------------------------------------------------------------
-- | A utility type to use any instance of 'Read' and 'Show' as an instance of
--   'Var'.
newtype ReadShowVar a = ReadShowVar { forall a. ReadShowVar a -> a
unReadShowVar :: a }

instance (Typeable a, Show a, Read a) => Var (ReadShowVar a) where
  toVar :: ReadShowVar a -> String
toVar = a -> String
forall a. Show a => a -> String
show (a -> String) -> (ReadShowVar a -> a) -> ReadShowVar a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadShowVar a -> a
forall a. ReadShowVar a -> a
unReadShowVar
  fromVar :: String -> Maybe (ReadShowVar a)
fromVar = (a -> ReadShowVar a) -> Maybe a -> Maybe (ReadShowVar a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ReadShowVar a
forall a. a -> ReadShowVar a
ReadShowVar (Maybe a -> Maybe (ReadShowVar a))
-> (String -> Maybe a) -> String -> Maybe (ReadShowVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe
------------------------------------------------------------------------------
-- | Environment retrieval with failure info
decodeEnv :: FromEnv a => IO (Either String a)
decodeEnv :: forall a. FromEnv a => IO (Either String a)
decodeEnv = Parser a -> IO (Either String a)
forall a. Parser a -> IO (Either String a)
evalParser (Maybe a -> Parser a
forall a. FromEnv a => Maybe a -> Parser a
fromEnv Maybe a
forall a. Maybe a
Nothing)

------------------------------------------------------------------------------
-- | Environment retrieval (with no failure info)
decode :: FromEnv a => IO (Maybe a)
decode :: forall a. FromEnv a => IO (Maybe a)
decode = (Either String a -> Maybe a)
-> IO (Either String a) -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String a -> Maybe a
forall {a} {a}. Either a a -> Maybe a
eitherToMaybe IO (Either String a)
forall a. FromEnv a => IO (Either String a)
decodeEnv
  where
    eitherToMaybe :: Either a a -> Maybe a
eitherToMaybe (Left a
_)  = Maybe a
forall a. Maybe a
Nothing
    eitherToMaybe (Right a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

------------------------------------------------------------------------------
-- | Environment retrieval with default values provided
decodeWithDefaults :: FromEnv a => a -> IO a
decodeWithDefaults :: forall a. FromEnv a => a -> IO a
decodeWithDefaults a
def = (String -> IO a) -> (a -> IO a) -> Either String a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO a
forall a. HasCallStack => String -> a
error a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO a) -> IO (Either String a) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser a -> IO (Either String a)
forall a. Parser a -> IO (Either String a)
evalParser (Maybe a -> Parser a
forall a. FromEnv a => Maybe a -> Parser a
fromEnv (a -> Maybe a
forall a. a -> Maybe a
Just a
def))

------------------------------------------------------------------------------
-- | Catch an IO exception and return it in an Either.
wrapIOException :: IO a -> IO (Either String a)
wrapIOException :: forall a. IO a -> IO (Either String a)
wrapIOException IO a
action = IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action IO (Either IOException a)
-> (Either IOException a -> IO (Either String a))
-> IO (Either String a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left (IOException
ex :: IOException) -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
ex
  Right a
x -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
x

------------------------------------------------------------------------------
-- | Set environment via a ToEnv constrained type
setEnvironment :: EnvList a -> IO (Either String ())
setEnvironment :: forall a. EnvList a -> IO (Either String ())
setEnvironment (EnvList [EnvVar]
envVars) = IO () -> IO (Either String ())
forall a. IO a -> IO (Either String a)
wrapIOException (IO () -> IO (Either String ())) -> IO () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ (EnvVar -> IO ()) -> [EnvVar] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EnvVar -> IO ()
set [EnvVar]
envVars
  where set :: EnvVar -> IO ()
set EnvVar
var = String -> String -> Bool -> IO ()
setEnv (EnvVar -> String
variableName EnvVar
var) (EnvVar -> String
variableValue EnvVar
var) Bool
True

------------------------------------------------------------------------------
-- | Set environment directly using a value of class ToEnv
setEnvironment' :: ToEnv a => a -> IO (Either String ())
setEnvironment' :: forall a. ToEnv a => a -> IO (Either String ())
setEnvironment' = EnvList a -> IO (Either String ())
forall a. EnvList a -> IO (Either String ())
setEnvironment (EnvList a -> IO (Either String ()))
-> (a -> EnvList a) -> a -> IO (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> EnvList a
forall a. ToEnv a => a -> EnvList a
toEnv

------------------------------------------------------------------------------
-- | Unset Environment from a `ToEnv` constrained type
unsetEnvironment :: EnvList a -> IO (Either String ())
unsetEnvironment :: forall a. EnvList a -> IO (Either String ())
unsetEnvironment (EnvList [EnvVar]
envVars) = IO () -> IO (Either String ())
forall a. IO a -> IO (Either String a)
wrapIOException (IO () -> IO (Either String ())) -> IO () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ (EnvVar -> IO ()) -> [EnvVar] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EnvVar -> IO ()
unset [EnvVar]
envVars
  where unset :: EnvVar -> IO ()
unset EnvVar
var = String -> IO ()
unsetEnv (EnvVar -> String
variableName EnvVar
var)

------------------------------------------------------------------------------
-- | Unset Environment using a value of class ToEnv
unsetEnvironment' :: ToEnv a => a -> IO (Either String ())
unsetEnvironment' :: forall a. ToEnv a => a -> IO (Either String ())
unsetEnvironment' = EnvList a -> IO (Either String ())
forall a. EnvList a -> IO (Either String ())
unsetEnvironment (EnvList a -> IO (Either String ()))
-> (a -> EnvList a) -> a -> IO (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> EnvList a
forall a. ToEnv a => a -> EnvList a
toEnv

------------------------------------------------------------------------------
-- | Display all environment variables, for convenience
showEnv :: IO ()
showEnv :: IO ()
showEnv = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> IO ()
forall a. Show a => a -> IO ()
print ([(String, String)] -> IO ()) -> IO [(String, String)] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [(String, String)]
getEnvironment