module Database.Relational.Query.Type (
Query (..), unsafeTypedQuery,
relationalQuery', relationalQuery,
relationalQuerySQL,
KeyUpdate (..), unsafeTypedKeyUpdate, typedKeyUpdate, typedKeyUpdateTable,
Update (..), unsafeTypedUpdate, typedUpdate, typedUpdateTable, targetUpdate, targetUpdateTable,
typedUpdateAllColumn, restrictedUpdateAllColumn, restrictedUpdateTableAllColumn,
updateSQL,
Insert (..), unsafeTypedInsert', unsafeTypedInsert, typedInsert', typedInsert, derivedInsert,
InsertQuery (..), unsafeTypedInsertQuery, typedInsertQuery, derivedInsertQuery,
insertQuerySQL,
Delete (..), unsafeTypedDelete, typedDelete, restrictedDelete,
deleteSQL,
UntypeableNoFetch (..)
) where
import Data.Monoid ((<>))
import Database.Record (PersistableWidth)
import Database.Relational.Query.Internal.SQL (showStringSQL)
import Database.Relational.Query.Relation (Relation, sqlFromRelationWith, tableOf)
import Database.Relational.Query.Effect
(Restriction, RestrictionContext, restriction',
UpdateTarget, UpdateTargetContext, updateTarget', liftTargetAllColumn',
sqlWhereFromRestriction, sqlFromUpdateTarget)
import Database.Relational.Query.Pi (Pi)
import qualified Database.Relational.Query.Pi as Pi
import Database.Relational.Query.Component (Config (chunksInsertSize), defaultConfig)
import Database.Relational.Query.Table (Table, TableDerivable, derivedTable)
import Database.Relational.Query.SQL
(QuerySuffix, showsQuerySuffix, insertPrefixSQL, insertSQL, insertSizedChunkSQL,
updateOtherThanKeySQL, updatePrefixSQL, deletePrefixSQL)
newtype Query p a = Query { untypeQuery :: String }
unsafeTypedQuery :: String
-> Query p a
unsafeTypedQuery = Query
instance Show (Query p a) where
show = untypeQuery
relationalQuerySQL :: Config -> Relation p r -> QuerySuffix -> String
relationalQuerySQL config rel qsuf = showStringSQL $ sqlFromRelationWith rel config <> showsQuerySuffix qsuf
relationalQuery' :: Relation p r -> QuerySuffix -> Query p r
relationalQuery' rel qsuf = unsafeTypedQuery $ relationalQuerySQL defaultConfig rel qsuf
relationalQuery :: Relation p r -> Query p r
relationalQuery = (`relationalQuery'` [])
data KeyUpdate p a = KeyUpdate { updateKey :: Pi a p
, untypeKeyUpdate :: String
}
unsafeTypedKeyUpdate :: Pi a p -> String -> KeyUpdate p a
unsafeTypedKeyUpdate = KeyUpdate
typedKeyUpdate :: Table a -> Pi a p -> KeyUpdate p a
typedKeyUpdate tbl key = unsafeTypedKeyUpdate key $ updateOtherThanKeySQL tbl key
typedKeyUpdateTable :: TableDerivable r => Relation () r -> Pi r p -> KeyUpdate p r
typedKeyUpdateTable = typedKeyUpdate . tableOf
instance Show (KeyUpdate p a) where
show = untypeKeyUpdate
newtype Update p = Update { untypeUpdate :: String }
unsafeTypedUpdate :: String -> Update p
unsafeTypedUpdate = Update
updateSQL :: Table r -> UpdateTarget p r -> String
updateSQL tbl ut = showStringSQL $ updatePrefixSQL tbl <> sqlFromUpdateTarget tbl ut
typedUpdate :: Table r -> UpdateTarget p r -> Update p
typedUpdate tbl ut = unsafeTypedUpdate $ updateSQL tbl ut
typedUpdateTable :: TableDerivable r => Relation () r -> UpdateTarget p r -> Update p
typedUpdateTable = typedUpdate . tableOf
targetUpdate :: Table r
-> UpdateTargetContext p r
-> Update p
targetUpdate tbl = typedUpdate tbl . updateTarget'
targetUpdateTable :: TableDerivable r
=> Relation () r
-> UpdateTargetContext p r
-> Update p
targetUpdateTable = targetUpdate . tableOf
typedUpdateAllColumn :: PersistableWidth r
=> Table r
-> Restriction p r
-> Update (r, p)
typedUpdateAllColumn tbl r = typedUpdate tbl $ liftTargetAllColumn' r
restrictedUpdateAllColumn :: PersistableWidth r
=> Table r
-> RestrictionContext p r
-> Update (r, p)
restrictedUpdateAllColumn tbl = typedUpdateAllColumn tbl . restriction'
restrictedUpdateTableAllColumn :: (PersistableWidth r, TableDerivable r)
=> Relation () r
-> RestrictionContext p r
-> Update (r, p)
restrictedUpdateTableAllColumn = restrictedUpdateAllColumn . tableOf
instance Show (Update p) where
show = untypeUpdate
data Insert a =
Insert
{ untypeInsert :: String
, untypeChunkInsert :: String
, chunkSizeOfInsert :: Int
}
unsafeTypedInsert' :: String -> String -> Int -> Insert a
unsafeTypedInsert' = Insert
unsafeTypedInsert :: String -> Insert a
unsafeTypedInsert q = unsafeTypedInsert' q q 1
typedInsert' :: Config -> Pi r r' -> Table r -> Insert r'
typedInsert' config pi' tbl = unsafeTypedInsert' (insertSQL pi' tbl) ci n where
(ci, n) = insertSizedChunkSQL pi' tbl $ chunksInsertSize config
typedInsert :: Pi r r' -> Table r -> Insert r'
typedInsert = typedInsert' defaultConfig
derivedInsert :: TableDerivable r => Insert r
derivedInsert = typedInsert Pi.id' derivedTable
instance Show (Insert a) where
show = untypeInsert
newtype InsertQuery p = InsertQuery { untypeInsertQuery :: String }
unsafeTypedInsertQuery :: String -> InsertQuery p
unsafeTypedInsertQuery = InsertQuery
insertQuerySQL :: TableDerivable r => Config -> Pi r r' -> Relation p r' -> String
insertQuerySQL config pi' rel = showStringSQL $ insertPrefixSQL pi' derivedTable <> sqlFromRelationWith rel config
typedInsertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p
typedInsertQuery pi' rel = unsafeTypedInsertQuery $ insertQuerySQL defaultConfig pi' rel
derivedInsertQuery :: TableDerivable r => Relation p r -> InsertQuery p
derivedInsertQuery = typedInsertQuery Pi.id'
instance Show (InsertQuery p) where
show = untypeInsertQuery
newtype Delete p = Delete { untypeDelete :: String }
unsafeTypedDelete :: String -> Delete p
unsafeTypedDelete = Delete
deleteSQL :: Table r -> Restriction p r -> String
deleteSQL tbl r = showStringSQL $ deletePrefixSQL tbl <> sqlWhereFromRestriction tbl r
typedDelete :: Table r -> Restriction p r -> Delete p
typedDelete tbl r = unsafeTypedDelete $ deleteSQL tbl r
restrictedDelete :: Table r
-> RestrictionContext p r
-> Delete p
restrictedDelete tbl = typedDelete tbl . restriction'
instance Show (Delete p) where
show = untypeDelete
class UntypeableNoFetch s where
untypeNoFetch :: s p -> String
instance UntypeableNoFetch Insert where
untypeNoFetch = untypeInsert
instance UntypeableNoFetch Update where
untypeNoFetch = untypeUpdate
instance UntypeableNoFetch Delete where
untypeNoFetch = untypeDelete