module Database.Relational.Query.Monad.BaseType
(
ConfigureQuery, configureQuery,
qualifyQuery, askConfig,
Relation, unsafeTypeRelation, untypeRelation,
dump,
sqlFromRelationWith, sqlFromRelation,
rightPh, leftPh,
) where
import Data.Functor.Identity (Identity, runIdentity)
import Control.Applicative ((<$>))
import Database.Relational.Query.Component (Config, defaultConfig)
import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL)
import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL)
import qualified Database.Relational.Query.Monad.Trans.Qualify as Qualify
import Database.Relational.Query.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime)
import Database.Relational.Query.Monad.Trans.Config (QueryConfig, runQueryConfig, askQueryConfig)
type ConfigureQuery = Qualify (QueryConfig Identity)
configureQuery :: ConfigureQuery q -> Config -> q
configureQuery cq c = runIdentity $ runQueryConfig (evalQualifyPrime cq) c
qualifyQuery :: a -> ConfigureQuery (Qualified a)
qualifyQuery = Qualify.qualifyQuery
askConfig :: ConfigureQuery Config
askConfig = qualify askQueryConfig
newtype Relation p r = SubQuery (ConfigureQuery SubQuery)
unsafeTypeRelation :: ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation = SubQuery
untypeRelation :: Relation p r -> ConfigureQuery SubQuery
untypeRelation (SubQuery qsub) = qsub
unsafeCastPlaceHolder :: Relation a r -> Relation b r
unsafeCastPlaceHolder (SubQuery qsub) = SubQuery qsub
rightPh :: Relation ((), p) r -> Relation p r
rightPh = unsafeCastPlaceHolder
leftPh :: Relation (p, ()) r -> Relation p r
leftPh = unsafeCastPlaceHolder
sqlFromRelationWith :: Relation p r -> Config -> StringSQL
sqlFromRelationWith = configureQuery . (showSQL <$>) . untypeRelation
sqlFromRelation :: Relation p r -> StringSQL
sqlFromRelation = (`sqlFromRelationWith` defaultConfig)
dump :: Relation p r -> String
dump = show . (`configureQuery` defaultConfig) . untypeRelation
instance Show (Relation p r) where
show = showStringSQL . sqlFromRelation