git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Generic/Rel8able.hs
175 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 )
50-- | The kind of 'Rel8able' types
51type KRel8able :: Type
52type KRel8able = K.Rel8able
55-- | This type class allows you to define custom 'Table's using higher-kinded
56-- data types. Higher-kinded data types are data types of the pattern:
57--
58-- @
59-- data MyType f =
60-- MyType { field1 :: Column f T1 OR HK1 f
61-- , field2 :: Column f T2 OR HK2 f
62-- , ...
63-- , fieldN :: Column f Tn OR HKn f
64-- }
65-- @
66--
67-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
68--
69-- That is, higher-kinded data are records where all fields in the record are
70-- all either of the type @Column f T@ (for any @T@), or are themselves
71-- higher-kinded data:
72--
73-- [Nested]
74--
75-- @
76-- data Nested f =
77-- Nested { nested1 :: MyType f
78-- , nested2 :: MyType f
79-- }
80-- @
81--
82-- The @Rel8able@ type class is used to give us a special mapping operation
83-- that lets us change the type parameter @f@.
84--
85-- [Supplying @Rel8able@ instances]
86--
87-- This type class should be derived generically for all table types in your
88-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
89-- extensions:
90--
91-- @
92-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
93--
94-- data MyType f = MyType { fieldA :: Column f T }
95-- deriving ( GHC.Generics.Generic, Rel8able )
96-- @
97type Rel8able :: K.Rel8able -> Constraint
98class HTable (GColumns t) => Rel8able t where
99 type GColumns t :: K.HTable
101 gfromColumns :: (Labelable context, Reifiable context)
102 => GColumns t (Col (Reify context)) -> t (Reify context)
104 gtoColumns :: (Labelable context, Reifiable context)
105 => t (Reify context) -> GColumns t (Col (Reify context))
107 greify :: (Labelable context, Reifiable context)
108 => t context -> t (Reify context)
110 gunreify :: (Labelable context, Reifiable context)
111 => t (Reify context) -> t context
113 type GColumns t = G.GColumns TColumns (GRep t (Reify Result))
115 default gfromColumns :: forall context.
116 ( Generic (Record (t (Reify context)))
117 , G.GTable (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context))
118 , G.GColumns TColumns (GRep t (Reify context)) ~ GColumns t
119 )
120 => GColumns t (Col (Reify context)) -> t (Reify context)
121 gfromColumns =
122 unrecord .
123 to .
124 G.gfromColumns @(TTable (Reify context)) @TColumns fromColumns
126 default gtoColumns :: forall context.
127 ( Generic (Record (t (Reify context)))
128 , G.GTable (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context))
129 , G.GColumns TColumns (GRep t (Reify context)) ~ GColumns t
130 )
131 => t (Reify context) -> GColumns t (Col (Reify context))
132 gtoColumns =
133 G.gtoColumns @(TTable (Reify context)) @TColumns toColumns .
134 from .
135 Record
137 default greify :: forall context.
138 ( Generic (Record (t context))
139 , Generic (Record (t (Reify context)))
140 , GMappable (TTable (Reify context)) (GRep t (Reify context))
141 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
142 )
143 => t context -> t (Reify context)
144 greify =
145 unrecord .
146 to .
147 gunmap @(TTable (Reify context)) (Proxy @TUnreify) (reify Refl) .
148 from .
149 Record
151 default gunreify :: forall context.
152 ( Generic (Record (t context))
153 , Generic (Record (t (Reify context)))
154 , GMappable (TTable (Reify context)) (GRep t (Reify context))
155 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
156 )
157 => t (Reify context) -> t context
158 gunreify =
159 unrecord .
160 to .
161 gmap @(TTable (Reify context)) (Proxy @TUnreify) (unreify Refl) .
162 from .
163 Record
166type Algebra :: K.Rel8able -> K.Algebra
167type Algebra t = GAlgebra (GRep t (Reify Result))
170type GRep :: K.Rel8able -> K.Context -> Type -> Type
171type GRep t context = Rep (Record (t context))
174data TUnreifyContext :: Type -> Exp K.Context
175type instance Eval (TUnreifyContext a) = UnwrapReify (Eval (TContext a))