{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Extensible.Envy
( recordFromEnvWith
, recordFromEnvWithDefault
, recordFromEnv
, FieldLabelToEnvName
, defaultFieldLabelToEnvName
, camelToUpperSnakeCase
) where
import Control.Applicative ((<|>))
import qualified Data.Char as C
import Data.Extensible (Forall, Instance1)
import qualified Data.Extensible as Ex
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import GHC.TypeLits (KnownSymbol, Symbol)
import qualified System.Envy as Env
type FieldLabelToEnvName = String -> String
defaultFieldLabelToEnvName :: String -> FieldLabelToEnvName
defaultFieldLabelToEnvName "" s = camelToUpperSnakeCase s
defaultFieldLabelToEnvName prefix s = prefix ++ "_" ++ camelToUpperSnakeCase s
{-# INLINE defaultFieldLabelToEnvName #-}
camelToUpperSnakeCase :: FieldLabelToEnvName
camelToUpperSnakeCase =
foldMap (\c -> if C.isUpper c then '_' : [c] else [C.toUpper c])
{-# INLINE camelToUpperSnakeCase #-}
recordFromEnv
:: forall (xs :: [Ex.Assoc Symbol Type]) h
. Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs
=> Env.Parser (Ex.RecordOf h xs)
recordFromEnv = recordFromEnvWith $ defaultFieldLabelToEnvName ""
{-# INLINE recordFromEnv #-}
recordFromEnvWith
:: forall (xs :: [Ex.Assoc Symbol Type]) h
. Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs
=> FieldLabelToEnvName
-> Env.Parser (Ex.RecordOf h xs)
recordFromEnvWith fl2en =
Ex.hgenerateFor
(Proxy :: Proxy (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h))) f
where
f membership = Ex.Field <$> Env.env (fl2en $ Ex.stringKeyOf membership)
{-# INLINE recordFromEnvWith #-}
recordFromEnvWithDefault
:: forall (xs :: [Ex.Assoc Symbol Type]) h
. Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs
=> Ex.RecordOf h xs
-> FieldLabelToEnvName
-> Env.Parser (Ex.RecordOf h xs)
recordFromEnvWithDefault def fl2en =
Ex.hgenerateFor
(Proxy :: Proxy (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h))) f
where
f membership =
( Ex.Field <$> Env.env (fl2en $ Ex.stringKeyOf membership)
) <|> pure (Ex.hlookup membership def)
{-# INLINE recordFromEnvWithDefault #-}