content: {-# language AllowAmbiguousTypes #-}
  {-# language ConstraintKinds #-}
  {-# language DataKinds #-}
  {-# language DefaultSignatures #-}
  {-# language FlexibleContexts #-}
  {-# language FlexibleInstances #-}
  {-# language LambdaCase #-}
  {-# language MultiParamTypeClasses #-}
  {-# language PolyKinds #-}
  {-# language QuantifiedConstraints #-}
  {-# language ScopedTypeVariables #-}
  {-# language StandaloneKindSignatures #-}
  {-# language TypeApplications #-}
  {-# language TypeFamilyDependencies #-}
  {-# language TypeOperators #-}
  {-# language UndecidableInstances #-}
  
  module Rel8.Generic.Rel8able
    ( KRel8able, Rel8able
    , Algebra
    , GRep
    , GColumns, gfromColumns, gtoColumns
    , GFromExprs, gfromResult, gtoResult
    , TSerialize, serialize, deserialize
    )
  where
  
  -- base
  import Data.Functor.Identity ( Identity )
  import Data.Kind ( Constraint, Type )
  import Data.Type.Bool ( type (&&) )
  import GHC.Generics ( Generic, Rep, from, to )
  import Prelude
  
  -- rel8
  import Rel8.Expr ( Expr )
  import Rel8.FCF ( Exp, Eval )
  import Rel8.Generic.Record ( Record(..) )
  import Rel8.Generic.Table ( GAlgebra )
  import qualified Rel8.Generic.Table.Record as G
  import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
  import Rel8.Kind.Context ( SContext(..) )
  import Rel8.Schema.Field ( Field )
  import Rel8.Schema.HTable ( HTable )
  import qualified Rel8.Schema.Kind as K
  import Rel8.Schema.Name ( Name )
  import Rel8.Schema.Result ( Result )
  import Rel8.Table
    ( Table, Columns, Context, fromColumns, toColumns
    , FromExprs, fromResult, toResult
    , Transpose
    , TTable, TColumns
    )
  import Rel8.Table.Transpose ( Transposes )
  
  
  -- | The kind of 'Rel8able' types
  type KRel8able :: Type
  type KRel8able = K.Rel8able
  
  
  -- This is almost 'Data.Type.Equality.==', but we add an extra case.
  type (==) :: k -> k -> Bool
  type family a == b where
    -- This extra case is needed to solve the equation "a == a" (where a is a
    -- KRel8able), which occurs when we have polymorphic Rel8ables
    -- (e.g., newtype T t f = T { x :: t a })
    (a :: KRel8able) == (a :: KRel8able) = 'True
  
    -- This extra case is needed to solve the equation "a == Identity a", 
    -- which occurs when we have polymorphic Rel8ables 
    -- (e.g., newtype T a f = T { x :: Column f a })
    a == Identity a = 'False
    
    -- These cases are exactly the same as those in 'Data.Type.Equality.==.
    f a == g b = f == g && a == b
    a == a = 'True
    _ == _ = 'False
  
  
  type Serialize :: Bool -> Type -> Type -> Constraint
  class transposition ~ (a == Transpose Result expr) =>
    Serialize transposition expr a
   where
    serialize :: a -> Columns expr Result
    deserialize :: Columns expr Result -> a
  
  
  instance
    ( (a == Transpose Result expr) ~ 'True
    , Transposes Expr Result expr a
    )
    => Serialize 'True expr a
   where
    serialize = toColumns
    deserialize = fromColumns
  
  
  instance
    ( (a == Transpose Result expr) ~ 'False
    , Table (Context expr) expr
    , FromExprs expr ~ a
    )
    => Serialize 'False expr a
   where
    serialize = toResult @_ @expr
    deserialize = fromResult @_ @expr
  
  
  data TSerialize :: Type -> Type -> Exp Constraint
  type instance Eval (TSerialize expr a) =
    Serialize (a == Transpose Result expr) expr a
  
  
  -- | This type class allows you to define custom 'Table's using higher-kinded
  -- data types. Higher-kinded data types are data types of the pattern:
  --
  -- @
  -- data MyType f =
  --   MyType { field1 :: Column f T1 OR HK1 f
  --          , field2 :: Column f T2 OR HK2 f
  --          , ...
  --          , fieldN :: Column f Tn OR HKn f
  --          }
  -- @
  --
  -- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
  --
  -- That is, higher-kinded data are records where all fields in the record are
  -- all either of the type @Column f T@ (for any @T@), or are themselves
  -- higher-kinded data:
  --
  -- [Nested]
  --
  -- @
  -- data Nested f =
  --   Nested { nested1 :: MyType f
  --          , nested2 :: MyType f
  --          }
  -- @
  --
  -- The @Rel8able@ type class is used to give us a special mapping operation
  -- that lets us change the type parameter @f@.
  --
  -- [Supplying @Rel8able@ instances]
  --
  -- This type class should be derived generically for all table types in your
  -- project. To do this, enable the @DeriveAnyClass@ and @DeriveGeneric@ language
  -- extensions:
  --
  -- @
  -- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
  --
  -- data MyType f = MyType { fieldA :: Column f T }
  --   deriving ( GHC.Generics.Generic, Rel8able )
  -- @
  type Rel8able :: K.Rel8able -> Constraint
  class HTable (GColumns t) => Rel8able t where
    type GColumns t :: K.HTable
    type GFromExprs t :: Type
  
    gfromColumns :: SContext context -> GColumns t context -> t context
    gtoColumns :: SContext context -> t context -> GColumns t context
  
    gfromResult :: GColumns t Result -> GFromExprs t
    gtoResult :: GFromExprs t -> GColumns t Result
  
    type GColumns t = G.GColumns TColumns (GRep t Expr)
    type GFromExprs t = t Result
  
    {-# NOINLINE gfromColumns #-} -- See Note [Generics and Inlining]
    default gfromColumns :: forall context.
      ( SRel8able t Expr
      , forall table. SRel8able t (Field table)
      , SRel8able t Name
      , SSerialize t
      )
      => SContext context -> GColumns t context -> t context
    gfromColumns = \case
      SExpr -> sfromColumns
      SField -> sfromColumns
      SName -> sfromColumns
      SResult -> sfromResult
  
    {-# NOINLINE gtoColumns #-} -- See Note [Generics and Inlining]
    default gtoColumns :: forall context.
      ( SRel8able t Expr
      , forall table. SRel8able t (Field table)
      , SRel8able t Name
      , SSerialize t
      )
      => SContext context -> t context -> GColumns t context
    gtoColumns = \case
      SExpr -> stoColumns
      SField -> stoColumns
      SName -> stoColumns
      SResult -> stoResult
  
    {-# NOINLINE gfromResult #-} -- See Note [Generics and Inlining]
    default gfromResult :: (SSerialize t, GFromExprs t ~ t Result)
      => GColumns t Result -> GFromExprs t
    gfromResult = sfromResult
  
    {-# NOINLINE gtoResult #-} -- See Note [Generics and Inlining]
    default gtoResult :: (SSerialize t, GFromExprs t ~ t Result)
      => GFromExprs t -> GColumns t Result
    gtoResult = stoResult
  
  
  type Algebra :: K.Rel8able -> K.Algebra
  type Algebra t = GAlgebra (GRep t Expr)
  
  
  type GRep :: K.Rel8able -> K.Context -> Type -> Type
  type GRep t context = Rep (Record (t context))
  
  
  type SRel8able :: K.Rel8able -> K.Context -> Constraint
  class
    ( Generic (Record (t context))
    , G.GTable (TTable context) TColumns (GRep t context)
    , G.GColumns TColumns (GRep t context) ~ GColumns t
    )
    => SRel8able t context
  instance
    ( Generic (Record (t context))
    , G.GTable (TTable context) TColumns (GRep t context)
    , G.GColumns TColumns (GRep t context) ~ GColumns t
    )
    => SRel8able t context
  
  
  type SSerialize :: K.Rel8able -> Constraint
  type SSerialize t =
    ( Generic (Record (t Result))
    , G.GSerialize TSerialize TColumns (GRep t Expr) (GRep t Result)
    , G.GColumns TColumns (GRep t Expr) ~ GColumns t
    )
  
  
  sfromColumns :: forall t context. SRel8able t context
    => GColumns t context -> t context
  sfromColumns =
    unrecord .
    to .
    G.gfromColumns @(TTable context) @TColumns fromColumns
  
  
  stoColumns :: forall t context. SRel8able t context
    => t context -> GColumns t context
  stoColumns =
    G.gtoColumns @(TTable context) @TColumns toColumns .
    from .
    Record
  
  
  sfromResult :: forall t. SSerialize t
    => GColumns t Result -> t Result
  sfromResult =
    unrecord .
    to .
    G.gfromResult
      @TSerialize
      @TColumns
      @(GRep t Expr)
      @(GRep t Result)
      (\(_ :: proxy x) -> deserialize @_ @x)
  
  
  stoResult :: forall t. SSerialize t
    => t Result -> GColumns t Result
  stoResult =
    G.gtoResult
      @TSerialize
      @TColumns
      @(GRep t Expr)
      @(GRep t Result)
      (\(_ :: proxy x) -> serialize @_ @x) .
    from .
    Record
  
  -- Note [Generics and Inlining]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- We want to make sure that Generics derived functions (by default)
  -- do not expose their unfoldings. These are always unoptimised code and can
  -- therefore be quite large, and bloat our interfaces.
  -- By marking these as NOINLINE we can considerably speed up our compile times.
  -- If users do want these INLINEd, they can locally override the default using a pragma.
  