module Database.Relational.Query.Monad.Unique
( QueryUnique, unsafeUniqueSubQuery,
toSubQuery,
) where
import Control.Applicative (Applicative)
import Database.Relational.Query.Internal.BaseSQL (Duplication)
import Database.Relational.Query.Context (Flat)
import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection
import Database.Relational.Query.Projectable (PlaceHolders)
import Database.Relational.Query.Monad.Class (MonadQualify, MonadQuery)
import Database.Relational.Query.Monad.Trans.Join (unsafeSubQueryWithAttr)
import Database.Relational.Query.Monad.Trans.Restricting (restrictings)
import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Query.Monad.Type (QueryCore, extractCore)
import Database.Relational.Query.Sub
(SubQuery, QueryRestriction, Qualified, JoinProduct, NodeAttr, flatSubQuery)
newtype QueryUnique a = QueryUnique (QueryCore a)
deriving (MonadQualify ConfigureQuery, MonadQuery, Monad, Applicative, Functor)
unsafeUniqueSubQuery :: NodeAttr
-> Qualified SubQuery
-> QueryUnique (Projection c r)
unsafeUniqueSubQuery a = QueryUnique . restrictings . unsafeSubQueryWithAttr a
extract :: QueryUnique a
-> ConfigureQuery (((a, QueryRestriction Flat), JoinProduct), Duplication)
extract (QueryUnique c) = extractCore c
toSubQuery :: QueryUnique (PlaceHolders p, Projection c r)
-> ConfigureQuery SubQuery
toSubQuery q = do
((((_ph, pj), rs), pd), da) <- extract q
c <- askConfig
return $ flatSubQuery c (Projection.untype pj) da pd rs []