Commit cd9239b4 authored by Bas Lijnse's avatar Bas Lijnse

Updated the demo program for the database bindings

git-svn-id: https://svn.cs.ru.nl/repos/clean-platform/trunk@50 2afc29ad-3112-4e41-907a-9359c7e6e986
parent 9b43c94c
module SQLDbDemo
/*
* Simple program that illustrates connecting to a MySQL database and some examples of
* functions that insert or select data in a database.
*
* The database schema, with a simple addressbook, for this demo can be found in SQLDbDemo.sql
*/
import StdEnv
import StdEnv,Text
import SQL
import MySQL
import Text
import SQL //Import SQL database API
import MySQL //Import MySQL databaseimplementation
Start :: !*World -> (!String,!*World)
MYSQL_HOST :== "localhost"
MYSQL_USER :== "root"
MYSQL_PASS :== "test"
MYSQL_NAME :== "addressbook"
:: Contact =
{ name :: String
, phoneNr :: String
}
Start :: !*World -> *World
Start world
# (cursor, connection, context, world) = dbInit world
//# (err,cursor) = execute "INSERT INTO project VALUES(NULL,?,NULL)" [SQLVVarchar "testje"] cursor
# (err,cursor) = execute "SELECT * FROM project" [] cursor
| isJust err = (toString (fromJust err),world)
//# (err,id,cursor) = insertId cursor
# (err,mbRow,cursor) = fetchOne cursor
| isJust err = (toString (fromJust err),world)
# world = dbEnd cursor connection context world
= (foldr (+++) " " (map toString (fromJust mbRow)),world)
# (cursor, connection, context, world) = openMySQLDb world
// ============================================================
// Uncomment one of these demo actions
// ============================================================
// Fill the database with test data
//# cursor = fillDatabase cursor
// Print all contacts
//# (cursor,world) = printAllContacts cursor world
# world = closeMySQLDb cursor connection context world
= world
//Database initialization for a MySQL database
openMySQLDb :: !*World -> (!*MySQLCursor, !*MySQLConnection, !*MySQLContext, !*World)
openMySQLDb world
# (err,mbContext,world) = openContext world
| isJust err = abort (toString (fromJust err))
# (err,mbConn,context) = openConnection MYSQL_HOST MYSQL_USER MYSQL_PASS MYSQL_NAME (fromJust mbContext)
| isJust err = abort (toString (fromJust err))
# (err,mbCursor,connection) = openCursor (fromJust mbConn)
| isJust err = abort (toString (fromJust err))
= (fromJust mbCursor,connection, context, world)
closeMySQLDb :: !*MySQLCursor !*MySQLConnection !*MySQLContext !*World -> *World
closeMySQLDb cursor connection context world
# (err,connection) = closeCursor cursor connection
# (err,context) = closeConnection connection context
# (err,world) = closeContext context world
= world
//Inserting data
fillDatabase :: !*cursor -> *cursor | SQLCursor cursor
fillDatabase cursor = insertContacts contacts cursor
where
insertContacts [] cursor = cursor
insertContacts [c:cs] cursor = insertContacts cs (insertContact c cursor)
contacts = [ {Contact| name = "Bas", phoneNr = "1234567890"}
, {Contact| name = "Rinus", phoneNr = "0987654321"}
]
insertContact :: Contact !*cursor -> *cursor | SQLCursor cursor
insertContact contact cursor
# (error,cursor) = execute "INSERT INTO contacts (name,phoneNr) VALUES(?,?)" values cursor
| isJust error = abort (toString (fromJust error))
= cursor
where
dbInit :: !*World -> (!*MySQLCursor, !*MySQLConnection, !*MySQLContext, !*World)
dbInit world
# (err,mbContext,world) = openContext world
| isJust err = abort (toString (fromJust err))
# (err,mbConn,context) = openConnection "localhost" "root" "test" "pmdemo" (fromJust mbContext)
| isJust err = abort (toString (fromJust err))
# (err,mbCursor,connection) = openCursor (fromJust mbConn)
| isJust err = abort (toString (fromJust err))
= (fromJust mbCursor,connection, context, world)
dbEnd :: !*MySQLCursor !*MySQLConnection !*MySQLContext !*World -> *World
dbEnd cursor connection context world
# (err,connection) = closeCursor cursor connection
# (err,context) = closeConnection connection context
# (err,world) = closeContext context world
= world
\ No newline at end of file
values = [SQLVVarchar contact.name, SQLVVarchar contact.phoneNr]
//Selecting data
printAllContacts :: !*cursor !*World -> (*cursor,*World) | SQLCursor cursor
printAllContacts cursor world
# (error,cursor) = execute "SELECT * FROM contacts" [] cursor
| isJust error = abort (toString (fromJust error))
# (error,rows,cursor) = fetchAll cursor
| isJust error = abort (toString (fromJust error))
# (console,world) = stdio world
# console = fwrites (join "\n" (map (\row -> join ", " (map toString row)) rows)) console
# (_,world) = fclose console world
= (cursor,world)
\ No newline at end of file
DROP TABLE IF EXISTS contacts;
CREATE TABLE contacts (
contactId int unsigned NOT NULL auto_increment,
name varchar(255) NOT NULL,
phoneNr varchar(16),
PRIMARY KEY(contactId)
);
\ No newline at end of file
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment