git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Generic/Rel8able.hs
174 lines 5.3 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language DefaultSignatures #-}
4{-# language FlexibleContexts #-}
5{-# language FlexibleInstances #-}
6{-# language MultiParamTypeClasses #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
13module Rel8.Generic.Rel8able
14 ( KRel8able, Rel8able
15 , Algebra
16 , GRep
17 , GColumns, gfromColumns, gtoColumns
18 , greify, gunreify
19 , TUnreifyContext
20 )
21where
23-- base
24import Data.Kind ( Constraint, Type )
25import Data.Proxy ( Proxy( Proxy ) )
26import Data.Type.Equality ( (:~:)( Refl ) )
27import GHC.Generics ( Generic, Rep, from, to )
28import Prelude
30-- rel8
31import Rel8.Kind.Context ( Reifiable )
32import Rel8.FCF ( Eval, Exp )
33import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )
34import Rel8.Generic.Record ( Record(..) )
35import Rel8.Generic.Table ( GAlgebra )
36import qualified Rel8.Generic.Table.Record as G
37import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
38import Rel8.Schema.Context ( Col )
39import Rel8.Schema.Context.Label ( Labelable )
40import Rel8.Schema.HTable ( HTable )
41import qualified Rel8.Schema.Kind as K
42import Rel8.Schema.Reify ( Reify, UnwrapReify )
43import Rel8.Schema.Result ( Result )
44import Rel8.Table
45 ( fromColumns, toColumns, reify, unreify
46 , TTable, TColumns, TContext, TUnreify
47 )
50type KRel8able :: Type
51type KRel8able = K.Rel8able
54-- | This type class allows you to define custom 'Table's using higher-kinded
55-- data types. Higher-kinded data types are data types of the pattern:
56--
57-- @
58-- data MyType f =
59-- MyType { field1 :: Column f T1 OR HK1 f
60-- , field2 :: Column f T2 OR HK2 f
61-- , ...
62-- , fieldN :: Column f Tn OR HKn f
63-- }
64-- @
65--
66-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
67--
68-- That is, higher-kinded data are records where all fields in the record are
69-- all either of the type @Column f T@ (for any @T@), or are themselves
70-- higher-kinded data:
71--
72-- [Nested]
73--
74-- @
75-- data Nested f =
76-- Nested { nested1 :: MyType f
77-- , nested2 :: MyType f
78-- }
79-- @
80--
81-- The @Rel8able@ type class is used to give us a special mapping operation
82-- that lets us change the type parameter @f@.
83--
84-- [Supplying @Rel8able@ instances]
85--
86-- This type class should be derived generically for all table types in your
87-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
88-- extensions:
89--
90-- @
91-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
92--
93-- data MyType f = MyType { fieldA :: Column f T }
94-- deriving ( GHC.Generics.Generic, Rel8able )
95-- @
96type Rel8able :: K.Rel8able -> Constraint
97class HTable (GColumns t) => Rel8able t where
98 type GColumns t :: K.HTable
100 gfromColumns :: (Labelable context, Reifiable context)
101 => GColumns t (Col (Reify context)) -> t (Reify context)
103 gtoColumns :: (Labelable context, Reifiable context)
104 => t (Reify context) -> GColumns t (Col (Reify context))
106 greify :: (Labelable context, Reifiable context)
107 => t context -> t (Reify context)
109 gunreify :: (Labelable context, Reifiable context)
110 => t (Reify context) -> t context
112 type GColumns t = G.GColumns TColumns (GRep t (Reify Result))
114 default gfromColumns :: forall context.
115 ( Generic (Record (t (Reify context)))
116 , G.GTable (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context))
117 , G.GColumns TColumns (GRep t (Reify context)) ~ GColumns t
118 )
119 => GColumns t (Col (Reify context)) -> t (Reify context)
120 gfromColumns =
121 unrecord .
122 to .
123 G.gfromColumns @(TTable (Reify context)) @TColumns fromColumns
125 default gtoColumns :: forall context.
126 ( Generic (Record (t (Reify context)))
127 , G.GTable (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context))
128 , G.GColumns TColumns (GRep t (Reify context)) ~ GColumns t
129 )
130 => t (Reify context) -> GColumns t (Col (Reify context))
131 gtoColumns =
132 G.gtoColumns @(TTable (Reify context)) @TColumns toColumns .
133 from .
134 Record
136 default greify :: forall context.
137 ( Generic (Record (t context))
138 , Generic (Record (t (Reify context)))
139 , GMappable (TTable (Reify context)) (GRep t (Reify context))
140 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
141 )
142 => t context -> t (Reify context)
143 greify =
144 unrecord .
145 to .
146 gunmap @(TTable (Reify context)) (Proxy @TUnreify) (reify Refl) .
147 from .
148 Record
150 default gunreify :: forall context.
151 ( Generic (Record (t context))
152 , Generic (Record (t (Reify context)))
153 , GMappable (TTable (Reify context)) (GRep t (Reify context))
154 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
155 )
156 => t (Reify context) -> t context
157 gunreify =
158 unrecord .
159 to .
160 gmap @(TTable (Reify context)) (Proxy @TUnreify) (unreify Refl) .
161 from .
162 Record
165type Algebra :: K.Rel8able -> K.Algebra
166type Algebra t = GAlgebra (GRep t (Reify Result))
169type GRep :: K.Rel8able -> K.Context -> Type -> Type
170type GRep t context = Rep (Record (t context))
173data TUnreifyContext :: Type -> Exp K.Context
174type instance Eval (TUnreifyContext a) = UnwrapReify (Eval (TContext a))