{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Database.Relational.Monad.Simple (
QuerySimple, SimpleQuery,
simple,
toSQL,
toSubQuery,
) where
import Database.Relational.Internal.ContextType (Flat)
import Database.Relational.SqlSyntax
(Duplication, OrderingTerm, JoinProduct, Predicate, Record,
SubQuery, flatSubQuery, )
import qualified Database.Relational.SqlSyntax as Syntax
import qualified Database.Relational.Record as Record
import Database.Relational.Monad.Trans.Join (join')
import Database.Relational.Monad.Trans.Restricting (restrictings)
import Database.Relational.Monad.Trans.Ordering
(Orderings, orderings, extractOrderingTerms)
import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Monad.Type (QueryCore, extractCore, OrderedQuery)
import Database.Relational.Projectable (PlaceHolders)
type QuerySimple = Orderings Flat QueryCore
type SimpleQuery p r = OrderedQuery Flat QueryCore p r
simple :: ConfigureQuery a -> QuerySimple a
simple = orderings . restrictings . join'
extract :: SimpleQuery p r
-> ConfigureQuery (((((PlaceHolders p, Record Flat r), [OrderingTerm]), [Predicate Flat]),
JoinProduct), Duplication)
extract = extractCore . extractOrderingTerms
toSQL :: SimpleQuery p r
-> ConfigureQuery String
toSQL = fmap Syntax.toSQL . toSubQuery
toSubQuery :: SimpleQuery p r
-> ConfigureQuery SubQuery
toSubQuery q = do
(((((_ph, pj), ot), rs), pd), da) <- extract q
c <- askConfig
return $ flatSubQuery c (Record.untype pj) da pd rs ot