module Database.Relational.Query.Projection (
Projection,
width,
columns,
untype,
unsafeFromColumns,
unsafeFromQualifiedSubQuery,
unsafeFromScalarSubQuery,
unsafeFromTable,
predicateProjectionFromExpr,
pi, piMaybe, piMaybe',
flattenMaybe, just,
unsafeToAggregated, unsafeToFlat, unsafeChangeContext,
unsafeShowSqlNotNullMaybeProjection,
pfmap, pap,
ListProjection, list, unsafeListProjectionFromSubQuery,
unsafeShowSqlListProjection
) where
import Prelude hiding (pi)
import qualified Language.SQL.Keyword as SQL
import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint)
import qualified Database.Record.KeyConstraint as KeyConstraint
import Database.Relational.Query.Internal.SQL (rowListStringString)
import Database.Relational.Query.Context (Aggregated, Flat)
import Database.Relational.Query.Component (ColumnSQL, columnSQL')
import Database.Relational.Query.Table (Table)
import qualified Database.Relational.Query.Table as Table
import Database.Relational.Query.Pure (ProductConstructor (..))
import Database.Relational.Query.Expr.Unsafe (Expr, sqlExpr)
import Database.Relational.Query.Pi (Pi)
import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi
import Database.Relational.Query.Sub
(SubQuery, Qualified,
UntypedProjection, widthOfUntypedProjection, columnsOfUntypedProjection, untypedProjectionFromColumns,
untypedProjectionFromColumns, untypedProjectionFromJoinedSubQuery, untypedProjectionFromScalarSubQuery)
import qualified Database.Relational.Query.Sub as SubQuery
newtype Projection c t = Projection { untypeProjection :: UntypedProjection }
typedProjection :: UntypedProjection -> Projection c t
typedProjection = Projection
width :: Projection c r -> Int
width = widthOfUntypedProjection . untypeProjection
columns :: Projection c r
-> [ColumnSQL]
columns = columnsOfUntypedProjection . untypeProjection
untype :: Projection c r -> UntypedProjection
untype = untypeProjection
unsafeFromColumns :: [ColumnSQL]
-> Projection c r
unsafeFromColumns = typedProjection . untypedProjectionFromColumns
unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Projection c t
unsafeFromQualifiedSubQuery = typedProjection . untypedProjectionFromJoinedSubQuery
unsafeFromScalarSubQuery :: SubQuery -> Projection c t
unsafeFromScalarSubQuery = typedProjection . untypedProjectionFromScalarSubQuery
unsafeFromTable :: Table r
-> Projection c r
unsafeFromTable = unsafeFromColumns . Table.columns
predicateProjectionFromExpr :: Expr c (Maybe Bool) -> Projection c (Maybe Bool)
predicateProjectionFromExpr =
typedProjection . untypedProjectionFromColumns . (:[]) . columnSQL' . sqlExpr
unsafeProject :: Projection c a' -> Pi a b -> Projection c b'
unsafeProject p pi' =
unsafeFromColumns
. (`UnsafePi.pi` pi')
. columns $ p
pi :: Projection c a
-> Pi a b
-> Projection c b
pi = unsafeProject
piMaybe :: Projection c (Maybe a)
-> Pi a b
-> Projection c (Maybe b)
piMaybe = unsafeProject
piMaybe' :: Projection c (Maybe a)
-> Pi a (Maybe b)
-> Projection c (Maybe b)
piMaybe' = unsafeProject
unsafeCast :: Projection c r -> Projection c r'
unsafeCast = typedProjection . untypeProjection
flattenMaybe :: Projection c (Maybe (Maybe a)) -> Projection c (Maybe a)
flattenMaybe = unsafeCast
just :: Projection c r -> Projection c (Maybe r)
just = unsafeCast
unsafeChangeContext :: Projection c r -> Projection c' r
unsafeChangeContext = typedProjection . untypeProjection
unsafeToAggregated :: Projection Flat r -> Projection Aggregated r
unsafeToAggregated = unsafeChangeContext
unsafeToFlat :: Projection Aggregated r -> Projection Flat r
unsafeToFlat = unsafeChangeContext
notNullMaybeConstraint :: HasColumnConstraint NotNull r => Projection c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint = const KeyConstraint.columnConstraint
unsafeShowSqlNotNullMaybeProjection :: HasColumnConstraint NotNull r => Projection c (Maybe r) -> String
unsafeShowSqlNotNullMaybeProjection p = show . (!! KeyConstraint.index (notNullMaybeConstraint p)) . columns $ p
pfmap :: ProductConstructor (a -> b)
=> (a -> b) -> Projection c a -> Projection c b
_ `pfmap` p = unsafeCast p
pap :: Projection c (a -> b) -> Projection c a -> Projection c b
pf `pap` pa = typedProjection $ untypeProjection pf ++ untypeProjection pa
data ListProjection p t = List [p t]
| Sub SubQuery
list :: [p t] -> ListProjection p t
list = List
unsafeListProjectionFromSubQuery :: SubQuery -> ListProjection p t
unsafeListProjectionFromSubQuery = Sub
unsafeShowSqlListProjection :: (p t -> String) -> ListProjection p t -> String
unsafeShowSqlListProjection sf = d where
d (List ps) = rowListStringString $ map sf ps
d (Sub sub) = SQL.wordShow . SQL.paren $ SubQuery.showSQL sub