module Database.Relational.Record (
Record,
width,
columns,
untype,
unsafeFromSqlTerms,
unsafeFromQualifiedSubQuery,
unsafeFromScalarSubQuery,
unsafeFromTable,
unsafeStringSql,
pi, piMaybe, piMaybe',
wpi,
flattenMaybe, just,
unsafeToAggregated, unsafeToFlat, unsafeChangeContext,
unsafeStringSqlNotNullMaybe,
RecordList, list, unsafeListFromSubQuery,
unsafeStringSqlList
) where
import Prelude hiding (pi)
import Data.Functor.ProductIsomorphic
(ProductIsoFunctor, (|$|), ProductIsoApplicative, pureP, (|*|),
ProductIsoEmpty, pureE, peRight, peLeft, )
import qualified Language.SQL.Keyword as SQL
import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint, PersistableWidth, persistableWidth)
import Database.Record.Persistable (PersistableRecordWidth)
import qualified Database.Record.KeyConstraint as KeyConstraint
import Database.Relational.Internal.ContextType (Aggregated, Flat)
import Database.Relational.Internal.String (StringSQL, listStringSQL, rowStringSQL)
import Database.Relational.SqlSyntax
(SubQuery, Qualified, Tuple, Record,
recordRawColumns, tupleFromJoinedSubQuery,)
import qualified Database.Relational.SqlSyntax as Syntax
import Database.Relational.Table (Table)
import qualified Database.Relational.Table as Table
import Database.Relational.Pi (Pi)
import qualified Database.Relational.Pi.Unsafe as UnsafePi
unsafeStringSql :: Record c r -> StringSQL
unsafeStringSql = rowStringSQL . recordRawColumns
columns :: Record c r
-> [StringSQL]
columns = recordRawColumns
width :: Record c r -> Int
width = Syntax.recordWidth
untype :: Record c r -> Tuple
untype = Syntax.untypeRecord
unsafeFromQualifiedSubQuery :: Qualified SubQuery -> Record c t
unsafeFromQualifiedSubQuery = Syntax.record . tupleFromJoinedSubQuery
unsafeFromScalarSubQuery :: SubQuery -> Record c t
unsafeFromScalarSubQuery = Syntax.typeFromScalarSubQuery
unsafeFromTable :: Table r
-> Record c r
unsafeFromTable = Syntax.typeFromRawColumns . Table.columns
unsafeFromSqlTerms :: [StringSQL] -> Record c t
unsafeFromSqlTerms = Syntax.typeFromRawColumns
unsafeProject :: PersistableRecordWidth a -> Record c a' -> Pi a b -> Record c b'
unsafeProject w p pi' =
Syntax.typeFromRawColumns
. (UnsafePi.pi w pi')
. columns $ p
wpi :: PersistableRecordWidth a
-> Record c a
-> Pi a b
-> Record c b
wpi = unsafeProject
pi :: PersistableWidth a
=> Record c a
-> Pi a b
-> Record c b
pi = unsafeProject persistableWidth
piMaybe :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a b
-> Record c (Maybe b)
piMaybe = unsafeProject persistableWidth
piMaybe' :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a (Maybe b)
-> Record c (Maybe b)
piMaybe' = unsafeProject persistableWidth
unsafeCast :: Record c r -> Record c r'
unsafeCast = Syntax.record . Syntax.untypeRecord
flattenMaybe :: Record c (Maybe (Maybe a)) -> Record c (Maybe a)
flattenMaybe = unsafeCast
just :: Record c r -> Record c (Maybe r)
just = unsafeCast
unsafeChangeContext :: Record c r -> Record c' r
unsafeChangeContext = Syntax.record . Syntax.untypeRecord
unsafeToAggregated :: Record Flat r -> Record Aggregated r
unsafeToAggregated = unsafeChangeContext
unsafeToFlat :: Record Aggregated r -> Record Flat r
unsafeToFlat = unsafeChangeContext
notNullMaybeConstraint :: HasColumnConstraint NotNull r => Record c (Maybe r) -> NotNullColumnConstraint r
notNullMaybeConstraint = const KeyConstraint.columnConstraint
unsafeStringSqlNotNullMaybe :: HasColumnConstraint NotNull r => Record c (Maybe r) -> StringSQL
unsafeStringSqlNotNullMaybe p = (!! KeyConstraint.index (notNullMaybeConstraint p)) . columns $ p
pempty :: Record c ()
pempty = Syntax.record []
instance ProductIsoFunctor (Record c) where
_ |$| p = unsafeCast p
instance ProductIsoApplicative (Record c) where
pureP _ = unsafeCast pempty
pf |*| pa = Syntax.record $ Syntax.untypeRecord pf ++ Syntax.untypeRecord pa
instance ProductIsoEmpty (Record c) () where
pureE = pureP ()
peRight = unsafeCast
peLeft = unsafeCast
data RecordList p t = List [p t]
| Sub SubQuery
list :: [p t] -> RecordList p t
list = List
unsafeListFromSubQuery :: SubQuery -> RecordList p t
unsafeListFromSubQuery = Sub
unsafeStringSqlList :: (p t -> StringSQL) -> RecordList p t -> StringSQL
unsafeStringSqlList sf = d where
d (List ps) = listStringSQL $ map sf ps
d (Sub sub) = SQL.paren $ Syntax.showSQL sub