{-# LANGUAGE CPP #-}
module Database.Persist.Class.PersistConfig
( PersistConfig (..)
) where
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Aeson (Value (Object))
import Data.Aeson.Types (Parser)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as AM
#else
import qualified Data.HashMap.Strict as AM
#endif
import Data.Kind (Type)
class PersistConfig c where
type PersistConfigBackend c :: (Type -> Type) -> Type -> Type
type PersistConfigPool c
loadConfig :: Value -> Parser c
applyEnv :: c -> IO c
applyEnv = forall (m :: * -> *) a. Monad m => a -> m a
return
createPoolConfig :: c -> IO (PersistConfigPool c)
runPool :: MonadUnliftIO m
=> c
-> PersistConfigBackend c m a
-> PersistConfigPool c
-> m a
instance
( PersistConfig c1
, PersistConfig c2
, PersistConfigPool c1 ~ PersistConfigPool c2
, PersistConfigBackend c1 ~ PersistConfigBackend c2
) => PersistConfig (Either c1 c2) where
type PersistConfigBackend (Either c1 c2) = PersistConfigBackend c1
type PersistConfigPool (Either c1 c2) = PersistConfigPool c1
loadConfig :: Value -> Parser (Either c1 c2)
loadConfig (Object Object
o) =
case forall v. Key -> KeyMap v -> Maybe v
AM.lookup Key
"left" Object
o of
Just Value
v -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. PersistConfig c => Value -> Parser c
loadConfig Value
v
Maybe Value
Nothing ->
case forall v. Key -> KeyMap v -> Maybe v
AM.lookup Key
"right" Object
o of
Just Value
v -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. PersistConfig c => Value -> Parser c
loadConfig Value
v
Maybe Value
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PersistConfig for Either: need either a left or right"
loadConfig Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PersistConfig for Either: need an object"
createPoolConfig :: Either c1 c2 -> IO (PersistConfigPool (Either c1 c2))
createPoolConfig = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall c. PersistConfig c => c -> IO (PersistConfigPool c)
createPoolConfig forall c. PersistConfig c => c -> IO (PersistConfigPool c)
createPoolConfig
runPool :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Either c1 c2
-> PersistConfigBackend (Either c1 c2) m a
-> PersistConfigPool (Either c1 c2)
-> m a
runPool (Left c1
c) = forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
runPool c1
c
runPool (Right c2
c) = forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
runPool c2
c