{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
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