{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language UndecidableSuperClasses #-}

module Rel8.Table.HKD
  ( HKD( HKD )
  , HKDable
  , BuildableHKD
  , BuildHKD, buildHKD
  , ConstructableHKD
  , ConstructHKD, constructHKD
  , DeconstructHKD, deconstructHKD
  , NameHKD, nameHKD
  , AggregateHKD, aggregateHKD
  , HKDRep
  )
where

-- base
import Data.Kind ( Constraint, Type )
import GHC.Generics ( Generic, Rep, from, to )
import GHC.TypeLits ( Symbol )
import Prelude

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Column ( TColumn )
import Rel8.Expr ( Expr )
import Rel8.FCF ( Eval, Exp )
import Rel8.Kind.Algebra ( KnownAlgebra )
import Rel8.Generic.Construction
  ( GGBuildable
  , GGBuild, ggbuild
  , GGConstructable
  , GGConstruct, ggconstruct
  , GGDeconstruct, ggdeconstruct
  , GGName, ggname
  , GGAggregate, ggaggregate
  )
import Rel8.Generic.Map ( GMap )
import Rel8.Generic.Record
  ( GRecord, GRecordable, grecord, gunrecord
  , Record( Record ), unrecord
  )
import Rel8.Generic.Rel8able
  ( Rel8able
  , GColumns, gfromColumns, gtoColumns
  , GFromExprs, gfromResult, gtoResult
  )
import Rel8.Generic.Table
  ( GGSerialize, GGColumns, GAlgebra, ggfromResult, ggtoResult
  )
import Rel8.Generic.Table.Record ( GTable, GContext )
import qualified Rel8.Generic.Table.Record as G
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.Name ( Name )
import Rel8.Schema.Result ( Result )
import Rel8.Table
  ( Table, fromColumns, toColumns, fromResult, toResult
  , TTable, TColumns, TContext
  , TSerialize
  )


type GColumnsHKD :: Type -> K.HTable
type GColumnsHKD a =
  Eval (GGColumns (GAlgebra (Rep a)) TColumns (GRecord (GMap (TColumn Expr) (Rep a))))


type HKD :: Type -> K.Rel8able
newtype HKD a f = HKD (GColumnsHKD a f)


instance HKDable a => Rel8able (HKD a) where
  type GColumns (HKD a) = GColumnsHKD a
  type GFromExprs (HKD a) = a

  gfromColumns :: SContext context -> GColumns (HKD a) context -> HKD a context
gfromColumns SContext context
_ = GColumns (HKD a) context -> HKD a context
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD
  gtoColumns :: SContext context -> HKD a context -> GColumns (HKD a) context
gtoColumns SContext context
_ (HKD GColumnsHKD a context
a) = GColumnsHKD a context
GColumns (HKD a) context
a

  gfromResult :: GColumns (HKD a) Result -> GFromExprs (HKD a)
gfromResult =
    Record a -> a
forall a. Record a -> a
unrecord (Record a -> a)
-> (Eval
      (GGColumns
         (GAlgebra (Rep a))
         TColumns
         (GRecord (GMap (TColumn Expr) (Rep a))))
      Result
    -> Record a)
-> Eval
     (GGColumns
        (GAlgebra (Rep a))
        TColumns
        (GRecord (GMap (TColumn Expr) (Rep a))))
     Result
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GRecord (Rep a) Any -> Record a
forall a x. Generic a => Rep a x -> a
to (GRecord (Rep a) Any -> Record a)
-> (Eval
      (GGColumns
         (GAlgebra (Rep a))
         TColumns
         (GRecord (GMap (TColumn Expr) (Rep a))))
      Result
    -> GRecord (Rep a) Any)
-> Eval
     (GGColumns
        (GAlgebra (Rep a))
        TColumns
        (GRecord (GMap (TColumn Expr) (Rep a))))
     Result
-> Record a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall expr a (proxy :: Context).
 Eval (TSerialize expr a) =>
 proxy expr -> Eval (TColumns expr) Result -> a)
