cf8bdc7 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Add constructors for HKD

cf8bdc7Shane O'Brien6 years ago

src/Rel8.hs+16−4

compare with master

unifiedsplit

@@ -82,9 +82,6 @@ module Rel8

82 , bindTheseTable

83 , bitraverseTheseTable

85− -- ** @ADT@

86− , ADT

87−

88 -- ** @ListTable@

85 -- ** @ListTable@

89 , ListTable

86 , ListTable

90 , many

87 , many

@@ -93,6 +90,22 @@ module Rel8

93 , NonEmptyTable

90 , NonEmptyTable

94 , some

91 , some

93+ -- ** @ADT@

94+ , ADT

95+ , ConstructADT, constructADT

96+ , DeconstructADT, deconstructADT

97+ , InsertADT, insertADT

98+ , NameADT, nameADT

99+ , AggregateADT, aggregateADT

100+

101+ -- ** @HKD@

102+ , HKD

103+ , ConstructHKD, constructHKD

104+ , DeconstructHKD, deconstructHKD

105+ , InsertHKD, insertHKD

106+ , NameHKD, nameHKD

107+ , AggregateHKD, aggregateHKD

108+

96 -- ** Table schemas

109 -- ** Table schemas

97 , TableSchema(..)

110 , TableSchema(..)

98 , Name

111 , Name

@@ -246,7 +259,6 @@ module Rel8

246 , ToExprs(..)

259 , ToExprs(..)

247 , FromExprs

260 , FromExprs

248 , Result

261 , Result

249− , HKD

250 , HKDT(..)

262 , HKDT(..)

251 ) where

263 ) where

252

264

src/Rel8/Aggregate/Legacy.hs+16−2

@@ -16,14 +16,15 @@ module Rel8.Aggregate.Legacy

16 , listAgg

17 , nonEmptyAgg

19− , AggregateADT

19+ , AggregateADT, aggregateADT

20− , aggregateADT

20+ , AggregateHKD, aggregateHKD

21 )

22where

24-- base

25import Data.Functor.Identity ( Identity( Identity ) )

26import Data.Kind ( Type )

27+import GHC.Generics ( Rep )

27import Prelude

28import Prelude

29-- opaleye

30-- opaleye

@@ -34,6 +35,7 @@ import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )

34import Rel8.Expr ( Col(..), Expr )

35import Rel8.Expr ( Col(..), Expr )

35import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )

36import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )

36import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )

37import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )

38+import Rel8.Generic.Table ( GAlgebra )

37import Rel8.Kind.Algebra ( Algebra( Sum ) )

39import Rel8.Kind.Algebra ( Algebra( Sum ) )

38import Rel8.Query ( Query )

40import Rel8.Query ( Query )

39import Rel8.Query.Opaleye ( mapOpaleye )

41import Rel8.Query.Opaleye ( mapOpaleye )

@@ -44,6 +46,7 @@ import Rel8.Schema.Kind ( Rel8able )

44import Rel8.Table ( toColumns, fromColumns )

46import Rel8.Table ( toColumns, fromColumns )

45import Rel8.Table.ADT ( ConstructableADT, ADT( ADT ), ADTRep )

47import Rel8.Table.ADT ( ConstructableADT, ADT( ADT ), ADTRep )

46import Rel8.Table.Eq ( EqTable, eqTable )

48import Rel8.Table.Eq ( EqTable, eqTable )

49+import Rel8.Table.HKD ( ConstructableHKD, HKD( HKD ), HKDRep )

47import Rel8.Table.List ( ListTable )

50import Rel8.Table.List ( ListTable )

48import Rel8.Table.NonEmpty ( NonEmptyTable )

51import Rel8.Table.NonEmpty ( NonEmptyTable )

49import Rel8.Table.Opaleye ( aggregator )

52import Rel8.Table.Opaleye ( aggregator )

@@ -113,3 +116,14 @@ aggregateADT :: forall t. ConstructableADT t

113aggregateADT f =

116aggregateADT f =

114 ggaggregate' @'Sum @(ADTRep t) @(ADT t Expr) @(ADT t Aggregate) ADT (\(ADT a) -> a)

117 ggaggregate' @'Sum @(ADTRep t) @(ADT t Expr) @(ADT t Aggregate) ADT (\(ADT a) -> a)

115 (f @(ADT t Aggregate))

118 (f @(ADT t Aggregate))

119+

120+

121+type AggregateHKD :: Type -> Type

122+type AggregateHKD a = forall r. GGAggregate' (GAlgebra (Rep a)) (HKDRep a) r

123+

124+

125+aggregateHKD :: forall a. ConstructableHKD a

126+ => AggregateHKD a -> HKD a Expr -> HKD a Aggregate

127+aggregateHKD f =

128+ ggaggregate' @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @(HKD a Aggregate) HKD (\(HKD a) -> a)

129+ (f @(HKD a Aggregate))

src/Rel8/Table/HKD.hs+76−3

@@ -1,7 +1,9 @@

1+{-# language AllowAmbiguousTypes #-}

1{-# language DataKinds #-}

2{-# language DataKinds #-}

2{-# language FlexibleContexts #-}

3{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

4{-# language FlexibleInstances #-}

4{-# language MultiParamTypeClasses #-}

5{-# language MultiParamTypeClasses #-}

6+{-# language RankNTypes #-}

5{-# language ScopedTypeVariables #-}

7{-# language ScopedTypeVariables #-}

6{-# language StandaloneKindSignatures #-}

8{-# language StandaloneKindSignatures #-}

7{-# language TypeApplications #-}

9{-# language TypeApplications #-}

@@ -10,9 +12,15 @@

10{-# language UndecidableSuperClasses #-}

12{-# language UndecidableSuperClasses #-}

12module Rel8.Table.HKD

14module Rel8.Table.HKD

13− ( HKD( HKD ), HKDT(..)

15+ ( HKD( HKD )

14− , fromHKD, toHKD

16+ , HKDT(..), fromHKD, toHKD, GHKD

15− , GHKD

17+ , ConstructableHKD

18+ , ConstructHKD, constructHKD

19+ , DeconstructHKD, deconstructHKD

20+ , InsertHKD, insertHKD

21+ , NameHKD, nameHKD

22+ , AggregateHKD, aggregateHKD

23+ , HKDRep

16 )

24 )

17where

25where

@@ -24,11 +32,20 @@ import GHC.Generics ( Generic, Rep, from, to )

24import Prelude

32import Prelude

26-- rel8

34-- rel8

35+import Rel8.Aggregate ( Aggregate )

27import Rel8.Column ( Column )

36import Rel8.Column ( Column )

28import Rel8.Expr ( Expr )

37import Rel8.Expr ( Expr )

29import Rel8.FCF ( Eval, Exp )

38import Rel8.FCF ( Eval, Exp )

30import Rel8.Kind.Algebra ( KnownAlgebra )

39import Rel8.Kind.Algebra ( KnownAlgebra )

31import qualified Rel8.Kind.Algebra as K

40import qualified Rel8.Kind.Algebra as K

41+import Rel8.Generic.Construction

42+ ( GGConstructable

43+ , GGConstruct, ggconstruct

44+ , GGDeconstruct, ggdeconstruct

45+ , GGInsert, gginsert

46+ , GGName, ggname

47+ , GGAggregate, ggaggregate

48+ )

32import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )

49import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )

33import Rel8.Generic.Record ( GRecord, GRecordable, grecord, gunrecord )

50import Rel8.Generic.Record ( GRecord, GRecordable, grecord, gunrecord )

34import Rel8.Generic.Rel8able

51import Rel8.Generic.Rel8able

@@ -46,6 +63,8 @@ import qualified Rel8.Generic.Table.ADT as G

46import Rel8.Schema.Context ( Col )

63import Rel8.Schema.Context ( Col )

47import qualified Rel8.Schema.Kind as K

64import qualified Rel8.Schema.Kind as K

48import Rel8.Schema.HTable ( HTable )

65import Rel8.Schema.HTable ( HTable )

66+import Rel8.Schema.Insert ( Insert )

67+import Rel8.Schema.Name ( Name )

49import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )

68import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )

50import Rel8.Schema.Result ( Result )

69import Rel8.Schema.Result ( Result )

51import Rel8.Table

70import Rel8.Table

@@ -221,3 +240,57 @@ instance

221 , GMap TUnreify (GMap (TColumn (Reify Result)) (Rep a)) ~ GMap (TColumn Result) (Rep a)

240 , GMap TUnreify (GMap (TColumn (Reify Result)) (Rep a)) ~ GMap (TColumn Result) (Rep a)

222 )

241 )

223 => GHKD a

242 => GHKD a

243+

244+

245+type ConstructableHKD :: Type -> Constraint

246+class GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

247+instance GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

248+

249+

250+type ConstructHKD :: Type -> Type

251+type ConstructHKD a = GGConstruct (GAlgebra (Rep a)) (HKDRep a) (HKD a Expr)

252+

253+

254+constructHKD :: forall a. ConstructableHKD a => ConstructHKD a

255+constructHKD = ggconstruct @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) HKD

256+

257+

258+type DeconstructHKD :: Type -> Type -> Type

259+type DeconstructHKD a r = GGDeconstruct (GAlgebra (Rep a)) (HKDRep a) (HKD a Expr) r

260+

261+

262+deconstructHKD :: forall a r. (ConstructableHKD a, Table Expr r)

263+ => DeconstructHKD a r

264+deconstructHKD = ggdeconstruct @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @r (\(HKD a) -> a)

265+

266+

267+type InsertHKD :: Type -> Type

268+type InsertHKD a = GGInsert (GAlgebra (Rep a)) (HKDRep a) (HKD a Insert)

269+

270+

271+insertHKD :: forall a. ConstructableHKD a => InsertHKD a

272+insertHKD = gginsert @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Insert) HKD

273+

274+

275+type NameHKD :: Type -> Type

276+type NameHKD a = GGName (GAlgebra (Rep a)) (HKDRep a) (HKD a Name)

277+

278+

279+nameHKD :: forall a. ConstructableHKD a => NameHKD a

280+nameHKD = ggname @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Name) HKD

281+

282+

283+type AggregateHKD :: Type -> Type

284+type AggregateHKD a = forall r. GGAggregate (GAlgebra (Rep a)) (HKDRep a) r

285+

286+

287+aggregateHKD :: forall a. ConstructableHKD a

288+ => AggregateHKD a -> HKD a Expr -> Aggregate (HKD a Expr)

289+aggregateHKD f =

290+ ggaggregate @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) HKD (\(HKD a) -> a)

291+ (f @(Aggregate (HKD a Expr)))

292+

293+

294+data HKDRep :: Type -> K.Context -> Exp (Type -> Type)

295+type instance Eval (HKDRep a context) =

296+ GRecord (GMap (TColumn context) (Rep a))