{-# language AllowAmbiguousTypes #-}
{-# language BlockArguments #-}
{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TupleSections #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}

module Rel8.Generic.Construction.ADT
  ( GConstructableADT
  , GBuildADT, gbuildADT, gunbuildADT
  , GConstructADT, gconstructADT, gdeconstructADT
  , GFields, RepresentableFields, gftabulate, gfindex
  , GConstructors, RepresentableConstructors, gctabulate, gcindex
  , GConstructorADT, GMakeableADT, gmakeADT
  )
where

-- base
import Data.Bifunctor ( first )
import Data.Functor.Identity ( runIdentity )
import Data.Kind ( Constraint, Type )
import Data.List.NonEmpty ( NonEmpty )
import Data.Proxy ( Proxy( Proxy ) )
import GHC.Generics
  ( (:+:), (:*:)( (:*:) ), M1, U1
  , C, D
  , Meta( MetaData, MetaCons )
  )
import GHC.TypeLits
  ( ErrorMessage( (:<>:), Text ), TypeError
  , Symbol, KnownSymbol, symbolVal
  )
import Prelude hiding ( null )

-- rel8
import Rel8.FCF ( Exp )
import Rel8.Generic.Construction.Record
  ( GConstruct, GConstructable, gconstruct, gdeconstruct
  , GFields, Representable, gtabulate, gindex
  , FromColumns, ToColumns
  )
import Rel8.Generic.Table.ADT ( GColumnsADT, GColumnsADT' )
import Rel8.Generic.Table.Record ( GColumns )
import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.HTable.Identity ( HType )
import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
import Rel8.Schema.HTable.Nullify ( HNullify, hnulls, hnullify, hunnullify )
import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )
import Rel8.Schema.Null ( Nullify )
import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
import qualified Rel8.Schema.Kind as K
import Rel8.Type.Tag ( Tag( Tag ) )

-- text
import Data.Text ( pack )


type Null :: K.HContext -> Type
type Null context = forall labels a. ()
  => SSpec ('Spec labels a)
  -> context ('Spec labels (Nullify a))


type Nullifier :: K.HContext -> Type
type Nullifier context = forall labels a. ()
  => SSpec ('Spec labels a)
  -> context ('Spec labels a)
  -> context ('Spec labels (Nullify a))


type Unnullifier :: K.HContext -> Type
type Unnullifier context = forall labels a. ()
  => SSpec ('Spec labels a)
  -> context ('Spec labels (Nullify a))
  -> context ('Spec labels a)


type NoConstructor :: Symbol -> Symbol -> ErrorMessage
type NoConstructor datatype constructor =
  ( 'Text "The type `" ':<>:
    'Text datatype ':<>:
    'Text "` has no constructor `" ':<>:
    'Text constructor ':<>:
    'Text "`."
  )


type GConstructorADT :: Symbol -> (Type -> Type) -> Type -> Type
type family GConstructorADT name rep where
  GConstructorADT name (M1 D ('MetaData datatype _ _ _) rep) =
    GConstructorADT' name rep (TypeError (NoConstructor datatype name))


type GConstructorADT' :: Symbol -> (Type -> Type) -> (Type -> Type) -> Type -> Type
type family GConstructorADT' name rep fallback where
  GConstructorADT' name (M1 D _ rep) fallback =
    GConstructorADT' name rep fallback
  GConstructorADT' name (a :+: b) fallback =
    GConstructorADT' name a (GConstructorADT' name b fallback)
  GConstructorADT' name (M1 C ('MetaCons name _ _) rep) _ = rep
  GConstructorADT' _ _ fallback = fallback


type GConstructADT
  :: (Type -> Exp Type)
  -> (Type -> Type) -> Type -> Type -> Type
type family GConstructADT f rep r x where
  GConstructADT f (M1 D _ rep) r x = GConstructADT f rep r x
  GConstructADT f (a :+: b) r x = GConstructADT f a r (GConstructADT f b r x)
  GConstructADT f (M1 C _ rep) r x = GConstruct f rep r -> x


type GConstructors :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type
type family GConstructors f rep where
  GConstructors f (M1 D _ rep) = GConstructors f rep
  GConstructors f (a :+: b) = GConstructors f a :*: GConstructors f b
  GConstructors f (M1 C _ rep) = (->) (GFields f rep)


type RepresentableConstructors :: (Type -> Exp Type) -> (Type -> Type) -> Constraint
class RepresentableConstructors f rep where
  gctabulate :: (GConstructors f rep r -> a) -> GConstructADT f rep r a
  gcindex :: GConstructADT f rep r a -> GConstructors f rep r -> a


instance RepresentableConstructors f rep => RepresentableConstructors f (M1 D meta rep) where
  gctabulate :: (GConstructors f (M1 D meta rep) r -> a)
-> GConstructADT f (M1 D meta rep) r a
gctabulate = forall r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
gctabulate @f @rep
  gcindex :: GConstructADT f (M1 D meta rep) r a
-> GConstructors f (M1 D meta rep) r -> a
gcindex = forall r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
gcindex @f @rep


instance (RepresentableConstructors f a, RepresentableConstructors f b) =>
  RepresentableConstructors f (a :+: b)
 where
  gctabulate :: (GConstructors f (a :+: b) r -> a) -> GConstructADT f (a :+: b) r a
gctabulate GConstructors f (a :+: b) r -> a
f =
    (GConstructors f a r -> GConstructADT f b r a)
-> GConstructADT f a r (GConstructADT f b r a)
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
gctabulate @f @a \GConstructors f a r
a -> (GConstructors f b r -> a) -> GConstructADT f b r a
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
gctabulate @f @b \GConstructors f b r
b -> GConstructors f (a :+: b) r -> a
f (GConstructors f a r
a GConstructors f a r
-> GConstructors f b r
-> (:*:) (GConstructors f a) (GConstructors f b) r
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: GConstructors f b r
b)
  gcindex :: GConstructADT f (a :+: b) r a -> GConstructors f (a :+: b) r -> a
gcindex GConstructADT f (a :+: b) r a
f (a :*: b) = GConstructADT f b r a -> GConstructors f b r -> a
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
gcindex @f @b (GConstructADT f a r (GConstructADT f b r a)
-> GConstructors f a r -> GConstructADT f b r a
forall (f :: * -> Exp *) (rep :: Exp *) r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
gcindex @f @a GConstructADT f a r (GConstructADT f b r a)
GConstructADT f (a :+: b) r a
f GConstructors f a r
a) GConstructors f b r
b


instance Representable f rep => RepresentableConstructors f (M1 C meta rep) where
  gctabulate :: (GConstructors f (M1 C meta rep) r -> a)
-> GConstructADT f (M1 C meta rep) r a
gctabulate GConstructors f (M1 C meta rep) r -> a
f = GConstructors f (M1 C meta rep) r -> a
(GFields f rep -> r) -> a
f ((GFields f rep -> r) -> a)
-> (GConstruct f rep r -> GFields f rep -> r)
-> GConstruct f rep r
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
forall (f :: * -> Exp *) (rep :: Exp *) a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
gindex @f @rep
  gcindex :: GConstructADT f (M1 C meta rep) r a
-> GConstructors f (M1 C meta rep) r -> a
gcindex GConstructADT f (M1 C meta rep) r a
f = GConstructADT f (M1 C meta rep) r a
GConstruct f rep r -> a
f (GConstruct f rep r -> a)
-> ((GFields f rep -> r) -> GConstruct f rep r)
-> (GFields f rep -> r)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
forall (f :: * -> Exp *) (rep :: Exp *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @f @rep


type GBuildADT :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type
type family GBuildADT f rep r where
  GBuildADT f (M1 D _ rep) r = GBuildADT f rep r
  GBuildADT f (a :+: b) r = GBuildADT f a (GBuildADT f b r)
  GBuildADT f (M1 C _ rep) r = GConstruct f rep r


type GFieldsADT :: (Type -> Exp Type) -> (Type -> Type) -> Type
type family GFieldsADT f rep where
  GFieldsADT f (M1 D _ rep) = GFieldsADT f rep
  GFieldsADT f (a :+: b) = (GFieldsADT f a, GFieldsADT f b)
  GFieldsADT f (M1 C _ rep) = GFields f rep


type RepresentableFields :: (Type -> Exp Type) -> (Type -> Type) -> Constraint
class RepresentableFields f rep where
  gftabulate :: (GFieldsADT f rep -> a) -> GBuildADT f rep a
  gfindex :: GBuildADT f rep a -> GFieldsADT f rep -> a


instance RepresentableFields f rep => RepresentableFields f (M1 D meta rep) where
  gftabulate :: (GFieldsADT f (M1 D meta rep) -> a)
-> GBuildADT f (M1 D meta rep) a
gftabulate = forall a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @f @rep
  gfindex :: GBuildADT f (M1 D meta rep) a -> GFieldsADT f (M1 D meta rep) -> a
gfindex = forall a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
gfindex @f @rep


instance (RepresentableFields f a, RepresentableFields f b) => RepresentableFields f (a :+: b) where
  gftabulate :: (GFieldsADT f (a :+: b) -> a) -> GBuildADT f (a :+: b) a
gftabulate GFieldsADT f (a :+: b) -> a
f =
    (GFieldsADT f a -> GBuildADT f b a)
-> GBuildADT f a (GBuildADT f b a)
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @f @a \GFieldsADT f a
a -> (GFieldsADT f b -> a) -> GBuildADT f b a
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @f @b \GFieldsADT f b
b -> GFieldsADT f (a :+: b) -> a
f (GFieldsADT f a
a, GFieldsADT f b
b)
  gfindex :: GBuildADT f (a :+: b) a -> GFieldsADT f (a :+: b) -> a
gfindex GBuildADT f (a :+: b) a
f (a, b) = GBuildADT f b a -> GFieldsADT f b -> a
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
gfindex @f @b (GBuildADT f a (GBuildADT f b a)
-> GFieldsADT f a -> GBuildADT f b a
forall (f :: * -> Exp *) (rep :: Exp *) a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
gfindex @f @a GBuildADT f a (GBuildADT f b a)
GBuildADT f (a :+: b) a
f GFieldsADT f a
a) GFieldsADT f b
b


instance Representable f rep => RepresentableFields f (M1 C meta rep) where
  gftabulate :: (GFieldsADT f (M1 C meta rep) -> a)
-> GBuildADT f (M1 C meta rep) a
gftabulate = forall a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
forall (f :: * -> Exp *) (rep :: Exp *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @f @rep
  gfindex :: GBuildADT f (M1 C meta rep) a -> GFieldsADT f (M1 C meta rep) -> a
gfindex = forall a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
forall (f :: * -> Exp *) (rep :: Exp *) a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
gindex @f @rep


type GConstructableADT
  :: (Type -> Exp Constraint)
  -> (Type -> Exp K.HTable)
  -> (Type -> Exp Type)
  -> K.HContext -> (Type -> Type) -> Constraint
class GConstructableADT _Table _Columns f context rep where
  gbuildADT :: ()
    => ToColumns _Table _Columns f context
    -> (Tag -> Nullifier context)
    -> HType Tag context
    -> GFieldsADT f rep
    -> GColumnsADT _Columns rep context

  gunbuildADT :: ()
    => FromColumns _Table _Columns f context
    -> Unnullifier context
    -> GColumnsADT _Columns rep context
    -> (HType Tag context, GFieldsADT f rep)

  gconstructADT :: ()
    => ToColumns _Table _Columns f context
    -> Null context
    -> Nullifier context
    -> (Tag -> HType Tag context)
    -> GConstructors f rep (GColumnsADT _Columns rep context)

  gdeconstructADT :: ()
    => FromColumns _Table _Columns f context
    -> Unnullifier context
    -> GConstructors f rep r
    -> GColumnsADT _Columns rep context
    -> (HType Tag context, NonEmpty (Tag, r))


instance
  ( htable ~ HLabel "tag" (HType Tag)
  , GConstructableADT' _Table _Columns f context htable rep
  , HLabelable context
  )
  => GConstructableADT _Table _Columns f context (M1 D meta rep)
 where
  gbuildADT :: ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> HType Tag context
-> GFieldsADT f (M1 D meta rep)
-> GColumnsADT _Columns (M1 D meta rep) context
gbuildADT ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier =
    ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f rep
-> GColumnsADT' _Columns htable rep context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f rep
-> GColumnsADT' _Columns htable rep context
gbuildADT' @_Table @_Columns @f @context @htable @rep ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier (htable context
 -> GFieldsADT f rep
 -> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context)
-> (HType Tag context -> htable context)
-> HType Tag context
-> GFieldsADT f rep
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec ("tag" : labels) a))
-> HType Tag context -> HLabel "tag" (HType Tag) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec ("tag" : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler

  gunbuildADT :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT _Columns (M1 D meta rep) context
-> (HType Tag context, GFieldsADT f (M1 D meta rep))
gunbuildADT FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier =
    (HLabel "tag" (HType Tag) context -> HType Tag context)
-> (HLabel "tag" (HType Tag) context, GFieldsADT f rep)
-> (HType Tag context, GFieldsADT f rep)
forall (p :: * -> Exp *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((forall (labels :: Labels) a.
 context ('Spec ("tag" : labels) a) -> context ('Spec labels a))
-> HLabel "tag" (HType Tag) context -> HType Tag context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec ("tag" : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler) ((HLabel "tag" (HType Tag) context, GFieldsADT f rep)
 -> (HType Tag context, GFieldsADT f rep))
-> (GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
    -> (HLabel "tag" (HType Tag) context, GFieldsADT f rep))
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
-> (HType Tag context, GFieldsADT f rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable rep context
-> (htable context, GFieldsADT f rep)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable rep context
-> (htable context, GFieldsADT f rep)
gunbuildADT' @_Table @_Columns @f @context @htable @rep FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier

  gconstructADT :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> HType Tag context)
-> GConstructors
     f (M1 D meta rep) (GColumnsADT _Columns (M1 D meta rep) context)
gconstructADT ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier Tag -> HType Tag context
mk =
    ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors f rep (GColumnsADT' _Columns htable rep context)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors f rep (GColumnsADT' _Columns htable rep context)
gconstructADT' @_Table @_Columns @f @context @htable @rep ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier
      ((forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec ("tag" : labels) a))
-> HType Tag context -> HLabel "tag" (HType Tag) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec ("tag" : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HType Tag context -> HLabel "tag" (HType Tag) context)
-> (Tag -> HType Tag context)
-> Tag
-> HLabel "tag" (HType Tag) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> HType Tag context
mk)

  gdeconstructADT :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f (M1 D meta rep) r
-> GColumnsADT _Columns (M1 D meta rep) context
-> (HType Tag context, NonEmpty (Tag, r))
gdeconstructADT FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GConstructors f (M1 D meta rep) r
cases =
    (HLabel "tag" (HType Tag) context -> HType Tag context)
-> (HLabel "tag" (HType Tag) context, NonEmpty (Tag, r))
-> (HType Tag context, NonEmpty (Tag, r))
forall (p :: * -> Exp *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((forall (labels :: Labels) a.
 context ('Spec ("tag" : labels) a) -> context ('Spec labels a))
-> HLabel "tag" (HType Tag) context -> HType Tag context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec ("tag" : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler) ((HLabel "tag" (HType Tag) context, NonEmpty (Tag, r))
 -> (HType Tag context, NonEmpty (Tag, r)))
-> (GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
    -> (HLabel "tag" (HType Tag) context, NonEmpty (Tag, r)))
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
-> (HType Tag context, NonEmpty (Tag, r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f rep r
-> GColumnsADT' _Columns htable rep context
-> (htable context, NonEmpty (Tag, r))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *) r.
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f rep r
-> GColumnsADT' _Columns htable rep context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' @_Table @_Columns @f @context @htable @rep FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GConstructors f rep r
GConstructors f (M1 D meta rep) r
cases


type GConstructableADT'
  :: (Type -> Exp Constraint)
  -> (Type -> Exp K.HTable)
  -> (Type -> Exp Type)
  -> K.HContext -> K.HTable -> (Type -> Type) -> Constraint
class GConstructableADT' _Table _Columns f context htable rep where
  gbuildADT' :: ()
    => ToColumns _Table _Columns f context
    -> (Tag -> Nullifier context)
    -> htable context
    -> GFieldsADT f rep
    -> GColumnsADT' _Columns htable rep context

  gunbuildADT' :: ()
    => FromColumns _Table _Columns f context
    -> Unnullifier context
    -> GColumnsADT' _Columns htable rep context
    -> (htable context, GFieldsADT f rep)

  gconstructADT' :: ()
    => ToColumns _Table _Columns f context
    -> Null context
    -> Nullifier context
    -> (Tag -> htable context)
    -> GConstructors f rep (GColumnsADT' _Columns htable rep context)

  gdeconstructADT' :: ()
    => FromColumns _Table _Columns f context
    -> Unnullifier context
    -> GConstructors f rep r
    -> GColumnsADT' _Columns htable rep context
    -> (htable context, NonEmpty (Tag, r))

  gfill :: ()
    => Null context
    -> htable context
    -> GColumnsADT' _Columns htable rep context


instance
  ( htable' ~ GColumnsADT' _Columns htable a
  , Functor (GConstructors f a)
  , GConstructableADT' _Table _Columns f context htable a
  , GConstructableADT' _Table _Columns f context htable' b
  )
  => GConstructableADT' _Table _Columns f context htable (a :+: b)
 where
  gbuildADT' :: ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f (a :+: b)
-> GColumnsADT' _Columns htable (a :+: b) context
gbuildADT' ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier htable context
htable (a, b) =
    ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable' context
-> GFieldsADT f b
-> GColumnsADT' _Columns htable' b context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f rep
-> GColumnsADT' _Columns htable rep context
gbuildADT' @_Table @_Columns @f @context @htable' @b ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier
      (ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f a
-> GColumnsADT' _Columns htable a context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f rep
-> GColumnsADT' _Columns htable rep context
gbuildADT' @_Table @_Columns @f @context @htable @a ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier htable context
htable GFieldsADT f a
a)
      GFieldsADT f b
b

  gunbuildADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable (a :+: b) context
-> (htable context, GFieldsADT f (a :+: b))
gunbuildADT' FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GColumnsADT' _Columns htable (a :+: b) context
columns =
    case FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable' b context
-> (htable' context, GFieldsADT f b)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable rep context
-> (htable context, GFieldsADT f rep)
gunbuildADT' @_Table @_Columns @f @context @htable' @b FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GColumnsADT' _Columns htable' b context
GColumnsADT' _Columns htable (a :+: b) context
columns of
      (htable' context
htable', GFieldsADT f b
b) ->
        case FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable a context
-> (htable context, GFieldsADT f a)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable rep context
-> (htable context, GFieldsADT f rep)
gunbuildADT' @_Table @_Columns @f @context @htable @a FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier htable' context
GColumnsADT' _Columns htable a context
htable' of
          (htable context
htable, GFieldsADT f a
a) -> (htable context
htable, (GFieldsADT f a
a, GFieldsADT f b
b))

  gconstructADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors
     f (a :+: b) (GColumnsADT' _Columns htable (a :+: b) context)
gconstructADT' ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier Tag -> htable context
mk =
    (htable' context -> GColumnsADT' _Columns htable' b context)
-> GConstructors f a (htable' context)
-> GConstructors f a (GColumnsADT' _Columns htable' b context)
forall (f :: Exp *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Null context
-> htable' context -> GColumnsADT' _Columns htable' b context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
Null context
-> htable context -> GColumnsADT' _Columns htable rep context
gfill @_Table @_Columns @f @context @htable' @b Null context
null) (ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors f a (GColumnsADT' _Columns htable a context)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors f rep (GColumnsADT' _Columns htable rep context)
gconstructADT' @_Table @_Columns @f @context @htable @a ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier Tag -> htable context
mk) GConstructors f a (GColumnsADT' _Columns htable' b context)
-> GConstructors f b (GColumnsADT' _Columns htable' b context)
-> (:*:)
     (GConstructors f a)
     (GConstructors f b)
     (GColumnsADT' _Columns htable' b context)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:
    ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable' context)
-> GConstructors f b (GColumnsADT' _Columns htable' b context)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors f rep (GColumnsADT' _Columns htable rep context)
gconstructADT' @_Table @_Columns @f @context @htable' @b ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier (Null context
-> htable context -> GColumnsADT' _Columns htable a context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
Null context
-> htable context -> GColumnsADT' _Columns htable rep context
gfill @_Table @_Columns @f @context @htable @a Null context
null (htable context -> htable' context)
-> (Tag -> htable context) -> Tag -> htable' context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> htable context
mk)

  gdeconstructADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f (a :+: b) r
-> GColumnsADT' _Columns htable (a :+: b) context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier (a :*: b) GColumnsADT' _Columns htable (a :+: b) context
columns =
    case FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f b r
-> GColumnsADT' _Columns htable' b context
-> (htable' context, NonEmpty (Tag, r))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *) r.
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f rep r
-> GColumnsADT' _Columns htable rep context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' @_Table @_Columns @f @context @htable' @b FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GConstructors f b r
b GColumnsADT' _Columns htable' b context
GColumnsADT' _Columns htable (a :+: b) context
columns of
      (htable' context
htable', NonEmpty (Tag, r)
cases) ->
        case FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f a r
-> GColumnsADT' _Columns htable a context
-> (htable context, NonEmpty (Tag, r))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *) r.
GConstructableADT' _Table _Columns f context htable rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f rep r
-> GColumnsADT' _Columns htable rep context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' @_Table @_Columns @f @context @htable @a FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GConstructors f a r
a htable' context
GColumnsADT' _Columns htable a context
htable' of
          (htable context
htable, NonEmpty (Tag, r)
cases') -> (htable context
htable, NonEmpty (Tag, r)
cases' NonEmpty (Tag, r) -> NonEmpty (Tag, r) -> NonEmpty (Tag, r)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Tag, r)
cases)

  gfill :: Null context
-> htable context -> GColumnsADT' _Columns htable (a :+: b) context
gfill Null context
null =
    Null context
-> htable' context -> GColumnsADT' _Columns htable' b context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
Null context
-> htable context -> GColumnsADT' _Columns htable rep context
gfill @_Table @_Columns @f @context @htable' @b Null context
null (htable' context -> GColumnsADT' _Columns htable' b context)
-> (htable context -> htable' context)
-> htable context
-> GColumnsADT' _Columns htable' b context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Null context
-> htable context -> GColumnsADT' _Columns htable a context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (rep :: Exp *).
GConstructableADT' _Table _Columns f context htable rep =>
Null context
-> htable context -> GColumnsADT' _Columns htable rep context
gfill @_Table @_Columns @f @context @htable @a Null context
null


instance (meta ~ 'MetaCons label _fixity _isRecord, KnownSymbol label) =>
  GConstructableADT' _Table _Columns f context htable (M1 C meta U1)
 where
  gbuildADT' :: ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f (M1 C meta U1)
-> GColumnsADT' _Columns htable (M1 C meta U1) context
gbuildADT' ToColumns _Table _Columns f context
_ Tag -> Nullifier context
_ = htable context
-> GFieldsADT f (M1 C meta U1)
-> GColumnsADT' _Columns htable (M1 C meta U1) context
forall a b. a -> b -> a
const
  gunbuildADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable (M1 C meta U1) context
-> (htable context, GFieldsADT f (M1 C meta U1))
gunbuildADT' FromColumns _Table _Columns f context
_ Unnullifier context
_ = (, ())
  gconstructADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors
     f
     (M1 C meta U1)
     (GColumnsADT' _Columns htable (M1 C meta U1) context)
gconstructADT' ToColumns _Table _Columns f context
_ Null context
_ Nullifier context
_ Tag -> htable context
f ()
_ = Tag -> htable context
f Tag
tag
    where
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
  gdeconstructADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f (M1 C meta U1) r
-> GColumnsADT' _Columns htable (M1 C meta U1) context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' FromColumns _Table _Columns f context
_ Unnullifier context
_ GConstructors f (M1 C meta U1) r
r GColumnsADT' _Columns htable (M1 C meta U1) context
htable = (htable context
GColumnsADT' _Columns htable (M1 C meta U1) context
htable, (Tag, r) -> NonEmpty (Tag, r)
forall (f :: Exp *) a. Applicative f => a -> f a
pure (Tag
tag, GConstructors f (M1 C meta U1) r
() -> r
r ()))
    where
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
  gfill :: Null context
-> htable context
-> GColumnsADT' _Columns htable (M1 C meta U1) context
gfill Null context
_ = htable context
-> GColumnsADT' _Columns htable (M1 C meta U1) context
forall a. a -> a
id


instance {-# OVERLAPPABLE #-}
  ( HTable (GColumns _Columns rep)
  , KnownSymbol label
  , meta ~ 'MetaCons label _fixity _isRecord
  , HLabelable context
  , GConstructable _Table _Columns f context rep
  , GColumnsADT' _Columns htable (M1 C meta rep) ~
      HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
  )
  => GConstructableADT' _Table _Columns f context htable (M1 C meta rep)
 where
  gbuildADT' :: ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> htable context
-> GFieldsADT f (M1 C meta rep)
-> GColumnsADT' _Columns htable (M1 C meta rep) context
gbuildADT' ToColumns _Table _Columns f context
toColumns Tag -> Nullifier context
nullifier htable context
htable =
    htable context
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct htable context
htable (HLabel label (HNullify (GColumns _Columns rep)) context
 -> HProduct
      htable (HLabel label (HNullify (GColumns _Columns rep))) context)
-> (GFields f rep
    -> HLabel label (HNullify (GColumns _Columns rep)) context)
-> GFields f rep
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> HNullify (GColumns _Columns rep) context
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec (label : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify (GColumns _Columns rep) context
 -> HLabel label (HNullify (GColumns _Columns rep)) context)
-> (GFields f rep -> HNullify (GColumns _Columns rep) context)
-> GFields f rep
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Nullifier context
-> GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify (Tag -> Nullifier context
nullifier Tag
tag) (GColumns _Columns rep context
 -> HNullify (GColumns _Columns rep) context)
-> (GFields f rep -> GColumns _Columns rep context)
-> GFields f rep
-> HNullify (GColumns _Columns rep) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (rep :: Exp *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct @_Table @_Columns @f @context @rep ToColumns _Table _Columns f context
toColumns
    where
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)

  gunbuildADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT' _Columns htable (M1 C meta rep) context
-> (htable context, GFieldsADT f (M1 C meta rep))
gunbuildADT' FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier (HProduct htable a) =
    ( htable context
htable
    , FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (rep :: Exp *).
GConstructable _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
gdeconstruct @_Table @_Columns @f @context @rep FromColumns _Table _Columns f context
fromColumns (GColumns _Columns rep context -> GFields f rep)
-> GColumns _Columns rep context -> GFields f rep
forall a b. (a -> b) -> a -> b
$
        Identity (GColumns _Columns rep context)
-> GColumns _Columns rep context
forall a. Identity a -> a
runIdentity (Identity (GColumns _Columns rep context)
 -> GColumns _Columns rep context)
-> Identity (GColumns _Columns rep context)
-> GColumns _Columns rep context
forall a b. (a -> b) -> a -> b
$
        (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> Identity (context ('Spec labels a)))
-> HNullify (GColumns _Columns rep) context
-> Identity (GColumns _Columns rep context)
forall (t :: HTable) (m :: Exp *) (context :: HContext).
(HTable t, Apply m) =>
(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 (\SSpec ('Spec labels a)
spec -> context ('Spec labels a) -> Identity (context ('Spec labels a))
forall (f :: Exp *) a. Applicative f => a -> f a
pure (context ('Spec labels a) -> Identity (context ('Spec labels a)))
-> (context ('Spec labels (Nullify a)) -> context ('Spec labels a))
-> context ('Spec labels (Nullify a))
-> Identity (context ('Spec labels a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a)) -> context ('Spec labels a)
Unnullifier context
unnullifier SSpec ('Spec labels a)
spec) (HNullify (GColumns _Columns rep) context
 -> Identity (GColumns _Columns rep context))
-> HNullify (GColumns _Columns rep) context
-> Identity (GColumns _Columns rep context)
forall a b. (a -> b) -> a -> b
$
        (forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec (label : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler
        HLabel label (HNullify (GColumns _Columns rep)) context
a
    )

  gconstructADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> htable context)
-> GConstructors
     f
     (M1 C meta rep)
     (GColumnsADT' _Columns htable (M1 C meta rep) context)
gconstructADT' ToColumns _Table _Columns f context
toColumns Null context
_ Nullifier context
nullifier Tag -> htable context
mk =
    htable context
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct htable context
htable (HLabel label (HNullify (GColumns _Columns rep)) context
 -> HProduct
      htable (HLabel label (HNullify (GColumns _Columns rep))) context)
-> (GFields f rep
    -> HLabel label (HNullify (GColumns _Columns rep)) context)
-> GFields f rep
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> HNullify (GColumns _Columns rep) context
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec (label : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify (GColumns _Columns rep) context
 -> HLabel label (HNullify (GColumns _Columns rep)) context)
-> (GFields f rep -> HNullify (GColumns _Columns rep) context)
-> GFields f rep
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Nullifier context
-> GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify Nullifier context
nullifier (GColumns _Columns rep context
 -> HNullify (GColumns _Columns rep) context)
-> (GFields f rep -> GColumns _Columns rep context)
-> GFields f rep
-> HNullify (GColumns _Columns rep) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (rep :: Exp *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct @_Table @_Columns @f @context @rep ToColumns _Table _Columns f context
toColumns
    where
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
      htable :: htable context
htable = Tag -> htable context
mk Tag
tag

  gdeconstructADT' :: FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f (M1 C meta rep) r
-> GColumnsADT' _Columns htable (M1 C meta rep) context
-> (htable context, NonEmpty (Tag, r))
gdeconstructADT' FromColumns _Table _Columns f context
fromColumns Unnullifier context
unnullifier GConstructors f (M1 C meta rep) r
r (HProduct htable columns) =
    ( htable context
htable
    , (Tag, r) -> NonEmpty (Tag, r)
forall (f :: Exp *) a. Applicative f => a -> f a
pure (Tag
tag, GConstructors f (M1 C meta rep) r
GFields f rep -> r
r GFields f rep
a)
    )
    where
      a :: GFields f rep
a = FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (rep :: Exp *).
GConstructable _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
gdeconstruct @_Table @_Columns @f @context @rep FromColumns _Table _Columns f context
fromColumns (GColumns _Columns rep context -> GFields f rep)
-> GColumns _Columns rep context -> GFields f rep
forall a b. (a -> b) -> a -> b
$
        Identity (GColumns _Columns rep context)
-> GColumns _Columns rep context
forall a. Identity a -> a
runIdentity (Identity (GColumns _Columns rep context)
 -> GColumns _Columns rep context)
-> Identity (GColumns _Columns rep context)
-> GColumns _Columns rep context
forall a b. (a -> b) -> a -> b
$
        (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> Identity (context ('Spec labels a)))
-> HNullify (GColumns _Columns rep) context
-> Identity (GColumns _Columns rep context)
forall (t :: HTable) (m :: Exp *) (context :: HContext).
(HTable t, Apply m) =>
(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 (\SSpec ('Spec labels a)
spec -> context ('Spec labels a) -> Identity (context ('Spec labels a))
forall (f :: Exp *) a. Applicative f => a -> f a
pure (context ('Spec labels a) -> Identity (context ('Spec labels a)))
-> (context ('Spec labels (Nullify a)) -> context ('Spec labels a))
-> context ('Spec labels (Nullify a))
-> Identity (context ('Spec labels a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a)) -> context ('Spec labels a)
Unnullifier context
unnullifier SSpec ('Spec labels a)
spec) (HNullify (GColumns _Columns rep) context
 -> Identity (GColumns _Columns rep context))
-> HNullify (GColumns _Columns rep) context
-> Identity (GColumns _Columns rep context)
forall a b. (a -> b) -> a -> b
$
        (forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec (label : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler
        HLabel label (HNullify (GColumns _Columns rep)) context
columns
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)

  gfill :: Null context
-> htable context
-> GColumnsADT' _Columns htable (M1 C meta rep) context
gfill Null context
null htable context
htable = htable context
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct htable context
htable ((forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> HNullify (GColumns _Columns rep) context
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec (label : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (Null context -> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> HNullify t context
hnulls Null context
null))


type GMakeableADT
  :: (Type -> Exp Constraint)
  -> (Type -> Exp K.HTable)
  -> (Type -> Exp Type)
  -> K.HContext -> Symbol -> (Type -> Type) -> Constraint
class GMakeableADT _Table _Columns f context name rep where
  gmakeADT :: ()
    => ToColumns _Table _Columns f context
    -> Null context
    -> Nullifier context
    -> (Tag -> HType Tag context)
    -> GFields f (GConstructorADT name rep)
    -> GColumnsADT _Columns rep context


instance
  ( htable ~ HLabel "tag" (HType Tag)
  , meta ~ 'MetaData datatype _module _package _newtype
  , fallback ~ TypeError (NoConstructor datatype name)
  , fields ~ GFields f (GConstructorADT' name rep fallback)
  , GMakeableADT' _Table _Columns f context htable name rep fields
  , HLabelable context
  , KnownSymbol name
  )
  => GMakeableADT _Table _Columns f context name (M1 D meta rep)
 where
  gmakeADT :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> HType Tag context)
-> GFields f (GConstructorADT name (M1 D meta rep))
-> GColumnsADT _Columns (M1 D meta rep) context
gmakeADT ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier Tag -> HType Tag context
wrap =
    ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable rep context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (name :: Symbol)
       (rep :: Exp *) fields.
GMakeableADT' _Table _Columns f context htable name rep fields =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable rep context
gmakeADT'
      @_Table @_Columns @f @context @htable @name @rep @fields
      ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier htable context
HLabel "tag" (HType Tag) context
htable
    where
      tag :: Tag
tag = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
      htable :: HLabel "tag" (HType Tag) context
htable = (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec ("tag" : labels) a))
-> HType Tag context -> HLabel "tag" (HType Tag) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec ("tag" : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (Tag -> HType Tag context
wrap Tag
tag)


type GMakeableADT'
  :: (Type -> Exp Constraint)
  -> (Type -> Exp K.HTable)
  -> (Type -> Exp Type)
  -> K.HContext -> K.HTable -> Symbol -> (Type -> Type) -> Type -> Constraint
class GMakeableADT' _Table _Columns f context htable name rep fields where
  gmakeADT' :: ()
    => ToColumns _Table _Columns f context
    -> Null context
    -> Nullifier context
    -> htable context
    -> fields
    -> GColumnsADT' _Columns htable rep context


instance
  ( htable' ~ GColumnsADT' _Columns htable a
  , GMakeableADT' _Table _Columns f context htable name a fields
  , GMakeableADT' _Table _Columns f context htable' name b fields
  )
  => GMakeableADT' _Table _Columns f context htable name (a :+: b) fields
 where
  gmakeADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable (a :+: b) context
gmakeADT' ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier htable context
htable fields
x =
    ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable' context
-> fields
-> GColumnsADT' _Columns htable' b context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (name :: Symbol)
       (rep :: Exp *) fields.
GMakeableADT' _Table _Columns f context htable name rep fields =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable rep context
gmakeADT' @_Table @_Columns @f @context @htable' @name @b @fields
      ToColumns _Table _Columns f context
toColumns Null context
null Nullifier context
nullifier
      (ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable a context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (htable :: HTable) (name :: Symbol)
       (rep :: Exp *) fields.
GMakeableADT' _Table _Columns f context htable name rep fields =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT' _Columns htable rep context
gmakeADT'
         @_Table @_Columns @f @context @htable @name @a @fields ToColumns _Table _Columns f context
toColumns
         Null context
null Nullifier context
nullifier htable context
htable fields
x)
      fields
x


instance {-# OVERLAPPING #-}
  GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons name _fixity _isRecord) U1) fields
 where
  gmakeADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons name _fixity _isRecord) U1)
     context
gmakeADT' ToColumns _Table _Columns f context
_ Null context
_ Nullifier context
_ = htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons name _fixity _isRecord) U1)
     context
forall a b. a -> b -> a
const


instance {-# OVERLAPS #-}
  GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons label _fixity _isRecord) U1) fields
 where
  gmakeADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons label _fixity _isRecord) U1)
     context
gmakeADT' ToColumns _Table _Columns f context
_ Null context
_ Nullifier context
_ = htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons label _fixity _isRecord) U1)
     context
forall a b. a -> b -> a
const


instance {-# OVERLAPS #-}
  ( HTable (GColumns _Columns rep)
  , KnownSymbol name
  , HLabelable context
  , GConstructable _Table _Columns f context rep
  , fields ~ GFields f rep
  , GColumnsADT' _Columns htable (M1 C ('MetaCons name _fixity _isRecord) rep) ~
      HProduct htable (HLabel name (HNullify (GColumns _Columns rep)))
  )
  => GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons name _fixity _isRecord) rep) fields
 where
  gmakeADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons name _fixity _isRecord) rep)
     context
gmakeADT' ToColumns _Table _Columns f context
toColumns Null context
_ Nullifier context
nullifier htable context
htable =
    htable context
-> HLabel name (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel name (HNullify (GColumns _Columns rep))) context
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct htable context
htable (HLabel name (HNullify (GColumns _Columns rep)) context
 -> HProduct
      htable (HLabel name (HNullify (GColumns _Columns rep))) context)
-> (fields
    -> HLabel name (HNullify (GColumns _Columns rep)) context)
-> fields
-> HProduct
     htable (HLabel name (HNullify (GColumns _Columns rep))) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (name : labels) a))
-> HNullify (GColumns _Columns rep) context
-> HLabel name (HNullify (GColumns _Columns rep)) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec (name : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify (GColumns _Columns rep) context
 -> HLabel name (HNullify (GColumns _Columns rep)) context)
-> (fields -> HNullify (GColumns _Columns rep) context)
-> fields
-> HLabel name (HNullify (GColumns _Columns rep)) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Nullifier context
-> GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify Nullifier context
nullifier (GColumns _Columns rep context
 -> HNullify (GColumns _Columns rep) context)
-> (fields -> GColumns _Columns rep context)
-> fields
-> HNullify (GColumns _Columns rep) context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> Exp *)
       (context :: HContext) (rep :: Exp *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct @_Table @_Columns @f @context @rep ToColumns _Table _Columns f context
toColumns


instance {-# OVERLAPPABLE #-}
  ( HTable (GColumns _Columns rep)
  , KnownSymbol label
  , HLabelable context
  , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~
      HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
  )
  => GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons label _fixity _isRecord) rep) fields
 where
  gmakeADT' :: ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> htable context
-> fields
-> GColumnsADT'
     _Columns
     htable
     (M1 C ('MetaCons label _fixity _isRecord) rep)
     context
gmakeADT' ToColumns _Table _Columns f context
_ Null context
null Nullifier context
_ htable context
htable fields
_ =
    htable context
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct htable context
htable (HLabel label (HNullify (GColumns _Columns rep)) context
 -> HProduct
      htable (HLabel label (HNullify (GColumns _Columns rep))) context)
-> HLabel label (HNullify (GColumns _Columns rep)) context
-> HProduct
     htable (HLabel label (HNullify (GColumns _Columns rep))) context
forall a b. (a -> b) -> a -> b
$
    (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> HNullify (GColumns _Columns rep) context
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec (label : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify (GColumns _Columns rep) context
 -> HLabel label (HNullify (GColumns _Columns rep)) context)
-> HNullify (GColumns _Columns rep) context
-> HLabel label (HNullify (GColumns _Columns rep)) context
forall a b. (a -> b) -> a -> b
$
    Null context -> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> HNullify t context
hnulls Null context
null