module Internal.Data.Basic.Replace where
import Internal.Interlude
import Internal.Data.Basic.Types
import Internal.Data.Basic.Common
import Internal.Data.Basic.Lens
import Internal.Data.Basic.Compare
import Internal.Control.Effects.Basic
import GHC.TypeLits
import Database.PostgreSQL.Simple.ToField (ToField)
class PrimaryKeyMatch (fields :: [Symbol]) table where
primaryKeyMatch :: Entity ('FromDb c) table -> Var 'Filtering table -> ConditionExp
instance ( Ord (TableFieldType table field)
, TableField table field
, ToField (TableFieldType table field)
, KindOfDbExp (TableFieldType table field) ~ 'LiteralExp )
=> PrimaryKeyMatch '[field] table where
primaryKeyMatch ent v = v ^. fieldOptic @field ==. ent ^. fieldOptic @field
instance ( Ord (TableFieldType table field)
, TableField table field
, ToField (TableFieldType table field)
, fields ~ (f ': fs)
, PrimaryKeyMatch fields table
, KindOfDbExp (TableFieldType table field) ~ 'LiteralExp )
=> PrimaryKeyMatch (field ': (f ': fs)) table where
primaryKeyMatch ent v =
primaryKeyMatch @fields ent v
&&. (v ^. fieldOptic @field ==. ent ^. fieldOptic @field)
class SetAllFields fields table where
setAllFields :: Entity ('FromDb c) table -> Var 'Updating table -> UpdateExp fields table
instance SetAllFields '[] table where
setAllFields _ v = NoUpdate v
instance ( SetAllFields fields table
, CheckWithError (Not (Elem field fields))
( 'Text "Cannot update the field " ':<>: 'ShowType field
':<>: 'Text " because it's already updated in this expression" )
, TableField table field
, ToField (TableFieldType table field)
, KindOfDbExp (TableFieldType table field) ~ 'LiteralExp )
=> SetAllFields (field ': fields) table where
setAllFields ent var =
setAllFields @fields ent var & fieldOptic @field .~ ent ^. fieldOptic @field
save :: forall table pk fields c m.
( Table table
, 'Just pk ~ TablePrimaryKey table
, fields ~ UniqueFields pk
, PrimaryKeyMatch fields table
, SetAllFields (TableFields table) table
, MonadEffect Basic m )
=> Entity ('FromDb c) table -> m (Entity ('FromDb 'Live) table)
save ent =
allRows @(TableName table) & dfilter (primaryKeyMatch @fields ent)
& dupdate (setAllFields @(TableFields table) ent)
& fmap unsafeHead