circuithub/rel8
1
1
Fork 0
mirror of https://github.com/circuithub/rel8.git synced 2024-08-17 20:00:23 +03:00
Code Issues Projects Releases Wiki Activity

Have users define ToExprs HKD

Browse Source
This commit is contained in:
Oliver Charles 2021-04-16 10:10:55 +01:00
parent 1459c775f7
commit 484a236905
2 changed files with 6 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Rel8.hs
View File

@ -34,7 +34,7 @@ module Rel8
, HList
, HNonEmpty
, HThese
, Lift, FlipHKD(..)
, Lift, FlipHKD(..), toGHKD, fromGHKD
, Table(..)
, AltTable((<|>:))

15
src/Rel8/Schema/HKD.hs
View File

@ -19,7 +19,7 @@
{-# options -Wno-orphans #-}
module Rel8.Schema.HKD ( Lift, FlipHKD(..) ) where
module Rel8.Schema.HKD ( Lift, FlipHKD(..), fromGHKD, toGHKD ) where
-- base
import Control.Applicative ( Const(..) )
@ -151,7 +151,7 @@ type family GHTable_ rep where
type Lift :: K.Context -> Type -> Type
type family Lift context a where
Lift (Reify context) a = ALift context a
Lift Identity a = Identity a
Lift Identity a = a
Lift f a = FlipHKD f a
@ -196,7 +196,7 @@ sfromColumnsLift = \case
SExpr -> ALift . fromColumns . hunreify
SName -> ALift . fromColumns . hunreify
SAggregate -> ALift . fromColumns . hunreify
SIdentity -> ALift . construct . HKD @a . toGHKD @(Rep a) . hunreify
SIdentity -> ALift . runIdentity . construct . HKD @a . toGHKD @(Rep a) . hunreify
SReify context -> ALift . sfromColumnsLift context . hunreify
SInsert -> ALift . fromColumns . hunreify
@ -209,14 +209,9 @@ stoColumnsLift = \case
SExpr -> hreify . toColumns . runALift
SName -> hreify . toColumns . runALift
SAggregate -> hreify . toColumns . runALift
SIdentity -> hreify . toColumns . FlipHKD . deconstruct . runIdentity . runALift
SIdentity -> hreify . toColumns . FlipHKD . deconstruct . runALift
SReify context -> hreify . stoColumnsLift context . runALift
SInsert -> hreify . toColumns . runALift
instance (x ~ FlipHKD Expr a, HKDSpec (Rep a), Construct Identity a) => ToExprs (Identity a) x where
fromIdentity = construct . HKD @a . toGHKD
toIdentity = fromGHKD . runHKD . deconstruct . runIdentity
type instance FromExprs (FlipHKD Expr a) = Identity a
type instance FromExprs (FlipHKD Expr a) = a