d07e3b5 · rel8 · git.iko.soy

git.iko.soy/rel8

Add and export missing constructors for MaybeTable and friends

commitd07e3b5cfcdc2579ec06653f59b879e2daf36733 authorShane O'Brien <shane.obrien@circuithub.com> dateWed 5 May 2021, 03:13 (6 years ago) parent8a680c9

6 files changed+88−9

compare with master

unifiedsplit

src/Rel8.hs+15 src/Rel8/Table/Either.hs+11−1 src/Rel8/Table/List.hs+21−1 src/Rel8/Table/Maybe.hs+10−2 src/Rel8/Table/NonEmpty.hs+21−3 src/Rel8/Table/These.hs+10−2

src/Rel8.hs+15

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

5757 , catMaybeTable

5858 , bindMaybeTable

5959 , traverseMaybeTable

60+ , aggregateMaybeTable

61+ , insertMaybeTable

62+ , nameMaybeTable

6063

6164 -- ** @EitherTable@

6265 , EitherTable

@@ -66,6 +69,9 @@ module Rel8

6669 , keepRightTable

6770 , bindEitherTable

6871 , bitraverseEitherTable

72+ , aggregateEitherTable

73+ , insertEitherTable

74+ , nameEitherTable

6975

7076 -- ** @TheseTable@

7177 , TheseTable

@@ -81,13 +87,22 @@ module Rel8

8187 , keepThoseTable, loseThoseTable

8288 , bindTheseTable

8389 , bitraverseTheseTable

90+ , aggregateTheseTable

91+ , insertTheseTable

92+ , nameTheseTable

8493

8594 -- ** @ListTable@

8695 , ListTable

96+ , listTable

97+ , insertListTable

98+ , nameListTable

8799 , many

88100

89101 -- ** @NonEmptyTable@

90102 , NonEmptyTable

103+ , nonEmptyTable

104+ , insertNonEmptyTable

105+ , nameNonEmptyTable

91106 , some

92107

93108 -- ** @ADT@

src/Rel8/Table/Either.hs+11−1

@@ -3,6 +3,7 @@

