6d0a671 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

connect poll & compile

6d0a671Eitan Chatav9 years ago

squeal-postgresql/exe/Example.hs+54−53

compare with dev

unifiedsplit

@@ -1,3 +1,4 @@

1+{-# OPTIONS_GHC -fno-warn-unused-imports #-}

1{-# LANGUAGE

2{-# LANGUAGE

2 DataKinds

3 DataKinds

3 , DeriveGeneric

4 , DeriveGeneric

@@ -23,13 +24,13 @@ import Squeal.PostgreSQL

23import qualified Data.ByteString.Char8 as Char8

24import qualified Data.ByteString.Char8 as Char8

24import qualified GHC.Generics as GHC

25import qualified GHC.Generics as GHC

26−type Schema =

27+-- type Schema =

27− '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]

28+-- '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]

28− , "table1" :::

29+-- , "table1" :::

29− '[ "col1" ::: 'Required ('NotNull 'PGint4)

30+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)

30− , "col2" ::: 'Required ('NotNull 'PGint4)

31+-- , "col2" ::: 'Required ('NotNull 'PGint4)

31− ]

32+-- ]

32− ]

33+-- ]

34data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }

35data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }

35 deriving (Show, GHC.Generic)

36 deriving (Show, GHC.Generic)

@@ -39,49 +40,49 @@ instance HasDatatypeInfo Table1Row

39main :: IO ()

40main :: IO ()

40main = do

41main = do

41 Char8.putStrLn "squeal"

42 Char8.putStrLn "squeal"

42− connectionString <- pure

43+ -- connectionString <- pure

43− "host=localhost port=5432 dbname=exampledb"

44+ -- "host=localhost port=5432 dbname=exampledb"

44− Char8.putStrLn $ "connecting to " <> connectionString

45+ -- Char8.putStrLn $ "connecting to " <> connectionString

45− connection0 <- connectdb connectionString

46+ -- connection0 <- connectdb connectionString

46− Char8.putStrLn "setting up schema"

47+ -- Char8.putStrLn "setting up schema"

47− connection1 <- runPQ (connection0 :: Connection '[]) $ pqExec $

48+ -- connection1 <- runPQ (connection0 :: Connection '[]) $ pqExec $

48− createTable #students ((text & notNull) `As` #name :* Nil ) []

49+ -- createTable #students ((text & notNull) `As` #name :* Nil ) []

49− >>>

50+ -- >>>

50− createTable #table1

51+ -- createTable #table1

51− ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []

52+ -- ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []

52− connection2 <- runPQ (connection1 :: Connection Schema) $ do

53+ -- connection2 <- runPQ (connection1 :: Connection Schema) $ do

53− let

54+ -- let

54− manipulation :: Manipulation Schema

55+ -- manipulation :: Manipulation Schema

55− '[ 'Required ('NotNull 'PGint4)

56+ -- '[ 'Required ('NotNull 'PGint4)

56− , 'Required ('NotNull 'PGint4)

57+ -- , 'Required ('NotNull 'PGint4)

57− , 'Required ('NotNull 'PGint4)

58+ -- , 'Required ('NotNull 'PGint4)

58− , 'Required ('NotNull 'PGint4)

59+ -- , 'Required ('NotNull 'PGint4)

59− ] '[]

60+ -- ] '[]

60− manipulation =

61+ -- manipulation =

61− insertInto #table1

62+ -- insertInto #table1

