git.iko.soy/rel8
on fb21075 help sign in
rel8/src/Rel8/Schema/Generic.hs
137 lines 4.0 kB history raw
1{-# language DataKinds #-}
2{-# language DefaultSignatures #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10{-# options_ghc -fno-warn-orphans #-}
12module Rel8.Schema.Generic
13 ( Rel8able
14 , KRel8able
15 )
16where
18-- base
19import Data.Kind ( Constraint, Type )
20import GHC.Generics ( Generic, Rep, from, to )
21import Prelude
22import Unsafe.Coerce ( unsafeCoerce )
24-- rel8
25import Rel8.Generic.Record ( Record(..) )
26import Rel8.Schema.Context ( Col )
27import Rel8.Schema.Context.Label ( Labelable )
28import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
29import Rel8.Schema.HTable ( HTable )
30import qualified Rel8.Schema.Kind as K
31import Rel8.Schema.Name ( Name )
32import Rel8.Table
33 ( Table, Columns, Context, fromColumns, toColumns
34 , GTable, GColumns, fromGColumns, toGColumns
35 )
38instance
39 ( Rel8able t
40 , Labelable context
41 , Reifiable context
42 ) => Table context (t context)
43 where
44 type Columns (t context) = GRep t
45 type Context (t context) = context
47 fromColumns = unreify . gfromColumns . hreify
48 toColumns = hunreify . gtoColumns . reify
51type KRel8able :: Type
52type KRel8able = K.Table
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 :: KRel8able -> Constraint
98class HTable (GRep t) => Rel8able t where
99 gfromColumns :: (Labelable context, Reifiable context)
100 => GRep t (Col (Reify context)) -> t (Reify context)
102 gtoColumns :: (Labelable context, Reifiable context)
103 => t (Reify context) -> GRep t (Col (Reify context))
105 default gfromColumns ::
106 ( Generic (Record (t (Reify context)))
107 , GColumns (Rep (Record (t (Reify context)))) ~ GRep t
108 , GTable (Reify context) (Rep (Record (t (Reify context))))
109 ) => GRep t (Col (Reify context)) -> t (Reify context)
110 gfromColumns = unrecord . to . fromGColumns
112 default gtoColumns ::
113 ( Generic (Record (t (Reify context)))
114 , GColumns (Rep (Record (t (Reify context)))) ~ GRep t
115 , GTable (Reify context) (Rep (Record (t (Reify context))))
116 ) => t (Reify context) -> GRep t (Col (Reify context))
117 gtoColumns = toGColumns . from . Record
120type GRep :: K.Table -> K.HTable
121type GRep t = GColumns (Rep (Record (t (Reify Name))))
124reify ::
125 (-- Rel8able t
126 --, forall necessity a. Coercible (Field context necessity a) (AField context necessity a) => Coercible (t context) (t (Reify context))
127 )
128 => t context -> t (Reify context)
129reify = unsafeCoerce
132unreify ::
133 (-- Rel8able t
134 --, forall necessity a. Coercible (AField context necessity a) (Field context necessity a) => Coercible (t (Reify context)) (t context)
135 )
136 => t (Reify context) -> t context
137unreify = unsafeCoerce