d2dd242 · squeal · git.iko.soy

git.iko.soy/squeal

chain statement executions

* `decimal` for num literals * remove `Category` instance for `Statement`s with chained `(&>>)` statement execution

commitd2dd2428bdd5bd7a4368688707b473d7502c198d authorEitan Chatav <eitan.chatav@gmail.com> dateMon 3 Jul 2017, 22:44 (9 years ago) parent71b64ef

5 files changed+58−59

compare with dev

unifiedsplit

squeel-postgresql/exe/Example.hs+26−34 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+10−2 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+8−7 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+8−10 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+6−6

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

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

1010module Main (main) where

1111

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

1312import Control.Monad.Base

1413import Control.Monad.Except

1514import Control.Monad.Trans.Maybe

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

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

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

3029 connection0 <- connectdb connectionString

31− Char8.putStrLn "creating tables"

32− connection1 <- flip execPQ connection0 $ pqExec $

33− createTable #students

30+ Char8.putStrLn "creating database"

31+ connection1 <- flip execPQ connection0 $

32+ pqExec ( createTable #students

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

35− :* Nil )

36− >>>

37− createTable #table1

34+ :* Nil ) )

35+ &>> createTable #table1

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

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

4038 :* 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"

4142 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)

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

49− getValue (RowNumber 0) colNum0

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

51− getValue (RowNumber 0) colNum1

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

53− getValue (RowNumber 1) colNum0

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

55− getValue (RowNumber 1) colNum1

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

57− getRow (RowNumber 0)

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

59− getRow (RowNumber 1)

60− liftBase $ do

61− print (value00 :: Int32)

62− print (value01 :: Int32)

63− print (value10 :: Int32)

64− print (value11 :: Int32)

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

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

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

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

44+ runMaybeT . runExceptT . flip runValue result $ do

45+ value00 <- getValue (RowNumber 0) colNum0

46+ value01 <- getValue (RowNumber 0) colNum1

47+ value10 <- getValue (RowNumber 1) colNum0

48+ value11 <- getValue (RowNumber 1) colNum1

49+ row0 <- getRow (RowNumber 0)

50+ row1 <- getRow (RowNumber 1)

51+ liftBase $ do

52+ print (value00 :: Int32)

53+ print (value01 :: Int32)

54+ print (value10 :: Int32)

55+ print (value11 :: Int32)

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

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

58+ Char8.putStrLn "tearing down database"

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

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

69− >>> dropTable #students

61+ &>> dropTable #students

7062 finish connection3

7163

7264type Columns =

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

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

8282 :: (MonadBase IO io, ToOids ps)

8383 => ByteString

8484 -> 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)

8686

8787 pqExecPrepared

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

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

9090 -> NP I xs

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

9292

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+

93100instance MonadPQ PQ where

94101

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

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

177184withConnection connString action =

178185 bracket (connectdb connString) finish action

179186

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

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

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

181189

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

183191

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

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

1717 ( PGType (..)

1818 , ToOid (..)

1919 , ToOids (..)

20− , PGNum

20+ , PGNum (..)

2121 , PGFractional

2222 , PGFloating

2323 , (:::)

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

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

8383

8484class PGNum (ty :: PGType) where

85−instance PGNum 'PGInt2

86−instance PGNum 'PGInt4

87−instance PGNum 'PGInt8

88−instance PGNum 'PGNumeric

89−instance PGNum 'PGFloat4

90−instance PGNum 'PGFloat8

85+ decimal :: proxy ty -> Bool

86+instance PGNum 'PGInt2 where decimal _ = False

87+instance PGNum 'PGInt4 where decimal _ = False

88+instance PGNum 'PGInt8 where decimal _ = False

89+instance PGNum 'PGNumeric where decimal _ = True

90+instance PGNum 'PGFloat4 where decimal _ = True

91+instance PGNum 'PGFloat8 where decimal _ = True

9192

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

9394instance PGFractional 'PGNumeric

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

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

1515

1616module Squeel.PostgreSQL.Statement where

1717

18−import Control.Category

1918import Data.Boolean

2019import Data.Boolean.Numbers

2120import Data.ByteString (ByteString)

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

2726import GHC.Exts

2827import GHC.OverloadedLabels

2928import GHC.TypeLits

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

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

3130

3231import qualified Data.ByteString as ByteString

3332

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

134133 (*) = unsafeBinaryOp "*"

135134 abs = unsafeFunction "abs"

136135 signum = unsafeFunction "sign"

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

136+ fromInteger

137+ = UnsafeExpression

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

139+ . fromString

140+ . show

138141

139142instance PGFractional ty

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

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

334337 = UnsafeStatement { renderStatement :: ByteString }

335338 deriving (Show,Eq)

336339

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

338− id = UnsafeStatement ";"

339− statement2 . statement1 = UnsafeStatement $

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

341−

342340newtype PreparedStatement

343341 (params :: [ColumnType])

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

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

711709 dropTable (Alias table) = UnsafeStatement $

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

713711instance {-# OVERLAPPING #-}

714− (KnownSymbol table, table ~ table')

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

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

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

716714instance {-# OVERLAPPABLE #-}

717715 DropTable table schema0 schema1

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

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

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

4747 let

4848 statement :: Statement '[] Columns Tables Tables

4949 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;"

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

5252 let

5353 statement :: Statement '[] Columns Tables Tables

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

5555 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;"

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

5858 let

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

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

6363 let

6464 statement :: Statement '[] Columns Tables Tables

6565 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;"

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

6868 let

6969 statement :: Statement '[] Columns Tables Tables

7070 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);"

7272 it "correctly render simple INSERTs" $ do

7373 let

7474 statement :: Statement '[] '[] Tables Tables

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

7676 statement `shouldRenderAs`

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

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

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

7979 let

8080 statement :: Statement '[] '[] StudentsTable StudentsTable

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

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

146146 :* Nil)

147147 `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);"

149149 it "should render DROP TABLE statements" $ do

150150 let

151151 statement :: Statement '[] '[] Tables '[]