926e5d4 · rel8 · git.iko.soy

src/Rel8/Query/SQL.hs+2−1

compare with master

unifiedsplit

@@ -31,6 +31,7 @@ import Rel8.Schema.Name ( Selects, Col(..) )

31import Rel8.Schema.HTable ( htabulateA, hfield )

32import Rel8.Table ( Table, toColumns )

33import Rel8.Table.Name ( namesFromLabels )

34+import Rel8.Table.Opaleye ( castTable )

34

35

36

36-- | Convert a query to a 'String' containing the query as a @SELECT@

37-- | Convert a query to a 'String' containing the query as a @SELECT@

@@ -59,7 +60,7 @@ optimize = Opaleye.removeEmpty . Opaleye.optimize

59

60

60selectFrom :: Selects names exprs

61selectFrom :: Selects names exprs

61 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select

62 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select

62−selectFrom (toColumns -> names) (toColumns -> exprs) query =

63+selectFrom (toColumns -> names) (toColumns . castTable -> exprs) query =

63 Opaleye.SelectFrom $ Opaleye.newSelect

64 Opaleye.SelectFrom $ Opaleye.newSelect

64 { Opaleye.attrs = Opaleye.SelectAttrs attributes

65 { Opaleye.attrs = Opaleye.SelectAttrs attributes

65 , Opaleye.tables = Opaleye.oneTable select

66 , Opaleye.tables = Opaleye.oneTable select

src/Rel8/Statement/Delete.hs+2−2

@@ -33,7 +33,7 @@ import Rel8.Schema.Name ( Selects )

33import Rel8.Schema.Table ( TableSchema )

34import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )

35import Rel8.Table ( fromColumns, toColumns )

36−import Rel8.Table.Opaleye ( table, unpackspec )

36+import Rel8.Table.Opaleye ( castTable, table, unpackspec )

37import Rel8.Table.Serialize ( Serializable, parse )

38

39-- text

@@ -85,7 +85,7 @@ delete c Delete {from, deleteWhere, returning} =

85 where

86 from' = table $ toColumns <$> from

87 where' = toColumn . toPrimExpr . deleteWhere . fromColumns

88− project' = toColumns . project . fromColumns

88+ project' = castTable . toColumns . project . fromColumns

89 where

90 decoder :: forall exprs projection a. Serializable projection a

91 => (exprs -> projection) -> Hasql.Result [a]

src/Rel8/Statement/Insert.hs+2−2

@@ -30,7 +30,7 @@ import qualified Opaleye.Manipulation as Opaleye

30import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )

31import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )

32import Rel8.Table ( fromColumns, toColumns )

33−import Rel8.Table.Opaleye ( table, unpackspec )

33+import Rel8.Table.Opaleye ( castTable, table, unpackspec )

34import Rel8.Table.Serialize ( Serializable, parse )

35

36-- text

@@ -76,7 +76,7 @@ insert c Insert {into, rows, onConflict, returning} =

76 where

77 into' = table $ toColumns <$> into

78 rows' = toColumns <$> x :| xs

79− project' = toColumns . project . fromColumns

79+ project' = castTable . toColumns . project . fromColumns

80

81 where

82 onConflict' =

src/Rel8/Statement/Update.hs+2−2

@@ -36,7 +36,7 @@ import Rel8.Schema.Table ( TableSchema )

36import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )

37import Rel8.Table ( fromColumns, toColumns )

38import Rel8.Table.Insert ( toInsert )

39−import Rel8.Table.Opaleye ( table, unpackspec )

39+import Rel8.Table.Opaleye ( castTable, table, unpackspec )

40import Rel8.Table.Serialize ( Serializable, parse )

41

42-- text

@@ -97,7 +97,7 @@ update c Update {target, set, updateWhere, returning} =

97 target' = lmap toInsert $ table $ toColumns <$> target

98 set' = toColumns . set . fromColumns

99 where' = toColumn . toPrimExpr . updateWhere . fromColumns

100− project' = toColumns . project . fromColumns

100+ project' = castTable . toColumns . project . fromColumns

101

102 where

103 decoder :: forall exprs projection a. Serializable projection a

src/Rel8/Table/Opaleye.hs+16−1

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

1+{-# language BlockArguments #-}

1{-# language DisambiguateRecordFields #-}

2{-# language DisambiguateRecordFields #-}

2{-# language FlexibleContexts #-}

3{-# language FlexibleContexts #-}

3{-# language NamedFieldPuns #-}

4{-# language NamedFieldPuns #-}

@@ -12,6 +13,7 @@ module Rel8.Table.Opaleye

12 , tableFields

13 , tableFields

13 , unpackspec

14 , unpackspec

14 , valuesspec

15 , valuesspec

16+ , castTable

15 )

17 )

16where

18where

17

19

@@ -38,9 +40,10 @@ import Rel8.Expr.Opaleye

38 ( fromPrimExpr, toPrimExpr

40 ( fromPrimExpr, toPrimExpr

39 , traversePrimExpr

41 , traversePrimExpr

40 , fromColumn, toColumn

42 , fromColumn, toColumn

43+ , scastExpr

41 )

44 )

42import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

45import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

43−import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs )

46+import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )

44import Rel8.Schema.Insert ( Insert, Inserts, Col(..) )

47import Rel8.Schema.Insert ( Insert, Inserts, Col(..) )

45import Rel8.Schema.Name ( Name, Selects, Col(..) )

48import Rel8.Schema.Name ( Name, Selects, Col(..) )

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

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

@@ -124,3 +127,15 @@ toPackMap as = Opaleye.PackMap $ \f () ->

124 unwrapApplicative .

127 unwrapApplicative .

125 htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $

128 htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $

126 toColumns as

129 toColumns as

130+

131+

132+-- | Transform a table by adding 'CAST' to all columns. This is most useful for

133+-- finalising a SELECT or RETURNING statement, guaranteed that the output

134+-- matches what is encoded in each columns TypeInformation.

135+castTable :: Table Expr a => a -> a

136+castTable (toColumns -> as) = fromColumns $ htabulate \i ->

137+ case hfield hspecs i of

138+ SSpec{info} ->

139+ case hfield as i of

140+ DB expr ->

141+ DB (scastExpr info expr)