{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Database.Relational.Monad.Trans.Config
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines monad transformer which requires query generate configuration.
module Database.Relational.Monad.Trans.Config (
  -- * Transformer into query with configuration
  QueryConfig, queryConfig,
  runQueryConfig, askQueryConfig
  ) where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
import Control.Applicative (Applicative)

import Database.Relational.Internal.Config (Config)


-- | 'ReaderT' type to require query generate configuration.
newtype QueryConfig m a =
  QueryConfig (ReaderT Config m a)
  deriving (Applicative (QueryConfig m)
a -> QueryConfig m a
Applicative (QueryConfig m)
-> (forall a b.
    QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m b)
-> (forall a b.
    QueryConfig m a -> QueryConfig m b -> QueryConfig m b)
-> (forall a. a -> QueryConfig m a)
-> Monad (QueryConfig m)
QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m b
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
forall a. a -> QueryConfig m a
forall a b. QueryConfig m a -> QueryConfig m b -> QueryConfig m b
forall a b.
QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m b
forall (m :: * -> *). Monad m => Applicative (QueryConfig m)
forall (m :: * -> *) a. Monad m => a -> QueryConfig m a
forall (m :: * -> *) a b.
Monad m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
forall (m :: * -> *) a b.
Monad m =>
QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m 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
return :: a -> QueryConfig m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> QueryConfig m a
>> :: QueryConfig m a -> QueryConfig m b -> QueryConfig m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
>>= :: QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
QueryConfig m a -> (a -> QueryConfig m b) -> QueryConfig m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (QueryConfig m)
Monad, a -> QueryConfig m b -> QueryConfig m a
(a -> b) -> QueryConfig m a -> QueryConfig m b
(forall a b. (a -> b) -> QueryConfig m a -> QueryConfig m b)
-> (forall a b. a -> QueryConfig m b -> QueryConfig m a)
-> Functor (QueryConfig m)
forall a b. a -> QueryConfig m b -> QueryConfig m a
forall a b. (a -> b) -> QueryConfig m a -> QueryConfig m b
forall (m :: * -> *) a b.
Functor m =>
a -> QueryConfig m b -> QueryConfig m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryConfig m a -> QueryConfig m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QueryConfig m b -> QueryConfig m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QueryConfig m b -> QueryConfig m a
fmap :: (a -> b) -> QueryConfig m a -> QueryConfig m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryConfig m a -> QueryConfig m b
Functor, Functor (QueryConfig m)
a -> QueryConfig m a
Functor (QueryConfig m)
-> (forall a. a -> QueryConfig m a)
-> (forall a b.
    QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b)
-> (forall a b c.
    (a -> b -> c)
    -> QueryConfig m a -> QueryConfig m b -> QueryConfig m c)
-> (forall a b.
    QueryConfig m a -> QueryConfig m b -> QueryConfig m b)
-> (forall a b.
    QueryConfig m a -> QueryConfig m b -> QueryConfig m a)
-> Applicative (QueryConfig m)
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
QueryConfig m a -> QueryConfig m b -> QueryConfig m a
QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b
(a -> b -> c)
-> QueryConfig m a -> QueryConfig m b -> QueryConfig m c
forall a. a -> QueryConfig m a
forall a b. QueryConfig m a -> QueryConfig m b -> QueryConfig m a
forall a b. QueryConfig m a -> QueryConfig m b -> QueryConfig m b
forall a b.
QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b
forall a b c.
(a -> b -> c)
-> QueryConfig m a -> QueryConfig m b -> QueryConfig m 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
forall (m :: * -> *). Applicative m => Functor (QueryConfig m)
forall (m :: * -> *) a. Applicative m => a -> QueryConfig m a
forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m a
forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QueryConfig m a -> QueryConfig m b -> QueryConfig m c
<* :: QueryConfig m a -> QueryConfig m b -> QueryConfig m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m a
*> :: QueryConfig m a -> QueryConfig m b -> QueryConfig m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m a -> QueryConfig m b -> QueryConfig m b
liftA2 :: (a -> b -> c)
-> QueryConfig m a -> QueryConfig m b -> QueryConfig m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> QueryConfig m a -> QueryConfig m b -> QueryConfig m c
<*> :: QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryConfig m (a -> b) -> QueryConfig m a -> QueryConfig m b
pure :: a -> QueryConfig m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QueryConfig m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (QueryConfig m)
Applicative)

-- | Run 'QueryConfig' to expand with configuration
runQueryConfig :: QueryConfig m a -> Config -> m a
runQueryConfig :: QueryConfig m a -> Config -> m a
runQueryConfig (QueryConfig ReaderT Config m a
r) = ReaderT Config m a -> Config -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Config m a
r

-- | Lift to 'QueryConfig'.
queryConfig :: Monad m => m a -> QueryConfig m a
queryConfig :: m a -> QueryConfig m a
queryConfig =  ReaderT Config m a -> QueryConfig m a
forall (m :: * -> *) a. ReaderT Config m a -> QueryConfig m a
QueryConfig (ReaderT Config m a -> QueryConfig m a)
-> (m a -> ReaderT Config m a) -> m a -> QueryConfig m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Config m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Read configuration.
askQueryConfig :: Monad m => QueryConfig m Config
askQueryConfig :: QueryConfig m Config
askQueryConfig =  ReaderT Config m Config -> QueryConfig m Config
forall (m :: * -> *) a. ReaderT Config m a -> QueryConfig m a
QueryConfig ReaderT Config m Config
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask