git.iko.soy/rel8
on 8cf243e help sign in
rel8/src/Rel8/Schema/Generic.hs
183 lines 5.6 kB history raw
1{-# language DataKinds #-}
2{-# language DefaultSignatures #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language ScopedTypeVariables #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeApplications #-}
9{-# language TypeFamilies #-}
10{-# language UndecidableInstances #-}
12{-# options_ghc -fno-warn-orphans #-}
14module Rel8.Schema.Generic
15 ( Rel8able
16 , KRel8able
17 )
18where
20-- base
21import Data.Kind ( Constraint, Type )
22import Data.Proxy ( Proxy( Proxy ) )
23import Data.Type.Equality ( (:~:)( Refl ) )
24import GHC.Generics ( Generic, Rep, from, to )
25import Prelude
27-- rel8
28import Rel8.Kind.Context
29 ( SContext( SReify )
30 , Reifiable, contextSing
31 , sLabelable, sReifiable
32 )
33import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )
34import Rel8.Generic.Record ( Record(..) )
35import Rel8.Generic.Table ( GTable, GColumns, fromGColumns, toGColumns )
36import Rel8.Schema.Context ( Col )
37import Rel8.Schema.Context.Label ( Labelable )
38import Rel8.Schema.Dict ( Dict( Dict ) )
39import Rel8.Schema.HTable ( HTable )
40import qualified Rel8.Schema.Kind as K
41import Rel8.Schema.Name ( Name )
42import Rel8.Schema.Reify ( Reify, UnwrapReify, hreify, hunreify )
43import Rel8.Table
44 ( Table, Columns, Context, fromColumns, toColumns
45 , Unreify, reify, unreify
46 , TTable, TColumns, TUnreify
47 )
50instance (Rel8able t, Labelable context, Reifiable context) =>
51 Table context (t context)
52 where
53 type Columns (t context) = GRep t
54 type Context (t context) = context
55 type Unreify (t context) = t (UnwrapReify context)
57 fromColumns = gunreify . gfromColumns . hreify
58 toColumns = hunreify . gtoColumns . greify
60 reify Refl = case contextSing @context of
61 SReify context -> case sLabelable context of
62 Dict -> case sReifiable context of
63 Dict -> greify
65 unreify Refl = case contextSing @context of
66 SReify context -> case sLabelable context of
67 Dict -> case sReifiable context of
68 Dict -> gunreify
71type KRel8able :: Type
72type KRel8able = K.Table
75-- | This type class allows you to define custom 'Table's using higher-kinded
76-- data types. Higher-kinded data types are data types of the pattern:
77--
78-- @
79-- data MyType f =
80-- MyType { field1 :: Column f T1 OR HK1 f
81-- , field2 :: Column f T2 OR HK2 f
82-- , ...
83-- , fieldN :: Column f Tn OR HKn f
84-- }
85-- @
86--
87-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
88--
89-- That is, higher-kinded data are records where all fields in the record are
90-- all either of the type @Column f T@ (for any @T@), or are themselves
91-- higher-kinded data:
92--
93-- [Nested]
94--
95-- @
96-- data Nested f =
97-- Nested { nested1 :: MyType f
98-- , nested2 :: MyType f
99-- }
100-- @
101--
102-- The @Rel8able@ type class is used to give us a special mapping operation
103-- that lets us change the type parameter @f@.
104--
105-- [Supplying @Rel8able@ instances]
106--
107-- This type class should be derived generically for all table types in your
108-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
109-- extensions:
110--
111-- @
112-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
113--
114-- data MyType f = MyType { fieldA :: Column f T }
115-- deriving ( GHC.Generics.Generic, Rel8able )
116-- @
117type Rel8able :: KRel8able -> Constraint
118class HTable (GRep t) => Rel8able t where
119 type GRep t :: K.HTable
121 gfromColumns :: (Labelable context, Reifiable context)
122 => GRep t (Col (Reify context)) -> t (Reify context)
124 gtoColumns :: (Labelable context, Reifiable context)
125 => t (Reify context) -> GRep t (Col (Reify context))
127 greify :: (Labelable context, Reifiable context)
128 => t context -> t (Reify context)
130 gunreify :: (Labelable context, Reifiable context)
131 => t (Reify context) -> t context
133 type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
135 default gfromColumns :: forall context.
136 ( Generic (Record (t (Reify context)))
137 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
138 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
139 )
140 => GRep t (Col (Reify context)) -> t (Reify context)
141 gfromColumns =
142 unrecord .
143 to .
144 fromGColumns @(TTable (Reify context)) @TColumns fromColumns
146 default gtoColumns :: forall context.
147 ( Generic (Record (t (Reify context)))
148 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
149 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
150 )
151 => t (Reify context) -> GRep t (Col (Reify context))
152 gtoColumns =
153 toGColumns @(TTable (Reify context)) @TColumns toColumns .
154 from .
155 Record
157 default greify :: forall context.
158 ( Generic (Record (t context))
159 , Generic (Record (t (Reify context)))
160 , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))
161 , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))
162 )
163 => t context -> t (Reify context)
164 greify =
165 unrecord .
166 to .
167 gunmap @(TTable (Reify context)) (Proxy @TUnreify) (reify Refl) .
168 from .
169 Record
171 default gunreify :: forall context.
172 ( Generic (Record (t context))
173 , Generic (Record (t (Reify context)))
174 , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))
175 , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))
176 )
177 => t (Reify context) -> t context
178 gunreify =
179 unrecord .
180 to .
181 gmap @(TTable (Reify context)) (Proxy @TUnreify) (unreify Refl) .
182 from .
183 Record