git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/Lift.hs
89 lines 2.5 kB history raw
1{-# language DataKinds #-}
2{-# language LambdaCase #-}
3{-# language MultiParamTypeClasses #-}
4{-# language StandaloneKindSignatures #-}
5{-# language TypeFamilies #-}
7module Rel8.Column.Lift
8 ( Lift, ALift(..)
9 )
10where
12-- base
13import Data.Kind ( Type )
14import Prelude
16-- rel8
17import Rel8.Generic.Rel8able ( GColumns )
18import Rel8.Kind.Context ( Reifiable(..), SContext(..) )
19import Rel8.Schema.Context ( Col )
20import qualified Rel8.Schema.Kind as K
21import Rel8.Schema.Reify ( Reify, hreify, hunreify )
22import Rel8.Schema.Result ( Result )
23import Rel8.Table
24 ( Table, Columns, Context, fromColumns, toColumns
25 , Unreify, reify, unreify
26 )
27import Rel8.Table.Rel8able ()
28import Rel8.Table.HKD ( HKD( HKD ), HKDable, fromHKD, toHKD )
29import Rel8.Table.Recontextualize ( Recontextualize )
32type Lift :: K.Context -> Type -> Type
33type family Lift context a where
34 Lift (Reify context) a = ALift context a
35 Lift Result a = a
36 Lift context a = HKD a context
39type ALift :: K.Context -> Type -> Type
40newtype ALift context a = ALift
41 { unALift :: Lift context a
42 }
45instance (Reifiable context, HKDable a) =>
46 Table (Reify context) (ALift context a)
47 where
48 type Context (ALift context a) = Reify context
49 type Columns (ALift context a) = GColumns (HKD a)
50 type Unreify (ALift context a) = Lift context a
52 fromColumns = sfromColumnsLift contextSing
53 toColumns = stoColumnsLift contextSing
54 reify _ = ALift
55 unreify _ (ALift a) = a
58instance (Reifiable context, Reifiable context', HKDable a) =>
59 Recontextualize
60 (Reify context)
61 (Reify context')
62 (ALift context a)
63 (ALift context' a)
66sfromColumnsLift :: HKDable a
67 => SContext context
68 -> GColumns (HKD a) (Col (Reify context))
69 -> ALift context a
70sfromColumnsLift = \case
71 SAggregate -> ALift . fromColumns . hunreify
72 SExpr -> ALift . fromColumns . hunreify
73 SInsert -> ALift . fromColumns . hunreify
74 SName -> ALift . fromColumns . hunreify
75 SResult -> ALift . fromHKD . HKD . hunreify
76 SReify context -> ALift . sfromColumnsLift context . hunreify
79stoColumnsLift :: HKDable a
80 => SContext context
81 -> ALift context a
82 -> GColumns (HKD a) (Col (Reify context))
83stoColumnsLift = \case
84 SAggregate -> hreify . toColumns . unALift
85 SExpr -> hreify . toColumns . unALift
86 SInsert -> hreify . toColumns . unALift
87 SName -> hreify . toColumns . unALift
88 SResult -> hreify . (\(HKD a) -> a) . toHKD . unALift
89 SReify context -> hreify . stoColumnsLift context . unALift