d2dd242 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

chain statement executions

d2dd242Eitan Chatav9 years ago

squeel-postgresql/exe/Example.hs+26−34

compare with dev

unifiedsplit

@@ -9,7 +9,6 @@

10module Main (main) where

12−import Control.Category ((>>>))

13import Control.Monad.Base

12import Control.Monad.Base

14import Control.Monad.Except

13import Control.Monad.Except

15import Control.Monad.Trans.Maybe

14import Control.Monad.Trans.Maybe

@@ -28,45 +27,38 @@ main = do

28 "host=localhost port=5432 dbname=exampledb"

27 "host=localhost port=5432 dbname=exampledb"

29 Char8.putStrLn $ "connecting to " <> connectionString

28 Char8.putStrLn $ "connecting to " <> connectionString

30 connection0 <- connectdb connectionString

29 connection0 <- connectdb connectionString

31− Char8.putStrLn "creating tables"

30+ Char8.putStrLn "creating database"

32− connection1 <- flip execPQ connection0 $ pqExec $

31+ connection1 <- flip execPQ connection0 $

33− createTable #students

32+ pqExec ( createTable #students

34 ( (text & notNull) `As` #name

33 ( (text & notNull) `As` #name

35− :* Nil )

34+ :* Nil ) )

36− >>>

37− createTable #table1

35+ &>> createTable #table1

38 ( (int4 & notNull) `As` #col1

36 ( (int4 & notNull) `As` #col1

39 :* (int4 & notNull) `As` #col2

37 :* (int4 & notNull) `As` #col2

40 :* Nil )

38 :* Nil )

39+ &>> insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )

40+ &>> insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )

41+ Char8.putStrLn "querying"

41 connection2 <- flip execPQ connection1 $ do

42 connection2 <- flip execPQ connection1 $ do

42− _insertTable1Result <- pqExec $

43− insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil )

44− >>>

45− insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil )

46− Just selectTable1Result <- flip pqExecParams Nil $

47− (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)