62− ( Values

63+ -- ( Values

63− (param (Proxy @1) `As` #col1 :* param (Proxy @2) `As` #col2 :* Nil)

64+ -- (param (Proxy @1) `As` #col1 :* param (Proxy @2) `As` #col2 :* Nil)

64− [param (Proxy @3) `As` #col1 :* param (Proxy @4) `As` #col2 :* Nil]

65+ -- [param (Proxy @3) `As` #col1 :* param (Proxy @4) `As` #col2 :* Nil]

65− ) Conflict (Returning Nil)

66+ -- ) Conflict (Returning Nil)

66− liftBase $ Char8.putStrLn "manipulating"

67+ -- liftBase $ Char8.putStrLn "manipulating"

67− _ <- pqExecParams manipulation (1::Int32,2::Int32,3::Int32,4::Int32)

68+ -- _ <- pqExecParams manipulation (1::Int32,2::Int32,3::Int32,4::Int32)

68− liftBase $ Char8.putStrLn "querying"

69+ -- liftBase $ Char8.putStrLn "querying"

69− Just result <- pqExecNil . query $

70+ -- Just result <- pqExecNil . query $

70− selectStar (from (Table (#table1 `As` #table1)))

71+ -- selectStar (from (Table (#table1 `As` #table1)))

71− value00 <- getValue (RowNumber 0) (columnNumber @0) result

72+ -- value00 <- getValue (RowNumber 0) (columnNumber @0) result

72− value01 <- getValue (RowNumber 0) (columnNumber @1) result

73+ -- value01 <- getValue (RowNumber 0) (columnNumber @1) result

73− value10 <- getValue (RowNumber 1) (columnNumber @0) result

74+ -- value10 <- getValue (RowNumber 1) (columnNumber @0) result

74− value11 <- getValue (RowNumber 1) (columnNumber @1) result

75+ -- value11 <- getValue (RowNumber 1) (columnNumber @1) result

75− row0 <- getRow (RowNumber 0) result

76+ -- row0 <- getRow (RowNumber 0) result

76− row1 <- getRow (RowNumber 1) result

77+ -- row1 <- getRow (RowNumber 1) result

77− liftBase $ do

78+ -- liftBase $ do

78− print (value00 :: Int32)

79+ -- print (value00 :: Int32)

79− print (value01 :: Int32)

80+ -- print (value01 :: Int32)

80− print (value10 :: Int32)

81+ -- print (value10 :: Int32)

81− print (value11 :: Int32)

82+ -- print (value11 :: Int32)

82− print (row0 :: Table1Row)

83+ -- print (row0 :: Table1Row)

83− print (row1 :: Table1Row)

84+ -- print (row1 :: Table1Row)

84− Char8.putStrLn "tearing down schema"

85+ -- Char8.putStrLn "tearing down schema"

85− connection3 <- runPQ (connection2 :: Connection Schema) $ pqExec $

86+ -- connection3 <- runPQ (connection2 :: Connection Schema) $ pqExec $

86− dropTable #table1 >>> dropTable #students

87+ -- dropTable #table1 >>> dropTable #students

87− finish (connection3 :: Connection '[])

88+ -- finish (connection3 :: Connection '[])

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+9−3

@@ -154,6 +154,8 @@ class Monad pq => MonadPQ schema pq | pq -> schema where

154 => list x -> Manipulation schema params ys -> pq ()

155 forPrepared_ = flip traversePrepared_

156

157+ connectPoll :: pq LibPQ.PollingStatus

158+

157instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where

159instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where

158

160

159 manipulateParams

161 manipulateParams

@@ -197,6 +199,10 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where

197 LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

199 LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

198 return ((), Connection conn)

200 return ((), Connection conn)

199

201

202+ connectPoll = undefined--PQ $ \ (Connection conn) -> do

203+ -- pollingStatus <- liftBase $ connectPoll conn

204+ -- return (pollingStatus, Connection conn)

205+

200instance Monad m => Applicative (PQ schema schema m) where

206instance Monad m => Applicative (PQ schema schema m) where

201 pure x = PQ $ \ conn -> pure (x, conn)

207 pure x = PQ $ \ conn -> pure (x, conn)

202 (<*>) = pqAp

208 (<*>) = pqAp

@@ -233,12 +239,12 @@ finish :: MonadBase IO io => Connection schema -> io ()

233finish = liftBase . LibPQ.finish . unConnection

239finish = liftBase . LibPQ.finish . unConnection

234

240

235withConnection

241withConnection

242+ :: forall schema io x

236− :: MonadBaseControl IO io

243+ . MonadBaseControl IO io

237 => ByteString

244 => ByteString

238 -> (Connection schema -> io x)

245 -> (Connection schema -> io x)

239 -> io x

246 -> io x

240−withConnection connString action =

241− bracket (connectdb connString) finish action

247+withConnection connString = bracket (connectdb connString) finish

242

248

243newtype Result (xs :: [(Symbol,ColumnType)])

249newtype Result (xs :: [(Symbol,ColumnType)])

244 = Result { unResult :: LibPQ.Result }

250 = Result { unResult :: LibPQ.Result }

squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+1−1

@@ -20,7 +20,7 @@ import Squeal.PostgreSQL.Schema

20spec :: Spec

21spec = do

22 let

23− qry `queryRenders` str = query qry `manipulationRenders` str

23+ qry `queryRenders` str = queryStatement qry `manipulationRenders` str

24 definition `definitionRenders` str =

25 renderDefinition definition `shouldBe` str

26 manipulation `manipulationRenders` str =