module Database.Relational.Query.Monad.BaseType
(
ConfigureQuery, configureQuery,
qualifyQuery, askConfig,
Relation, unsafeTypeRelation, untypeRelation, relationWidth,
dump,
sqlFromRelationWith, sqlFromRelation,
rightPh, leftPh,
) where
import Data.Functor.Identity (Identity, runIdentity)
import Control.Applicative ((<$>))
import Database.Record.Persistable (PersistableRecordWidth, unsafePersistableRecordWidth)
import Database.Relational.Query.Internal.Config (Config, defaultConfig)
import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL)
import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL, width)
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
relationWidth :: Relation p r -> PersistableRecordWidth r
relationWidth rel =
unsafePersistableRecordWidth . width $ configureQuery (untypeRelation rel) defaultConfig
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