43+ Just result <- pqExecParams (select (starFrom #table1)) Nil

48− Just (Right value00) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

44+ runMaybeT . runExceptT . flip runValue result $ do

49− getValue (RowNumber 0) colNum0

45+ value00 <- getValue (RowNumber 0) colNum0

50− Just (Right value01) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

51− getValue (RowNumber 0) colNum1

46+ value01 <- getValue (RowNumber 0) colNum1

52− Just (Right value10) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

53− getValue (RowNumber 1) colNum0

47+ value10 <- getValue (RowNumber 1) colNum0

54− Just (Right value11) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

55− getValue (RowNumber 1) colNum1

48+ value11 <- getValue (RowNumber 1) colNum1

56− Just (Right row0) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

57− getRow (RowNumber 0)

49+ row0 <- getRow (RowNumber 0)

58− Just (Right row1) <- runMaybeT . runExceptT . flip runValue selectTable1Result $

59− getRow (RowNumber 1)

50+ row1 <- getRow (RowNumber 1)

60− liftBase $ do

51+ liftBase $ do

61− print (value00 :: Int32)

52+ print (value00 :: Int32)

62− print (value01 :: Int32)

53+ print (value01 :: Int32)

63− print (value10 :: Int32)

54+ print (value10 :: Int32)

64− print (value11 :: Int32)

55+ print (value11 :: Int32)

65− print (row0 :: NP I '[Int32,Int32])

56+ print (row0 :: NP I '[Int32,Int32])

66− print (row1 :: NP I '[Int32,Int32])

57+ print (row1 :: NP I '[Int32,Int32])

58+ Char8.putStrLn "tearing down database"

67− connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec $

59+ connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec

68 (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])

60 (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])

69− >>> dropTable #students

61+ &>> dropTable #students

70 finish connection3

62 finish connection3

72type Columns =

64type Columns =

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

@@ -82,7 +82,7 @@ class MonadPQ pq where

82 :: (MonadBase IO io, ToOids ps)

83 => ByteString

84 -> Statement ps xs db0 db1

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

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

87 pqExecPrepared

88 :: (MonadBase IO io, AllZip HasEncoding ps xs, All Top ps)

@@ -90,6 +90,13 @@ class MonadPQ pq where

90 -> NP I xs

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

93+(&>>)

94+ :: (MonadPQ pq, MonadBase IO io)

95+ => pq db0 db1 io (Maybe (Result '[]))

96+ -> Statement '[] '[] db1 db2

97+ -> pq db0 db2 io (Maybe (Result '[]))

98+pq1 &>> statement2 = pqBind (\ _ -> pqExec statement2) pq1

99+

93instance MonadPQ PQ where

100instance MonadPQ PQ where

101

95 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do

102 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do

@@ -177,7 +184,8 @@ withConnection

177withConnection connString action =

184withConnection connString action =

178 bracket (connectdb connString) finish action

185 bracket (connectdb connString) finish action

179

186

187+newtype Result (xs :: [(Symbol,ColumnType)])

180−newtype Result xs = Result { unResult :: LibPQ.Result }

188+ = Result { unResult :: LibPQ.Result }

181

189

182newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }

190newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }

183

191

squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+8−7

@@ -17,7 +17,7 @@ module Squeel.PostgreSQL.Schema

17 ( PGType (..)

18 , ToOid (..)

19 , ToOids (..)

20− , PGNum

20+ , PGNum (..)

21 , PGFractional

22 , PGFloating

23 , (:::)

@@ -82,12 +82,13 @@ instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where

82 toOids _ = toOid (proxy# :: Proxy# pg) : toOids (proxy# :: Proxy# pgs)

84class PGNum (ty :: PGType) where

85+ decimal :: proxy ty -> Bool

85−instance PGNum 'PGInt2

86+instance PGNum 'PGInt2 where decimal _ = False

86−instance PGNum 'PGInt4

87+instance PGNum 'PGInt4 where decimal _ = False

87−instance PGNum 'PGInt8

88+instance PGNum 'PGInt8 where decimal _ = False

88−instance PGNum 'PGNumeric

89+instance PGNum 'PGNumeric where decimal _ = True

89−instance PGNum 'PGFloat4

90+instance PGNum 'PGFloat4 where decimal _ = True

90−instance PGNum 'PGFloat8

91+instance PGNum 'PGFloat8 where decimal _ = True

92class PGNum ty => PGFractional (ty :: PGType) where

93class PGNum ty => PGFractional (ty :: PGType) where

93instance PGFractional 'PGNumeric

94instance PGFractional 'PGNumeric

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+8−10

@@ -15,7 +15,6 @@

16module Squeel.PostgreSQL.Statement where

18−import Control.Category

19import Data.Boolean

18import Data.Boolean

20import Data.Boolean.Numbers

19import Data.Boolean.Numbers

21import Data.ByteString (ByteString)

20import Data.ByteString (ByteString)

@@ -27,7 +26,7 @@ import Generics.SOP

27import GHC.Exts

26import GHC.Exts

28import GHC.OverloadedLabels

27import GHC.OverloadedLabels

29import GHC.TypeLits

28import GHC.TypeLits

30−import Prelude hiding (id,(.),RealFrac(..))

29+import Prelude hiding (RealFrac(..))

32import qualified Data.ByteString as ByteString

31import qualified Data.ByteString as ByteString

@@ -134,7 +133,11 @@ instance PGNum ty

134 (*) = unsafeBinaryOp "*"

133 (*) = unsafeBinaryOp "*"

135 abs = unsafeFunction "abs"

134 abs = unsafeFunction "abs"

136 signum = unsafeFunction "sign"

135 signum = unsafeFunction "sign"

136+ fromInteger

137− fromInteger = UnsafeExpression . (<> ".") . fromString . show

137+ = UnsafeExpression

138+ . (<> if decimal (Proxy :: Proxy ty) then "." else "")

139+ . fromString

140+ . show

138

141

139instance PGFractional ty

142instance PGFractional ty

140 => Fractional (Expression params tables ('Required (nullity ty))) where

143 => Fractional (Expression params tables ('Required (nullity ty))) where

@@ -334,11 +337,6 @@ newtype Statement

334 = UnsafeStatement { renderStatement :: ByteString }

337 = UnsafeStatement { renderStatement :: ByteString }

335 deriving (Show,Eq)

338 deriving (Show,Eq)

336

339

337−instance Category (Statement '[] '[]) where

338− id = UnsafeStatement ";"

339− statement2 . statement1 = UnsafeStatement $

340− renderStatement statement1 <> " " <> renderStatement statement2

341−

342newtype PreparedStatement

340newtype PreparedStatement

343 (params :: [ColumnType])

341 (params :: [ColumnType])

344 (columns :: [(Symbol,ColumnType)])

342 (columns :: [(Symbol,ColumnType)])

@@ -711,8 +709,8 @@ class KnownSymbol table => DropTable table schema0 schema1

711 dropTable (Alias table) = UnsafeStatement $

709 dropTable (Alias table) = UnsafeStatement $

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

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

713instance {-# OVERLAPPING #-}

711instance {-# OVERLAPPING #-}

714− (KnownSymbol table, table ~ table')

712+ (KnownSymbol table, table ~ table', schema ~ schema')

715− => DropTable table ((table' ::: columns) ': schema) schema

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

716instance {-# OVERLAPPABLE #-}

714instance {-# OVERLAPPABLE #-}

717 DropTable table schema0 schema1

715 DropTable table schema0 schema1

718 => DropTable table (table' ': schema0) (table' ': schema1)

716 => DropTable table (table' ': schema0) (table' ': schema1)

squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+6−6

@@ -47,13 +47,13 @@ spec = do

47 let

48 statement :: Statement '[] Columns Tables Tables

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

50− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1.;"

50+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"

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

52 let

53 statement :: Statement '[] Columns Tables Tables

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

55 statement `shouldRenderAs`

56− "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;"

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

58 let

59 statement :: Statement '[ 'Required ('NotNull 'PGInt8)] Columns Tables Tables

@@ -63,18 +63,18 @@ spec = do

63 let

64 statement :: Statement '[] Columns Tables Tables

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

66− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1.;"

66+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"

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

68 let

69 statement :: Statement '[] Columns Tables Tables

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

71− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1. + 2.);"

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

72 it "correctly render simple INSERTs" $ do

73 let

74 statement :: Statement '[] '[] Tables Tables

75 statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil

76 statement `shouldRenderAs`

77− "INSERT INTO table1 (col1, col2) VALUES (2., 4.);"

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

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

79 let

80 statement :: Statement '[] '[] StudentsTable StudentsTable

@@ -145,7 +145,7 @@ spec = do

145 :* (int8 & notNull & default_ 8) `As` #col3

146 :* Nil)

147 `shouldRenderAs`

148− "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8.);"

148+ "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"

149 it "should render DROP TABLE statements" $ do

150 let

151 statement :: Statement '[] '[] Tables '[]