git.iko.soy/squeal
on dev help sign in
Merge pull request #21 from echatav/create-complex
f707a33Eitan Chatav
squeel-postgresql/exe/Example.hsnew file+82
compare with dev
unifiedsplit
@@ -0,0 +1,82 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , MagicHash
4+ , OverloadedLabels
5+ , OverloadedStrings
6+ , TypeOperators
7+#-}
8+
9+module Main (main) where
10+
11+import Control.Category ((>>>))
12+import Control.Monad.Base
13+import Data.Function ((&))
14+import Data.Int
15+import Data.Monoid
16+import Data.Vinyl
17+import Squeel.PostgreSQL
18+
19+import qualified Data.ByteString.Char8 as Char8
20+
21+main :: IO ()
22+main = do
23+ Char8.putStrLn "squeel"
24+ connectionString <- pure
25+ "host=localhost port=5432 dbname=exampledb"
26+ Char8.putStrLn $ "connecting to " <> connectionString
27+ connection0 <- connectdb connectionString
28+ Char8.putStrLn "creating tables"
29+ connection1 <- flip execPQ connection0 $ pqExec $
30+ createTable #students
31+ ( (text & notNull) `As` #name
32+ :& RNil )
33+ >>>
34+ createTable #table1
35+ ( (int4 & notNull) `As` #col1
36+ :& (int4 & notNull) `As` #col2
37+ :& RNil )
38+ connection2 <- flip execPQ connection1 $ do
39+ _insertTable1Result <- pqExec $
40+ insertInto #table1 ( 1 `As` #col1 :& 2 `As` #col2 :& RNil )
41+ >>>
42+ insertInto #table1 ( 3 `As` #col1 :& 4 `As` #col2 :& RNil )
43+ Just selectTable1Result <- flip pqExecParams RNil $
44+ (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
45+ Just (Right value00) <- getvalue selectTable1Result (RowNumber 0) colNum0
46+ Just (Right value01) <- getvalue selectTable1Result (RowNumber 0) colNum1
47+ Just (Right value10) <- getvalue selectTable1Result (RowNumber 1) colNum0
48+ Just (Right value11) <- getvalue selectTable1Result (RowNumber 1) colNum1
49+ liftBase $ do
50+ print (value00 :: Int32)
51+ print (value01 :: Int32)
52+ print (value10 :: Int32)
53+ print (value11 :: Int32)
54+ finish connection2
55+
56+type Columns =
57+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
58+ , "col2" ::: 'Required ('NotNull 'PGInt4)
59+ ]
60+-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
61+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
62+type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
63+-- type OrderColumns =
64+-- [ "orderID" ::: 'NotNull 'PGInt4
65+-- , "orderVal" ::: 'NotNull 'PGText
66+-- , "customerID" ::: 'NotNull 'PGInt4
67+-- , "shipperID" ::: 'NotNull 'PGInt4
68+-- ]
69+-- type CustomerColumns =
70+-- [ "customerID" ::: 'NotNull 'PGInt4, "customerVal" ::: 'NotNull 'PGFloat4 ]
71+-- type ShipperColumns =
72+-- [ "shipperID" ::: 'NotNull 'PGInt4, "shipperVal" ::: 'NotNull 'PGBool ]
73+-- type JoinTables =
74+-- [ "shippers" ::: ShipperColumns
75+-- , "customers" ::: CustomerColumns
76+-- , "orders" ::: OrderColumns
77+-- ]
78+-- type ValueColumns =
79+-- [ "orderVal" ::: 'NotNull 'PGText
80+-- , "customerVal" ::: 'NotNull 'PGFloat4
81+-- , "shipperVal" ::: 'NotNull 'PGBool
82+-- ]
squeel-postgresql/squeel-postgresql.cabal+13
@@ -13,6 +13,7 @@ cabal-version: >=1.10
13library
13library
14 hs-source-dirs: src
14 hs-source-dirs: src
15 exposed-modules:
15 exposed-modules:
16+ Squeel.PostgreSQL
16 Squeel.PostgreSQL.Binary
17 Squeel.PostgreSQL.Binary
17 Squeel.PostgreSQL.PQ
18 Squeel.PostgreSQL.PQ
18 Squeel.PostgreSQL.Statement
19 Squeel.PostgreSQL.Statement
@@ -52,6 +53,18 @@ test-suite squeel-postgresql-test
52 , squeel-postgresql
53 , squeel-postgresql
53 , vinyl
54 , vinyl
54
55
56+executable squeel-postgresql-example
57+ default-language: Haskell2010
58+ hs-source-dirs: exe
59+ ghc-options: -Wall -Werror
60+ main-is: Example.hs
61+ build-depends:
62+ base
63+ , bytestring
64+ , squeel-postgresql
65+ , transformers-base
66+ , vinyl
67+
55source-repository head
68source-repository head
56 type: git
69 type: git
57 location: https://github.com/echatav/squeel
70 location: https://github.com/echatav/squeel
squeel-postgresql/src/Squeel/PostgreSQL.hsnew file+11
@@ -0,0 +1,11 @@
1+module Squeel.PostgreSQL
2+ ( module Squeel.PostgreSQL.Binary
3+ , module Squeel.PostgreSQL.PQ
4+ , module Squeel.PostgreSQL.Schema
5+ , module Squeel.PostgreSQL.Statement
6+ ) where
7+
8+import Squeel.PostgreSQL.Binary
9+import Squeel.PostgreSQL.PQ
10+import Squeel.PostgreSQL.Schema
11+import Squeel.PostgreSQL.Statement
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+13−11
@@ -17,8 +17,8 @@ import Data.ByteString (ByteString)
17import Data.Int (Int16,Int32,Int64)
17import Data.Int (Int16,Int32,Int64)
18import Data.Vinyl
18import Data.Vinyl
19import Data.Vinyl.Functor
19import Data.Vinyl.Functor
20−import PostgreSQL.Binary.Decoder (Decoder)
20+import PostgreSQL.Binary.Decoding (Value)
21−import PostgreSQL.Binary.Encoder (Encoder)
21+import PostgreSQL.Binary.Encoding (Encoding)
22import Data.Scientific (Scientific)
22import Data.Scientific (Scientific)
23import Data.Text (Text)
23import Data.Text (Text)
24import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
24import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
@@ -28,16 +28,16 @@ import GHC.Exts
28import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
28import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
29import qualified Data.Text as Text (pack)
29import qualified Data.Text as Text (pack)
30import qualified Data.Text.Lazy as Lazy (Text)
30import qualified Data.Text.Lazy as Lazy (Text)
31−import qualified PostgreSQL.Binary.Decoder as Decoder
31+import qualified PostgreSQL.Binary.Decoding as Decoder
32−import qualified PostgreSQL.Binary.Encoder as Encoder
32+import qualified PostgreSQL.Binary.Encoding as Encoder
33
33
34import Squeel.PostgreSQL.Schema
34import Squeel.PostgreSQL.Schema
35
35
36decodeValue :: FromValue pg x => Proxy# pg -> ByteString -> Either Text x
36decodeValue :: FromValue pg x => Proxy# pg -> ByteString -> Either Text x
37−decodeValue p = Decoder.run $ fromValue p
37+decodeValue p = Decoder.valueParser $ fromValue p
38
38
39−class FromValue (pg :: PGType) x where
39+class FromValue pg x where
40− fromValue :: Proxy# pg -> Decoder x
40+ fromValue :: Proxy# pg -> Value x
41instance FromValue 'PGInt2 Int16 where
41instance FromValue 'PGInt2 Int16 where
42 fromValue _ = Decoder.int
42 fromValue _ = Decoder.int
43instance FromValue 'PGInt4 Int32 where
43instance FromValue 'PGInt4 Int32 where
@@ -80,6 +80,8 @@ instance FromValue 'PGTimestampTZ UTCTime where
80 fromValue _ = Decoder.timestamptz_int
80 fromValue _ = Decoder.timestamptz_int
81instance FromValue 'PGInterval DiffTime where
81instance FromValue 'PGInterval DiffTime where
82 fromValue _ = Decoder.interval_int
82 fromValue _ = Decoder.interval_int
83+instance FromValue pg ty => FromValue (column ::: 'Required ('NotNull pg)) ty where
84+ fromValue _ = fromValue (proxy# :: Proxy# pg)
83
85
84class FromValues pgs xs where
86class FromValues pgs xs where
85 decodeValues :: Proxy# pgs -> Rec (Const ByteString) xs -> Rec (Either Text) xs
87 decodeValues :: Proxy# pgs -> Rec (Const ByteString) xs -> Rec (Either Text) xs
@@ -90,8 +92,8 @@ instance (FromValue pg x, FromValues pgs xs)
90 decodeValue (proxy# :: Proxy# pg) result
92 decodeValue (proxy# :: Proxy# pg) result
91 :& decodeValues (proxy# :: Proxy# pgs) results
93 :& decodeValues (proxy# :: Proxy# pgs) results
92
94
93−class ToValue x (pg :: PGType) where
95+class ToValue x pg where
94− toValue :: Proxy# pg -> Encoder x
96+ toValue :: Proxy# pg -> x -> Encoding
95instance ToValue Int16 'PGInt2 where
97instance ToValue Int16 'PGInt2 where
96 toValue _ = Encoder.int2_int16
98 toValue _ = Encoder.int2_int16
97instance ToValue Int32 'PGInt4 where
99instance ToValue Int32 'PGInt4 where
@@ -113,7 +115,7 @@ instance ToValue Text 'PGText where
113instance ToValue Lazy.Text 'PGText where
115instance ToValue Lazy.Text 'PGText where
114 toValue _ = Encoder.text_lazy
116 toValue _ = Encoder.text_lazy
115instance ToValue Char ('PGChar 1) where
117instance ToValue Char ('PGChar 1) where
116− toValue _ = Encoder.char
118+ toValue _ = Encoder.char_utf8
117instance ToValue Scientific 'PGNumeric where
119instance ToValue Scientific 'PGNumeric where
118 toValue _ = Encoder.numeric
120 toValue _ = Encoder.numeric
119instance ToValue UUID 'PGUuid where
121instance ToValue UUID 'PGUuid where
@@ -141,5 +143,5 @@ instance ToValues '[] '[] where toValues _ _ = []
141instance (ToValue x pg, ToValues xs pgs)
143instance (ToValue x pg, ToValues xs pgs)
142 => ToValues (x ': xs) (pg ': pgs) where
144 => ToValues (x ': xs) (pg ': pgs) where
143 toValues _ (Identity x :& xs)
145 toValues _ (Identity x :& xs)
144− = Encoder.run (toValue (proxy# :: Proxy# pg)) x
146+ = Encoder.encodingBytes ((toValue (proxy# :: Proxy# pg)) x)
145 : toValues (proxy# :: Proxy# pgs) xs
147 : toValues (proxy# :: Proxy# pgs) xs
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+31−24
@@ -1,5 +1,7 @@
1+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
1{-# LANGUAGE
2{-# LANGUAGE
2 DataKinds
3 DataKinds
4+ , FunctionalDependencies
3 , PolyKinds
5 , PolyKinds
4 , DeriveFunctor
6 , DeriveFunctor
5 , FlexibleContexts
7 , FlexibleContexts
@@ -35,8 +37,8 @@ import Squeel.PostgreSQL.Schema
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
37newtype Connection db = Connection { unConnection :: LibPQ.Connection }
36
38
37newtype PQ
39newtype PQ
38− (db0 :: [(Symbol,[(Symbol,NullityType)])])
40+ (db0 :: [(Symbol,[(Symbol,ColumnType)])])
39− (db1 :: [(Symbol,[(Symbol,NullityType)])])
41+ (db1 :: [(Symbol,[(Symbol,ColumnType)])])
40 (m :: * -> *)
42 (m :: * -> *)
41 (x :: *) =
43 (x :: *) =
42 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
44 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
@@ -64,24 +66,24 @@ class MonadPQ pq where
64
66
65 pqExec
67 pqExec
66 :: MonadBase IO io
68 :: MonadBase IO io
67− => Statement '[] db0 db1 xs
69+ => Statement '[] '[] db0 db1
68− -> pq db0 db1 io (Maybe (Result xs))
70+ -> pq db0 db1 io (Maybe (Result '[]))
69
71
70 pqExecParams
72 pqExecParams
71 :: (MonadBase IO io, ToOids ps, ToValues xs ps)
73 :: (MonadBase IO io, ToOids ps, ToValues xs ps)
72− => Statement ps db0 db1 ys
74+ => Statement ps ys db0 db1
73 -> Rec Identity xs
75 -> Rec Identity xs
74 -> pq db0 db1 io (Maybe (Result ys))
76 -> pq db0 db1 io (Maybe (Result ys))
75
77
76 pqPrepare
78 pqPrepare
77 :: (MonadBase IO io, ToOids ps)
79 :: (MonadBase IO io, ToOids ps)
78 => ByteString
80 => ByteString
79− -> Statement ps db0 db1 xs
81+ -> Statement ps xs db0 db1
80− -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps db0 db1 xs)
82+ -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps xs db0 db1)
81
83
82 pqExecPrepared
84 pqExecPrepared
83 :: (MonadBase IO io, ToValues xs ps)
85 :: (MonadBase IO io, ToValues xs ps)
84− => PreparedStatement ps db0 db1 ys
86+ => PreparedStatement ps ys db0 db1
85 -> Rec Identity xs
87 -> Rec Identity xs
86 -> pq db0 db1 io (Maybe (Result ys))
88 -> pq db0 db1 io (Maybe (Result ys))
87
89
@@ -100,7 +102,7 @@ instance MonadPQ PQ where
100 result <- liftBase $ LibPQ.exec conn q
102 result <- liftBase $ LibPQ.exec conn q
101 return (Result <$> result, Connection conn)
103 return (Result <$> result, Connection conn)
102
104
103− pqExecParams (UnsafeStatement q :: Statement ps db0 db1 ys) params =
105+ pqExecParams (UnsafeStatement q :: Statement ps ys db0 db1) params =
104 PQ $ \ (Connection conn) -> do
106 PQ $ \ (Connection conn) -> do
105 let
107 let
106 params' =
108 params' =
@@ -113,7 +115,7 @@ instance MonadPQ PQ where
113 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
115 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
114 return (Result <$> result, Connection conn)
116 return (Result <$> result, Connection conn)
115
117
116− pqPrepare statementName (UnsafeStatement q :: Statement ps db0 db1 ys) =
118+ pqPrepare statementName (UnsafeStatement q :: Statement ps ys db0 db1) =
117 PQ $ \ (Connection conn) -> do
119 PQ $ \ (Connection conn) -> do
118 result <- liftBase $
120 result <- liftBase $
119 LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
121 LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
@@ -122,7 +124,7 @@ instance MonadPQ PQ where
122 , UnsafePreparedStatement statementName
124 , UnsafePreparedStatement statementName
123 ) , Connection conn )
125 ) , Connection conn )
124
126
125− pqExecPrepared (q :: PreparedStatement ps db0 db1 ys) params =
127+ pqExecPrepared (q :: PreparedStatement ps ys db0 db1) params =
126 PQ $ \ (Connection conn) -> do
128 PQ $ \ (Connection conn) -> do
127 let
129 let
128 params' =
130 params' =
@@ -181,27 +183,32 @@ newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
181
183
182newtype ColumnNumber cs c = ColumnNumber { unColumnNumber :: LibPQ.Column }
184newtype ColumnNumber cs c = ColumnNumber { unColumnNumber :: LibPQ.Column }
183
185
184−colNum0 :: ColumnNumber (c0:cs) c0
186+class KnownNat n => HasColumnNumber (n :: Nat) columns column
187+ | n columns -> column where
188+ colNum :: Proxy# n -> ColumnNumber columns column
185−colNum0 = ColumnNumber 0
189+ colNum p = ColumnNumber . fromIntegral $ natVal' p
190+instance {-# OVERLAPPING #-} HasColumnNumber 0 (column1:columns) column1
191+instance {-# OVERLAPPABLE #-}
192+ (KnownNat n, HasColumnNumber (n-1) columns column)
193+ => HasColumnNumber n (column' : columns) column
186
194
195+colNum0 :: ColumnNumber (c0:cs) c0
196+colNum0 = colNum (proxy# :: Proxy# 0)
187colNum1 :: ColumnNumber (c0:c1:cs) c1
197colNum1 :: ColumnNumber (c0:c1:cs) c1
188−colNum1 = ColumnNumber 1
198+colNum1 = colNum (proxy# :: Proxy# 1)
189−
190colNum2 :: ColumnNumber (c0:c1:c2:cs) c2
199colNum2 :: ColumnNumber (c0:c1:c2:cs) c2
191−colNum2 = ColumnNumber 2
200+colNum2 = colNum (proxy# :: Proxy# 2)
192−
193colNum3 :: ColumnNumber (c0:c1:c2:c3:cs) c3
201colNum3 :: ColumnNumber (c0:c1:c2:c3:cs) c3
194−colNum3 = ColumnNumber 3
202+colNum3 = colNum (proxy# :: Proxy# 3)
195−
196colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4
203colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4
197−colNum4 = ColumnNumber 4
204+colNum4 = colNum (proxy# :: Proxy# 4)
198
205
199getvalue
206getvalue
200 :: (FromValue x y, MonadBase IO io)
207 :: (FromValue x y, MonadBase IO io)
201− => Proxy# x
202− -> Result xs
208+ => Result xs
203 -> RowNumber
209 -> RowNumber
204 -> ColumnNumber xs x
210 -> ColumnNumber xs x
205 -> io (Maybe (Either Text y))
211 -> io (Maybe (Either Text y))
206−getvalue proxy (Result result) (RowNumber r) (ColumnNumber c) = liftBase $
212+getvalue (Result result) (RowNumber r) (ColumnNumber c :: ColumnNumber xs x) =
213+ liftBase $ fmap (fmap (decodeValue (proxy# :: Proxy# x)))
207− fmap (fmap (decodeValue proxy)) (LibPQ.getvalue result r c)
214+ (LibPQ.getvalue' result r c)
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+15−83
@@ -21,13 +21,12 @@ module Squeel.PostgreSQL.Schema
21 , (:::)
21 , (:::)
22 , Alias (Alias)
22 , Alias (Alias)
23 , Aliased (As)
23 , Aliased (As)
24− , KnownPGType (..)
25− , KnownColumns (..)
26 , renderAliased
24 , renderAliased
27 , NullityType (..)
25 , NullityType (..)
28− , NullifyType
26+ , NullifyColumn
29 , NullifyColumns
27 , NullifyColumns
30 , NullifyTable
28 , NullifyTable
29+ , ColumnType (..)
31 , module GHC.OverloadedLabels
30 , module GHC.OverloadedLabels
32 , module GHC.TypeLits
31 , module GHC.TypeLits
33 ) where
32 ) where
@@ -68,6 +67,13 @@ data PGType
68 | PGJsonb
67 | PGJsonb
69
68
70class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
69class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
70+--staticTypeInfo
71+instance ToOid ('NotNull 'PGBool) where toOid _ = LibPQ.Oid 16
72+instance ToOid ('NotNull 'PGBytea) where toOid _ = LibPQ.Oid 17
73+instance ToOid ('NotNull 'PGInt8) where toOid _ = LibPQ.Oid 20
74+instance ToOid ('NotNull 'PGInt2) where toOid _ = LibPQ.Oid 21
75+instance ToOid ('NotNull 'PGInt4) where toOid _ = LibPQ.Oid 23
76+instance ToOid ('NotNull 'PGText) where toOid _ = LibPQ.Oid 26
71class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
77class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
72instance ToOids '[] where toOids _ = []
78instance ToOids '[] where toOids _ = []
73instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
79instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
@@ -106,92 +112,18 @@ renderAliased
106renderAliased render (expression `As` Alias alias) =
112renderAliased render (expression `As` Alias alias) =
107 render expression <> " AS " <> fromString (symbolVal' alias)
113 render expression <> " AS " <> fromString (symbolVal' alias)
108
114
109−class KnownPGType (ty :: PGType) where
110− renderPGType :: Proxy# ty -> ByteString
111−instance KnownPGType 'PGBool where renderPGType _ = "bool"
112−instance KnownPGType 'PGInt2 where renderPGType _ = "int2"
113−instance KnownPGType 'PGInt4 where renderPGType _ = "int4"
114−instance KnownPGType 'PGInt8 where renderPGType _ = "int8"
115−instance KnownPGType 'PGNumeric where renderPGType _ = "numeric"
116−instance KnownPGType 'PGFloat4 where renderPGType _ = "float4"
117−instance KnownPGType 'PGFloat8 where renderPGType _ = "float8"
118−instance KnownPGType 'PGSerial2 where renderPGType _ = "serial2"
119−instance KnownPGType 'PGSerial4 where renderPGType _ = "serial4"
120−instance KnownPGType 'PGSerial8 where renderPGType _ = "serial8"
121−instance KnownPGType 'PGMoney where renderPGType _ = "money"
122−instance KnownNat n => KnownPGType ('PGChar n) where
123− renderPGType _ = "char("
124− <> fromString (show (natVal' (proxy# :: Proxy# n)))
125− <> ")"
126−instance KnownNat n => KnownPGType ('PGVarChar n) where
127− renderPGType _ = "varchar("
128− <> fromString (show (natVal' (proxy# :: Proxy# n)))
129− <> ")"
130−instance KnownPGType 'PGText where renderPGType _ = "text"
131−instance KnownPGType 'PGBytea where renderPGType _ = "bytea"
132−instance KnownPGType 'PGTimestamp where renderPGType _ = "timestamp"
133−instance KnownPGType 'PGTimestampTZ where renderPGType _ = "timestampTZ"
134−instance KnownPGType 'PGDate where renderPGType _ = "date"
135−instance KnownPGType 'PGTime where renderPGType _ = "time"
136−instance KnownPGType 'PGTimeTZ where renderPGType _ = "timeTZ"
137−instance KnownPGType 'PGInterval where renderPGType _ = "interval"
138−instance KnownPGType 'PGUuid where renderPGType _ = "uuid"
139−instance KnownPGType 'PGJson where renderPGType _ = "json"
140−instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
141−
142−class KnownColumns (columns :: [(Symbol,NullityType)]) where
143− renderColumns :: Proxy# columns -> ByteString
144−instance
145− ( KnownSymbol column
146− , KnownPGType ty
147− ) => KnownColumns '[column ::: 'NotNull ty] where
148− renderColumns _ =
149− fromString (symbolVal' (proxy# :: Proxy# column))
150− <> " "
151− <> renderPGType (proxy# :: Proxy# ty)
152− <> " NOT NULL"
153−instance
154− ( KnownSymbol column
155− , KnownPGType ty
156− ) => KnownColumns '[column ::: 'Null ty] where
157− renderColumns _ =
158− fromString (symbolVal' (proxy# :: Proxy# column))
159− <> " "
160− <> renderPGType (proxy# :: Proxy# ty)
161− <> " NULL"
162−instance
163− ( KnownSymbol column
164− , KnownPGType ty
165− , KnownColumns (columnsHead ': columnsTail)
166− ) => KnownColumns ((column ::: 'NotNull ty) ': columnsHead ': columnsTail) where
167− renderColumns _ =
168− fromString (symbolVal' (proxy# :: Proxy# column))
169− <> " "
170− <> renderPGType (proxy# :: Proxy# ty)
171− <> " NOT NULL, "
172− <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
173−instance
174− ( KnownSymbol column
175− , KnownPGType ty
176− , KnownColumns (columnsHead ': columnsTail)
177− ) => KnownColumns ((column ::: 'Null ty) ': columnsHead ': columnsTail) where
178− renderColumns _ =
179− fromString (symbolVal' (proxy# :: Proxy# column))
180− <> " "
181− <> renderPGType (proxy# :: Proxy# ty)
182− <> " NULL, "
183− <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
184−
185data NullityType = Null PGType | NotNull PGType
115data NullityType = Null PGType | NotNull PGType
186
116
187−type family NullifyType nullty where
117+data ColumnType = Optional NullityType | Required NullityType
188− NullifyType ('Null ty) = 'Null ty
118+
189− NullifyType ('NotNull ty) = 'Null ty
119+type family NullifyColumn (column :: ColumnType) where
120+ NullifyColumn (optionality ('Null ty)) = optionality ('Null ty)
121+ NullifyColumn (optionality ('NotNull ty)) = optionality ('Null ty)
190
122
191type family NullifyColumns columns where
123type family NullifyColumns columns where
192 NullifyColumns '[] = '[]
124 NullifyColumns '[] = '[]
193 NullifyColumns ((column ::: ty) ': columns) =
125 NullifyColumns ((column ::: ty) ': columns) =
194− (column ::: (NullifyType ty)) ': (NullifyColumns columns)
126+ (column ::: NullifyColumn ty) ': (NullifyColumns columns)
195
127
196type family NullifyTable table where
128type family NullifyTable table where
197 NullifyTable (table ::: columns) = table ::: NullifyColumns columns
129 NullifyTable (table ::: columns) = table ::: NullifyColumns columns
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+219−144
@@ -14,6 +14,7 @@
14
14
15module Squeel.PostgreSQL.Statement where
15module Squeel.PostgreSQL.Statement where
16
16
17+import Control.Category
17import Data.Boolean
18import Data.Boolean
18import Data.ByteString (ByteString)
19import Data.ByteString (ByteString)
19import Data.Maybe
20import Data.Maybe
@@ -24,16 +25,22 @@ import Data.Vinyl.Functor
24import GHC.Exts
25import GHC.Exts
25import GHC.OverloadedLabels
26import GHC.OverloadedLabels
26import GHC.TypeLits
27import GHC.TypeLits
28+import Prelude hiding (id,(.))
27
29
28import qualified Data.ByteString as ByteString
30import qualified Data.ByteString as ByteString
29
31
30import Squeel.PostgreSQL.Schema
32import Squeel.PostgreSQL.Schema
31
33
34+{-----------------------------------------
35+column expressions
36+-----------------------------------------}
37+
32newtype Expression
38newtype Expression
33− (params :: [NullityType])
39+ (params :: [ColumnType])
34− (tables :: [(Symbol,[(Symbol,NullityType)])])
40+ (tables :: [(Symbol,[(Symbol,ColumnType)])])
35− (ty :: NullityType)
41+ (ty :: ColumnType)
36− = UnsafeExpression { renderExpression :: ByteString }
42+ = UnsafeExpression { renderExpression :: ByteString }
43+ deriving (Show,Eq)
37
44
38class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
45class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
39 param :: Proxy# n -> Expression params tables ty
46 param :: Proxy# n -> Expression params tables ty
@@ -58,7 +65,7 @@ class KnownSymbol column => HasColumn column columns ty
58 getColumn :: Proxy# column -> Expression params '[table ::: columns] ty
65 getColumn :: Proxy# column -> Expression params '[table ::: columns] ty
59 getColumn column = UnsafeExpression $ fromString $ symbolVal' column
66 getColumn column = UnsafeExpression $ fromString $ symbolVal' column
60instance {-# OVERLAPPING #-} KnownSymbol column
67instance {-# OVERLAPPING #-} KnownSymbol column
61− => HasColumn column ((column ::: ty) ': tys) ty
68+ => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
62instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
69instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
63 => HasColumn column (ty' ': table) ty
70 => HasColumn column (ty' ': table) ty
64
71
@@ -66,14 +73,31 @@ instance (HasColumn column columns ty, tables ~ '[table ::: columns])
66 => IsLabel column (Expression params tables ty) where
73 => IsLabel column (Expression params tables ty) where
67 fromLabel = getColumn
74 fromLabel = getColumn
68
75
69−(.&.)
76+(&.)
70 :: (HasTable table tables columns, HasColumn column columns ty)
77 :: (HasTable table tables columns, HasColumn column columns ty)
71 => Alias table -> Alias column -> Expression params tables ty
78 => Alias table -> Alias column -> Expression params tables ty
72−Alias table .&. Alias column = UnsafeExpression $
79+Alias table &. Alias column = UnsafeExpression $
73 fromString (symbolVal' table)
80 fromString (symbolVal' table)
74 <> "." <>
81 <> "." <>
75 fromString (symbolVal' column)
82 fromString (symbolVal' column)
76
83
84+def :: Expression params '[] ('Optional (nullity ty))
85+def = UnsafeExpression "DEFAULT"
86+
87+null :: Expression params tables (optionality ('Null ty))
88+null = UnsafeExpression "NULL"
89+
90+coalesce
91+ :: [Expression params tables ('Required ('Null x))]
92+ -> Expression params tables ('Required ('NotNull x))
93+ -> Expression params tables ('Required ('NotNull x))
94+coalesce nulls isn'tNull = UnsafeExpression $ mconcat
95+ [ "COALESCE("
96+ , ByteString.intercalate ", " $ map renderExpression nulls
97+ , ", ", renderExpression isn'tNull
98+ , ")"
99+ ]
100+
77unsafeBinaryOp
101unsafeBinaryOp
78 :: ByteString
102 :: ByteString
79 -> Expression params tables ty0
103 -> Expression params tables ty0
@@ -96,7 +120,7 @@ unsafeFunction
96unsafeFunction fn x = UnsafeExpression $ mconcat
120unsafeFunction fn x = UnsafeExpression $ mconcat
97 [fn, "(", renderExpression x, ")"]
121 [fn, "(", renderExpression x, ")"]
98
122
99−instance PGNum ty => Num (Expression params tables (nullity ty)) where
123+instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where
100 (+) = unsafeBinaryOp "+"
124 (+) = unsafeBinaryOp "+"
101 (-) = unsafeBinaryOp "-"
125 (-) = unsafeBinaryOp "-"
102 (*) = unsafeBinaryOp "*"
126 (*) = unsafeBinaryOp "*"
@@ -104,7 +128,7 @@ instance PGNum ty => Num (Expression params tables (nullity ty)) where
104 signum = unsafeFunction "sign"
128 signum = unsafeFunction "sign"
105 fromInteger = UnsafeExpression . fromString . show
129 fromInteger = UnsafeExpression . fromString . show
106
130
107−instance IsString (Expression params tables (nullity 'PGText)) where
131+instance IsString (Expression params tables ('Required (nullity 'PGText))) where
108 fromString str = UnsafeExpression $
132 fromString str = UnsafeExpression $
109 "E\'" <> fromString (escape =<< str) <> "\'"
133 "E\'" <> fromString (escape =<< str) <> "\'"
110 where
134 where
@@ -119,7 +143,7 @@ instance IsString (Expression params tables (nullity 'PGText)) where
119 '\\' -> "\\\\"
143 '\\' -> "\\\\"
120 c -> [c]
144 c -> [c]
121
145
122−instance Boolean (Expression params tables ('NotNull 'PGBool)) where
146+instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
123 true = UnsafeExpression "TRUE"
147 true = UnsafeExpression "TRUE"
124 false = UnsafeExpression "FALSE"
148 false = UnsafeExpression "FALSE"
125 notB = unsafeUnaryOp "NOT"
149 notB = unsafeUnaryOp "NOT"
@@ -127,21 +151,10 @@ instance Boolean (Expression params tables ('NotNull 'PGBool)) where
127 (||*) = unsafeBinaryOp "OR"
151 (||*) = unsafeBinaryOp "OR"
128
152
129type instance BooleanOf (Expression params tables ty) =
153type instance BooleanOf (Expression params tables ty) =
130− Expression params tables ('NotNull 'PGBool)
154+ Expression params tables ('Required ('NotNull 'PGBool))
131−
132−coalesce
133− :: [Expression params tables ('Null x)]
134− -> Expression params tables ('NotNull x)
135− -> Expression params tables ('NotNull x)
136−coalesce nulls notNull = UnsafeExpression $ mconcat
137− [ "COALESCE("
138− , ByteString.intercalate ", " $ map renderExpression nulls
139− , ", ", renderExpression notNull
140− , ")"
141− ]
142
155
143caseWhenThenElse
156caseWhenThenElse
144− :: [(Expression params tables ('NotNull 'PGBool), Expression params tables ty)]
157+ :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
145 -> Expression params tables ty
158 -> Expression params tables ty
146 -> Expression params tables ty
159 -> Expression params tables ty
147caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
160caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -160,115 +173,149 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
160instance IfB (Expression params tables ty) where
173instance IfB (Expression params tables ty) where
161 ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
174 ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
162
175
163−instance EqB (Expression params tables ty) where
176+instance EqB (Expression params tables (optionality ('NotNull ty))) where
164 (==*) = unsafeBinaryOp "="
177 (==*) = unsafeBinaryOp "="
165 (/=*) = unsafeBinaryOp "<>"
178 (/=*) = unsafeBinaryOp "<>"
166
179
167−instance OrdB (Expression params tables ty) where
180+instance OrdB (Expression params tables (optionality ('NotNull ty))) where
168 (>*) = unsafeBinaryOp ">"
181 (>*) = unsafeBinaryOp ">"
169 (>=*) = unsafeBinaryOp ">="
182 (>=*) = unsafeBinaryOp ">="
170 (<*) = unsafeBinaryOp "<"
183 (<*) = unsafeBinaryOp "<"
171 (<=*) = unsafeBinaryOp "<="
184 (<=*) = unsafeBinaryOp "<="
172
185
186+{-----------------------------------------
187+table expressions
188+-----------------------------------------}
189+
173newtype TableExpression
190newtype TableExpression
174− (params :: [NullityType])
191+ (params :: [ColumnType])
175− (schema :: [(Symbol,[(Symbol,NullityType)])])
192+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
176− (columns :: [(Symbol,NullityType)])
193+ (columns :: [(Symbol,ColumnType)])
177 = UnsafeTableExpression { renderTableExpression :: ByteString }
194 = UnsafeTableExpression { renderTableExpression :: ByteString }
195+ deriving (Show,Eq)
196+
197+class KnownSymbol table => HasTable table tables columns
198+ | table tables -> columns where
199+ getTable :: Proxy# table -> TableExpression params tables columns
200+ getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
201+instance {-# OVERLAPPING #-} KnownSymbol table
202+ => HasTable table ((table ::: columns) ': tables) columns
203+instance {-# OVERLAPPABLE #-}
204+ (KnownSymbol table, HasTable table schema columns)
205+ => HasTable table (table' ': schema) columns
206+
207+instance HasTable table schema columns
208+ => IsLabel table (TableExpression params schema columns) where
209+ fromLabel = getTable
210+
211+{-----------------------------------------
212+statements
213+-----------------------------------------}
214+
215+newtype Statement
216+ (params :: [ColumnType])
217+ (columns :: [(Symbol,ColumnType)])
218+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
219+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
220+ = UnsafeStatement { renderStatement :: ByteString }
221+ deriving (Show,Eq)
222+
223+instance Category (Statement '[] '[]) where
224+ id = UnsafeStatement ";"
225+ statement2 . statement1 = UnsafeStatement $
226+ renderStatement statement1 <> " " <> renderStatement statement2
227+
228+newtype PreparedStatement
229+ (params :: [ColumnType])
230+ (columns :: [(Symbol,ColumnType)])
231+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
232+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
233+ = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
234+ deriving (Show,Eq)
178
235
236+{-----------------------------------------
237+SELECT statements
238+-----------------------------------------}
239+
179−data JoinExpression params schema tables where
240+data Join params schema tables where
180 Table
241 Table
181 :: Aliased (TableExpression params schema) table
242 :: Aliased (TableExpression params schema) table
182− -> JoinExpression params schema '[table]
243+ -> Join params schema '[table]
183 Subselect
244 Subselect
184 :: Aliased (Selection params schema) table
245 :: Aliased (Selection params schema) table
185− -> JoinExpression params schema '[table]
246+ -> Join params schema '[table]
186 Cross
247 Cross
187 :: Aliased (TableExpression params schema) table
248 :: Aliased (TableExpression params schema) table
188− -> JoinExpression params schema tables
249+ -> Join params schema tables
189− -> JoinExpression params schema (table ': tables)
250+ -> Join params schema (table ': tables)
190 Inner
251 Inner
191 :: Aliased (TableExpression params schema) table
252 :: Aliased (TableExpression params schema) table
192− -> Expression params (table ': tables) ('NotNull 'PGBool)
253+ -> Expression params (table ': tables) ('Required ('NotNull 'PGBool))
193− -> JoinExpression params schema tables
254+ -> Join params schema tables
194− -> JoinExpression params schema (table ': tables)
255+ -> Join params schema (table ': tables)
195 LeftOuter
256 LeftOuter
196 :: Aliased (TableExpression params schema) right
257 :: Aliased (TableExpression params schema) right
197− -> Expression params '[left,right] ('NotNull 'PGBool)
258+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
198− -> JoinExpression params schema (tables)
259+ -> Join params schema (tables)
199− -> JoinExpression params schema (NullifyTable right ': left ': tables)
260+ -> Join params schema (NullifyTable right ': left ': tables)
200 RightOuter
261 RightOuter
201 :: Aliased (TableExpression params schema) right
262 :: Aliased (TableExpression params schema) right
202− -> Expression params '[left,right] ('NotNull 'PGBool)
263+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
203− -> JoinExpression params schema (left : tables)
264+ -> Join params schema (left : tables)
204− -> JoinExpression params schema (right ': NullifyTable left ': tables)
265+ -> Join params schema (right ': NullifyTable left ': tables)
205 FullOuter
266 FullOuter
206 :: Aliased (TableExpression params schema) right
267 :: Aliased (TableExpression params schema) right
207− -> Expression params '[left,right] ('NotNull 'PGBool)
268+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
208− -> JoinExpression params schema (left : tables)
269+ -> Join params schema (left : tables)
209− -> JoinExpression params schema
270+ -> Join params schema
210 (NullifyTable right ': NullifyTable left ': tables)
271 (NullifyTable right ': NullifyTable left ': tables)
211
272
212−renderJoinExpression :: JoinExpression params schema tables -> ByteString
273+renderJoin :: Join params schema tables -> ByteString
213−renderJoinExpression = \case
274+renderJoin = \case
214 Table table -> renderAliased renderTableExpression table
275 Table table -> renderAliased renderTableExpression table
215 Subselect selection -> "SELECT " <> renderAliased renderSelection selection
276 Subselect selection -> "SELECT " <> renderAliased renderSelection selection
216 Cross table tables -> mconcat
277 Cross table tables -> mconcat
217− [ renderJoinExpression tables
278+ [ renderJoin tables
218 , " CROSS JOIN "
279 , " CROSS JOIN "
219 , renderAliased renderTableExpression table
280 , renderAliased renderTableExpression table
220 ]
281 ]
221 Inner table on tables -> mconcat
282 Inner table on tables -> mconcat
222− [ renderJoinExpression tables
283+ [ renderJoin tables
223 , " INNER JOIN "
284 , " INNER JOIN "
224 , renderAliased renderTableExpression table
285 , renderAliased renderTableExpression table
225 , " ON "
286 , " ON "
226 , renderExpression on
287 , renderExpression on
227 ]
288 ]
228 LeftOuter table on tables -> mconcat
289 LeftOuter table on tables -> mconcat
229− [ renderJoinExpression tables
290+ [ renderJoin tables
230 , " LEFT OUTER JOIN "
291 , " LEFT OUTER JOIN "
231 , renderAliased renderTableExpression table
292 , renderAliased renderTableExpression table
232 , " ON "
293 , " ON "
233 , renderExpression on
294 , renderExpression on
234 ]
295 ]
235 RightOuter table on tables -> mconcat
296 RightOuter table on tables -> mconcat
236− [ renderJoinExpression tables
297+ [ renderJoin tables
237 , " RIGHT OUTER JOIN "
298 , " RIGHT OUTER JOIN "
238 , renderAliased renderTableExpression table
299 , renderAliased renderTableExpression table
239 , " ON "
300 , " ON "
240 , renderExpression on
301 , renderExpression on
241 ]
302 ]
242 FullOuter table on tables -> mconcat
303 FullOuter table on tables -> mconcat
243− [ renderJoinExpression tables
304+ [ renderJoin tables
244 , " FULL OUTER JOIN "
305 , " FULL OUTER JOIN "
245 , renderAliased renderTableExpression table
306 , renderAliased renderTableExpression table
246 , " ON "
307 , " ON "
247 , renderExpression on
308 , renderExpression on
248 ]
309 ]
249
310
250−class KnownSymbol table => HasTable table tables columns
251− | table tables -> columns where
252− getTable :: Proxy# table -> TableExpression params tables columns
253− getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
254−instance {-# OVERLAPPING #-} KnownSymbol table
255− => HasTable table ((table ::: columns) ': tables) columns
256−instance {-# OVERLAPPABLE #-}
257− (KnownSymbol table, HasTable table schema columns)
258− => HasTable table (table' ': schema) columns
259−
260instance HasTable table schema columns
311instance HasTable table schema columns
261− => IsLabel table (TableExpression params schema columns) where
262− fromLabel = getTable
263−
264−instance HasTable table schema columns
265− => IsLabel table (JoinExpression params schema '[table ::: columns]) where
312+ => IsLabel table (Join params schema '[table ::: columns]) where
266 fromLabel p = Table $ fromLabel p
313 fromLabel p = Table $ fromLabel p
267
314
268data Clauses params tables = Clauses
315data Clauses params tables = Clauses
269− { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))
316+ { whereClause :: Maybe (Expression params tables ('Required ('NotNull 'PGBool)))
270− , limitClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
317+ , limitClause :: Maybe (Expression params '[] ('Required ('NotNull 'PGInt8)))
271− , offsetClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
318+ , offsetClause :: Maybe (Expression params '[] ('Required ('NotNull 'PGInt8)))
272 }
319 }
273
320
274instance Monoid (Clauses params tables) where
321instance Monoid (Clauses params tables) where
@@ -291,124 +338,108 @@ instance Monoid (Clauses params tables) where
291 (Just o1,Just o2) -> Just (o1 + o2)
338 (Just o1,Just o2) -> Just (o1 + o2)
292 }
339 }
293
340
294−data FromExpression
341+data From
295− (params :: [NullityType])
342+ (params :: [ColumnType])
296− (schema :: [(Symbol,[(Symbol,NullityType)])])
343+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
297− (tables :: [(Symbol,[(Symbol,NullityType)])])
344+ (tables :: [(Symbol,[(Symbol,ColumnType)])])
298− = FromExpression
345+ = From
299− { joinExpression :: JoinExpression params schema tables
346+ { fromJoin :: Join params schema tables
300− , clauses :: Clauses params tables
347+ , fromClauses :: Clauses params tables
301 }
348 }
302
349
303join
350join
304− :: JoinExpression params schema tables
351+ :: Join params schema tables
305− -> FromExpression params schema tables
352+ -> From params schema tables
306−join tref = FromExpression tref mempty
353+join tables = From tables mempty
307
354
308−renderFromExpression :: FromExpression params schema tables -> ByteString
355+renderFrom :: From params schema tables -> ByteString
309−renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat
356+renderFrom (From tref (Clauses wh lim off))= mconcat
310− [ renderJoinExpression tref
357+ [ renderJoin tref
311 , maybe "" ((" WHERE " <>) . renderExpression) wh
358 , maybe "" ((" WHERE " <>) . renderExpression) wh
312 , maybe "" ((" LIMIT " <>) . renderExpression) lim
359 , maybe "" ((" LIMIT " <>) . renderExpression) lim
313 , maybe "" ((" OFFSET " <>) . renderExpression) off
360 , maybe "" ((" OFFSET " <>) . renderExpression) off
314 ]
361 ]
315
362
316instance (HasTable table schema columns, table ~ table')
363instance (HasTable table schema columns, table ~ table')
317− => IsLabel table (FromExpression params schema '[table' ::: columns]) where
364+ => IsLabel table (From params schema '[table' ::: columns]) where
318− fromLabel p = FromExpression (fromLabel p) mempty
365+ fromLabel p = From (fromLabel p) mempty
319
366
320where_
367where_
321− :: Expression params tables ('NotNull 'PGBool)
368+ :: Expression params tables ('Required ('NotNull 'PGBool))
322− -> FromExpression params schema tables
369+ -> From params schema tables
323− -> FromExpression params schema tables
370+ -> From params schema tables
324−where_ wh (FromExpression tabs clauses1) = FromExpression tabs
371+where_ wh (From tabs fromClauses1) = From tabs
325− (clauses1 <> Clauses (Just wh) Nothing Nothing)
372+ (fromClauses1 <> Clauses (Just wh) Nothing Nothing)
326
373
327limit
374limit
328− :: Expression params '[] ('NotNull 'PGInt8)
375+ :: Expression params '[] ('Required ('NotNull 'PGInt8))
329− -> FromExpression params schema tables
376+ -> From params schema tables
330− -> FromExpression params schema tables
377+ -> From params schema tables
331−limit lim (FromExpression tabs clauses1) = FromExpression tabs
378+limit lim (From tabs fromClauses1) = From tabs
332− (clauses1 <> Clauses Nothing (Just lim) Nothing)
379+ (fromClauses1 <> Clauses Nothing (Just lim) Nothing)
333
380
334offset
381offset
335− :: Expression params '[] ('NotNull 'PGInt8)
382+ :: Expression params '[] ('Required ('NotNull 'PGInt8))
336− -> FromExpression params schema tables
383+ -> From params schema tables
337− -> FromExpression params schema tables
384+ -> From params schema tables
338−offset off (FromExpression tabs clauses1) = FromExpression tabs
385+offset off (From tabs fromClauses1) = From tabs
339− (clauses1 <> Clauses Nothing Nothing (Just off))
386+ (fromClauses1 <> Clauses Nothing Nothing (Just off))
340
387
341newtype Selection
388newtype Selection
342− (params :: [NullityType])
389+ (params :: [ColumnType])
343− (schema :: [(Symbol,[(Symbol,NullityType)])])
390+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
344− (columns :: [(Symbol,NullityType)])
391+ (columns :: [(Symbol,ColumnType)])
345 = UnsafeSelection { renderSelection :: ByteString }
392 = UnsafeSelection { renderSelection :: ByteString }
393+ deriving (Show,Eq)
346
394
347starFrom
395starFrom
348 :: tables ~ '[table ::: columns]
396 :: tables ~ '[table ::: columns]
349− => FromExpression params schema tables
397+ => From params schema tables
350 -> Selection params schema columns
398 -> Selection params schema columns
351−starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs
399+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFrom tabs
352
400
353dotStarFrom
401dotStarFrom
354 :: HasTable table tables columns
402 :: HasTable table tables columns
355 => Alias table
403 => Alias table
356− -> FromExpression params schema tables
404+ -> From params schema tables
357 -> Selection params schema columns
405 -> Selection params schema columns
358Alias tab `dotStarFrom` tabs = UnsafeSelection $
406Alias tab `dotStarFrom` tabs = UnsafeSelection $
359− fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs
407+ fromString (symbolVal' tab) <> ".* FROM " <> renderFrom tabs
360
408
361from
409from
362 :: Rec (Aliased (Expression params tables)) columns
410 :: Rec (Aliased (Expression params tables)) columns
363− -> FromExpression params schema tables
411+ -> From params schema tables
364 -> Selection params schema columns
412 -> Selection params schema columns
365list `from` tabs = UnsafeSelection $
413list `from` tabs = UnsafeSelection $
366− renderList list <> " FROM " <> renderFromExpression tabs
414+ renderList list <> " FROM " <> renderFrom tabs
367 where
415 where
368 renderList
416 renderList
369 = ByteString.intercalate ", "
417 = ByteString.intercalate ", "
370 . recordToList
418 . recordToList
371 . rmap (Const . renderAliased renderExpression)
419 . rmap (Const . renderAliased renderExpression)
372
420
373−newtype Statement
374− (params :: [NullityType])
375− (schema0 :: [(Symbol,[(Symbol,NullityType)])])
376− (schema1 :: [(Symbol,[(Symbol,NullityType)])])
377− (columns :: [(Symbol,NullityType)])
378− = UnsafeStatement { renderStatement :: ByteString }
379−
380−(.>>.)
381− :: Statement params schema0 schema1 '[]
382− -> Statement params schema1 schema2 results
383− -> Statement params schema0 schema2 results
384−statement1 .>>. statement2 = UnsafeStatement $
385− renderStatement statement1 <> " " <> renderStatement statement2
386−
387−newtype PreparedStatement
388− (params :: [NullityType])
389− (schema0 :: [(Symbol,[(Symbol,NullityType)])])
390− (schema1 :: [(Symbol,[(Symbol,NullityType)])])
391− (columns :: [(Symbol,NullityType)])
392− = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
393−
394select
421select
395 :: Selection params schema columns
422 :: Selection params schema columns
396− -> Statement params schema schema columns
423+ -> Statement params columns schema schema
397select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
424select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
398
425
399subselect
426subselect
400 :: Aliased (Selection params schema) table
427 :: Aliased (Selection params schema) table
401− -> FromExpression params schema '[table]
428+ -> From params schema '[table]
402−subselect selection = FromExpression
429+subselect selection = From
403− { joinExpression = Subselect selection
430+ { fromJoin = Subselect selection
404− , clauses = mempty
431+ , fromClauses = mempty
405 }
432 }
406
433
434+{-----------------------------------------
435+INSERT statements
436+-----------------------------------------}
437+
407insertInto
438insertInto
408 :: HasTable table schema columns
439 :: HasTable table schema columns
409 => Alias table
440 => Alias table
410 -> Rec (Aliased (Expression params '[])) columns
441 -> Rec (Aliased (Expression params '[])) columns
411− -> Statement params schema schema '[]
442+ -> Statement params '[] schema schema
412insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
443insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
413 <> fromString (symbolVal' table)
444 <> fromString (symbolVal' table)
414 <> " (" <> ByteString.intercalate ", " aliases
445 <> " (" <> ByteString.intercalate ", " aliases
@@ -423,22 +454,62 @@ insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
423 (\ (expression `As` _) -> Const (renderExpression expression))
454 (\ (expression `As` _) -> Const (renderExpression expression))
424 expressions
455 expressions
425
456
457+{-----------------------------------------
458+CREATE statements
459+-----------------------------------------}
460+
461+newtype TypeExpression (ty :: ColumnType)
462+ = UnsafeTypeExpression { renderTypeExpression :: ByteString }
463+ deriving (Show,Eq)
464+
465+int2 :: TypeExpression ('Required ('Null 'PGInt2))
466+int2 = UnsafeTypeExpression "int2"
467+int4 :: TypeExpression ('Required ('Null 'PGInt4))
468+int4 = UnsafeTypeExpression "int4"
469+int8 :: TypeExpression ('Required ('Null 'PGInt8))
470+int8 = UnsafeTypeExpression "int8"
471+bool :: TypeExpression ('Required ('Null 'PGBool))
472+bool = UnsafeTypeExpression "bool"
473+text :: TypeExpression ('Required ('Null 'PGText))
474+text = UnsafeTypeExpression "text"
475+notNull
476+ :: TypeExpression ('Required ('Null ty))
477+ -> TypeExpression ('Required ('NotNull ty))
478+notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <> " NOT NULL"
479+default_
480+ :: Expression '[] '[] ('Required ty)
481+ -> TypeExpression ('Required ty)
482+ -> TypeExpression ('Optional ty)
483+default_ x ty = UnsafeTypeExpression $
484+ renderTypeExpression ty <> " DEFAULT " <> renderExpression x
485+serial :: TypeExpression ('Optional ('NotNull 'PGInt4))
486+serial = UnsafeTypeExpression "serial"
487+
426createTable
488createTable
427− :: (KnownSymbol table, KnownColumns columns)
489+ :: KnownSymbol table
428− => Alias table
490+ => Alias table
429− -> Proxy# columns
491+ -> Rec (Aliased TypeExpression) columns
430− -> Statement '[] schema ((table ::: columns) ': schema) '[]
492+ -> Statement '[] '[] schema ((table ::: columns) ': schema)
431createTable (Alias table) columns = UnsafeStatement $ mconcat
493createTable (Alias table) columns = UnsafeStatement $ mconcat
432 [ "CREATE TABLE "
494 [ "CREATE TABLE "
433 , fromString $ symbolVal' table
495 , fromString $ symbolVal' table
434 , " ("
496 , " ("
435− , renderColumns columns
497+ , ByteString.intercalate ", " . recordToList $
498+ rmap (Const . renderColumn) columns
436 , ");"
499 , ");"
437 ]
500 ]
501+ where
502+ renderColumn :: Aliased TypeExpression x -> ByteString
503+ renderColumn (ty `As` Alias column) =
504+ fromString (symbolVal' column) <> " " <> renderTypeExpression ty
505+
506+{-----------------------------------------
507+DROP statements
508+-----------------------------------------}
438
509
439class KnownSymbol table => DropTable table schema0 schema1
510class KnownSymbol table => DropTable table schema0 schema1
440 | table schema0 -> schema1 where
511 | table schema0 -> schema1 where
441− dropTable :: Alias table -> Statement '[] schema0 schema1 '[]
512+ dropTable :: Alias table -> Statement '[] '[] schema0 schema1
442 dropTable (Alias table) = UnsafeStatement $
513 dropTable (Alias table) = UnsafeStatement $
443 "DROP TABLE " <> fromString (symbolVal' table) <> ";"
514 "DROP TABLE " <> fromString (symbolVal' table) <> ";"
444instance {-# OVERLAPPING #-}
515instance {-# OVERLAPPING #-}
@@ -448,6 +519,10 @@ instance {-# OVERLAPPABLE #-}
448 (KnownSymbol table, DropTable table schema0 schema1)
519 (KnownSymbol table, DropTable table schema0 schema1)
449 => DropTable table (tabCols ': schema0) (tabCols ': schema1)
520 => DropTable table (tabCols ': schema0) (tabCols ': schema1)
450
521
522+{-----------------------------------------
523+UPDATE statements
524+-----------------------------------------}
525+
451set :: g x -> (Maybe `Compose` g) x
526set :: g x -> (Maybe `Compose` g) x
452set = Compose . Just
527set = Compose . Just
453
528
@@ -458,8 +533,8 @@ update
458 :: HasTable table schema columns
533 :: HasTable table schema columns
459 => Alias table
534 => Alias table
460 -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
535 -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
461− -> Expression params '[table ::: columns] ('NotNull 'PGBool)
536+ -> Expression params '[table ::: columns] ('Required ('NotNull 'PGBool))
462− -> Statement params schema schema '[]
537+ -> Statement params '[] schema schema
463update (Alias table) columns where' = UnsafeStatement $ mconcat
538update (Alias table) columns where' = UnsafeStatement $ mconcat
464 [ "UPDATE "
539 [ "UPDATE "
465 , fromString $ symbolVal' table
540 , fromString $ symbolVal' table
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+58−44
@@ -11,7 +11,6 @@ module Squeel.PostgreSQL.StatementSpec where
11import Data.Boolean
11import Data.Boolean
12import Data.Function
12import Data.Function
13import Data.Vinyl
13import Data.Vinyl
14−import GHC.Exts
15import Test.Hspec
14import Test.Hspec
16
15
17import Squeel.PostgreSQL.Statement
16import Squeel.PostgreSQL.Statement
@@ -23,7 +22,7 @@ spec = do
23 query `shouldRenderAs` str = renderStatement query `shouldBe` str
22 query `shouldRenderAs` str = renderStatement query `shouldBe` str
24 it "correctly renders a simple SELECT query" $ do
23 it "correctly renders a simple SELECT query" $ do
25 let
24 let
26− statement :: Statement '[] Tables Tables SumAndCol1
25+ statement :: Statement '[] SumAndCol1 Tables Tables
27 statement = select $
26 statement = select $
28 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
27 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
29 `from` (#table1 & where_ true)
28 `from` (#table1 & where_ true)
@@ -31,7 +30,7 @@ spec = do
31 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE TRUE;"
30 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE TRUE;"
32 it "combines WHEREs using AND" $ do
31 it "combines WHEREs using AND" $ do
33 let
32 let
34− statement :: Statement '[] Tables Tables SumAndCol1
33+ statement :: Statement '[] SumAndCol1 Tables Tables
35 statement = select $
34 statement = select $
36 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
35 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
37 `from` (#table1 & where_ true & where_ false)
36 `from` (#table1 & where_ true & where_ false)
@@ -40,45 +39,45 @@ spec = do
40 it "performs sub SELECTs" $ do
39 it "performs sub SELECTs" $ do
41 let
40 let
42 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1
41 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1
43− statement :: Statement '[] Tables Tables SumAndCol1
42+ statement :: Statement '[] SumAndCol1 Tables Tables
44 statement = select $ starFrom (subselect (selection `As` #sub))
43 statement = select $ starFrom (subselect (selection `As` #sub))
45 statement `shouldRenderAs`
44 statement `shouldRenderAs`
46 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
45 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
47 it "does LIMIT clauses" $ do
46 it "does LIMIT clauses" $ do
48 let
47 let
49− statement :: Statement '[] Tables Tables Columns
48+ statement :: Statement '[] Columns Tables Tables
50 statement = select $ starFrom (#table1 & limit 1)
49 statement = select $ starFrom (#table1 & limit 1)
51 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"
50 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"
52 it "should use the minimum of given LIMITs" $ do
51 it "should use the minimum of given LIMITs" $ do
53 let
52 let
54− statement :: Statement '[] Tables Tables Columns
53+ statement :: Statement '[] Columns Tables Tables
55 statement = select $ starFrom (#table1 & limit 1 & limit 2)
54 statement = select $ starFrom (#table1 & limit 1 & limit 2)
56 statement `shouldRenderAs`
55 statement `shouldRenderAs`
57 "SELECT * FROM table1 AS table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"
56 "SELECT * FROM table1 AS table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"
58 it "should render parameters using $ signs" $ do
57 it "should render parameters using $ signs" $ do
59 let
58 let
60− statement :: Statement '[ 'NotNull 'PGInt8] Tables Tables Columns
59+ statement :: Statement '[ 'Required ('NotNull 'PGInt8)] Columns Tables Tables
61 statement = select $ starFrom (#table1 & limit param1)
60 statement = select $ starFrom (#table1 & limit param1)
62 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
61 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
63 it "does OFFSET clauses" $ do
62 it "does OFFSET clauses" $ do
64 let
63 let
65− statement :: Statement '[] Tables Tables Columns
64+ statement :: Statement '[] Columns Tables Tables
66 statement = select $ starFrom (#table1 & offset 1)
65 statement = select $ starFrom (#table1 & offset 1)
67 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"
66 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"
68 it "should use the sum of given OFFSETs" $ do
67 it "should use the sum of given OFFSETs" $ do
69 let
68 let
70− statement :: Statement '[] Tables Tables Columns
69+ statement :: Statement '[] Columns Tables Tables
71 statement = select $ starFrom (#table1 & offset 1 & offset 2)
70 statement = select $ starFrom (#table1 & offset 1 & offset 2)
72 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1 + 2);"
71 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1 + 2);"
73 it "correctly render simple INSERTs" $ do
72 it "correctly render simple INSERTs" $ do
74 let
73 let
75− statement :: Statement '[] Tables Tables '[]
74+ statement :: Statement '[] '[] Tables Tables
76 statement = insertInto #table1 $ 2 `As` #col1 :& 4 `As` #col2 :& RNil
75 statement = insertInto #table1 $ 2 `As` #col1 :& 4 `As` #col2 :& RNil
77 statement `shouldRenderAs`
76 statement `shouldRenderAs`
78 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
77 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
79 it "should be safe against SQL injection in literal text" $ do
78 it "should be safe against SQL injection in literal text" $ do
80 let
79 let
81− statement :: Statement '[] StudentsTable StudentsTable '[]
80+ statement :: Statement '[] '[] StudentsTable StudentsTable
82 statement = insertInto #students $
81 statement = insertInto #students $
83 "Robert'); DROP TABLE students;" `As` #name :& RNil
82 "Robert'); DROP TABLE students;" `As` #name :& RNil
84 statement `shouldRenderAs`
83 statement `shouldRenderAs`
@@ -86,12 +85,12 @@ spec = do
86 describe "JOINs" $ do
85 describe "JOINs" $ do
87 let
86 let
88 vals =
87 vals =
89− #orders .&. #orderVal `As` #orderVal
88+ #orders &. #orderVal `As` #orderVal
90− :& #customers .&. #customerVal `As` #customerVal
89+ :& #customers &. #customerVal `As` #customerVal
91− :& #shippers .&. #shipperVal `As` #shipperVal :& RNil
90+ :& #shippers &. #shipperVal `As` #shipperVal :& RNil
92 it "should render CROSS JOINs" $ do
91 it "should render CROSS JOINs" $ do
93 let
92 let
94− statement :: Statement '[] JoinTables JoinTables ValueColumns
93+ statement :: Statement '[] ValueColumns JoinTables JoinTables
95 statement = select $ vals `from`
94 statement = select $ vals `from`
96 (join (#orders & Cross #customers & Cross #shippers))
95 (join (#orders & Cross #customers & Cross #shippers))
97 statement `shouldRenderAs`
96 statement `shouldRenderAs`
@@ -104,14 +103,14 @@ spec = do
104 \ CROSS JOIN shippers AS shippers;"
103 \ CROSS JOIN shippers AS shippers;"
105 it "should render INNER JOINs" $ do
104 it "should render INNER JOINs" $ do
106 let
105 let
107− innerJoins :: FromExpression '[] JoinTables JoinTables
106+ innerJoins :: From '[] JoinTables JoinTables
108 innerJoins = join $
107 innerJoins = join $
109 #orders
108 #orders
110 & Inner #customers
109 & Inner #customers
111− (#orders .&. #customerID ==* #customers .&. #customerID)
110+ (#orders &. #customerID ==* #customers &. #customerID)
112 & Inner #shippers
111 & Inner #shippers
113− (#orders .&. #shipperID ==* #shippers .&. #shipperID)
112+ (#orders &. #shipperID ==* #shippers &. #shipperID)
114− selection :: Statement '[] JoinTables JoinTables ValueColumns
113+ selection :: Statement '[] ValueColumns JoinTables JoinTables
115 selection = select $ vals `from` innerJoins
114 selection = select $ vals `from` innerJoins
116 selection `shouldRenderAs`
115 selection `shouldRenderAs`
117 "SELECT\
116 "SELECT\
@@ -125,7 +124,7 @@ spec = do
125 \ ON (orders.shipperID = shippers.shipperID);"
124 \ ON (orders.shipperID = shippers.shipperID);"
126 it "should render self JOINs" $ do
125 it "should render self JOINs" $ do
127 let
126 let
128− statement :: Statement '[] JoinTables JoinTables OrderColumns
127+ statement :: Statement '[] OrderColumns JoinTables JoinTables
129 statement = select $ #orders1 `dotStarFrom`
128 statement = select $ #orders1 `dotStarFrom`
130 (join (Table (#orders `As` #orders1)
129 (join (Table (#orders `As` #orders1)
131 & Cross (#orders `As` #orders2)))
130 & Cross (#orders `As` #orders2)))
@@ -133,40 +132,55 @@ spec = do
133 "SELECT orders1.*\
132 "SELECT orders1.*\
134 \ FROM orders AS orders1\
133 \ FROM orders AS orders1\
135 \ CROSS JOIN orders AS orders2;"
134 \ CROSS JOIN orders AS orders2;"
136− it "should render simple CREATE TABLE statements" $ do
135+ it "should render CREATE TABLE statements" $ do
137− let
138− statement :: Statement '[] '[] Tables '[]
139− statement = createTable #table1 (proxy# :: Proxy# Columns)
136+ createTable #table1
137+ ( (int4 & notNull) `As` #col1
138+ :& (int4 & notNull) `As` #col2
139+ :& RNil)
140− statement `shouldRenderAs`
140+ `shouldRenderAs`
141 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
141 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
142+ createTable #table2
143+ ( serial `As` #col1
144+ :& text `As` #col2
145+ :& (int8 & notNull & default_ 8) `As` #col3
146+ :& RNil)
147+ `shouldRenderAs`
148+ "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"
142 it "should render DROP TABLE statements" $ do
149 it "should render DROP TABLE statements" $ do
143 let
150 let
144− statement :: Statement '[] Tables '[] '[]
151+ statement :: Statement '[] '[] Tables '[]
145 statement = dropTable #table1
152 statement = dropTable #table1
146 statement `shouldRenderAs` "DROP TABLE table1;"
153 statement `shouldRenderAs` "DROP TABLE table1;"
147
154
155+type Columns =
148−type Columns = '[ "col1" ::: 'NotNull 'PGInt4, "col2" ::: 'NotNull 'PGInt4]
156+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
157+ , "col2" ::: 'Required ('NotNull 'PGInt4)
158+ ]
149type Tables = '[ "table1" ::: Columns ]
159type Tables = '[ "table1" ::: Columns ]
150−type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
160+type SumAndCol1 = '[ "sum" ::: 'Required ('NotNull 'PGInt4), "col1" ::: 'Required ('NotNull 'PGInt4)]
151−type StudentsColumns = '["name" ::: 'NotNull 'PGText]
161+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
152type StudentsTable = '["students" ::: StudentsColumns]
162type StudentsTable = '["students" ::: StudentsColumns]
153type OrderColumns =
163type OrderColumns =
154− [ "orderID" ::: 'NotNull 'PGInt4
164+ '[ "orderID" ::: 'Required ('NotNull 'PGInt4)
155− , "orderVal" ::: 'NotNull 'PGText
165+ , "orderVal" ::: 'Required ('NotNull 'PGText)
156− , "customerID" ::: 'NotNull 'PGInt4
166+ , "customerID" ::: 'Required ('NotNull 'PGInt4)
157− , "shipperID" ::: 'NotNull 'PGInt4
167+ , "shipperID" ::: 'Required ('NotNull 'PGInt4)
158− ]
168+ ]
159type CustomerColumns =
169type CustomerColumns =
170+ '[ "customerID" ::: 'Required ('NotNull 'PGInt4)
160− [ "customerID" ::: 'NotNull 'PGInt4, "customerVal" ::: 'NotNull 'PGFloat4 ]
171+ , "customerVal" ::: 'Required ('NotNull 'PGFloat4)
172+ ]
161type ShipperColumns =
173type ShipperColumns =
174+ '[ "shipperID" ::: 'Required ('NotNull 'PGInt4)
162− [ "shipperID" ::: 'NotNull 'PGInt4, "shipperVal" ::: 'NotNull 'PGBool ]
175+ , "shipperVal" ::: 'Required ('NotNull 'PGBool)
176+ ]
163type JoinTables =
177type JoinTables =
164− [ "shippers" ::: ShipperColumns
178+ '[ "shippers" ::: ShipperColumns
165− , "customers" ::: CustomerColumns
179+ , "customers" ::: CustomerColumns
166− , "orders" ::: OrderColumns
180+ , "orders" ::: OrderColumns
167− ]
181+ ]
168type ValueColumns =
182type ValueColumns =
169− [ "orderVal" ::: 'NotNull 'PGText
183+ '[ "orderVal" ::: 'Required ('NotNull 'PGText)
170− , "customerVal" ::: 'NotNull 'PGFloat4
184+ , "customerVal" ::: 'Required ('NotNull 'PGFloat4)
171− , "shipperVal" ::: 'NotNull 'PGBool
185+ , "shipperVal" ::: 'Required ('NotNull 'PGBool)
172− ]
186+ ]
stack.yaml+1−7
@@ -1,9 +1,3 @@
1−resolver: nightly-2016-12-31
1+resolver: nightly-2017-06-26
2packages:
2packages:
3- squeel-postgresql
3- squeel-postgresql
4−extra-deps:
5−- bifunctors-5.3
6−- indexed-0.1.3
7−- indexed-extras-0.2
8−flags: {}
9−extra-package-dbs: []