Skip to content

Commit e61d222

Browse files
tathougiestathougies
authored
Update docs, add runBeam* functions (#207)
1 parent 0de1e98 commit e61d222

30 files changed

+110
-101
lines changed

‎beam-postgres/ChangeLog.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# 0.3.1.0
2+
3+
Add `runBeamPostgres` and `runBeamPostgresDebug` functions.
4+
15
# 0.3.0.0
26

37
Initial hackage beam-postgres

‎beam-postgres/Database/Beam/Postgres/Connection.hs

+11-4
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,8 @@ module Database.Beam.Postgres.Connection
1414
( PgRowReadError(..), PgError(..)
1515
, Pg(..), PgF(..)
1616

17+
, runBeamPostgres, runBeamPostgresDebug
18+
1719
, pgRenderSyntax, runPgRowReader, getFields
1820

1921
, withPgDebug
@@ -300,11 +302,16 @@ newtype Pg a = Pg { runPg :: F PgF a }
300302
instance MonadIO Pg where
301303
liftIO x = liftF (PgLiftIO x id)
302304

305+
runBeamPostgresDebug :: (String -> IO ()) -> Pg.Connection -> Pg a -> IO a
306+
runBeamPostgresDebug dbg conn action =
307+
withPgDebug dbg conn action >>= either throwIO pure
308+
309+
runBeamPostgres :: Pg.Connection -> Pg a -> IO a
310+
runBeamPostgres = runBeamPostgresDebug (\_ -> pure ())
311+
303312
instance MonadBeam PgCommandSyntax Postgres Pg.Connection Pg where
304-
withDatabase conn action =
305-
withPgDebug (\_ -> pure ()) conn action >>= either throwIO pure
306-
withDatabaseDebug dbg conn action =
307-
withPgDebug dbg conn action >>= either throwIO pure
313+
withDatabase = runBeamPostgres
314+
withDatabaseDebug = runBeamPostgresDebug
308315

309316
runReturningMany cmd consume =
310317
liftF (PgRunReturning cmd consume id)

‎beam-postgres/beam-docs.sh

+1-1
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
set -e
44

55
CHINOOK_POSTGRES_URL="https://raw.githubusercontent.com/lerocha/chinook-database/master/ChinookDatabase/DataSources/Chinook_PostgreSql.sql"
6-
EXPECTED_SHA256="013d267b57b31193adad64412ee4d0800807b39b4006028ce7fb958e0667a7e0"
6+
EXPECTED_SHA256="6945d59e3bca94591e2a96451b9bd69084b026f7fb7dbda3d15d06114ffb34c4"
77

88
PGCONNSTR=$1
99
PGDB=$2

‎beam-postgres/beam-postgres.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: beam-postgres
2-
version: 0.3.0.0
2+
version: 0.3.1.0
33
synopsis: Connection layer between beam and postgres
44
description: Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS
55
homepage: http://tathougies.github.io/beam/user-guide/backends/beam-postgres

‎beam-sqlite/ChangeLog.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# 0.3.1.0
2+
3+
Add `runBeamSqlite` and `runBeamSqliteDebug` functions
4+
15
# 0.3.0.0
26

37
* Re-introduce backend parameter to `Database` class

‎beam-sqlite/Database/Beam/Sqlite/Connection.hs

+11-3
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,12 @@ module Database.Beam.Sqlite.Connection
77
( Sqlite(..), SqliteM(..)
88
, sqliteUriSyntax
99

10+
, runBeamSqlite, runBeamSqliteDebug
11+
1012
-- * Emulated @INSERT RETURNING@ support
1113
, SqliteInsertReturning
1214
, insertReturning, runInsertReturningList
13-
, ) where
15+
) where
1416

1517
import Database.Beam.Backend
1618
import Database.Beam.Backend.SQL
@@ -182,9 +184,15 @@ sqliteUriSyntax =
182184
hdl <- open sqliteName
183185
pure (hdl, close hdl))
184186

187+
runBeamSqliteDebug :: (String -> IO ()) -> Connection -> SqliteM a -> IO a
188+
runBeamSqliteDebug debugStmt conn x = runReaderT (runSqliteM x) (debugStmt, conn)
189+
190+
runBeamSqlite :: Connection -> SqliteM a -> IO a
191+
runBeamSqlite = runBeamSqliteDebug (\_ -> pure ())
192+
185193
instance MonadBeam SqliteCommandSyntax Sqlite Connection SqliteM where
186-
withDatabase = withDatabaseDebug (\_ -> pure ())
187-
withDatabaseDebug printStmt conn x = runReaderT (runSqliteM x) (printStmt, conn)
194+
withDatabase = runBeamSqlite
195+
withDatabaseDebug = runBeamSqliteDebug
188196