-> Eval
     (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
     Result
-> Eval (HKDRep a Result) Any
forall (algebra :: Algebra)
       (_Serialize :: * -> * -> Exp Constraint)
       (_Columns :: * -> Exp Rel8able) (exprs :: Context) (rep :: Context)
       x.
(KnownAlgebra algebra,
 Eval (GGSerialize algebra _Serialize _Columns exprs rep)) =>
(forall expr a (proxy :: Context).
 Eval (_Serialize expr a) =>
 proxy expr -> Eval (_Columns expr) Result -> a)
-> Eval (GGColumns algebra _Columns exprs) Result -> rep x
ggfromResult
      @(GAlgebra (Rep a))
      @TSerialize
      @TColumns
      @(Eval (HKDRep a Expr))
      @(Eval (HKDRep a Result))
      (\(proxy expr
_ :: proxy x) -> Table (Context expr) expr => Columns expr Result -> FromExprs expr
forall (context :: Context) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @x)

  gtoResult :: GFromExprs (HKD a) -> GColumns (HKD a) Result
gtoResult =
    (forall expr a (proxy :: Context).
 Eval (TSerialize expr a) =>
 proxy expr -> a -> Eval (TColumns expr) Result)
-> Eval (HKDRep a Result) Any
-> Eval
     (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
     Result
forall (algebra :: Algebra)
       (_Serialize :: * -> * -> Exp Constraint)
       (_Columns :: * -> Exp Rel8able) (exprs :: Context) (rep :: Context)
       x.
(KnownAlgebra algebra,
 Eval (GGSerialize algebra _Serialize _Columns exprs rep)) =>
(forall expr a (proxy :: Context).
 Eval (_Serialize expr a) =>
 proxy expr -> a -> Eval (_Columns expr) Result)
-> rep x -> Eval (GGColumns algebra _Columns exprs) Result
ggtoResult
      @(GAlgebra (Rep a))
      @TSerialize
      @TColumns
      @(Eval (HKDRep a Expr))
      @(Eval (HKDRep a Result))
      (\(proxy expr
_ :: proxy x) -> Table (Context expr) expr => FromExprs expr -> Columns expr Result
forall (context :: Context) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @x) (GRecord (Rep a) Any
 -> Eval
      (GGColumns
         (GAlgebra (Rep a))
         TColumns
         (GRecord (GMap (TColumn Expr) (Rep a))))
      Result)
-> (a -> GRecord (Rep a) Any)
-> a
-> Eval
     (GGColumns
        (GAlgebra (Rep a))
        TColumns
        (GRecord (GMap (TColumn Expr) (Rep a))))
     Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Record a -> GRecord (Rep a) Any
forall a x. Generic a => a -> Rep a x
from (Record a -> GRecord (Rep a) Any)
-> (a -> Record a) -> a -> GRecord (Rep a) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    a -> Record a
forall a. a -> Record a
Record


instance
  ( GTable (TTable f) TColumns (GRecord (GMap (TColumn f) (Rep a)))
  , G.GColumns TColumns (GRecord (GMap (TColumn f) (Rep a))) ~ GColumnsHKD a
  , GContext TContext (GRecord (GMap (TColumn f) (Rep a))) ~ f
  , GRecordable (GMap (TColumn f) (Rep a))
  )
  => Generic (HKD a f)
 where
  type Rep (HKD a f) = GMap (TColumn f) (Rep a)

  from :: HKD a f -> Rep (HKD a f) x
from =
    forall x.
GRecordable (GMap (TColumn f) (Rep a)) =>
GRecord (GMap (TColumn f) (Rep a)) x -> GMap (TColumn f) (Rep a) x
forall (rep :: Context) x.
GRecordable rep =>
GRecord rep x -> rep x
gunrecord @(GMap (TColumn f) (Rep a)) (GRecord (GMap (TColumn f) (Rep a)) x
 -> GMap (TColumn f) (Rep a) x)
-> (HKD a f -> GRecord (GMap (TColumn f) (Rep a)) x)
-> HKD a f
-> GMap (TColumn f) (Rep a) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall a. Eval (TTable f a) => Eval (TColumns a) f -> a)
-> GColumns TColumns (GRecord (GMap (TColumn f) (Rep a))) f
-> GRecord (GMap (TColumn f) (Rep a)) x
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp Rel8able) (rep :: Context)
       (context :: Context) x.
GTable _Table _Columns rep =>
(forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
-> GColumns _Columns rep context -> rep x
G.gfromColumns
      @(TTable f)
      @TColumns
      forall a. Eval (TTable f a) => Eval (TColumns a) f -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Eval
   (GGColumns
      (GAlgebra (Rep a))
      TColumns
      (GRecord (GMap (TColumn Expr) (Rep a))))
   f
 -> GRecord (GMap (TColumn f) (Rep a)) x)
