module Internal.Data.Basic.Common (module Internal.Data.Basic.Common) where
import Internal.Interlude hiding (filter)
import Database.PostgreSQL.Simple (FromRow)
import Database.PostgreSQL.Simple.ToRow (ToRow)
import Overload
import Internal.Data.Basic.Types
import Internal.Data.Basic.TH.Types (Schema(..))
import Internal.Control.Effects.Basic
class LiftedStatement fs t res where
liftDbExp :: DbStatement fs t -> res
instance (DbStatement fs ~ dbs, ts1 ~ ts2) => LiftedStatement fs ts1 (dbs (ts2 :: [*])) where
liftDbExp = identity
instance ( res ~ [DbResult ts]
, AllHaveFromRowInstance ts, MonadEffect Basic m )
=> LiftedStatement fs ts (m (res :: *)) where
liftDbExp = runDbStatement
djoin :: LiftedStatement 'Unfiltered (tables1 ++ tables2) res
=> DbStatement 'Unfiltered tables1
-> DbStatement 'Unfiltered tables2 -> res
djoin l r = liftDbExp (Join l r)
dfilter :: ( LiftedStatement 'Filtered tables res
, TableSetVars 'Filtering tables
, Selection f )
=> (Variables 'Filtering tables -> ConditionExp) -> DbStatement f tables -> res
dfilter f t = liftDbExp (Filter f t)
ddelete :: (LiftedStatement 'Deleted '[table] res, Selection f, Table table)
=> DbStatement f '[table] -> res
ddelete = liftDbExp . Delete
type AllRows table res = (Table table, LiftedStatement 'Unfiltered '[table] res)
allRows :: forall tableName table res.
(TableName table ~ tableName, AllRows table res)
=> res
allRows = liftDbExp (Table (Proxy @tableName))
allRowsProxy ::
forall table res proxy.
(Table table, LiftedStatement 'Unfiltered '[table] res)
=> proxy table -> res
allRowsProxy _ = allRows @(TableName table)
rawQuery :: forall a r m. (MonadEffect Basic m, FromRow a, ToRow r)
=> Text -> r -> m [Entity ('FromDb 'Live) a]
rawQuery q r = runDbStatement (Raw q r :: DbStatement 'RawQueried '[a])
insert :: (CanInsert entKind table, MonadEffect Basic m, FromRow table)
=> Entity entKind table -> m (Entity ('FromDb 'Live) table)
insert = fmap unsafeHead . runDbStatement . Insert
dupdate :: (MonadEffect Basic m, FromRow table, Selection f)
=> (Var 'Updating table -> UpdateExp fields table) -> DbStatement f '[table]
-> m [Entity ('FromDb 'Live) table]
dupdate f e = runDbStatement (Update f e)
dsortOn :: ( LiftedStatement 'Sorted tables res
, TableSetVars 'Sorting tables
, Sortable ord
, Selection f )
=> (Variables 'Sorting tables -> ord) -> DbStatement f tables -> res
dsortOn f t = liftDbExp (SortOn f t)
dtake :: ( LiftedStatement 'Limited tables res
, CanTake f )
=> Int -> DbStatement f tables -> res
dtake n t = liftDbExp (Take n t)
dgroupOn ::
( Groupable group
, TableSetVars 'Grouping tables
, Internal.Data.Basic.Types.Selection f )
=> (Variables 'Grouping tables -> group) -> DbStatement f tables -> GroupStatement group tables
dgroupOn = GroupOn
dmapAll ::
(Mappable map, CanMap f, TableSetVars 'Mapping tables)
=> (Variables 'Mapping tables -> map) -> DbStatement f tables
-> DbStatement 'Mapped '[MapResult map]
dmapAll = Map
dgroupMap ::
(GroupMappable map, InterpretAsGroupMap map ~ 'True)
=> ((AsAggregate group, DbStatement 'Grouped tables) -> map)
-> GroupStatement group tables
-> DbStatement 'Folded '[GroupMapResult map]
dgroupMap = GroupMap
overload "dmap'" ['dmapAll, 'dgroupMap]
class LiftedMapStatement fs t res where
liftMapStatement :: DbStatement fs '[t] -> res
instance (DbStatement fs ~ dbs, '[ts1] ~ ts2) => LiftedMapStatement fs ts1 (dbs (ts2 :: [*])) where
liftMapStatement = identity
instance
( res ~ [WithoutOnly ts]
, MonadEffect Basic m
, FromRow ts
, NoOnly ts )
=> LiftedMapStatement fs ts (m (res :: *)) where
liftMapStatement = runMapStatement
dmap :: forall f res a b m (ts :: [*]) t.
(Dmap' ((a -> b) -> m ts -> DbStatement f '[t]), LiftedMapStatement f t res)
=> (a -> b) -> m ts -> res
dmap f as = liftMapStatement @f @t @res (dmap' f as)
class
interpretAsGroupMap ~ InterpretAsGroupMap res
=> LiftedAggregation (interpretAsGroupMap :: Bool) aggr res where
liftAggregation :: AggregateStatement aggr 'AM -> res
instance
( GroupMappableThing (AggregationResult aggr) 'AM ~ aggStat, Aggregatable aggr
, InterpretAsGroupMap aggStat ~ 'True )
=> LiftedAggregation 'True aggr aggStat where
liftAggregation = GroupMappableAggr
instance
( GroupMappableThing (AggregationResult aggr) ~ aggStat, m ~ 'AM, Aggregatable aggr
, InterpretAsGroupMap (aggStat m) ~ i )
=> LiftedAggregation i aggr (aggStat (m :: AM)) where
liftAggregation = GroupMappableAggr
instance
( res ~ AggregationResult aggr, MonadEffect Basic m, FromRow res
, InterpretAsGroupMap (m res) ~ i )
=> LiftedAggregation i aggr (m (res :: *)) where
liftAggregation = runAggregateStatement
dfoldMap :: forall tables aggr f res.
( Aggregatable aggr
, CanAggregate f
, TableSetVars 'Folding tables
, LiftedAggregation (InterpretAsGroupMap res) aggr res )
=> (Variables 'Folding tables -> aggr) -> DbStatement f tables
-> res
dfoldMap f s = liftAggregation (Aggregate f s)
dfoldMapInner ::
( AsAggregate group ~ GroupMappableThing t 'AM
, LiftedMapStatement 'Folded (ListToSimpleTuple (TupleToList t ++ TupleToList (AggregationResult aggr))) res
, Aggregatable aggr
, TableSetVars 'Folding tables )
=> (Variables 'Folding tables -> aggr) -> GroupStatement group tables -> res
dfoldMapInner f s = liftMapStatement (dgroupMap (\(g, t) -> (g, GroupMappableAggr (Aggregate f t))) s)
delem :: (LiteralCollection collection a) => DbExp k a -> collection -> ConditionExp
delem = In
disNothing :: DbExp 'FieldExp (Maybe a) -> ConditionExp
disNothing = IsNull
disJust :: DbExp 'FieldExp (Maybe a) -> ConditionExp
disJust = IsNotNull
dtrue :: ConditionExp
dtrue = BoolLit True
dfalse :: ConditionExp
dfalse = BoolLit False
like, ilike :: DbExp 'FieldExp Text -> Text -> ConditionExp
like = Like False
ilike = Like True
executeQuery :: (ToRow r, MonadEffect Basic m) => Text -> r -> m ()
executeQuery q r = executeDbStatement (Execute q r :: DbStatement 'RawQueried '[])
applySchema :: MonadEffect Basic m => Schema -> m ()
applySchema (Schema sch) = void $ executeQuery sch ()