{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Rel8.Generic.Table.ADT
( GTableADT, GColumnsADT, gfromColumnsADT, gtoColumnsADT, gtableADT
, GTableADT', GColumnsADT'
, GToExprsADT, gfromResultADT, gtoResultADT
)
where
import Data.Kind ( Constraint, Type )
import Data.Proxy ( Proxy( Proxy ) )
import GHC.Generics
( (:+:)( L1, R1 ), M1( M1 ), U1( U1 )
, C, D
, Meta( MetaCons )
)
import GHC.TypeLits ( KnownSymbol, symbolVal )
import Prelude hiding ( null )
import Rel8.FCF ( Eval, Exp )
import Rel8.Generic.Table.Record
( GTable, GColumns, gtable
, GToExprs, gfromResult, gtoResult
)
import Rel8.Schema.Context.Label ( HLabelable, hlabeler, labeler, unlabeler )
import Rel8.Schema.HTable ( HTable, hmap )
import Rel8.Schema.HTable.Identity ( HIdentity( HType ), 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 qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Nullify )
import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
import Rel8.Schema.Result
( Col( R ), Result
, null, nullifier, unnullifier
)
import Rel8.Type.Tag ( Tag( Tag ) )
import Data.Text ( pack )
type GColumnsADT
:: (Type -> Exp K.HTable)
-> (Type -> Type) -> K.HTable
type family GColumnsADT _Columns rep where
GColumnsADT _Columns (M1 D _ rep) =
GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep
type GColumnsADT'
:: (Type -> Exp K.HTable)
-> K.HTable -> (Type -> Type) -> K.HTable
type family GColumnsADT' _Columns htable rep where
GColumnsADT' _Columns htable (a :+: b) =
GColumnsADT' _Columns (GColumnsADT' _Columns htable a) b
GColumnsADT' _Columns htable (M1 C ('MetaCons _ _ _) U1) = htable
GColumnsADT' _Columns htable (M1 C ('MetaCons label _ _) rep) =
HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
type GTableADT
:: (Type -> Exp Constraint)
-> (Type -> Exp K.HTable)
-> K.HContext -> (Type -> Type) -> Constraint
class GTableADT _Table _Columns context rep where
gfromColumnsADT :: ()
=> (forall spec. context spec -> Col Result spec)
-> (forall spec. Col Result spec -> context spec)
-> (forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
-> GColumnsADT _Columns rep context
-> rep x
gtoColumnsADT :: ()
=> (forall spec. context spec -> Col Result spec)
-> (forall spec. Col Result spec -> context spec)
-> (forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
-> rep x
-> GColumnsADT _Columns rep context
gtableADT :: ()
=> (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)
-> (forall a labels necessity. ()
=> SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> GColumnsADT _Columns rep context
instance
( htable ~ HLabel "tag" (HType Tag)
, HTable (GColumnsADT _Columns (M1 D meta rep))
, Eval (_Table (htable context))
, Eval (_Columns (htable context)) ~ htable
, GTableADT' _Table _Columns htable context rep
, GToExprsADT' (Const _Table) _Columns htable rep rep
)
=> GTableADT _Table _Columns context (M1 D meta rep)
where
gfromColumnsADT :: (forall (spec :: Spec). context spec -> Col Result spec)
-> (forall (spec :: Spec). Col Result spec -> context spec)
-> (forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
-> GColumnsADT _Columns (M1 D meta rep) context
-> M1 D meta rep x
gfromColumnsADT forall (spec :: Spec). context spec -> Col Result spec
fromContext forall (spec :: Spec). Col Result spec -> context spec
toContext forall a. Eval (_Table a) => Eval (_Columns a) context -> a
fromColumns =
(forall expr a (proxy :: * -> *).
(Eval (Const _Table expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> GColumnsADT _Columns (M1 D meta rep) (Col Result)
-> M1 D meta rep x
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *) x.
GToExprsADT _ToExprs _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> GColumnsADT _Columns exprs (Col Result) -> rep x
gfromResultADT @(Const _Table) @_Columns @(M1 D meta rep) @(M1 D meta rep)
((Eval (_Columns a) (Col Result) -> a)
-> proxy expr -> Eval (_Columns a) (Col Result) -> a
forall a b. a -> b -> a
const (Eval (_Columns a) context -> a
forall a. Eval (_Table a) => Eval (_Columns a) context -> a
fromColumns (Eval (_Columns a) context -> a)
-> (Eval (_Columns a) (Col Result) -> Eval (_Columns a) context)
-> Eval (_Columns a) (Col Result)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (spec :: Spec). Col Result spec -> context spec)
-> Eval (_Columns a) (Col Result) -> Eval (_Columns a) context
forall (t :: HTable) (context :: HContext) (context' :: HContext).
HTable t =>
(forall (spec :: Spec). context spec -> context' spec)
-> t context -> t context'
hmap forall (spec :: Spec). Col Result spec -> context spec
toContext)) (GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep (Col Result)
-> M1 D meta rep x)
-> (GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) rep (Col Result))
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
-> M1 D meta rep x
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (spec :: Spec). context spec -> Col Result spec)
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) rep (Col Result)
forall (t :: HTable) (context :: HContext) (context' :: HContext).
HTable t =>
(forall (spec :: Spec). context spec -> context' spec)
-> t context -> t context'
hmap forall (spec :: Spec). context spec -> Col Result spec
fromContext
gtoColumnsADT :: (forall (spec :: Spec). context spec -> Col Result spec)
-> (forall (spec :: Spec). Col Result spec -> context spec)
-> (forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
-> M1 D meta rep x
-> GColumnsADT _Columns (M1 D meta rep) context
gtoColumnsADT forall (spec :: Spec). context spec -> Col Result spec
fromContext forall (spec :: Spec). Col Result spec -> context spec
toContext forall a. Eval (_Table a) => a -> Eval (_Columns a) context
toColumns =
(forall (spec :: Spec). Col Result spec -> context spec)
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) rep (Col Result)
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
forall (t :: HTable) (context :: HContext) (context' :: HContext).
HTable t =>
(forall (spec :: Spec). context spec -> context' spec)
-> t context -> t context'
hmap forall (spec :: Spec). Col Result spec -> context spec
toContext (GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep (Col Result)
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context)
-> (M1 D meta rep x
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) rep (Col Result))
-> M1 D meta rep x
-> GColumnsADT' _Columns (HLabel "tag" (HType Tag)) rep context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall expr a (proxy :: * -> *).
(Eval (Const _Table expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> M1 D meta rep x
-> GColumnsADT _Columns (M1 D meta rep) (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *) x.
GToExprsADT _ToExprs _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> rep x -> GColumnsADT _Columns exprs (Col Result)
gtoResultADT @(Const _Table) @_Columns @(M1 D meta rep) @(M1 D meta rep)
((a -> Eval (_Columns a) (Col Result))
-> proxy expr -> a -> Eval (_Columns a) (Col Result)
forall a b. a -> b -> a
const ((forall (spec :: Spec). context spec -> Col Result spec)
-> Eval (_Columns a) context -> Eval (_Columns a) (Col Result)
forall (t :: HTable) (context :: HContext) (context' :: HContext).
HTable t =>
(forall (spec :: Spec). context spec -> context' spec)
-> t context -> t context'
hmap forall (spec :: Spec). context spec -> Col Result spec
fromContext (Eval (_Columns a) context -> Eval (_Columns a) (Col Result))
-> (a -> Eval (_Columns a) context)
-> a
-> Eval (_Columns a) (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eval (_Columns a) context
forall a. Eval (_Table a) => a -> Eval (_Columns a) context
toColumns))
gtableADT :: (forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> GColumnsADT _Columns (M1 D meta rep) context
gtableADT forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier =
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable rep context
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable)
(context :: HContext) (rep :: * -> *).
GTableADT' _Table _Columns htable context rep =>
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable rep context
gtableADT' @_Table @_Columns @htable @context @rep forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier htable context
Eval (_Columns (htable context)) context
htable
where
htable :: Eval (_Columns (htable context)) context
htable = Proxy (htable context) -> Eval (_Columns (htable context)) context
forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table (Proxy (htable context)
forall k (t :: k). Proxy t
Proxy @(htable context))
type GTableADT'
:: (Type -> Exp Constraint)
-> (Type -> Exp K.HTable)
-> K.HTable -> K.HContext -> (Type -> Type) -> Constraint
class GTableADT' _Table _Columns htable context rep where
gtableADT' :: ()
=> (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)
-> (forall a labels necessity. ()
=> SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable rep context
instance
( htable' ~ GColumnsADT' _Columns htable a
, GTableADT' _Table _Columns htable context a
, GTableADT' _Table _Columns htable' context b
)
=> GTableADT' _Table _Columns htable context (a :+: b)
where
gtableADT' :: (forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable (a :+: b) context
gtableADT' forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier =
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable' context
-> GColumnsADT' _Columns htable' b context
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable)
(context :: HContext) (rep :: * -> *).
GTableADT' _Table _Columns htable context rep =>
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable rep context
gtableADT' @_Table @_Columns @_ @_ @b forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier (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
.
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable a context
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable)
(context :: HContext) (rep :: * -> *).
GTableADT' _Table _Columns htable context rep =>
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable rep context
gtableADT' @_Table @_Columns @_ @_ @a forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier
instance meta ~ 'MetaCons label _fixity _isRecord =>
GTableADT' _Table _Columns htable context (M1 C meta U1)
where
gtableADT' :: (forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable (M1 C meta U1) context
gtableADT' forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
_ forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
_ = htable context
-> GColumnsADT' _Columns htable (M1 C meta U1) context
forall a. a -> a
id
instance {-# OVERLAPPABLE #-}
( HTable (GColumns _Columns rep)
, GTable _Table _Columns context rep
, HLabelable context
, meta ~ 'MetaCons label _fixity _isRecord
, KnownSymbol label
, GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~
HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
)
=> GTableADT' _Table _Columns htable context (M1 C meta rep)
where
gtableADT' :: (forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> (forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> htable context
-> GColumnsADT' _Columns htable (M1 C meta rep) context
gtableADT' forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier 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)
-> 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) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity 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) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity a)
forall (context :: HContext) (labels :: Labels)
(necessity :: Necessity) a (label :: Symbol).
HLabelable context =>
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity 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
$
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> t context -> HNullify t context
hnullify forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
forall a (labels :: Labels) (necessity :: Necessity).
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
hnullifier (GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context)
-> GColumns _Columns rep context
-> HNullify (GColumns _Columns rep) context
forall a b. (a -> b) -> a -> b
$
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> GColumns _Columns rep context
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (context :: HContext)
(rep :: * -> *).
GTable _Table _Columns context rep =>
(forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context)
-> GColumns _Columns rep context
gtable @_Table @_Columns @_ @rep forall a (proxy :: * -> *).
Eval (_Table a) =>
proxy a -> Eval (_Columns a) context
table
type GToExprsADT
:: (Type -> Type -> Exp Constraint)
-> (Type -> Exp K.HTable)
-> (Type -> Type) -> (Type -> Type) -> Constraint
class GToExprsADT _ToExprs _Columns exprs rep where
gfromResultADT :: ()
=> (forall expr a proxy.
( Eval (_ToExprs expr a)
, HTable (Eval (_Columns expr))
)
=> proxy expr
-> Eval (_Columns expr) (Col Result)
-> a)
-> GColumnsADT _Columns exprs (Col Result)
-> rep x
gtoResultADT :: ()
=> (forall expr a proxy.
( Eval (_ToExprs expr a)
, HTable (Eval (_Columns expr))
)
=> proxy expr
-> a
-> Eval (_Columns expr) (Col Result))
-> rep x
-> GColumnsADT _Columns exprs (Col Result)
instance
( htable ~ HLabel "tag" (HType Tag)
, GToExprsADT' _ToExprs _Columns htable exprs rep
)
=> GToExprsADT _ToExprs _Columns (M1 D meta exprs) (M1 D meta rep)
where
gfromResultADT :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> GColumnsADT _Columns (M1 D meta exprs) (Col Result)
-> M1 D meta rep x
gfromResultADT forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult GColumnsADT _Columns (M1 D meta exprs) (Col Result)
columns =
case (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (HLabel "tag" (HType Tag) (Col Result) -> Tag)
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) exprs (Col Result)
-> Maybe (rep x)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable exprs (Col Result)
-> Maybe (rep x)
gfromResultADT' @_ToExprs @_Columns @_ @exprs forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult HLabel "tag" (HType Tag) (Col Result) -> Tag
tag GColumnsADT' _Columns (HLabel "tag" (HType Tag)) exprs (Col Result)
GColumnsADT _Columns (M1 D meta exprs) (Col Result)
columns of
Just rep x
rep -> rep x -> M1 D meta rep x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 rep x
rep
Maybe (rep x)
_ -> [Char] -> M1 D meta rep x
forall a. HasCallStack => [Char] -> a
error [Char]
"ADT.fromColumns: mismatch between tag and data"
where
tag :: HLabel "tag" (HType Tag) (Col Result) -> Tag
tag = (\(HType (R a)) -> a
Tag
a) (HType Tag (Col Result) -> Tag)
-> (HLabel "tag" (HType Tag) (Col Result)
-> HType Tag (Col Result))
-> HLabel "tag" (HType Tag) (Col Result)
-> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec ("tag" : labels) necessity a)
-> Col Result ('Spec labels necessity a))
-> HLabel "tag" (HType Tag) (Col Result) -> HType Tag (Col Result)
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec (label : labels) necessity a)
-> context ('Spec labels necessity a))
-> HLabel label t context -> t context
hunlabel @_ @"tag" forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec ("tag" : labels) necessity a)
-> Col Result ('Spec labels necessity a)
forall (context :: Context) (label :: Symbol) (labels :: Labels)
(necessity :: Necessity) a.
Labelable context =>
Col context ('Spec (label : labels) necessity a)
-> Col context ('Spec labels necessity a)
unlabeler
gtoResultADT :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> M1 D meta rep x
-> GColumnsADT _Columns (M1 D meta exprs) (Col Result)
gtoResultADT forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult (M1 rep x
rep) =
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> HLabel "tag" (HType Tag) (Col Result))
-> Maybe (rep x)
-> GColumnsADT'
_Columns (HLabel "tag" (HType Tag)) exprs (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @exprs forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult Tag -> HLabel "tag" (HType Tag) (Col Result)
tag (rep x -> Maybe (rep x)
forall a. a -> Maybe a
Just rep x
rep)
where
tag :: Tag -> HLabel "tag" (HType Tag) (Col Result)
tag = (forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec ("tag" : labels) necessity a))
-> HType Tag (Col Result) -> HLabel "tag" (HType Tag) (Col Result)
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity a))
-> t context -> HLabel label t context
hlabel @_ @"tag" forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec ("tag" : labels) necessity a)
forall (context :: Context) (labels :: Labels)
(necessity :: Necessity) a (label :: Symbol).
Labelable context =>
Col context ('Spec labels necessity a)
-> Col context ('Spec (label : labels) necessity a)
labeler (HType Tag (Col Result) -> HLabel "tag" (HType Tag) (Col Result))
-> (Tag -> HType Tag (Col Result))
-> Tag
-> HLabel "tag" (HType Tag) (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Col Result ('Spec '[] 'Required Tag) -> HType Tag (Col Result)
forall (context :: HContext) a.
context ('Spec '[] 'Required a) -> HType a context
HType (Col Result ('Spec '[] 'Required Tag) -> HType Tag (Col Result))
-> (Tag -> Col Result ('Spec '[] 'Required Tag))
-> Tag
-> HType Tag (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Col Result ('Spec '[] 'Required Tag)
forall a (labels :: Labels) (necessity :: Necessity).
a -> Col Result ('Spec labels necessity a)
R
type GToExprsADT'
:: (Type -> Type -> Exp Constraint)
-> (Type -> Exp K.HTable)
-> K.HTable -> (Type -> Type) -> (Type -> Type) -> Constraint
class GToExprsADT' _ToExprs _Columns htable exprs rep where
gfromResultADT' :: ()
=> (forall expr a proxy.
( Eval (_ToExprs expr a)
, HTable (Eval (_Columns expr))
)
=> proxy expr
-> Eval (_Columns expr) (Col Result)
-> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable exprs (Col Result)
-> Maybe (rep x)
gtoResultADT' :: ()
=> (forall expr a proxy.
( Eval (_ToExprs expr a)
, HTable (Eval (_Columns expr))
)
=> proxy expr
-> a
-> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
:: GColumnsADT' _Columns htable exprs context -> htable context
instance
( htable' ~ GColumnsADT' _Columns htable a
, GToExprsADT' _ToExprs _Columns htable a rep1
, GToExprsADT' _ToExprs _Columns htable' b rep2
)
=> GToExprsADT' _ToExprs _Columns htable (a :+: b) (rep1 :+: rep2)
where
gfromResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable (a :+: b) (Col Result)
-> Maybe ((:+:) rep1 rep2 x)
gfromResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult htable (Col Result) -> Tag
f GColumnsADT' _Columns htable (a :+: b) (Col Result)
columns =
case Maybe (rep1 x)
ma of
Just rep1 x
a -> (:+:) rep1 rep2 x -> Maybe ((:+:) rep1 rep2 x)
forall a. a -> Maybe a
Just (rep1 x -> (:+:) rep1 rep2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 rep1 x
a)
Maybe (rep1 x)
Nothing -> rep2 x -> (:+:) rep1 rep2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (rep2 x -> (:+:) rep1 rep2 x)
-> Maybe (rep2 x) -> Maybe ((:+:) rep1 rep2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable' (Col Result) -> Tag)
-> GColumnsADT' _Columns htable' b (Col Result)
-> Maybe (rep2 x)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable exprs (Col Result)
-> Maybe (rep x)
gfromResultADT' @_ToExprs @_Columns @_ @b @rep2
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult
(htable (Col Result) -> Tag
f (htable (Col Result) -> Tag)
-> (htable' (Col Result) -> htable (Col Result))
-> htable' (Col Result)
-> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: HContext).
GToExprsADT' _ToExprs _Columns htable a rep1 =>
GColumnsADT' _Columns htable a context -> htable context
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) (context :: HContext).
GToExprsADT' _ToExprs _Columns htable exprs rep =>
GColumnsADT' _Columns htable exprs context -> htable context
extract @_ToExprs @_Columns @_ @a @rep1)
GColumnsADT' _Columns htable' b (Col Result)
GColumnsADT' _Columns htable (a :+: b) (Col Result)
columns
where
ma :: Maybe (rep1 x)
ma =
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable a (Col Result)
-> Maybe (rep1 x)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable exprs (Col Result)
-> Maybe (rep x)
gfromResultADT' @_ToExprs @_Columns @_ @a @rep1
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult
htable (Col Result) -> Tag
f
(GColumnsADT' _Columns htable' b (Col Result)
-> htable' (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) (context :: HContext).
GToExprsADT' _ToExprs _Columns htable exprs rep =>
GColumnsADT' _Columns htable exprs context -> htable context
extract @_ToExprs @_Columns @_ @b @rep2 GColumnsADT' _Columns htable' b (Col Result)
GColumnsADT' _Columns htable (a :+: b) (Col Result)
columns)
gtoResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe ((:+:) rep1 rep2 x)
-> GColumnsADT' _Columns htable (a :+: b) (Col Result)
gtoResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult Tag -> htable (Col Result)
tag = \case
Just (L1 rep1 x
a) ->
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable' (Col Result))
-> Maybe (rep2 Any)
-> GColumnsADT' _Columns htable' b (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @b @rep2
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult
(\Tag
_ -> (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep1 x)
-> GColumnsADT' _Columns htable a (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @a @rep1
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult
Tag -> htable (Col Result)
tag
(rep1 x -> Maybe (rep1 x)
forall a. a -> Maybe a
Just rep1 x
a))
Maybe (rep2 Any)
forall a. Maybe a
Nothing
Just (R1 rep2 x
b) ->
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable' (Col Result))
-> Maybe (rep2 x)
-> GColumnsADT' _Columns htable' b (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @b @rep2
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult
(\Tag
tag' ->
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep1 Any)
-> GColumnsADT' _Columns htable a (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @a @rep1
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult
(\Tag
_ -> Tag -> htable (Col Result)
tag Tag
tag')
Maybe (rep1 Any)
forall a. Maybe a
Nothing)
(rep2 x -> Maybe (rep2 x)
forall a. a -> Maybe a
Just rep2 x
b)
Maybe ((:+:) rep1 rep2 x)
Nothing ->
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable' (Col Result))
-> Maybe (rep2 Any)
-> GColumnsADT' _Columns htable' b (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @b @rep2
forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult
(\Tag
_ -> (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep1 Any)
-> GColumnsADT' _Columns htable a (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) x.
GToExprsADT' _ToExprs _Columns htable exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (rep x)
-> GColumnsADT' _Columns htable exprs (Col Result)
gtoResultADT' @_ToExprs @_Columns @_ @a @rep1 forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult Tag -> htable (Col Result)
tag Maybe (rep1 Any)
forall a. Maybe a
Nothing)
Maybe (rep2 Any)
forall a. Maybe a
Nothing
extract :: GColumnsADT' _Columns htable (a :+: b) context -> htable context
extract =
forall (context :: HContext).
GToExprsADT' _ToExprs _Columns htable a rep1 =>
GColumnsADT' _Columns htable a context -> htable context
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) (context :: HContext).
GToExprsADT' _ToExprs _Columns htable exprs rep =>
GColumnsADT' _Columns htable exprs context -> htable context
extract @_ToExprs @_Columns @_ @a @rep1 (htable' context -> htable context)
-> (GColumnsADT' _Columns htable' b context -> htable' context)
-> GColumnsADT' _Columns htable' b context
-> htable context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (context :: HContext).
GToExprsADT' _ToExprs _Columns htable' b rep2 =>
GColumnsADT' _Columns htable' b context -> htable' context
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (htable :: HTable) (exprs :: * -> *)
(rep :: * -> *) (context :: HContext).
GToExprsADT' _ToExprs _Columns htable exprs rep =>
GColumnsADT' _Columns htable exprs context -> htable context
extract @_ToExprs @_Columns @_ @b @rep2
instance
( meta ~ 'MetaCons label _fixity _isRecord
, KnownSymbol label
)
=> GToExprsADT' _ToExprs _Columns htable (M1 C meta U1) (M1 C meta U1)
where
gfromResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable (M1 C meta U1) (Col Result)
-> Maybe (M1 C meta U1 x)
gfromResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
_ htable (Col Result) -> Tag
tag GColumnsADT' _Columns htable (M1 C meta U1) (Col Result)
columns
| htable (Col Result) -> Tag
tag htable (Col Result)
GColumnsADT' _Columns htable (M1 C meta U1) (Col Result)
columns Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tag' = M1 C meta U1 x -> Maybe (M1 C meta U1 x)
forall a. a -> Maybe a
Just (U1 x -> M1 C meta U1 x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 x
forall k (p :: k). U1 p
U1)
| Bool
otherwise = Maybe (M1 C meta U1 x)
forall a. Maybe a
Nothing
where
tag' :: Tag
tag' = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
gtoResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (M1 C meta U1 x)
-> GColumnsADT' _Columns htable (M1 C meta U1) (Col Result)
gtoResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
_ Tag -> htable (Col Result)
tag Maybe (M1 C meta U1 x)
_ = Tag -> htable (Col Result)
tag Tag
tag'
where
tag' :: Tag
tag' = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
extract :: GColumnsADT' _Columns htable (M1 C meta U1) context
-> htable context
extract = GColumnsADT' _Columns htable (M1 C meta U1) context
-> htable context
forall a. a -> a
id
instance {-# OVERLAPPABLE #-}
( HTable (GColumns _Columns exprs)
, GToExprs _ToExprs _Columns exprs rep
, meta ~ 'MetaCons label _fixity _isRecord
, KnownSymbol label
, GColumnsADT' _Columns htable (M1 C meta exprs) ~
HProduct htable (HLabel label (HNullify (GColumns _Columns exprs)))
)
=> GToExprsADT' _ToExprs _Columns htable (M1 C meta exprs) (M1 C meta rep)
where
gfromResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> (htable (Col Result) -> Tag)
-> GColumnsADT' _Columns htable (M1 C meta exprs) (Col Result)
-> Maybe (M1 C meta rep x)
gfromResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult htable (Col Result) -> Tag
tag (HProduct a b)
| htable (Col Result) -> Tag
tag htable (Col Result)
a Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tag' =
rep x -> M1 C meta rep x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rep x -> M1 C meta rep x)
-> (GColumns _Columns exprs (Col Result) -> rep x)
-> GColumns _Columns exprs (Col Result)
-> M1 C meta rep x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> GColumns _Columns exprs (Col Result) -> rep x
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *) x.
GToExprs _ToExprs _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a)
-> GColumns _Columns exprs (Col Result) -> rep x
gfromResult @_ToExprs @_Columns @exprs forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> Eval (_Columns expr) (Col Result) -> a
fromResult (GColumns _Columns exprs (Col Result) -> M1 C meta rep x)
-> Maybe (GColumns _Columns exprs (Col Result))
-> Maybe (M1 C meta rep x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Col Result ('Spec labels necessity (Nullify a))
-> Maybe (Col Result ('Spec labels necessity a)))
-> HNullify (GColumns _Columns exprs) (Col Result)
-> Maybe (GColumns _Columns exprs (Col Result))
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a))
-> m (context ('Spec labels necessity a)))
-> HNullify t context -> m (t context)
hunnullify forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Col Result ('Spec labels necessity (Nullify a))
-> Maybe (Col Result ('Spec labels necessity a))
unnullifier ((forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec (label : labels) necessity a)
-> Col Result ('Spec labels necessity a))
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
-> HNullify (GColumns _Columns exprs) (Col Result)
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec (label : labels) necessity a)
-> context ('Spec labels necessity a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec (label : labels) necessity a)
-> Col Result ('Spec labels necessity a)
forall (context :: Context) (label :: Symbol) (labels :: Labels)
(necessity :: Necessity) a.
Labelable context =>
Col context ('Spec (label : labels) necessity a)
-> Col context ('Spec labels necessity a)
unlabeler HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
b)
| Bool
otherwise = Maybe (M1 C meta rep x)
forall a. Maybe a
Nothing
where
tag' :: Tag
tag' = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
gtoResultADT' :: (forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> (Tag -> htable (Col Result))
-> Maybe (M1 C meta rep x)
-> GColumnsADT' _Columns htable (M1 C meta exprs) (Col Result)
gtoResultADT' forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult Tag -> htable (Col Result)
tag = \case
Maybe (M1 C meta rep x)
Nothing -> htable (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
-> HProduct
htable
(HLabel label (HNullify (GColumns _Columns exprs)))
(Col Result)
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct (Tag -> htable (Col Result)
tag Tag
tag') ((forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec (label : labels) necessity a))
-> HNullify (GColumns _Columns exprs) (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec (label : labels) necessity a)
forall (context :: Context) (labels :: Labels)
(necessity :: Necessity) a (label :: Symbol).
Labelable context =>
Col context ('Spec labels necessity a)
-> Col context ('Spec (label : labels) necessity a)
labeler ((forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Col Result ('Spec labels necessity (Nullify a)))
-> HNullify (GColumns _Columns exprs) (Col Result)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> HNullify t context
hnulls (Col
Result ('Spec labels necessity (Maybe (Unnullify' (IsMaybe a) a)))
-> SSpec ('Spec labels necessity a)
-> Col
Result ('Spec labels necessity (Maybe (Unnullify' (IsMaybe a) a)))
forall a b. a -> b -> a
const Col
Result ('Spec labels necessity (Maybe (Unnullify' (IsMaybe a) a)))
forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity (Maybe a))
null)))
Just (M1 rep x
rep) -> htable (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
-> HProduct
htable
(HLabel label (HNullify (GColumns _Columns exprs)))
(Col Result)
forall (a :: HTable) (b :: HTable) (context :: HContext).
a context -> b context -> HProduct a b context
HProduct (Tag -> htable (Col Result)
tag Tag
tag') (HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
-> HProduct
htable
(HLabel label (HNullify (GColumns _Columns exprs)))
(Col Result))
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
-> HProduct
htable
(HLabel label (HNullify (GColumns _Columns exprs)))
(Col Result)
forall a b. (a -> b) -> a -> b
$
(forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec (label : labels) necessity a))
-> HNullify (GColumns _Columns exprs) (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
context ('Spec labels necessity a)
-> context ('Spec (label : labels) necessity a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) (necessity :: Necessity) a.
Col Result ('Spec labels necessity a)
-> Col Result ('Spec (label : labels) necessity a)
forall (context :: Context) (labels :: Labels)
(necessity :: Necessity) a (label :: Symbol).
Labelable context =>
Col context ('Spec labels necessity a)
-> Col context ('Spec (label : labels) necessity a)
labeler (HNullify (GColumns _Columns exprs) (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result))
-> HNullify (GColumns _Columns exprs) (Col Result)
-> HLabel label (HNullify (GColumns _Columns exprs)) (Col Result)
forall a b. (a -> b) -> a -> b
$
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Col Result ('Spec labels necessity a)
-> Col Result ('Spec labels necessity (Nullify a)))
-> GColumns _Columns exprs (Col Result)
-> HNullify (GColumns _Columns exprs) (Col Result)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> context ('Spec labels necessity a)
-> context ('Spec labels necessity (Nullify a)))
-> t context -> HNullify t context
hnullify forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Col Result ('Spec labels necessity a)
-> Col Result ('Spec labels necessity (Nullify a))
nullifier (GColumns _Columns exprs (Col Result)
-> HNullify (GColumns _Columns exprs) (Col Result))
-> GColumns _Columns exprs (Col Result)
-> HNullify (GColumns _Columns exprs) (Col Result)
forall a b. (a -> b) -> a -> b
$
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> rep x -> GColumns _Columns exprs (Col Result)
forall (_ToExprs :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *) x.
GToExprs _ToExprs _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result))
-> rep x -> GColumns _Columns exprs (Col Result)
gtoResult @_ToExprs @_Columns @exprs forall expr a (proxy :: * -> *).
(Eval (_ToExprs expr a), HTable (Eval (_Columns expr))) =>
proxy expr -> a -> Eval (_Columns expr) (Col Result)
toResult rep x
rep
where
tag' :: Tag
tag' = Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy label -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label)
extract :: GColumnsADT' _Columns htable (M1 C meta exprs) context
-> htable context
extract (HProduct a _) = htable context
a
data Const :: (a -> Exp Constraint) -> a -> a -> Exp Constraint
type instance Eval (Const f x a) = (Eval (f a), x ~ a)