git.iko.soy/rel8
on 1276beb help sign in
rel8/src/Rel8/Schema/Generic.hs
150 lines 4.4 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 GHC.Generics ( Generic, Rep, from, to )
23import Prelude
24import Unsafe.Coerce ( unsafeCoerce )
26-- rel8
27import Rel8.Generic.Record ( Record(..) )
28import Rel8.Generic.Table
29 ( GTable, GColumns, fromGColumns, toGColumns
30 )
31import Rel8.Schema.Context ( Col )
32import Rel8.Schema.Context.Label ( Labelable )
33import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
34import Rel8.Schema.HTable ( HTable )
35import qualified Rel8.Schema.Kind as K
36import Rel8.Schema.Name ( Name )
37import Rel8.Table
38 ( Table, Columns, Context, fromColumns, toColumns
39 , TTable, TColumns
40 )
43instance
44 ( Rel8able t
45 , Labelable context
46 , Reifiable context
47 ) => Table context (t context)
48 where
49 type Columns (t context) = GRep t
50 type Context (t context) = context
52 fromColumns = unreify . gfromColumns . hreify
53 toColumns = hunreify . gtoColumns . reify
56type KRel8able :: Type
57type KRel8able = K.Table
60-- | This type class allows you to define custom 'Table's using higher-kinded
61-- data types. Higher-kinded data types are data types of the pattern:
62--
63-- @
64-- data MyType f =
65-- MyType { field1 :: Column f T1 OR HK1 f
66-- , field2 :: Column f T2 OR HK2 f
67-- , ...
68-- , fieldN :: Column f Tn OR HKn f
69-- }
70-- @
71--
72-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
73--
74-- That is, higher-kinded data are records where all fields in the record are
75-- all either of the type @Column f T@ (for any @T@), or are themselves
76-- higher-kinded data:
77--
78-- [Nested]
79--
80-- @
81-- data Nested f =
82-- Nested { nested1 :: MyType f
83-- , nested2 :: MyType f
84-- }
85-- @
86--
87-- The @Rel8able@ type class is used to give us a special mapping operation
88-- that lets us change the type parameter @f@.
89--
90-- [Supplying @Rel8able@ instances]
91--
92-- This type class should be derived generically for all table types in your
93-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
94-- extensions:
95--
96-- @
97-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
98--
99-- data MyType f = MyType { fieldA :: Column f T }
100-- deriving ( GHC.Generics.Generic, Rel8able )
101-- @
102type Rel8able :: KRel8able -> Constraint
103class HTable (GRep t) => Rel8able t where
104 type GRep t :: K.HTable
106 gfromColumns :: (Labelable context, Reifiable context)
107 => GRep t (Col (Reify context)) -> t (Reify context)
109 gtoColumns :: (Labelable context, Reifiable context)
110 => t (Reify context) -> GRep t (Col (Reify context))
112 type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
114 default gfromColumns :: forall context.
115 ( Generic (Record (t (Reify context)))
116 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
117 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
118 )
119 => GRep t (Col (Reify context)) -> t (Reify context)
120 gfromColumns =
121 unrecord .
122 to .
123 fromGColumns @(TTable (Reify context)) @TColumns fromColumns
125 default gtoColumns :: forall context.
126 ( Generic (Record (t (Reify context)))
127 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
128 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
129 )
130 => t (Reify context) -> GRep t (Col (Reify context))
131 gtoColumns =
132 toGColumns @(TTable (Reify context)) @TColumns toColumns .
133 from .
134 Record
137reify ::
138 (-- Rel8able t
139 --, forall necessity a. Coercible (Field context necessity a) (AField context necessity a) => Coercible (t context) (t (Reify context))
140 )
141 => t context -> t (Reify context)
142reify = unsafeCoerce
145unreify ::
146 (-- Rel8able t
147 --, forall necessity a. Coercible (AField context necessity a) (Field context necessity a) => Coercible (t (Reify context)) (t context)
148 )
149 => t (Reify context) -> t context
150unreify = unsafeCoerce