230810f · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #18 from echatav/create-drop

Create and drop

commit230810f365d8b93e235b327a09f34fd64f3d9710 authorEitan Chatav <eitan.chatav@gmail.com> dateSun 11 Jun 2017, 08:46 (9 years ago) parent0f0e616 b865f94

5 files changed+135−39

compare with dev

unifiedsplit

squeel-postgresql/squeel-postgresql.cabal+2−2 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+12−12 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+58 squeel-postgresql/src/Squeel/PostgreSQL/Query.hs → squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+34−9 squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs → squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+29−16

squeel-postgresql/squeel-postgresql.cabal+2−2

@@ -14,7 +14,7 @@ library

1414 hs-source-dirs: src

1515 exposed-modules:

1616 Squeel.PostgreSQL.PQ

17− Squeel.PostgreSQL.Query

17+ Squeel.PostgreSQL.Statement

1818 Squeel.PostgreSQL.Schema

1919 Squeel.PostgreSQL.Value

2020 default-language: Haskell2010

@@ -43,7 +43,7 @@ test-suite squeel-postgresql-test

4343 ghc-options: -Wall -Werror

4444 main-is: Spec.hs

4545 other-modules:

46− Squeel.PostgreSQL.QuerySpec

46+ Squeel.PostgreSQL.StatementSpec

4747 Squeel.PostgreSQL.ValueSpec

4848 build-depends:

4949 base

squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+12−12

@@ -28,7 +28,7 @@ import GHC.TypeLits

2828

2929import qualified Database.PostgreSQL.LibPQ as LibPQ

3030

31−import Squeel.PostgreSQL.Query

31+import Squeel.PostgreSQL.Statement

3232import Squeel.PostgreSQL.Value

3333import Squeel.PostgreSQL.Schema

3434

@@ -64,24 +64,24 @@ class MonadPQ pq where

6464

6565 pqExec

6666 :: MonadBase IO io

67− => Query '[] db0 db1 xs

67+ => Statement '[] db0 db1 xs

6868 -> pq db0 db1 io (Maybe (Result xs))

6969

7070 pqExecParams

7171 :: (MonadBase IO io, ToOids ps, ToValues xs ps)

72− => Query ps db0 db1 ys

72+ => Statement ps db0 db1 ys

7373 -> Rec Identity xs

7474 -> pq db0 db1 io (Maybe (Result ys))

7575

7676 pqPrepare

7777 :: (MonadBase IO io, ToOids ps)

7878 => ByteString

79− -> Query ps db0 db1 xs

80− -> pq db0 db1 io (Maybe (Result []), PreparedQuery ps db0 db1 xs)

79+ -> Statement ps db0 db1 xs

80+ -> pq db0 db1 io (Maybe (Result []), PreparedStatement ps db0 db1 xs)

8181

8282 pqExecPrepared

8383 :: (MonadBase IO io, ToValues xs ps)

84− => PreparedQuery ps db0 db1 ys

84+ => PreparedStatement ps db0 db1 ys

8585 -> Rec Identity xs

8686 -> pq db0 db1 io (Maybe (Result ys))

8787

@@ -96,11 +96,11 @@ instance MonadPQ PQ where

9696 (x', conn') <- x conn

9797 runPQ (f x') conn'

9898

99− pqExec (UnsafeQuery q) = PQ $ \ (Connection conn) -> do

99+ pqExec (UnsafeStatement q) = PQ $ \ (Connection conn) -> do

100100 result <- liftBase $ LibPQ.exec conn q

101101 return (Result <$> result, Connection conn)

102102

103− pqExecParams (UnsafeQuery q :: Query ps db0 db1 ys) params =

103+ pqExecParams (UnsafeStatement q :: Statement ps db0 db1 ys) params =

104104 PQ $ \ (Connection conn) -> do

105105 let

106106 params' =

@@ -113,16 +113,16 @@ instance MonadPQ PQ where

113113 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary

114114 return (Result <$> result, Connection conn)

115115

116− pqPrepare statementName (UnsafeQuery q :: Query ps db0 db1 ys) =

116+ pqPrepare statementName (UnsafeStatement q :: Statement ps db0 db1 ys) =

117117 PQ $ \ (Connection conn) -> do

118118 result <- liftBase $

119119 LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))

120120 return

121121 ( ( Result <$> result

122− , UnsafePreparedQuery statementName

122+ , UnsafePreparedStatement statementName

123123 ) , Connection conn )

124124

125− pqExecPrepared (q :: PreparedQuery ps db0 db1 ys) params =

125+ pqExecPrepared (q :: PreparedStatement ps db0 db1 ys) params =

126126 PQ $ \ (Connection conn) -> do

127127 let

128128 params' =

@@ -130,7 +130,7 @@ instance MonadPQ PQ where

