    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeOperators #-}

    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)

    -- | Represents a value containing all the configuration options for a specific
    -- backend. This abstraction makes it easier to write code that can easily swap
    -- backends.
    class PersistConfig c where
        type PersistConfigBackend c :: (Type -> Type) -> Type -> Type
        type PersistConfigPool c

        -- | Load the config settings from a 'Value', most likely taken from a YAML
        -- config file.
        loadConfig :: Value -> Parser c

        -- | Modify the config settings based on environment variables.
        applyEnv :: c -> IO c
        applyEnv = c -> IO c
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

        -- | Create a new connection pool based on the given config settings.
        createPoolConfig :: c -> IO (PersistConfigPool c)

        -- | Run a database action by taking a connection from the pool.
        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 Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    AM.lookup Key
    "left" Object
    o of
                Just Value
    v -> c1 -> Either c1 c2
    forall a b. a -> Either a b
    Left (c1 -> Either c1 c2) -> Parser c1 -> Parser (Either c1 c2)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser c1
    forall c. PersistConfig c => Value -> Parser c
    loadConfig Value
    v
                Maybe Value
    Nothing ->
                    case Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    AM.lookup Key
    "right" Object
    o of
                        Just Value
    v -> c2 -> Either c1 c2
    forall a b. b -> Either a b
    Right (c2 -> Either c1 c2) -> Parser c2 -> Parser (Either c1 c2)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser c2
    forall c. PersistConfig c => Value -> Parser c
    loadConfig Value
    v
                        Maybe Value
    Nothing -> String -> Parser (Either c1 c2)
    forall a. String -> Parser a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "PersistConfig for Either: need either a left or right"
        loadConfig Value
    _ = String -> Parser (Either c1 c2)
    forall a. String -> Parser a
    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 = (c1 -> IO (PersistConfigPool c2))
    -> (c2 -> IO (PersistConfigPool c2))
    -> Either c1 c2
    -> IO (PersistConfigPool c2)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either c1 -> IO (PersistConfigPool c1)
    c1 -> IO (PersistConfigPool c2)
    forall c. PersistConfig c => c -> IO (PersistConfigPool c)
    createPoolConfig c2 -> IO (PersistConfigPool c2)
    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) = c1 -> PersistConfigBackend c1 m a -> PersistConfigPool c1 -> m a
    forall c (m :: * -> *) a.
    (PersistConfig c, MonadUnliftIO m) =>
    c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    c1 -> PersistConfigBackend c1 m a -> PersistConfigPool c1 -> m a
    runPool c1
    c
        runPool (Right c2
    c) = c2 -> PersistConfigBackend c2 m a -> PersistConfigPool c2 -> m a
    forall c (m :: * -> *) a.
    (PersistConfig c, MonadUnliftIO m) =>
    c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    c2 -> PersistConfigBackend c2 m a -> PersistConfigPool c2 -> m a
    runPool c2
    c