module Database.Relational.Query.Monad.Unique (
QueryUnique, toSubQuery
) where
import Control.Applicative (Applicative)
import Database.Relational.Query.Context (Flat)
import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection
import Database.Relational.Query.Monad.Class (MonadQualifyUnique(..), MonadQuery)
import Database.Relational.Query.Monad.Trans.Join (join')
import Database.Relational.Query.Monad.Trans.Restricting (restrictings)
import Database.Relational.Query.Monad.Type (ConfigureQuery, askConfig, QueryCore, extractCore)
import Database.Relational.Query.Component (Duplication, QueryRestriction)
import Database.Relational.Query.Sub (SubQuery, flatSubQuery, JoinProduct)
newtype QueryUnique a = QueryUnique (QueryCore a)
deriving (MonadQuery, Monad, Applicative, Functor)
queryUnique :: ConfigureQuery a -> QueryUnique a
queryUnique = QueryUnique . restrictings . join'
instance MonadQualifyUnique ConfigureQuery QueryUnique where
liftQualifyUnique = queryUnique
extract :: QueryUnique a
-> ConfigureQuery (((a, QueryRestriction Flat), JoinProduct), Duplication)
extract (QueryUnique c) = extractCore c
toSubQuery :: QueryUnique (Projection c r)
-> ConfigureQuery SubQuery
toSubQuery q = do
(((pj, rs), pd), da) <- extract q
c <- askConfig
return $ flatSubQuery c (Projection.untype pj) da pd rs []