module Database.Relational.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.Internal.String (StringSQL, showStringSQL)
import Database.Relational.Internal.Config (Config, defaultConfig)
import Database.Relational.SqlSyntax (Qualified, SubQuery, showSQL, width)
import qualified Database.Relational.Monad.Trans.Qualify as Qualify
import Database.Relational.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime)
import Database.Relational.Monad.Trans.Config (QueryConfig, runQueryConfig, askQueryConfig)
type ConfigureQuery = Qualify (QueryConfig Identity)
configureQuery :: ConfigureQuery q -> Config -> q
configureQuery :: ConfigureQuery q -> Config -> q
configureQuery ConfigureQuery q
cq Config
c = Identity q -> q
forall a. Identity a -> a
runIdentity (Identity q -> q) -> Identity q -> q
forall a b. (a -> b) -> a -> b
$ QueryConfig Identity q -> Config -> Identity q
forall (m :: * -> *) a. QueryConfig m a -> Config -> m a
runQueryConfig (ConfigureQuery q -> QueryConfig Identity q
forall (m :: * -> *) a. Monad m => Qualify m a -> m a
evalQualifyPrime ConfigureQuery q
cq) Config
c
qualifyQuery :: a -> ConfigureQuery (Qualified a)
qualifyQuery :: a -> ConfigureQuery (Qualified a)
qualifyQuery = a -> ConfigureQuery (Qualified a)
forall (m :: * -> *) query.
Monad m =>
query -> Qualify m (Qualified query)
Qualify.qualifyQuery
askConfig :: ConfigureQuery Config
askConfig :: ConfigureQuery Config
askConfig = QueryConfig Identity Config -> ConfigureQuery Config
forall (m :: * -> *) a. Monad m => m a -> Qualify m a
qualify QueryConfig Identity Config
forall (m :: * -> *). Monad m => QueryConfig m Config
askQueryConfig
newtype Relation p r = SubQuery (ConfigureQuery SubQuery)
unsafeTypeRelation :: ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation :: ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation = ConfigureQuery SubQuery -> Relation p r
forall p r. ConfigureQuery SubQuery -> Relation p r
SubQuery
untypeRelation :: Relation p r -> ConfigureQuery SubQuery
untypeRelation :: Relation p r -> ConfigureQuery SubQuery
untypeRelation (SubQuery ConfigureQuery SubQuery
qsub) = ConfigureQuery SubQuery
qsub
relationWidth :: Relation p r -> PersistableRecordWidth r
relationWidth :: Relation p r -> PersistableRecordWidth r
relationWidth Relation p r
rel =
Int -> PersistableRecordWidth r
forall a. Int -> PersistableRecordWidth a
unsafePersistableRecordWidth (Int -> PersistableRecordWidth r)
-> (SubQuery -> Int) -> SubQuery -> PersistableRecordWidth r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubQuery -> Int
width (SubQuery -> PersistableRecordWidth r)
-> SubQuery -> PersistableRecordWidth r
forall a b. (a -> b) -> a -> b
$ ConfigureQuery SubQuery -> Config -> SubQuery
forall q. ConfigureQuery q -> Config -> q
configureQuery (Relation p r -> ConfigureQuery SubQuery
forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation Relation p r
rel) Config
defaultConfig
unsafeCastPlaceHolder :: Relation a r -> Relation b r
unsafeCastPlaceHolder :: Relation a r -> Relation b r
unsafeCastPlaceHolder (SubQuery ConfigureQuery SubQuery
qsub) = ConfigureQuery SubQuery -> Relation b r
forall p r. ConfigureQuery SubQuery -> Relation p r
SubQuery ConfigureQuery SubQuery
qsub
rightPh :: Relation ((), p) r -> Relation p r
rightPh :: Relation ((), p) r -> Relation p r
rightPh = Relation ((), p) r -> Relation p r
forall a r b. Relation a r -> Relation b r
unsafeCastPlaceHolder
leftPh :: Relation (p, ()) r -> Relation p r
leftPh :: Relation (p, ()) r -> Relation p r
leftPh = Relation (p, ()) r -> Relation p r
forall a r b. Relation a r -> Relation b r
unsafeCastPlaceHolder
sqlFromRelationWith :: Relation p r -> Config -> StringSQL
sqlFromRelationWith :: Relation p r -> Config -> StringSQL
sqlFromRelationWith = ConfigureQuery StringSQL -> Config -> StringSQL
forall q. ConfigureQuery q -> Config -> q
configureQuery (ConfigureQuery StringSQL -> Config -> StringSQL)
-> (Relation p r -> ConfigureQuery StringSQL)
-> Relation p r
-> Config
-> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubQuery -> StringSQL
showSQL (SubQuery -> StringSQL)
-> ConfigureQuery SubQuery -> ConfigureQuery StringSQL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (ConfigureQuery SubQuery -> ConfigureQuery StringSQL)
-> (Relation p r -> ConfigureQuery SubQuery)
-> Relation p r
-> ConfigureQuery StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> ConfigureQuery SubQuery
forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation
sqlFromRelation :: Relation p r -> StringSQL
sqlFromRelation :: Relation p r -> StringSQL
sqlFromRelation = (Relation p r -> Config -> StringSQL
forall p r. Relation p r -> Config -> StringSQL
`sqlFromRelationWith` Config
defaultConfig)
dump :: Relation p r -> String
dump :: Relation p r -> String
dump = SubQuery -> String
forall a. Show a => a -> String
show (SubQuery -> String)
-> (Relation p r -> SubQuery) -> Relation p r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigureQuery SubQuery -> Config -> SubQuery
forall q. ConfigureQuery q -> Config -> q
`configureQuery` Config
defaultConfig) (ConfigureQuery SubQuery -> SubQuery)
-> (Relation p r -> ConfigureQuery SubQuery)
-> Relation p r
-> SubQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> ConfigureQuery SubQuery
forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation
instance Show (Relation p r) where
show :: Relation p r -> String
show = StringSQL -> String
showStringSQL (StringSQL -> String)
-> (Relation p r -> StringSQL) -> Relation p r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> StringSQL
forall p r. Relation p r -> StringSQL
sqlFromRelation