git.iko.soy/rel8
on master help sign in
CAST all outputs of SELECT and RETURNING (#35)
commit926e5d4bf51539835192bf4c2b3815926165a064 authorOllie Charles <oliver.charles@circuithub.com> dateTue 6 Apr 2021, 14:59 (6 years ago) parent1bcb280
5 files changed+24−8
compare with master
unifiedsplit
src/Rel8/Query/SQL.hs+2−1 src/Rel8/Statement/Delete.hs+2−2 src/Rel8/Statement/Insert.hs+2−2 src/Rel8/Statement/Update.hs+2−2 src/Rel8/Table/Opaleye.hs+16−1
src/Rel8/Query/SQL.hs+2−1
@@ -31,6 +31,7 @@ import Rel8.Schema.Name ( Selects, Col(..) )
3131import Rel8.Schema.HTable ( htabulateA, hfield )
3232import Rel8.Table ( Table, toColumns )
3333import Rel8.Table.Name ( namesFromLabels )
34+import Rel8.Table.Opaleye ( castTable )
3435
3536
3637-- | Convert a query to a 'String' containing the query as a @SELECT@
@@ -59,7 +60,7 @@ optimize = Opaleye.removeEmpty . Opaleye.optimize
5960
6061selectFrom :: Selects names exprs
6162 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
62−selectFrom (toColumns -> names) (toColumns -> exprs) query =
63+selectFrom (toColumns -> names) (toColumns . castTable -> exprs) query =
6364 Opaleye.SelectFrom $ Opaleye.newSelect
6465 { Opaleye.attrs = Opaleye.SelectAttrs attributes
6566 , Opaleye.tables = Opaleye.oneTable select
src/Rel8/Statement/Delete.hs+2−2
@@ -33,7 +33,7 @@ import Rel8.Schema.Name ( Selects )
3333import Rel8.Schema.Table ( TableSchema )
3434import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )
3535import Rel8.Table ( fromColumns, toColumns )
36−import Rel8.Table.Opaleye ( table, unpackspec )
36+import Rel8.Table.Opaleye ( castTable, table, unpackspec )
3737import Rel8.Table.Serialize ( Serializable, parse )
3838
3939-- text
@@ -85,7 +85,7 @@ delete c Delete {from, deleteWhere, returning} =
8585 where
8686 from' = table $ toColumns <$> from
8787 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
88− project' = toColumns . project . fromColumns
88+ project' = castTable . toColumns . project . fromColumns
8989 where
9090 decoder :: forall exprs projection a. Serializable projection a
9191 => (exprs -> projection) -> Hasql.Result [a]
src/Rel8/Statement/Insert.hs+2−2
@@ -30,7 +30,7 @@ import qualified Opaleye.Manipulation as Opaleye
3030import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )
3131import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
3232import Rel8.Table ( fromColumns, toColumns )
33−import Rel8.Table.Opaleye ( table, unpackspec )
33+import Rel8.Table.Opaleye ( castTable, table, unpackspec )
3434import Rel8.Table.Serialize ( Serializable, parse )
3535
3636-- text
@@ -76,7 +76,7 @@ insert c Insert {into, rows, onConflict, returning} =
7676 where
7777 into' = table $ toColumns <$> into
7878 rows' = toColumns <$> x :| xs
79− project' = toColumns . project . fromColumns
79+ project' = castTable . toColumns . project . fromColumns
8080
8181 where
8282 onConflict' =
src/Rel8/Statement/Update.hs+2−2
@@ -36,7 +36,7 @@ import Rel8.Schema.Table ( TableSchema )
3636import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
3737import Rel8.Table ( fromColumns, toColumns )
3838import Rel8.Table.Insert ( toInsert )
39−import Rel8.Table.Opaleye ( table, unpackspec )
39+import Rel8.Table.Opaleye ( castTable, table, unpackspec )
4040import Rel8.Table.Serialize ( Serializable, parse )
4141
4242-- text
@@ -97,7 +97,7 @@ update c Update {target, set, updateWhere, returning} =
9797 target' = lmap toInsert $ table $ toColumns <$> target
9898 set' = toColumns . set . fromColumns
9999 where' = toColumn . toPrimExpr . updateWhere . fromColumns
100− project' = toColumns . project . fromColumns
100+ project' = castTable . toColumns . project . fromColumns
101101
102102 where
103103 decoder :: forall exprs projection a. Serializable projection a
src/Rel8/Table/Opaleye.hs+16−1
@@ -1,3 +1,4 @@
1+{-# language BlockArguments #-}
12{-# language DisambiguateRecordFields #-}
23{-# language FlexibleContexts #-}
34{-# language NamedFieldPuns #-}
@@ -12,6 +13,7 @@ module Rel8.Table.Opaleye
1213 , tableFields
1314 , unpackspec
1415 , valuesspec
16+ , castTable
1517 )
1618where
1719
@@ -38,9 +40,10 @@ import Rel8.Expr.Opaleye
3840 ( fromPrimExpr, toPrimExpr
3941 , traversePrimExpr
4042 , fromColumn, toColumn
43+ , scastExpr
4144 )
4245import 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 )
4447import Rel8.Schema.Insert ( Insert, Inserts, Col(..) )
4548import Rel8.Schema.Name ( Name, Selects, Col(..) )
4649import Rel8.Schema.Spec ( SSpec(..) )
@@ -124,3 +127,15 @@ toPackMap as = Opaleye.PackMap $ \f () ->
124127 unwrapApplicative .
125128 htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $
126129 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)