130130 | param' <- toValues (proxy# :: Proxy# ps) params

131131 ]

132132 result <- liftBase $

133− LibPQ.execPrepared conn (renderPreparedQuery q) params' LibPQ.Binary

133+ LibPQ.execPrepared conn (renderPreparedStatement q) params' LibPQ.Binary

134134 return (Result <$> result, Connection conn)

135135

136136instance Monad m => Applicative (PQ db db m) where

squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+58

@@ -1,5 +1,6 @@

11{-# LANGUAGE

22 DataKinds

3+ , FlexibleContexts

34 , FlexibleInstances

45 , GADTs

56 , MagicHash

@@ -19,6 +20,8 @@ module Squeel.PostgreSQL.Schema

1920 , (:::)

2021 , Alias (Alias)

2122 , Aliased (As)

23+ , KnownPGType (..)

24+ , KnownColumns (..)

2225 , renderAliased

2326 , module GHC.OverloadedLabels

2427 , module GHC.TypeLits

@@ -97,3 +100,58 @@ renderAliased

97100 -> ByteString

98101renderAliased render (expression `As` Alias alias) =

99102 render expression <> " AS " <> fromString (symbolVal' alias)

103+

104+class KnownPGType (ty :: PGType) where

105+ renderPGType :: Proxy# ty -> ByteString

106+instance KnownPGType 'PGBool where renderPGType _ = "bool"

107+instance KnownPGType 'PGInt2 where renderPGType _ = "int2"

108+instance KnownPGType 'PGInt4 where renderPGType _ = "int4"

109+instance KnownPGType 'PGInt8 where renderPGType _ = "int8"

110+instance KnownPGType 'PGNumeric where renderPGType _ = "numeric"

111+instance KnownPGType 'PGFloat4 where renderPGType _ = "float4"

112+instance KnownPGType 'PGFloat8 where renderPGType _ = "float8"

113+instance KnownPGType 'PGSerial2 where renderPGType _ = "serial2"

114+instance KnownPGType 'PGSerial4 where renderPGType _ = "serial4"

115+instance KnownPGType 'PGSerial8 where renderPGType _ = "serial8"

116+instance KnownPGType 'PGMoney where renderPGType _ = "money"

117+instance KnownNat n => KnownPGType ('PGChar n) where

118+ renderPGType _ = "char("

119+ <> fromString (show (natVal' (proxy# :: Proxy# n)))

120+ <> ")"

121+instance KnownNat n => KnownPGType ('PGVarChar n) where

122+ renderPGType _ = "varchar("

123+ <> fromString (show (natVal' (proxy# :: Proxy# n)))

124+ <> ")"

125+instance KnownPGType 'PGText where renderPGType _ = "text"

126+instance KnownPGType 'PGBytea where renderPGType _ = "bytea"

127+instance KnownPGType 'PGTimestamp where renderPGType _ = "timestamp"

128+instance KnownPGType 'PGTimestampTZ where renderPGType _ = "timestampTZ"

129+instance KnownPGType 'PGDate where renderPGType _ = "date"

130+instance KnownPGType 'PGTime where renderPGType _ = "time"

131+instance KnownPGType 'PGTimeTZ where renderPGType _ = "timeTZ"

132+instance KnownPGType 'PGInterval where renderPGType _ = "interval"

133+instance KnownPGType 'PGUuid where renderPGType _ = "uuid"

134+instance KnownPGType 'PGJson where renderPGType _ = "json"

135+instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"

136+

137+class KnownColumns (columns :: [(Symbol,PGType)]) where

138+ renderColumns :: Proxy# columns -> ByteString

139+instance

140+ ( KnownSymbol column

141+ , KnownPGType ty

142+ ) => KnownColumns '[column ::: ty] where

143+ renderColumns _ =

144+ fromString (symbolVal' (proxy# :: Proxy# column))

145+ <> " "

146+ <> renderPGType (proxy# :: Proxy# ty)

147+instance

148+ ( KnownSymbol column

149+ , KnownPGType ty

150+ , KnownColumns (columnsHead ': columnsTail)

151+ ) => KnownColumns ((column ::: ty) ': columnsHead ': columnsTail) where

152+ renderColumns _ =

153+ fromString (symbolVal' (proxy# :: Proxy# column))

154+ <> " "

155+ <> renderPGType (proxy# :: Proxy# ty)

156+ <> ", "

157+ <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))

squeel-postgresql/src/Squeel/PostgreSQL/Query.hs → squeel-postgresql/src/Squeel/PostgreSQL/Statement.hsrenamed+34−9

@@ -11,7 +11,7 @@

1111 , UndecidableInstances

1212#-}

1313

14−module Squeel.PostgreSQL.Query where

14+module Squeel.PostgreSQL.Statement where

1515

1616import Data.Boolean

1717import Data.ByteString (ByteString)

@@ -302,24 +302,24 @@ list `from` tabs = UnsafeSelection $

302302 . recordToList

303303 . rmap (Const . renderAliased renderExpression)

304304

305−newtype Query

305+newtype Statement

306306 (params :: [PGType])

307307 (schema0 :: [(Symbol,[(Symbol,PGType)])])

308308 (schema1 :: [(Symbol,[(Symbol,PGType)])])

309309 (columns :: [(Symbol,PGType)])

310− = UnsafeQuery { renderQuery :: ByteString }

310+ = UnsafeStatement { renderStatement :: ByteString }

311311

312−newtype PreparedQuery

312+newtype PreparedStatement

313313 (params :: [PGType])

314314 (schema0 :: [(Symbol,[(Symbol,PGType)])])

315315 (schema1 :: [(Symbol,[(Symbol,PGType)])])

316316 (columns :: [(Symbol,PGType)])

317− = UnsafePreparedQuery { renderPreparedQuery :: ByteString }

317+ = UnsafePreparedStatement { renderPreparedStatement :: ByteString }

318318

319319select

320320 :: Selection params schema columns

321− -> Query params schema schema columns

322−select = UnsafeQuery . ("SELECT " <>) . (<> ";") . renderSelection

321+ -> Statement params schema schema columns

322+select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection

323323

324324subselect

325325 :: Aliased (Selection params schema) table

@@ -334,8 +334,8 @@ insertInto

334334 :: HasTable table schema columns

335335 => Alias table

336336 -> Rec (Aliased (Expression params '[])) columns

337− -> Query params schema schema '[]

338−insertInto (Alias table) expressions = UnsafeQuery $ "INSERT INTO "

337+ -> Statement params schema schema '[]

338+insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "

339339 <> fromString (symbolVal' table)

340340 <> " (" <> ByteString.intercalate ", " aliases

341341 <> ") VALUES ("

@@ -348,3 +348,28 @@ insertInto (Alias table) expressions = UnsafeQuery $ "INSERT INTO "

348348 values = recordToList $ rmap

349349 (\ (expression `As` _) -> Const (renderExpression expression))

350350 expressions

351+

352+createTable

353+ :: (KnownSymbol table, KnownColumns columns)

354+ => Alias table

355+ -> Proxy# columns

356+ -> Statement '[] schema ((table ::: columns) ': schema) '[]

357+createTable (Alias table) columns = UnsafeStatement $ mconcat

358+ [ "CREATE TABLE "

359+ , fromString $ symbolVal' table

360+ , " ("

361+ , renderColumns columns

362+ , ");"

363+ ]

364+

365+class KnownSymbol table => DropTable table schema0 schema1

366+ | table schema0 -> schema1 where

367+ dropTable :: Alias table -> Statement '[] schema0 schema1 '[]

368+ dropTable (Alias table) = UnsafeStatement $

369+ "DROP TABLE " <> fromString (symbolVal' table) <> ";"

370+instance {-# OVERLAPPING #-}

371+ (KnownSymbol table, table ~ table')

372+ => DropTable table ((table' ::: columns) ': schema) schema

373+instance {-# OVERLAPPABLE #-}

374+ (KnownSymbol table, DropTable table schema0 schema1)

375+ => DropTable table (tabCols ': schema0) (tabCols ': schema1)

squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs → squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hsrenamed+29−16

@@ -1,28 +1,29 @@

11{-# LANGUAGE

22 DataKinds

3+ , MagicHash

34 , OverloadedLabels

45 , OverloadedStrings

5− , PolyKinds

66 , TypeOperators

77#-}

9−module Squeel.PostgreSQL.QuerySpec where

9+module Squeel.PostgreSQL.StatementSpec where

1010

1111import Data.Boolean

1212import Data.Function

1313import Data.Vinyl

14+import GHC.Exts

1415import Test.Hspec

1516

16−import Squeel.PostgreSQL.Query

17+import Squeel.PostgreSQL.Statement

1718import Squeel.PostgreSQL.Schema

1819

1920spec :: Spec

2021spec = do

2122 let

22− query `shouldRenderAs` str = renderQuery query `shouldBe` str

23+ query `shouldRenderAs` str = renderStatement query `shouldBe` str

2324 it "correctly renders a simple SELECT query" $ do

2425 let

25− statement :: Query '[] Tables Tables SumAndCol1

26+ statement :: Statement '[] Tables Tables SumAndCol1

2627 statement = select $

2728 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

2829 `from` (#table1 & where_ true)

@@ -30,7 +31,7 @@ spec = do

3031 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 WHERE TRUE;"

3132 it "combines WHEREs using AND" $ do

3233 let

33− statement :: Query '[] Tables Tables SumAndCol1

34+ statement :: Statement '[] Tables Tables SumAndCol1

3435 statement = select $

3536 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

3637 `from` (#table1 & where_ true & where_ false)

@@ -39,45 +40,45 @@ spec = do

3940 it "performs sub SELECTs" $ do

4041 let

4142 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1

42− statement :: Query '[] Tables Tables SumAndCol1

43+ statement :: Statement '[] Tables Tables SumAndCol1

4344 statement = select $ starFrom (subselect (selection `As` #sub))

4445 statement `shouldRenderAs`

4546 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS sub;"

4647 it "does LIMIT clauses" $ do

4748 let

48− statement :: Query '[] Tables Tables Columns

49+ statement :: Statement '[] Tables Tables Columns

4950 statement = select $ starFrom (#table1 & limit 1)

5051 statement `shouldRenderAs` "SELECT * FROM table1 LIMIT 1;"

5152 it "should use the minimum of given LIMITs" $ do

5253 let

53− statement :: Query '[] Tables Tables Columns

54+ statement :: Statement '[] Tables Tables Columns

5455 statement = select $ starFrom (#table1 & limit 1 & limit 2)

5556 statement `shouldRenderAs`

5657 "SELECT * FROM table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"

5758 it "should render parameters using $ signs" $ do

5859 let

59− statement :: Query '[ 'PGInt8] Tables Tables Columns

60+ statement :: Statement '[ 'PGInt8] Tables Tables Columns

6061 statement = select $ starFrom (#table1 & limit param1)

6162 statement `shouldRenderAs` "SELECT * FROM table1 LIMIT $1;"

6263 it "does OFFSET clauses" $ do

6364 let

64− statement :: Query '[] Tables Tables Columns

65+ statement :: Statement '[] Tables Tables Columns

6566 statement = select $ starFrom (#table1 & offset 1)

6667 statement `shouldRenderAs` "SELECT * FROM table1 OFFSET 1;"

6768 it "should use the sum of given OFFSETs" $ do

6869 let

69− statement :: Query '[] Tables Tables Columns

70+ statement :: Statement '[] Tables Tables Columns

7071 statement = select $ starFrom (#table1 & offset 1 & offset 2)

7172 statement `shouldRenderAs` "SELECT * FROM table1 OFFSET (1 + 2);"

7273 it "correctly render simple INSERTs" $ do

7374 let

74− statement :: Query '[] Tables Tables '[]

75+ statement :: Statement '[] Tables Tables '[]

7576 statement = insertInto #table1 $ 2 `As` #col1 :& 4 `As` #col2 :& RNil

7677 statement `shouldRenderAs`

7778 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"

7879 it "should be safe against SQL injection in literal text" $ do

7980 let

80− statement :: Query '[] StudentsTable StudentsTable '[]

81+ statement :: Statement '[] StudentsTable StudentsTable '[]

8182 statement = insertInto #students $

8283 "Robert'); DROP TABLE students;" `As` #name :& RNil

8384 statement `shouldRenderAs`

@@ -90,7 +91,7 @@ spec = do

9091 :& #shippers .&. #shipperVal `As` #shipperVal :& RNil

9192 it "should render CROSS JOINs" $ do

9293 let

93− statement :: Query '[] JoinTables JoinTables ValueColumns

94+ statement :: Statement '[] JoinTables JoinTables ValueColumns

9495 statement = select $ vals `from`

9596 (tables (#orders & crossJoin #customers & crossJoin #shippers))

9697 statement `shouldRenderAs`

@@ -110,7 +111,7 @@ spec = do

110111 (#orders .&. #customerID ==* #customers .&. #customerID)

111112 & innerJoin #shippers

112113 (#orders .&. #shipperID ==* #shippers .&. #shipperID)

113− selection :: Query '[] JoinTables JoinTables ValueColumns

114+ selection :: Statement '[] JoinTables JoinTables ValueColumns

114115 selection = select $ vals `from` innerJoins

115116 selection `shouldRenderAs`

116117 "SELECT\

@@ -122,6 +123,18 @@ spec = do

122123 \ ON (orders.customerID = customers.customerID)\

123124 \ INNER JOIN shippers\

124125 \ ON (orders.shipperID = shippers.shipperID);"

126+ it "should render simple CREATE TABLE statements" $ do

127+ let

128+ statement :: Statement '[] '[] Tables '[]

129+ statement = createTable #table1 (proxy# :: Proxy# Columns)

130+ statement `shouldRenderAs`

131+ "CREATE TABLE table1 (col1 int4, col2 int4);"

132+ it "should render DROP TABLE statements" $ do

133+ let

134+ statement :: Statement '[] Tables '[] '[]

135+ statement = dropTable #table1

136+ statement `shouldRenderAs`

137+ "DROP TABLE table1;"

125138

126139type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]

127140type Tables = '[ "table1" ::: Columns ]