on master help sign in
Fix insertion of default values since broken by #85 (#121)
add7e77Shane
src/Rel8/Statement/Insert.hs+2−2
@@ -35,7 +35,7 @@ import Rel8.Schema.Name ( Name, Selects, ppColumn )
35import Rel8.Schema.Table ( TableSchema(..), ppTable )
35import Rel8.Schema.Table ( TableSchema(..), ppTable )
36import Rel8.Statement.OnConflict ( OnConflict, ppOnConflict )
36import Rel8.Statement.OnConflict ( OnConflict, ppOnConflict )
37import Rel8.Statement.Returning ( Returning, decodeReturning, ppReturning )
37import Rel8.Statement.Returning ( Returning, decodeReturning, ppReturning )
38−import Rel8.Statement.Select ( ppSelect )
38+import Rel8.Statement.Select ( ppRows )
39import Rel8.Table ( Table )
39import Rel8.Table ( Table )
40import Rel8.Table.Name ( showNames )
40import Rel8.Table.Name ( showNames )
41
41
@@ -66,7 +66,7 @@ ppInsert :: Insert a -> Doc
66ppInsert Insert {..} =
66ppInsert Insert {..} =
67 text "INSERT INTO" <+>
67 text "INSERT INTO" <+>
68 ppInto into $$
68 ppInto into $$
69− ppSelect rows $$
69+ ppRows rows $$
70 ppOnConflict into onConflict $$
70 ppOnConflict into onConflict $$
71 ppReturning into returning
71 ppReturning into returning
72
72
src/Rel8/Statement/Select.hs+31−3
@@ -11,10 +11,13 @@ module Rel8.Statement.Select
11
11
12 , Optimized(..)
12 , Optimized(..)
13 , ppPrimSelect
13 , ppPrimSelect
14+ , ppRows
14 )
15 )
15where
16where
16
17
17-- base
18-- base
19+import Data.Foldable ( toList )
20+import Data.List.NonEmpty ( NonEmpty( (:|) ) )
18import Data.Void ( Void )
21import Data.Void ( Void )
19import Prelude hiding ( undefined )
22import Prelude hiding ( undefined )
20
23
@@ -24,12 +27,15 @@ import qualified Hasql.Encoders as Hasql
24import qualified Hasql.Statement as Hasql
27import qualified Hasql.Statement as Hasql
25
28
26-- opaleye
29-- opaleye
30+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
27import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
31import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
32+import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
28import qualified Opaleye.Internal.PrimQuery as Opaleye
33import qualified Opaleye.Internal.PrimQuery as Opaleye
29import qualified Opaleye.Internal.Print as Opaleye
34import qualified Opaleye.Internal.Print as Opaleye
30import qualified Opaleye.Internal.Optimize as Opaleye
35import qualified Opaleye.Internal.Optimize as Opaleye
31import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
36import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
32−import qualified Opaleye.Internal.Sql as Opaleye
37+import qualified Opaleye.Internal.Sql as Opaleye hiding ( Values )
38+import qualified Opaleye.Internal.Tag as Opaleye
33
39
34-- pretty
40-- pretty
35import Text.PrettyPrint ( Doc )
41import Text.PrettyPrint ( Doc )
@@ -45,6 +51,7 @@ import Rel8.Table ( Table )
45import Rel8.Table.Cols ( toCols )
51import Rel8.Table.Cols ( toCols )
46import Rel8.Table.Name ( namesFromLabels )
52import Rel8.Table.Name ( namesFromLabels )
47import Rel8.Table.Opaleye ( castTable, exprsWithNames )
53import Rel8.Table.Opaleye ( castTable, exprsWithNames )
54+import qualified Rel8.Table.Opaleye as T
48import Rel8.Table.Serialize ( Serializable, parse )
55import Rel8.Table.Serialize ( Serializable, parse )
49import Rel8.Table.Undefined ( undefined )
56import Rel8.Table.Undefined ( undefined )
50
57
@@ -80,12 +87,33 @@ ppSelect query =
80 never = pure (toPrimExpr false)
87 never = pure (toPrimExpr false)
81
88
82
89
90+ppRows :: Table Expr a => Query a -> Doc
91+ppRows query = case optimize primQuery of
92+ -- Special case VALUES because we can't use DEFAULT inside a SELECT
93+ Optimized (Opaleye.Product ((_, Opaleye.Values symbols rows) :| []) [])
94+ | eqSymbols symbols (toList (T.exprs a)) ->
95+ Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)
96+ _ -> ppSelect query
97+ where
98+ (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
99+
100+ eqSymbols (symbol : symbols) (Opaleye.AttrExpr symbol' : exprs)
101+ | eqSymbol symbol symbol' = eqSymbols symbols exprs
102+ | otherwise = False
103+ eqSymbols [] [] = True
104+ eqSymbols _ _ = False
105+
106+ eqSymbol
107+ (Opaleye.Symbol name (Opaleye.UnsafeTag tag))
108+ (Opaleye.Symbol name' (Opaleye.UnsafeTag tag'))
109+ = name == name' && tag == tag'
110+
111+
83ppPrimSelect :: Query a -> (Optimized Doc, a)
112ppPrimSelect :: Query a -> (Optimized Doc, a)
84ppPrimSelect query =
113ppPrimSelect query =
85 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
114 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
86 where
115 where
87− (a, primQuery, _) =
88− Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
116+ (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
89
117
90
118
91data Optimized a = Empty | Unit | Optimized a
119data Optimized a = Empty | Unit | Optimized a