git.iko.soy/squeal
on dev help sign in
example
8dabc53Eitan Chatav
squeal-postgresql/exe/Example.hs+56−53
compare with dev
unifiedsplit
@@ -24,13 +24,13 @@ import Squeal.PostgreSQL
24import qualified Data.ByteString.Char8 as Char8
24import qualified Data.ByteString.Char8 as Char8
25import qualified GHC.Generics as GHC
25import qualified GHC.Generics as GHC
26
26
27−-- type Schema =
27+type Schema =
28−-- '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]
28+ '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]
29−-- , "table1" :::
29+ , "table1" :::
30−-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
30+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
31−-- , "col2" ::: 'Required ('NotNull 'PGint4)
31+ , "col2" ::: 'Required ('NotNull 'PGint4)
32−-- ]
32+ ]
33−-- ]
33+ ]
34
34
35data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }
35data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }
36 deriving (Show, GHC.Generic)
36 deriving (Show, GHC.Generic)
@@ -40,49 +40,52 @@ instance HasDatatypeInfo Table1Row
40main :: IO ()
40main :: IO ()
41main = do
41main = do
42 Char8.putStrLn "squeal"
42 Char8.putStrLn "squeal"
43− -- connectionString <- pure
43+ connectionString <- pure
44− -- "host=localhost port=5432 dbname=exampledb"
44+ "host=localhost port=5432 dbname=exampledb"
45− -- Char8.putStrLn $ "connecting to " <> connectionString
45+ Char8.putStrLn $ "connecting to " <> connectionString
46− -- connection0 <- connectdb connectionString
46+ connection0 <- connectdb connectionString
47− -- Char8.putStrLn "setting up schema"
47+ Char8.putStrLn "setting up schema"
48− -- connection1 <- runPQ (connection0 :: Connection '[]) $ pqExec $
48+ connection1 <- flip execPQ (connection0 :: Connection '[]) $ define $
49− -- createTable #students ((text & notNull) `As` #name :* Nil ) []
49+ createTable #students ((text & notNull) `As` #name :* Nil ) []
50− -- >>>
50+ >>>
51− -- createTable #table1
51+ createTable #table1
52− -- ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []
52+ ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []
53− -- connection2 <- runPQ (connection1 :: Connection Schema) $ do
53+ connection2 <- flip execPQ (connection1 :: Connection Schema) $ do
54− -- let
54+ let
55− -- manipulation :: Manipulation Schema
55+ insert :: Manipulation Schema
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+ , 'Required ('NotNull 'PGint4)
60− -- ] '[]
60+ ] '[]
61− -- manipulation =
61+ insert =
62− -- insertInto #table1
62+ insertInto #table1
63− -- ( Values
63+ ( Values
64− -- (param (Proxy @1) `As` #col1 :* param (Proxy @2) `As` #col2 :* Nil)
64+ (param (Proxy @1) `As` #col1 :* param (Proxy @2) `As` #col2 :* Nil)
65− -- [param (Proxy @3) `As` #col1 :* param (Proxy @4) `As` #col2 :* Nil]
65+ [param (Proxy @3) `As` #col1 :* param (Proxy @4) `As` #col2 :* Nil]
66− -- ) Conflict (Returning Nil)
66+ ) Conflict (Returning Nil)
67− -- liftBase $ Char8.putStrLn "manipulating"
67+ liftBase $ Char8.putStrLn "manipulating"
68+ _insertResult <- manipulateParams insert
68− -- _ <- pqExecParams manipulation (1::Int32,2::Int32,3::Int32,4::Int32)
69+ (1::Int32,2::Int32,3::Int32,4::Int32)
69− -- liftBase $ Char8.putStrLn "querying"
70+ liftBase $ Char8.putStrLn "querying"
70− -- Just result <- pqExecNil . query $
71+ result <- query $
71− -- selectStar (from (Table (#table1 `As` #table1)))
72+ selectStar (from (Table (#table1 `As` #table1)))
72− -- value00 <- getValue (RowNumber 0) (columnNumber @0) result
73+ value00 <- getValue (RowNumber 0) (columnNumber @0) result
73− -- value01 <- getValue (RowNumber 0) (columnNumber @1) result
74+ value01 <- getValue (RowNumber 0) (columnNumber @1) result
74− -- value10 <- getValue (RowNumber 1) (columnNumber @0) result
75+ value10 <- getValue (RowNumber 1) (columnNumber @0) result
75− -- value11 <- getValue (RowNumber 1) (columnNumber @1) result
76+ value11 <- getValue (RowNumber 1) (columnNumber @1) result
76− -- row0 <- getRow (RowNumber 0) result
77+ row0 <- getRow (RowNumber 0) result
77− -- row1 <- getRow (RowNumber 1) result
78+ row1 <- getRow (RowNumber 1) result
79+ rows <- getRows result
78− -- liftBase $ do
80+ liftBase $ do
79− -- print (value00 :: Int32)
81+ print (value00 :: Int32)
80− -- print (value01 :: Int32)
82+ print (value01 :: Int32)
81− -- print (value10 :: Int32)
83+ print (value10 :: Int32)
82− -- print (value11 :: Int32)
84+ print (value11 :: Int32)
83− -- print (row0 :: Table1Row)
85+ print (row0 :: Table1Row)
84− -- print (row1 :: Table1Row)
86+ print (row1 :: Table1Row)
87+ print (rows :: [Table1Row])
85− -- Char8.putStrLn "tearing down schema"
88+ Char8.putStrLn "tearing down schema"
86− -- connection3 <- runPQ (connection2 :: Connection Schema) $ pqExec $
89+ connection3 <- flip execPQ (connection2 :: Connection Schema) $ define $
87− -- dropTable #table1 >>> dropTable #students
90+ dropTable #table1 >>> dropTable #students
88− -- finish (connection3 :: Connection '[])
91+ finish (connection3 :: Connection '[])
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+13−4
@@ -89,16 +89,19 @@ pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
89define
89define
90 :: MonadBase IO io
90 :: MonadBase IO io
91 => Definition schema0 schema1
91 => Definition schema0 schema1
92− -> PQ schema0 schema1 io (Maybe (Result '[]))
92+ -> PQ schema0 schema1 io (Result '[])
93define (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
93define (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
94− result <- liftBase $ LibPQ.exec conn q
94+ resultMaybe <- liftBase $ LibPQ.exec conn q
95+ case resultMaybe of
96+ Nothing -> error
97+ "define: LibPQ.exec returned no results"
95− return (Result <$> result, Connection conn)
98+ Just result -> return (Result result, Connection conn)
96
99
97pqThenDefine
100pqThenDefine
98 :: MonadBase IO io
101 :: MonadBase IO io
99 => Definition schema1 schema2
102 => Definition schema1 schema2
100 -> PQ schema0 schema1 io x
103 -> PQ schema0 schema1 io x
101− -> PQ schema0 schema2 io (Maybe (Result '[]))
104+ -> PQ schema0 schema2 io (Result '[])
102pqThenDefine = pqThen . define
105pqThenDefine = pqThen . define
103
106
104class Monad pq => MonadPQ schema pq | pq -> schema where
107class Monad pq => MonadPQ schema pq | pq -> schema where
@@ -375,3 +378,9 @@ getRowMaybe (RowNumber r) (Result result :: Result columns) = liftBase $do
375 case fromList row' of
378 case fromList row' of
376 Nothing -> error "getRow: found unexpected length"
379 Nothing -> error "getRow: found unexpected length"
377 Just row -> return . Just $ fromRow @columns row
380 Just row -> return . Just $ fromRow @columns row
381+
382+liftResult
383+ :: MonadBase IO io
384+ => (LibPQ.Result -> IO x)
385+ -> Result results -> io x
386+liftResult f (Result result) = liftBase $ f result