33{-# language DerivingStrategies #-}

44{-# language FlexibleContexts #-}

55{-# language FlexibleInstances #-}

6+{-# language LambdaCase #-}

67{-# language MultiParamTypeClasses #-}

78{-# language NamedFieldPuns #-}

89{-# language ScopedTypeVariables #-}

@@ -17,7 +18,7 @@ module Rel8.Table.Either

1718 ( EitherTable(..)

1819 , eitherTable, leftTable, rightTable

1920 , isLeftTable, isRightTable

20− , aggregateEitherTable, nameEitherTable

21+ , aggregateEitherTable, insertEitherTable, nameEitherTable

2122 )

2223where

2324

@@ -48,6 +49,7 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..) )

4849import Rel8.Schema.HTable.Identity ( HIdentity(..) )

4950import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

5051import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

52+import Rel8.Schema.Insert ( Insert )

5153import Rel8.Schema.Name ( Name )

5254import Rel8.Table

5355 ( Table, Columns, Context, fromColumns, toColumns

@@ -55,6 +57,7 @@ import Rel8.Table

5557 )

5658import Rel8.Table.Bool ( bool )

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

60+import Rel8.Table.Insert ( toInsert )

5861import Rel8.Table.Ord ( OrdTable, ordTable )

5962import Rel8.Table.Recontextualize ( Recontextualize )

6063import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -188,6 +191,13 @@ aggregateEitherTable f g EitherTable {tag, left, right} =

188191 aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

189192

190193

194+insertEitherTable :: (Table Insert a, Table Insert b)

195+ => Either a b -> EitherTable a b

196+insertEitherTable = \case

197+ Left a -> EitherTable (fromExpr (litExpr IsLeft)) a (fromColumns (toInsert undefined))

198+ Right b -> EitherTable (fromExpr (litExpr IsRight)) (fromColumns (toInsert undefined)) b

199+

200+

191201nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b

192202nameEitherTable = EitherTable . fromName

193203

src/Rel8/Table/List.hs+21−1

@@ -10,7 +10,7 @@

1010

1111module Rel8.Table.List

1212 ( ListTable(..)

13− , listTable

13+ , listTable, insertListTable, nameListTable

1414 )

1515where

1616

@@ -23,9 +23,12 @@ import Prelude

2323-- rel8

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

2525import Rel8.Expr.Array ( sappend, sempty, slistOf )

26+import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )

2627import Rel8.Schema.Dict ( Dict( Dict ) )

2728import Rel8.Schema.HTable.List ( HListTable )

2829import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )

30+import Rel8.Schema.Insert ( Col( OptionalInsert, RequiredInsert ), Insert )

31+import Rel8.Schema.Name ( Col( NameCol ), Name )

2932import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

3033import Rel8.Schema.Spec ( SSpec(..) )

3134import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )

@@ -122,3 +125,20 @@ listTable =

122125 ListTable .

123126 hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .

124127 fmap toColumns

128+

129+

130+insertListTable :: Table Insert a => [a] -> ListTable a

131+insertListTable =

132+ ListTable .

133+ hvectorize (\SSpec {necessity, info} -> case necessity of

134+ SRequired -> RequiredInsert . slistOf info . fmap (\(RequiredInsert a) -> a)

135+ SOptional -> OptionalInsert . fmap (slistOf info) . traverse (\(OptionalInsert a) -> a)) .

136+ fmap toColumns

137+

138+

139+nameListTable :: Table Name a => a -> ListTable a

140+nameListTable =

141+ ListTable .

142+ hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .

143+ pure .

144+ toColumns

src/Rel8/Table/Maybe.hs+10−2

@@ -3,6 +3,7 @@

33{-# language DerivingStrategies #-}

44{-# language FlexibleContexts #-}

55{-# language FlexibleInstances #-}

6+{-# language LambdaCase #-}

67{-# language MultiParamTypeClasses #-}

78{-# language NamedFieldPuns #-}

89{-# language ScopedTypeVariables #-}

@@ -16,8 +17,7 @@ module Rel8.Table.Maybe

1617 , maybeTable, nothingTable, justTable

1718 , isNothingTable, isJustTable

1819 , ($?)

19− , aggregateMaybeTable

20− , nameMaybeTable

20+ , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

2121 )

2222where

2323

@@ -46,6 +46,7 @@ import Rel8.Schema.HTable.Identity ( HIdentity(..) )

4646import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

4747import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )

4848import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

49+import Rel8.Schema.Insert ( Insert )

4950import Rel8.Schema.Name ( Name )

5051import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql, nullable )

5152import Rel8.Table

@@ -58,6 +59,7 @@ import Rel8.Table.Alternative

5859 )

5960import Rel8.Table.Bool ( bool )

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

62+import Rel8.Table.Insert ( toInsert )

6163import Rel8.Table.Ord ( OrdTable, ordTable )

6264import Rel8.Table.Recontextualize ( Recontextualize )

6365import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -217,6 +219,12 @@ aggregateMaybeTable f MaybeTable {tag = tag@Tag {aggregator, expr}, just} =

217219 aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

218220

219221

222+insertMaybeTable :: Table Insert a => Maybe a -> MaybeTable a

223+insertMaybeTable = \case

224+ Nothing -> MaybeTable (fromExpr null) (fromColumns (toInsert undefined))

225+ Just a -> justTable a

226+

227+

220228nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a

221229nameMaybeTable = MaybeTable . fromName

222230

src/Rel8/Table/NonEmpty.hs+21−3

@@ -1,4 +1,3 @@

1−{-# language DataKinds #-}

21{-# language FlexibleContexts #-}

32{-# language FlexibleInstances #-}

43{-# language MultiParamTypeClasses #-}

@@ -11,8 +10,7 @@

1110

1211module Rel8.Table.NonEmpty

1312 ( NonEmptyTable(..)

14− , HNonEmptyTable

15− , nonEmptyTable

13+ , nonEmptyTable, insertNonEmptyTable, nameNonEmptyTable

1614 )

1715where

1816

@@ -26,9 +24,12 @@ import Prelude

2624-- rel8

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

2826import Rel8.Expr.Array ( sappend1, snonEmptyOf )

27+import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )

2928import Rel8.Schema.Dict ( Dict( Dict ) )

3029import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )

3130import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )

31+import Rel8.Schema.Insert ( Col( OptionalInsert, RequiredInsert ), Insert )

32+import Rel8.Schema.Name ( Col( NameCol ), Name )

3233import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

3334import Rel8.Schema.Reify ( hreify, hunreify )

3435import Rel8.Schema.Spec ( SSpec(..) )

@@ -115,3 +116,20 @@ nonEmptyTable =

115116 NonEmptyTable .

116117 hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .

117118 fmap toColumns

119+

120+

121+insertNonEmptyTable :: Table Insert a => NonEmpty a -> NonEmptyTable a

122+insertNonEmptyTable =

123+ NonEmptyTable .

124+ hvectorize (\SSpec {necessity, info} -> case necessity of

125+ SRequired -> RequiredInsert . snonEmptyOf info . fmap (\(RequiredInsert a) -> a)

126+ SOptional -> OptionalInsert . fmap (snonEmptyOf info) . traverse (\(OptionalInsert a) -> a)) .

127+ fmap toColumns

128+

129+

130+nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a

131+nameNonEmptyTable =

132+ NonEmptyTable .

133+ hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .

134+ pure .

135+ toColumns

src/Rel8/Table/These.hs+10−2

@@ -21,7 +21,7 @@ module Rel8.Table.These

2121 , isThisTable, isThatTable, isThoseTable

2222 , hasHereTable, hasThereTable

2323 , justHereTable, justThereTable

24− , aggregateTheseTable, nameTheseTable

24+ , aggregateTheseTable, insertTheseTable, nameTheseTable

2525 )

2626where

2727

@@ -52,6 +52,7 @@ import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

5252import Rel8.Schema.HTable.Identity ( HIdentity(..) )

5353import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

5454import Rel8.Schema.HTable.These ( HTheseTable(..) )

55+import Rel8.Schema.Insert ( Insert )

5556import Rel8.Schema.Name ( Name )

5657import Rel8.Table

5758 ( Table, Columns, Context, fromColumns, toColumns

@@ -62,7 +63,7 @@ import Rel8.Table.Maybe

6263 ( MaybeTable(..)

6364 , maybeTable, justTable, nothingTable

6465 , isJustTable

65− , aggregateMaybeTable, nameMaybeTable

66+ , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

6667 )

6768import Rel8.Table.Ord ( OrdTable, ordTable )

6869import Rel8.Table.Recontextualize ( Recontextualize )

@@ -77,6 +78,7 @@ import Data.Functor.Bind ( Bind, (>>-) )

7778

7879-- these

7980import Data.These ( These )

81+import Data.These.Combinators ( justHere, justThere )

8082

8183

8284type TheseTable :: Type -> Type -> Type

@@ -239,6 +241,12 @@ aggregateTheseTable f g TheseTable {here, there} =

239241 liftF2 TheseTable (aggregateMaybeTable f here) (aggregateMaybeTable g there)

240242

241243

244+insertTheseTable :: (Table Insert a, Table Insert b)

245+ => These a b -> TheseTable a b

246+insertTheseTable =

247+ TheseTable <$> insertMaybeTable . justHere <*> insertMaybeTable . justThere

248+

249+

242250nameTheseTable :: ()

243251 => Name (Maybe MaybeTag)

244252 -> Name (Maybe MaybeTag)