{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language DeriveGeneric #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language QuantifiedConstraints #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.HTable.Nullify
  ( HNullify( HNullify )
  , Nullify
  , hnulls, hnullify, hunnullify
  )
where

-- base
import Prelude hiding ( null )

-- rel8
import Rel8.Schema.HTable ( HTable, hfield, htabulate, htabulateA, hspecs )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import qualified Rel8.Schema.Null as Type ( Nullify )
import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

-- semigroupoids
import Data.Functor.Apply ( Apply )
import Rel8.Schema.HTable.MapTable
import Rel8.FCF
import GHC.Generics (Generic)


type HNullify :: K.HTable -> K.HTable
newtype HNullify table context = HNullify (HMapTable Nullify table context)
  deriving stock (forall x.
 HNullify table context -> Rep (HNullify table context) x)
-> (forall x.
    Rep (HNullify table context) x -> HNullify table context)
-> Generic (HNullify table context)
forall x. Rep (HNullify table context) x -> HNullify table context
forall x. HNullify table context -> Rep (HNullify table context) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (table :: HTable) (context :: HContext) x.
Rep (HNullify table context) x -> HNullify table context
forall (table :: HTable) (context :: HContext) x.
HNullify table context -> Rep (HNullify table context) x
$cto :: forall (table :: HTable) (context :: HContext) x.
Rep (HNullify table context) x -> HNullify table context
$cfrom :: forall (table :: HTable) (context :: HContext) x.
HNullify table context -> Rep (HNullify table context) x
Generic
  deriving anyclass HNullify table SSpec
(forall (context :: HContext) (spec :: Spec).
 HNullify table context
 -> HField (HNullify table) spec -> context spec)
-> (forall (context :: HContext).
    (forall (spec :: Spec).
     HField (HNullify table) spec -> context spec)
    -> HNullify table context)
-> (forall (m :: * -> *) (f :: HContext) (g :: HContext).
    Apply m =>
    (forall (spec :: Spec). f spec -> m (g spec))
    -> HNullify table f -> m (HNullify table g))
-> (forall (c :: Spec -> Constraint).
    HConstrainTable (HNullify table) c =>
    HNullify table (Dict c))
-> HNullify table SSpec
-> HTable (HNullify table)
forall (m :: * -> *) (f :: HContext) (g :: HContext).
Apply m =>
(forall (spec :: Spec). f spec -> m (g spec))
-> HNullify table f -> m (HNullify table g)
forall (c :: Spec -> Constraint).
HConstrainTable (HNullify table) c =>
HNullify table (Dict c)
forall (context :: HContext).
(forall (spec :: Spec).
 HField (HNullify table) spec -> context spec)
-> HNullify table context
forall (context :: HContext) (spec :: Spec).
HNullify table context
-> HField (HNullify table) spec -> context spec
forall (table :: HTable). HTable table => HNullify table SSpec
forall (table :: HTable) (m :: * -> *) (f :: HContext)
       (g :: HContext).
(HTable table, Apply m) =>
(forall (spec :: Spec). f spec -> m (g spec))
-> HNullify table f -> m (HNullify table g)
forall (table :: HTable) (c :: Spec -> Constraint).
(HTable table, HConstrainTable (HNullify table) c) =>
HNullify table (Dict c)
forall (table :: HTable) (context :: HContext).
HTable table =>
(forall (spec :: Spec).
 HField (HNullify table) spec -> context spec)
-> HNullify table context
forall (table :: HTable) (context :: HContext) (spec :: Spec).
HTable table =>
HNullify table context
-> HField (HNullify table) spec -> context spec
forall (t :: HTable).
(forall (context :: HContext) (spec :: Spec).
 t context -> HField t spec -> context spec)
-> (forall (context :: HContext).
    (forall (spec :: Spec). HField t spec -> context spec)
    -> t context)
-> (forall (m :: * -> *) (f :: HContext) (g :: HContext).
    Apply m =>
    (forall (spec :: Spec). f spec -> m (g spec)) -> t f -> m (t g))
-> (forall (c :: Spec -> Constraint).
    HConstrainTable t c =>
    t (Dict c))
-> t SSpec
-> HTable t
hspecs :: HNullify table SSpec
$chspecs :: forall (table :: HTable). HTable table => HNullify table SSpec
hdicts :: HNullify table (Dict c)
$chdicts :: forall (table :: HTable) (c :: Spec -> Constraint).
(HTable table, HConstrainTable (HNullify table) c) =>
HNullify table (Dict c)
htraverse :: (forall (spec :: Spec). f spec -> m (g spec))
-> HNullify table f -> m (HNullify table g)
$chtraverse :: forall (table :: HTable) (m :: * -> *) (f :: HContext)
       (g :: HContext).
(HTable table, Apply m) =>
(forall (spec :: Spec). f spec -> m (g spec))
-> HNullify table f -> m (HNullify table g)
htabulate :: (forall (spec :: Spec).
 HField (HNullify table) spec -> context spec)
-> HNullify table context
$chtabulate :: forall (table :: HTable) (context :: HContext).
HTable table =>
(forall (spec :: Spec).
 HField (HNullify table) spec -> context spec)
-> HNullify table context
hfield :: HNullify table context
-> HField (HNullify table) spec -> context spec
$chfield :: forall (table :: HTable) (context :: HContext) (spec :: Spec).
HTable table =>
HNullify table context
-> HField (HNullify table) spec -> context spec
HTable



-- | Transform a 'Spec' by allowing it to be @null@.
data Nullify :: Spec -> Exp Spec


type instance Eval (Nullify ('Spec labels a)) =
  'Spec labels (Type.Nullify a)


instance MapSpec Nullify where
  mapInfo :: SSpec x -> SSpec (Eval (Nullify x))
mapInfo = \case
    SSpec{SLabels labels
labels :: forall (labels :: Labels) a.
SSpec ('Spec labels a) -> SLabels labels
labels :: SLabels labels
labels, TypeInformation (Unnullify a)
info :: forall (labels :: Labels) a.
SSpec ('Spec labels a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info, Nullity a
nullity :: forall (labels :: Labels) a. SSpec ('Spec labels a) -> Nullity a
nullity :: Nullity a
nullity} -> SSpec :: forall (labels :: Labels) a.
SLabels labels
-> TypeInformation (Unnullify a)
-> Nullity a
-> SSpec ('Spec labels a)
SSpec
      { SLabels labels
labels :: SLabels labels
labels :: SLabels labels
labels
      , TypeInformation (Unnullify a)
TypeInformation
  (Unnullify' (IsMaybe (Maybe (Unnullify a))) (Maybe (Unnullify a)))
info :: TypeInformation
  (Unnullify' (IsMaybe (Maybe (Unnullify a))) (Maybe (Unnullify a)))
info :: TypeInformation (Unnullify a)
info
      , nullity :: Nullity (Maybe (Unnullify a))
nullity = case Nullity a
nullity of
          Nullity a
Null    -> Nullity (Maybe (Unnullify a))
forall a. NotNull a => Nullity (Maybe a)
Null
          Nullity a
NotNull -> Nullity (Maybe (Unnullify a))
forall a. NotNull a => Nullity (Maybe a)
Null
      } 


hnulls :: HTable t
  => (forall labels a. ()
    => SSpec ('Spec labels a)
    -> context ('Spec labels (Type.Nullify a)))
  -> HNullify t context
hnulls :: (forall (labels :: Labels) a.
 SSpec ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> HNullify t context
hnulls forall (labels :: Labels) a.
SSpec ('Spec labels a) -> context ('Spec labels (Nullify a))
null = HMapTable Nullify t context -> HNullify t context
forall (table :: HTable) (context :: HContext).
HMapTable Nullify table context -> HNullify table context
HNullify (HMapTable Nullify t context -> HNullify t context)
-> HMapTable Nullify t context -> HNullify t context
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (HMapTable Nullify t) spec -> context spec)
-> HMapTable Nullify t context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec).
  HField (HMapTable Nullify t) spec -> context spec)
 -> HMapTable Nullify t context)
-> (forall (spec :: Spec).
    HField (HMapTable Nullify t) spec -> context spec)
-> HMapTable Nullify t context
forall a b. (a -> b) -> a -> b
$ \(HMapTableField field) -> case t SSpec -> HField t a -> SSpec a
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField t a
field of
  spec :: SSpec a
spec@SSpec {} -> SSpec ('Spec labels a) -> context ('Spec labels (Nullify a))
forall (labels :: Labels) a.
SSpec ('Spec labels a) -> context ('Spec labels (Nullify a))
null SSpec a
SSpec ('Spec labels a)
spec
{-# INLINABLE hnulls #-}


hnullify :: HTable t
  => (forall labels a. ()
    => SSpec ('Spec labels a)
    -> context ('Spec labels a)
    -> context ('Spec labels (Type.Nullify a)))
  -> t context
  -> HNullify t context
hnullify :: (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> context ('Spec labels a) -> context ('Spec labels (Nullify a))
nullifier t context
a = HMapTable Nullify t context -> HNullify t context
forall (table :: HTable) (context :: HContext).
HMapTable Nullify table context -> HNullify table context
HNullify (HMapTable Nullify t context -> HNullify t context)
-> HMapTable Nullify t context -> HNullify t context
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (HMapTable Nullify t) spec -> context spec)
-> HMapTable Nullify t context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec).
  HField (HMapTable Nullify t) spec -> context spec)
 -> HMapTable Nullify t context)
-> (forall (spec :: Spec).
    HField (HMapTable Nullify t) spec -> context spec)
-> HMapTable Nullify t context
forall a b. (a -> b) -> a -> b
$ \(HMapTableField field) ->
  case t SSpec -> HField t a -> SSpec a
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField t a
field of
    spec :: SSpec a
spec@SSpec {} -> SSpec ('Spec labels a)
-> context ('Spec labels a) -> context ('Spec labels (Nullify a))
forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> context ('Spec labels a) -> context ('Spec labels (Nullify a))
nullifier SSpec a
SSpec ('Spec labels a)
spec (t context -> HField t ('Spec labels a) -> context ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t context
a HField t a
HField t ('Spec labels a)
field)
{-# INLINABLE hnullify #-}


hunnullify :: (HTable t, Apply m)
  => (forall labels a. ()
    => SSpec ('Spec labels a)
    -> context ('Spec labels (Type.Nullify a))
    -> m (context ('Spec labels a)))
  -> HNullify t context
  -> m (t context)
hunnullify :: (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> m (context ('Spec labels a)))
-> HNullify t context -> m (t context)
hunnullify forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a))
-> m (context ('Spec labels a))
unnullifier (HNullify HMapTable Nullify t context
as) =
  (forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA ((forall (spec :: Spec). HField t spec -> m (context spec))
 -> m (t context))
-> (forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
forall a b. (a -> b) -> a -> b
$ \HField t spec
field -> case t SSpec -> HField t spec -> SSpec spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField t spec
field of
    spec :: SSpec spec
spec@SSpec {} -> case HMapTable Nullify t context
-> HField
     (HMapTable Nullify t)
     ('Spec labels (Maybe (Unnullify' (IsMaybe a) a)))
-> context ('Spec labels (Maybe (Unnullify' (IsMaybe a) a)))
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield HMapTable Nullify t context
as (HField t ('Spec labels a)
-> HMapTableField Nullify t (Eval (Nullify ('Spec labels a)))
forall e (t :: HTable) (a :: Spec) (f :: Spec -> Exp e).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t spec
HField t ('Spec labels a)
field) of
      context ('Spec labels (Maybe (Unnullify' (IsMaybe a) a)))
a -> SSpec ('Spec labels a)
-> context ('Spec labels (Maybe (Unnullify' (IsMaybe a) a)))
-> m (context ('Spec labels a))
forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a))
-> m (context ('Spec labels a))
unnullifier SSpec spec
SSpec ('Spec labels a)
spec context ('Spec labels (Maybe (Unnullify' (IsMaybe a) a)))
a
{-# INLINABLE hunnullify #-}