-> (HKD a f
    -> Eval
         (GGColumns
            (GAlgebra (Rep a))
            TColumns
            (GRecord (GMap (TColumn Expr) (Rep a))))
         f)
-> HKD a f
-> GRecord (GMap (TColumn f) (Rep a)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (\(HKD Eval
  (GGColumns
     (GAlgebra (Rep a))
     TColumns
     (GRecord (GMap (TColumn Expr) (Rep a))))
  f
a) -> Eval
  (GGColumns
     (GAlgebra (Rep a))
     TColumns
     (GRecord (GMap (TColumn Expr) (Rep a))))
  f
a)

  to :: Rep (HKD a f) x -> HKD a f
to =
    Eval
  (GGColumns
     (GAlgebra (Rep a))
     TColumns
     (GRecord (GMap (TColumn Expr) (Rep a))))
  f
-> HKD a f
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD (Eval
   (GGColumns
      (GAlgebra (Rep a))
      TColumns
      (GRecord (GMap (TColumn Expr) (Rep a))))
   f
 -> HKD a f)
-> (GMap (TColumn f) (Rep a) x
    -> Eval
         (GGColumns
            (GAlgebra (Rep a))
            TColumns
            (GRecord (GMap (TColumn Expr) (Rep a))))
         f)
-> GMap (TColumn f) (Rep a) x
-> HKD a f
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall a. Eval (TTable f a) => a -> Eval (TColumns a) f)
-> GRecord (GMap (TColumn f) (Rep a)) x
-> GColumns TColumns (GRecord (GMap (TColumn f) (Rep a))) f
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp Rel8able) (rep :: Context)
       (context :: Context) x.
