{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Database.Relational.Monad.Trans.Qualify
-- Copyright   : 2013-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines monad transformer which qualify uniquely SQL table forms.
--
-- This is not public interface.
module Database.Relational.Monad.Trans.Qualify (
  -- * Qualify monad
  Qualify, qualify,
  evalQualifyPrime, qualifyQuery
  ) where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (StateT, runStateT, get, modify)
import Control.Applicative (Applicative)
import Control.Monad (liftM, ap)

import qualified Database.Relational.SqlSyntax as Syntax


-- | Monad type to qualify SQL table forms.
newtype Qualify m a =
  Qualify (StateT Int m a)
  deriving (Applicative (Qualify m)
a -> Qualify m a
Applicative (Qualify m)
-> (forall a b. Qualify m a -> (a -> Qualify m b) -> Qualify m b)
-> (forall a b. Qualify m a -> Qualify m b -> Qualify m b)
-> (forall a. a -> Qualify m a)
-> Monad (Qualify m)
Qualify m a -> (a -> Qualify m b) -> Qualify m b
Qualify m a -> Qualify m b -> Qualify m b
forall a. a -> Qualify m a
forall a b. Qualify m a -> Qualify m b -> Qualify m b
forall a b. Qualify m a -> (a -> Qualify m b) -> Qualify m b
forall (m :: * -> *). Monad m => Applicative (Qualify m)
forall (m :: * -> *) a. Monad m => a -> Qualify m a
forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m b
forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> (a -> Qualify m b) -> Qualify 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 -> Qualify m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Qualify m a
>> :: Qualify m a -> Qualify m b -> Qualify m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m b
>>= :: Qualify m a -> (a -> Qualify m b) -> Qualify m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> (a -> Qualify m b) -> Qualify m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (Qualify m)
Monad, a -> Qualify m b -> Qualify m a
(a -> b) -> Qualify m a -> Qualify m b
(forall a b. (a -> b) -> Qualify m a -> Qualify m b)
-> (forall a b. a -> Qualify m b -> Qualify m a)
-> Functor (Qualify m)
forall a b. a -> Qualify m b -> Qualify m a
forall a b. (a -> b) -> Qualify m a -> Qualify m b
forall (m :: * -> *) a b.
Functor m =>
a -> Qualify m b -> Qualify m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Qualify m a -> Qualify m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Qualify m b -> Qualify m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Qualify m b -> Qualify m a
fmap :: (a -> b) -> Qualify m a -> Qualify m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Qualify m a -> Qualify m b
Functor, Functor (Qualify m)
a -> Qualify m a
Functor (Qualify m)
-> (forall a. a -> Qualify m a)
-> (forall a b. Qualify m (a -> b) -> Qualify m a -> Qualify m b)
-> (forall a b c.
    (a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify m c)
-> (forall a b. Qualify m a -> Qualify m b -> Qualify m b)
-> (forall a b. Qualify m a -> Qualify m b -> Qualify m a)
-> Applicative (Qualify m)
Qualify m a -> Qualify m b -> Qualify m b
Qualify m a -> Qualify m b -> Qualify m a
Qualify m (a -> b) -> Qualify m a -> Qualify m b
(a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify m c
forall a. a -> Qualify m a
forall a b. Qualify m a -> Qualify m b -> Qualify m a
forall a b. Qualify m a -> Qualify m b -> Qualify m b
forall a b. Qualify m (a -> b) -> Qualify m a -> Qualify m b
forall a b c.
(a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify m c
forall (m :: * -> *). Monad m => Functor (Qualify m)
forall (m :: * -> *) a. Monad m => a -> Qualify m a
forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m a
forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m b
forall (m :: * -> *) a b.
Monad m =>
Qualify m (a -> b) -> Qualify m a -> Qualify m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify 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
<* :: Qualify m a -> Qualify m b -> Qualify m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m a
*> :: Qualify m a -> Qualify m b -> Qualify m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Qualify m a -> Qualify m b -> Qualify m b
liftA2 :: (a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Qualify m a -> Qualify m b -> Qualify m c
<*> :: Qualify m (a -> b) -> Qualify m a -> Qualify m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Qualify m (a -> b) -> Qualify m a -> Qualify m b
pure :: a -> Qualify m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> Qualify m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (Qualify m)
Applicative)

-- | Run qualify monad with initial state to get only result.
evalQualifyPrime :: Monad m => Qualify m a -> m a
evalQualifyPrime :: Qualify m a -> m a
evalQualifyPrime (Qualify StateT Int m a
s) = (a, Int) -> a
forall a b. (a, b) -> a
fst ((a, Int) -> a) -> m (a, Int) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT Int m a -> Int -> m (a, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Int m a
s Int
0 {- primary alias id -}

-- | Generated new qualifier on internal state.
newAlias :: Monad m => Qualify m Syntax.Qualifier
newAlias :: Qualify m Qualifier
newAlias =  StateT Int m Qualifier -> Qualify m Qualifier
forall (m :: * -> *) a. StateT Int m a -> Qualify m a
Qualify (StateT Int m Qualifier -> Qualify m Qualifier)
-> StateT Int m Qualifier -> Qualify m Qualifier
forall a b. (a -> b) -> a -> b
$ do
  Qualifier
ai <- Int -> Qualifier
Syntax.Qualifier (Int -> Qualifier) -> StateT Int m Int -> StateT Int m Qualifier
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Qualifier -> StateT Int m Qualifier
forall (m :: * -> *) a. Monad m => a -> m a
return Qualifier
ai

-- | Lift to 'Qualify'
qualify :: Monad m => m a -> Qualify m a
qualify :: m a -> Qualify m a
qualify =  StateT Int m a -> Qualify m a
forall (m :: * -> *) a. StateT Int m a -> Qualify m a
Qualify (StateT Int m a -> Qualify m a)
-> (m a -> StateT Int m a) -> m a -> Qualify m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Get qualifyed table form query.
qualifyQuery :: Monad m
             => query                              -- ^ Query to qualify
             -> Qualify m (Syntax.Qualified query) -- ^ Result with updated state
qualifyQuery :: query -> Qualify m (Qualified query)
qualifyQuery query
query =
  Qualifier -> query -> Qualified query
forall a. Qualifier -> a -> Qualified a
Syntax.qualify (Qualifier -> query -> Qualified query)
-> Qualify m Qualifier -> Qualify m (query -> Qualified query)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Qualify m Qualifier
forall (m :: * -> *). Monad m => Qualify m Qualifier
newAlias Qualify m (query -> Qualified query)
-> Qualify m query -> Qualify m (Qualified query)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` query -> Qualify m query
forall (m :: * -> *) a. Monad m => a -> m a
return query
query