{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Database.Relational.Monad.Trans.Qualify (
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
newtype Qualify m a =
Qualify (StateT Int m a)
deriving (Monad, Functor, Applicative)
evalQualifyPrime :: Monad m => Qualify m a -> m a
evalQualifyPrime (Qualify s) = fst `liftM` runStateT s 0
newAlias :: Monad m => Qualify m Syntax.Qualifier
newAlias = Qualify $ do
ai <- Syntax.Qualifier `liftM` get
modify (+ 1)
return ai
qualify :: Monad m => m a -> Qualify m a
qualify = Qualify . lift
qualifyQuery :: Monad m
=> query
-> Qualify m (Syntax.Qualified query)
qualifyQuery query =
Syntax.qualify `liftM` newAlias `ap` return query