GTable _Table _Columns rep =>
(forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
-> rep x -> GColumns _Columns rep context
G.gtoColumns
      @(TTable f)
      @TColumns
      forall a. Eval (TTable f a) => a -> Eval (TColumns a) f
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns (GRecord (GMap (TColumn f) (Rep a)) x
 -> Eval
      (GGColumns
         (GAlgebra (Rep a))
         TColumns
         (GRecord (GMap (TColumn Expr) (Rep a))))
      f)
-> (GMap (TColumn f) (Rep a) x
    -> GRecord (GMap (TColumn f) (Rep a)) x)
-> GMap (TColumn f) (Rep a) x
-> Eval
     (GGColumns
        (GAlgebra (Rep a))
        TColumns
        (GRecord (GMap (TColumn Expr) (Rep a))))
     f
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall x.
GRecordable (GMap (TColumn f) (Rep a)) =>
GMap (TColumn f) (Rep a) x -> GRecord (GMap (TColumn f) (Rep a)) x
forall (rep :: Context) x.
GRecordable rep =>
rep x -> GRecord rep x
grecord @(GMap (TColumn f) (Rep a))


type HKDable :: Type -> Constraint
class
  ( Generic (Record a)
  , HTable (GColumns (HKD a))
  , KnownAlgebra (GAlgebra (Rep a))
  , Eval (GGSerialize (GAlgebra (Rep a)) TSerialize TColumns (Eval (HKDRep a Expr)) (Eval (HKDRep a Result)))
  , GRecord (GMap (TColumn Result) (Rep a)) ~ Rep (Record a)
  )
  => HKDable a
instance
  ( Generic (Record a)
  , HTable (GColumns (HKD a))
  , KnownAlgebra (GAlgebra (Rep a))
  , Eval (GGSerialize (GAlgebra (Rep a)) TSerialize TColumns (Eval (HKDRep a Expr)) (Eval (HKDRep a Result)))
  , GRecord (GMap (TColumn Result) (Rep a)) ~ Rep (Record a)
  )
  => HKDable a


type Top_ :: Constraint
class Top_
instance Top_
Top_


data Top :: Type -> Exp Constraint
type instance Eval (Top _) = Top_


type BuildableHKD :: Type -> Symbol -> Constraint
class GGBuildable (GAlgebra (Rep a)) name (HKDRep a) => BuildableHKD a name
instance GGBuildable (GAlgebra (Rep a)) name (HKDRep a) => BuildableHKD a name


type BuildHKD :: Type -> Symbol -> Type
type BuildHKD a name = GGBuild (GAlgebra (Rep a)) name (HKDRep a) (HKD a Expr)


buildHKD :: forall a name. BuildableHKD a name => BuildHKD a name
buildHKD :: BuildHKD a name
buildHKD =
  (Eval
   (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
 -> HKD a Expr)
-> BuildHKD a name
forall (algebra :: Algebra) (name :: Symbol)
       (rep :: Context -> Rel8able) a.
GGBuildable algebra name rep =>
(Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> GGBuild algebra name rep a
ggbuild @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Expr) Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
-> HKD a Expr
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD


type ConstructableHKD :: Type -> Constraint
class GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a
instance GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a


type ConstructHKD :: Type -> Type
type ConstructHKD a = forall r. GGConstruct (GAlgebra (Rep a)) (HKDRep a) r


constructHKD :: forall a. ConstructableHKD a => ConstructHKD a -> HKD a Expr
constructHKD :: ConstructHKD a -> HKD a Expr
constructHKD ConstructHKD a
f =
  (Eval
   (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
 -> HKD a Expr)
-> GGConstruct (GAlgebra (Rep a)) (HKDRep a) (HKD a Expr)
-> HKD a Expr
forall (algebra :: Algebra) (rep :: Context -> Rel8able) a.
GGConstructable algebra rep =>
(Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> GGConstruct algebra rep a -> a
ggconstruct @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
-> HKD a Expr
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD
    (GGConstruct (GAlgebra (Rep a)) (HKDRep a) (HKD a Expr)
ConstructHKD a
f @(HKD a Expr))


type DeconstructHKD :: Type -> Type -> Type
type DeconstructHKD a r = GGDeconstruct (GAlgebra (Rep a)) (HKDRep a) (HKD a Expr) r


deconstructHKD :: forall a r. (ConstructableHKD a, Table Expr r)
  => DeconstructHKD a r
deconstructHKD :: DeconstructHKD a r
deconstructHKD = (HKD a Expr
 -> Eval
      (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
      Expr)
-> DeconstructHKD a r
forall (algebra :: Algebra) (rep :: Context -> Rel8able) a r.
(GGConstructable algebra rep, Table Expr r) =>
(a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GGDeconstruct algebra rep a r
ggdeconstruct @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @r (\(HKD GColumnsHKD a Expr
a) -> Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
GColumnsHKD a Expr
a)


type NameHKD :: Type -> Type
type NameHKD a = GGName (GAlgebra (Rep a)) (HKDRep a) (HKD a Name)


nameHKD :: forall a. ConstructableHKD a => NameHKD a
nameHKD :: NameHKD a
nameHKD = (Eval
   (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Name
 -> HKD a Name)
-> NameHKD a
forall (algebra :: Algebra) (rep :: Context -> Rel8able) a.
GGConstructable algebra rep =>
(Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
-> GGName algebra rep a
ggname @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Name) Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Name
-> HKD a Name
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD


type AggregateHKD :: Type -> Type
type AggregateHKD a = forall r. GGAggregate (GAlgebra (Rep a)) (HKDRep a) r


aggregateHKD :: forall a. ConstructableHKD a
  => AggregateHKD a -> HKD a Expr -> HKD a Aggregate
aggregateHKD :: AggregateHKD a -> HKD a Expr -> HKD a Aggregate
aggregateHKD AggregateHKD a
f =
  (Eval
   (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
   Aggregate
 -> HKD a Aggregate)
-> (HKD a Expr
    -> Eval
         (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
         Expr)
-> GGAggregate (GAlgebra (Rep a)) (HKDRep a) (HKD a Aggregate)
-> HKD a Expr
-> HKD a Aggregate
forall (algebra :: Algebra) (rep :: Context -> Rel8able) exprs agg.
GGConstructable algebra rep =>
(Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
 -> agg)
-> (exprs
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GGAggregate algebra rep agg
-> exprs
-> agg
ggaggregate @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @(HKD a Aggregate) Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr)))
  Aggregate
-> HKD a Aggregate
forall a (f :: Context). GColumnsHKD a f -> HKD a f
HKD (\(HKD GColumnsHKD a Expr
a) -> Eval
  (GGColumns (GAlgebra (Rep a)) TColumns (Eval (HKDRep a Expr))) Expr
GColumnsHKD a Expr
a)
    (GGAggregate (GAlgebra (Rep a)) (HKDRep a) (HKD a Aggregate)
AggregateHKD a
f @(HKD a Aggregate))


data HKDRep :: Type -> K.Context -> Exp (Type -> Type)
type instance Eval (HKDRep a context) =
  GRecord (GMap (TColumn context) (Rep a))