189197
runNoReturn (SqliteCommandSyntax (SqliteSyntax cmd vals)) =
190198
SqliteM $ do

‎beam-sqlite/beam-docs.sh

+1-1
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ set -e
44

55
SQLITE_DB=$1
66
CHINOOK_SQLITE_URL="https://raw.githubusercontent.com/lerocha/chinook-database/master/ChinookDatabase/DataSources/Chinook_Sqlite.sql"
7-
EXPECTED_SHA256="40215158e0dc3443d16565e3ae96c2f5d640ff00a92de3910568dc34fa086a82"
7+
EXPECTED_SHA256="b2e430ec8cb389509d25ec5bda2f958bbf6f0ca42e276fa5eb3de45eb816a460"
88

99
print_open_statement() {
1010
echo "chinook <- open \"chinook.db\""

‎beam-sqlite/beam-sqlite.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11

22
name: beam-sqlite
3-
version: 0.3.0.0
3+
version: 0.3.1.0
44
synopsis: Beam driver for SQLite
55
description: Beam driver for the <https://sqlite.org/ SQLite> embedded database.
66
See <http://tathougies.github.io/beam/user-guide/backends/beam-sqlite/ here>

‎docs/beam-docs-library.sh

+7-6
Original file line numberDiff line numberDiff line change
@@ -29,18 +29,19 @@ download () {
2929
DIR=$(dirname $TMP_FILE)
3030
mkdir -p $DIR
3131

32-
if [ -z $CONV ]; then
33-
curl $URL | sed -e 's/\r$//' > $TMP_FILE
34-
else
35-
curl $URL | $CONV | sed -e 's/\r$//' > $TMP_FILE
36-
fi
32+
curl $URL > $TMP_FILE
3733

3834
ACTUAL_SUM=$(sha256 $TMP_FILE)
3935
if [ "$ACTUAL_SUM" != "$EXPECTED_SHA256" ]; then
4036
status "Sum mismatch, got $ACTUAL_SUM, expected $EXPECTED_SHA256"
4137
exit 1
4238
else
43-
mv $TMP_FILE $CACHED_FILE
39+
if [ -z $CONV ]; then
40+
cat $TMP_FILE | sed -e 's/\r$//' > $CACHED_FILE
41+
else
42+
cat $TMP_FILE | bash -c "$CONV" | sed -e 's/\r$//' > $CACHED_FILE
43+
fi
44+
rm $TMP_FILE
4445
fi
4546

4647
status "Finished downloading"

‎docs/beam-templates/chinook.hs

+2
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@ main =
3434
stmts <- newIORef id
3535

3636
let onStmt s = modifyIORef stmts (. (s:))
37+
38+
record :: BEAM_BACKEND_MONAD a -> IO a
3739
record = withDatabaseDebug onStmt chinook
3840

3941
handle (\BeamDone -> pure ()) $

‎docs/beam-templates/chinookdml.hs

+2
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,8 @@ main =
3636
stmts <- newIORef id
3737

3838
let onStmt s = modifyIORef stmts (. (s:))
39+
40+
record :: BEAM_BACKEND_MONAD a -> IO a
3941
record a = withDatabaseDebug (onStmt . (++ ";")) chinook a
4042

4143
handle (\BeamDone -> pure ()) $

‎docs/beam-templates/employee1out-agg.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ main =
4747
do conn <- open ":memory:"
4848
execute_ conn "CREATE TABLE cart_users (email VARCHAR NOT NULL, first_name VARCHAR NOT NULL, last_name VARCHAR NOT NULL, password VARCHAR NOT NULL, PRIMARY KEY( email ));"
4949

50-
withDatabase conn $ runInsert $
50+
runBeamSqlite conn $ runInsert $
5151
insert (_shoppingCartUsers shoppingCartDb) $
5252
insertValues [ User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
5353
, User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
@@ -60,7 +60,7 @@ main =
6060

6161
let onStmt s = pure ()
6262

63-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
63+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
6464
putStrLn :: String -> IO ()
6565
putStrLn x = putStr (concatMap (\x -> if x == '\n' then "\n\n" else [x]) x ++ "\n --\n")
6666

‎docs/beam-templates/employee1out.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -47,15 +47,15 @@ main =
4747
do conn <- open ":memory:"
4848
execute_ conn "CREATE TABLE cart_users (email VARCHAR NOT NULL, first_name VARCHAR NOT NULL, last_name VARCHAR NOT NULL, password VARCHAR NOT NULL, PRIMARY KEY( email ));"
4949

50-
withDatabase conn $ runInsert $
50+
runBeamSqlite conn $ runInsert $
5151
insert (_shoppingCartUsers shoppingCartDb) $
5252
insertValues [ User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
5353
, User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
54-
, User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c" {- sam -} ]
54+
, User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c" {- sam -} ]
5555

5656
let onStmt s = pure ()
5757

58-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
58+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
5959
putStrLn :: String -> IO ()
6060
putStrLn x = putStr (concatMap (\x -> if x == '\n' then "\n\n" else [x]) x ++ "\n --\n")
6161

‎docs/beam-templates/employee1sql-agg.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ main =
4646
do conn <- open ":memory:"
4747
execute_ conn "CREATE TABLE cart_users (email VARCHAR NOT NULL, first_name VARCHAR NOT NULL, last_name VARCHAR NOT NULL, password VARCHAR NOT NULL, PRIMARY KEY( email ));"
4848

49-
withDatabase conn $ runInsert $
49+
runBeamSqlite conn $ runInsert $
5050
insert (_shoppingCartUsers shoppingCartDb) $
5151
insertValues [ User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
5252
, User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
@@ -60,7 +60,7 @@ main =
6060
stmts <- newIORef id
6161
let onStmt s = modifyIORef stmts (. (s:))
6262

63-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
63+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
6464
putStrLn :: String -> IO ()
6565
putStrLn _ = pure ()
6666

‎docs/beam-templates/employee1sql.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ main =
4646
do conn <- open ":memory:"
4747
execute_ conn "CREATE TABLE cart_users (email VARCHAR NOT NULL, first_name VARCHAR NOT NULL, last_name VARCHAR NOT NULL, password VARCHAR NOT NULL, PRIMARY KEY( email ));"
4848

49-
withDatabase conn $ runInsert $
49+
runBeamSqlite conn $ runInsert $
5050
insert (_shoppingCartUsers shoppingCartDb) $
5151
insertValues [ User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
5252
, User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
@@ -55,7 +55,7 @@ main =
5555
stmts <- newIORef id
5656
let onStmt s = modifyIORef stmts (. (s:))
5757

58-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
58+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
5959
putStrLn :: String -> IO ()
6060
putStrLn _ = pure ()
6161

‎docs/beam-templates/employee2out.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -110,13 +110,13 @@ main =
110110
let james = User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c"
111111
betty = User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f"
112112
sam = User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c"
113-
withDatabase conn $ runInsert $
113+
runBeamSqlite conn $ runInsert $
114114
insert (_shoppingCartUsers shoppingCartDb) $
115115
insertValues [ james, betty, sam ]
116116

117117
let onStmt s = pure ()
118118

119-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
119+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
120120
putStrLn :: String -> IO ()
121121
putStrLn x = putStr (concatMap (\x -> if x == '\n' then "\n\n" else [x]) x ++ "\n --\n")
122122

@@ -127,7 +127,7 @@ main =
127127
, Address default_ (val_ "222 Main Street") (val_ (Just "Ste 1")) (val_ "Houston") (val_ "TX") (val_ "8888") (pk betty)
128128
, Address default_ (val_ "9999 Residence Ave") (val_ Nothing) (val_ "Sugarland") (val_ "TX") (val_ "8989") (pk betty) ]
129129

130-
withDatabase conn $ runInsert $
130+
runBeamSqlite conn $ runInsert $
131131
insert (_shoppingCartUserAddresses shoppingCartDb) $
132132
insertExpressions addresses
133133

‎docs/beam-templates/employee2sql.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -109,14 +109,14 @@ main =
109109
let james = User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c"
110110
betty = User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f"
111111
sam = User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c"
112-
withDatabase conn $ runInsert $
112+
runBeamSqlite conn $ runInsert $
113113
insert (_shoppingCartUsers shoppingCartDb) $
114114
insertValues [ james, betty, sam ]
115115

116116
stmts <- newIORef id
117117
let onStmt s = modifyIORef stmts (. (s:))
118118

119-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
119+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
120120
putStrLn :: String -> IO ()
121121
putStrLn _ = pure ()
122122
print :: a -> IO ()
@@ -126,7 +126,7 @@ main =
126126
, Address default_ (val_ "222 Main Street") (val_ (Just "Ste 1")) (val_ "Houston") (val_ "TX") (val_ "8888") (pk betty)
127127
, Address default_ (val_ "9999 Residence Ave") (val_ Nothing) (val_ "Sugarland") (val_ "TX") (val_ "8989") (pk betty) ]
128128

129-
withDatabase conn $ runInsert $
129+
runBeamSqlite conn $ runInsert $
130130
insert (_shoppingCartUserAddresses shoppingCartDb) $
131131
insertExpressions addresses
132132

‎docs/beam-templates/employee3common.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -225,7 +225,7 @@ main =
225225
, Product default_ (val_ "Suitcase") (val_ "A hard durable suitcase") (val_ 15000) ]
226226

227227
(jamesAddress1, bettyAddress1, bettyAddress2, redBall, mathTextbook, introToHaskell, suitcase) <-
228-
withDatabase conn $ do
228+
runBeamSqlite conn $ do
229229
runInsert $ insert (shoppingCartDb ^. shoppingCartUsers) $
230230
insertValues users
231231

@@ -240,7 +240,7 @@ main =
240240
pure ( jamesAddress1, bettyAddress1, bettyAddress2, redBall, mathTextbook, introToHaskell, suitcase )
241241

242242
bettyShippingInfo <-
243-
withDatabase conn $ do
243+
runBeamSqlite conn $ do
244244
[bettyShippingInfo] <-
245245
runInsertReturningList $
246246
insertReturning (shoppingCartDb ^. shoppingCartShippingInfos) $

‎docs/beam-templates/employee3commonout.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
let onStmt s = pure ()
22

3-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
3+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
44

55
putStrLn :: String -> IO ()
66
putStrLn x = putStr (concatMap (\x -> if x == '\n' then "\n\n" else [x]) x ++ "\n --\n")

‎docs/beam-templates/employee3commonsql.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
stmts <- newIORef id
22
let onStmt s = modifyIORef stmts (. (s:))
33

4-
withDatabaseDebug _ q = Beam.withDatabaseDebug onStmt q
4+
withDatabaseDebug _ q = runBeamSqliteDebug onStmt q
55
putStrLn :: String -> IO ()
66
putStrLn _ = pure ()
77
print :: a -> IO ()

‎docs/beam-templates/employee3out-1.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module Main where
1212
#include "employee3common.hs"
1313

1414
[ jamesOrder1, bettyOrder1, jamesOrder2 ] <-
15-
withDatabase conn $ do
15+
runBeamSqlite conn $ do
1616
runInsertReturningList $
1717
insertReturning (shoppingCartDb ^. shoppingCartOrders) $
1818
insertExpressions $

‎docs/beam-templates/employee3out-2.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module Main where
1212
#include "employee3common.hs"
1313

1414
[ jamesOrder1, bettyOrder1, jamesOrder2 ] <-
15-
withDatabase conn $ do
15+
runBeamSqlite conn $ do
1616
runInsertReturningList $
1717
insertReturning (shoppingCartDb ^. shoppingCartOrders) $
1818
insertExpressions $
@@ -29,7 +29,7 @@ module Main where
2929

3030
, LineItem (pk jamesOrder2) (pk mathTextbook) 1 ]
3131

32-
withDatabase conn $ do
32+
runBeamSqlite conn $ do
3333
runInsert $ insert (shoppingCartDb ^. shoppingCartLineItems) $
3434
insertValues lineItems
3535
#include "employee3commonout.hs"

‎docs/beam-templates/employee3sql-1.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module Main where
1212
#include "employee3common.hs"
1313

1414
[ jamesOrder1, bettyOrder1, jamesOrder2 ] <-
15-
withDatabase conn $ do
15+
runBeamSqlite conn $ do
1616
runInsertReturningList $
1717
insertReturning (shoppingCartDb ^. shoppingCartOrders) $
1818
insertExpressions $

‎docs/beam-templates/employee3sql-2.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module Main where
1212
#include "employee3common.hs"
1313

1414
[ jamesOrder1, bettyOrder1, jamesOrder2 ] <-
15-
withDatabase conn $ do
15+
runBeamSqlite conn $ do
1616
runInsertReturningList $
1717
insertReturning (shoppingCartDb ^. shoppingCartOrders) $
1818
insertExpressions $
@@ -29,7 +29,7 @@ module Main where
2929

3030
, LineItem (pk jamesOrder2) (pk mathTextbook) 1 ]
3131

32-
withDatabase conn $ do
32+
runBeamSqlite conn $ do
3333
runInsert $ insert (shoppingCartDb ^. shoppingCartLineItems) $
3434
insertValues lineItems
3535
#include "employee3commonsql.hs"

‎docs/beam.yaml

+2-2
Original file line numberDiff line numberDiff line change
@@ -66,8 +66,8 @@ backends:
6666
backend-options: "127.0.0.1 3306 root '' beam_docs_chinook"
6767
src:
6868
github: tathougies/beam-mysql
69-
revision: a55d9ce7aa4b8c11f232da4bcd3b2a61c650df22
70-
sha256: d39a5b43a13c7cb96dac0d5ad066288d01fdfc576fd537265f3712746457510f
69+
revision: 84a731dcc9bc7bfe1f9f6ead6cdfa6ebe27d6629
70+
sha256: 5dc3c163c1ba89a02f9021457aabafcf717e50a2adabf7cce4b2fb73f6ed0554
7171
haskell-names:
7272
package: beam-mysql
7373
backend: MySQL

0 commit comments

Comments
 (0)