Commit 8ab3034a authored by Bas Lijnse's avatar Bas Lijnse

Added database libraries

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@719 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent dc907eec
libmysql.dll
mysql_affected_rows@4
mysql_close@4
mysql_errno@4
mysql_error@4
mysql_fetch_fields@4
mysql_fetch_lengths@4
mysql_fetch_row@4
mysql_free_result@4
mysql_init@4
mysql_insert_id@4
mysql_num_fields@4
mysql_num_rows@4
mysql_real_connect@32
mysql_real_escape_string@16
mysql_real_query@12
mysql_store_result@4
\ No newline at end of file
definition module MySQL
//This module defines implements the interface for relatational databases
//of SQL.dcl for the MySQL database engine
import SQL
import StdMaybe, StdString
:: MySQLContext
:: MySQLConnection
:: MySQLCursor
instance SQLEnvironment World MySQLContext
instance SQLContext MySQLContext MySQLConnection
instance SQLConnection MySQLConnection MySQLCursor
instance SQLCursor MySQLCursor
This diff is collapsed.
definition module RelationalMapping
/**
* This module provides type-generic functions that map Clean values to a relational database.
* It provides mapping functions for the basic C(reate)R(ead)U(pdate)D(elete) operations.
*
* Although it uses a type-generic function it is defined only for a subset of all Clean types.
* It only has meaning for types that are specifically designed to represent parts of a relational database.
*
* For more information about defining such "representation types" see:
* http://www.baslijnse.nl/projects/between-types-and-tables/
*/
import StdGeneric, StdMaybe
import SQL
// Wrapper functions which provide the basic mapping
mapRead :: !ref !*cur -> (!(Maybe MappingError), !(Maybe val), !*cur) | relMap{|*|} ref & relMap{|*|} val & SQLCursor cur & bimap{|*|} cur
mapCreate :: !val !*cur -> (!(Maybe MappingError), !(Maybe ref), !*cur) | relMap{|*|} ref & relMap{|*|} val & SQLCursor cur & bimap{|*|} cur
mapUpdate :: !val !*cur -> (!(Maybe MappingError), !(Maybe ref), !*cur) | relMap{|*|} ref & relMap{|*|} val & SQLCursor cur & bimap{|*|} cur
mapDelete :: !ref !*cur -> (!(Maybe MappingError), !(Maybe val), !*cur) | relMap{|*|} ref & relMap{|*|} val & SQLCursor cur & bimap{|*|} cur
// Errors
:: MappingError = DatabaseError SQLError //Something went wrong during interaction with the database
| TypeError String //The structure is not conform the constraints of "representation types"
instance toString MappingError
//----------------------------------------------------------------------------------------------------------------------------------------------
/*
* Everything below this line is only relevant if you want to define specializations of the generic mapping function.
* for normal use of the library you may ignore this machinery
*/
// The generic mapper can operate in six different modes
:: RelMapMode = RelMapCreate // Create a new representation in the database for a value
| RelMapRead // Read a representation from the database to the token stream
| RelMapUpdate // Update an existing representation in the database
| RelMapDelete // Remove a representation from the database
| RelMapInfo // Determine type structure information
| RelMapInit // Serialize a value to the tokenstream
// Some operations have to be performed in multiple passes
:: RelMapPass :== Int
// The different types of tokens in the token stream that is
// used as buffer for serializing and deserializing values
:: RelMapToken = RelMapValue SQLValue //Plain value, index in the stream determines to which field it is mapped
| RelMapTerminator //Terminator token, indicates the end of a list of values
| RelMapOverride String SQLValue //Field override, if there is such a token in the stream for a given field,
//its value is used instead of the 'normal' value in the stream
// Information about the structure of types
:: RelMapFieldInfo = { fld_table :: String //The database table in which this value is stored
, fld_select :: Maybe String //The database field in which this value is stored
, fld_match :: Maybe String //The database field on which can be matched to find the right database record
, rec_table :: String //The database table of the key field of the parent record
, rec_key :: String //The database field of the key field of the parent record
, val_list :: Bool //Are dealing with one, or with a set of values
, val_maybe :: Bool //Is the value optional
, val_fields :: [RelMapFieldInfo] //Information about the fields if this value is a record
, val_id :: Bool //Is the field an ID type or an entity record
}
// *The* core generic function
// This function does all operations on a database. It can both read and write information
generic relMap t ::
!RelMapMode !RelMapPass !(Maybe t) ![RelMapFieldInfo] ![RelMapToken] !*cur ->
(!(Maybe MappingError), !(Maybe t),![RelMapFieldInfo],![RelMapToken],!*cur) | SQLCursor cur
// Instances for the standard data types
derive relMap Int, Real, Bool, Char, String, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, {}, {!}, Maybe, []
\ No newline at end of file
This diff is collapsed.
definition module SQL
// *********************************************************************************************************************
// Clean Relational Database (SQL) API. v 0.2
// This module defines a common API for working with relational databases.
// *********************************************************************************************************************
import StdString, StdMaybe
// *********************************************************************************************************************
// Basic types
// *********************************************************************************************************************
// SQL Statements and queries are just strings
:: SQLStatement :== String
// This type represents the possible values that elements of a row in a
// result set can have. The constructors map directly to the constructors of
// the SQLType type.
:: SQLValue = SQLVChar !String
| SQLVVarchar !String
| SQLVText !String
| SQLVInteger !Int
| SQLVReal !Real
| SQLVFloat !Real
| SQLVDouble !Real
| SQLVDate !SQLDate
| SQLVTime !SQLTime
| SQLVTimestamp !Int
| SQLVDatetime !SQLDate !SQLTime
| SQLVEnum !String
| SQLVNull
| SQLVBlob !String
| SQLVUnknown !String
// Date and time structures
:: SQLDate =
{ year :: !Int
, month :: !Int
, day :: !Int
}
:: SQLTime =
{ hour :: !Int
, minute :: !Int
, second :: !Int
}
// A row is just a list of values
:: SQLRow :== [SQLValue]
// *********************************************************************************************************************
// Errors
// *********************************************************************************************************************
// Warning: Non fatal errors, you can still continue
// InterfaceError: Error related to the interface, not the database itself
// DatabaseError: Error related to the database that can not be classified
// as Operational error or Internal error
// DataError: Error due to problems with the data
// OperationalError: Error due to operational problems with the database.
// E.g. disconnects, memory full etc.
// IntegrityError: Errors related to data integrity, e.g. key constraint
// violations
// InternalError: Errors related to internal problems in the database
// library
// ProgrammingError: Errors of the end user, e.g. syntax errors in SQL
// statements
// NotSupportedError: An operation is not supported by the database library
:: SQLError = SQLWarning !Int !String
| SQLInterfaceError !Int !String
| SQLDatabaseError !Int !String
| SQLDataError !Int !String
| SQLOperationalError !Int !String
| SQLIntegrityError !Int !String
| SQLInternalError !Int !String
| SQLProgrammingError !Int !String
| SQLNotSupportedError
// *********************************************************************************************************************
// Database Interaction API
// *********************************************************************************************************************
class SQLEnvironment env ctx
where
openContext :: !*env -> (!(Maybe SQLError), !(Maybe *ctx), !*env)
closeContext :: !*ctx !*env -> (!(Maybe SQLError), !*env)
class SQLContext ctx con
where
openConnection :: !String !String !String !String !*ctx -> (!(Maybe SQLError), !(Maybe *con), !*ctx)
closeConnection :: !*con !*ctx -> (!(Maybe SQLError), !*ctx)
class SQLConnection con cur
where
openCursor :: !*con -> (!(Maybe SQLError), !(Maybe *cur), !*con)
closeCursor :: !*cur !*con -> (!(Maybe SQLError), !*con)
class SQLCursor cur
where
execute :: !SQLStatement ![SQLValue] !*cur -> (!(Maybe SQLError), !*cur)
executeMany :: !SQLStatement ![[SQLValue]] !*cur -> (!(Maybe SQLError), !*cur)
numRows :: !*cur -> (!(Maybe SQLError), !Int, !*cur)
numFields :: !*cur -> (!(Maybe SQLError), !Int, !*cur)
insertId :: !*cur -> (!(Maybe SQLError), !Int, !*cur)
fetchOne :: !*cur -> (!(Maybe SQLError), !(Maybe SQLRow), !*cur)
fetchMany :: !Int !*cur -> (!(Maybe SQLError), ![SQLRow], !*cur)
fetchAll :: !*cur -> (!(Maybe SQLError), ![SQLRow], !*cur)
commit :: !*cur -> (!(Maybe SQLError), !*cur)
rollback :: !*cur -> (!(Maybe SQLError), !*cur)
// *********************************************************************************************************************
// Common class instances
// *********************************************************************************************************************
instance toString SQLValue, SQLDate, SQLTime, SQLError
instance == SQLValue, SQLDate, SQLTime
implementation module SQL
import StdString, StdList, StdBool, StdMaybe, Text
//Utility functions
instance toString SQLValue
where
toString (SQLVChar s) = "SQLVChar " +++ s
toString (SQLVVarchar s) = "SQLVVarchar " +++ s
toString (SQLVText s) = "SQLVText " +++ s
toString (SQLVInteger i) = "SQLVInteger " +++ (toString i)
toString (SQLVReal r) = "SQLVReal " +++ (toString r)
toString (SQLVFloat f) = "SQLVFloat " +++ (toString f)
toString (SQLVDouble d) = "SQLVDouble " +++ (toString d)
toString (SQLVDate d) = "SQLVDate " +++ (toString d)
toString (SQLVTime t) = "SQLVTime " +++ (toString t)
toString (SQLVTimestamp i) = "SQLVTimestamp " +++ (toString i)
toString (SQLVDatetime d t) = "SQLVDatetime " +++ (toString d) +++ " " +++ (toString t)
toString (SQLVEnum s) = "SQLVEnum " +++ s
toString (SQLVNull) = "SQLVNull"
toString (SQLVBlob s) = "SQLVBlob " +++ s
toString (SQLVUnknown s) = "SQLVUnknown " +++ s
instance toString SQLDate
where
toString {SQLDate|year,month,day} = lpad (toString year) 4 '0' +++ "-" +++ lpad (toString month) 2 '0' +++ "-" +++ lpad (toString day) 2 '0'
instance toString SQLTime
where
toString {SQLTime|hour,minute,second} = lpad (toString hour) 2 '0' +++ ":" +++ lpad (toString minute) 2 '0' +++ ":" +++ lpad (toString second) 2 '0'
instance toString SQLError
where
toString (SQLWarning errno errmsg) = "SQLWarning " +++ toString errno +++ ": " +++ errmsg
toString (SQLInterfaceError errno errmsg) = "SQLInterfaceError " +++ toString errno +++ ": " +++ errmsg
toString (SQLDatabaseError errno errmsg) = "SQLDatabaseError " +++ toString errno +++ ": " +++ errmsg
toString (SQLDataError errno errmsg) = "SQLDataError " +++ toString errno +++ ": " +++ errmsg
toString (SQLOperationalError errno errmsg) = "SQLOperationalError " +++ toString errno +++ ": " +++ errmsg
toString (SQLIntegrityError errno errmsg) = "SQLIntegrityError " +++ toString errno +++ ": " +++ errmsg
toString (SQLInternalError errno errmsg) = "SQLInternalError " +++ toString errno +++ ": " +++ errmsg
toString (SQLProgrammingError errno errmsg) = "SQLProgrammingError " +++ toString errno +++ ": " +++ errmsg
toString (SQLNotSupportedError) = "SQLNotSupportedError"
instance == SQLValue
where
(==) (SQLVChar x) (SQLVChar y) = x == y
(==) (SQLVVarchar x) (SQLVVarchar y) = x == y
(==) (SQLVText x) (SQLVText y) = x == y
(==) (SQLVInteger x) (SQLVInteger y) = x == y
(==) (SQLVReal x) (SQLVReal y) = x == y
(==) (SQLVFloat x) (SQLVFloat y) = x == y
(==) (SQLVDouble x) (SQLVDouble y) = x == y
(==) (SQLVDate x) (SQLVDate y) = x == y
(==) (SQLVTime x) (SQLVTime y) = x == y
(==) (SQLVTimestamp x) (SQLVTimestamp y) = x == y
(==) (SQLVDatetime xd xt) (SQLVDatetime yd yt) = xd == yd && xt == yt
(==) (SQLVEnum x) (SQLVEnum y) = x == y
(==) (SQLVNull) (SQLVNull) = True
(==) (SQLVBlob x) (SQLVBlob y) = x == y
(==) (SQLVUnknown x) (SQLVUnknown y) = x == y
(==) _ _ = False
instance == SQLDate
where
(==) {SQLDate|year=xyear,month=xmonth,day=xday} {SQLDate|year=yyear,month=ymonth,day=yday}
= xyear == yyear && xmonth == ymonth && xday == yday
instance == SQLTime
where
(==) {SQLTime|hour=xhour,minute=xminute,second=xsecond} {SQLTime|hour=yhour,minute=yminute,second=ysecond}
= xhour == yhour && xminute == yminute && xsecond == ysecond
\ No newline at end of file
......@@ -98,6 +98,16 @@ class Text s
*/
rtrim :: !s -> s
/**
* Pads a string to a fixed length by adding characters to the beginning of a string.
*/
lpad :: !s !Int !Char -> s
/**
* Pads a string to a fixed length by adding characters to the end of a string.
*/
rpad :: !s !Int !Char -> s
/**
* Converts all characters in a string to lower case.
*/
......
......@@ -29,7 +29,7 @@ instance Text String
lastIndexOf :: !String !String -> Int
lastIndexOf "" haystack = -1
lastIndexOf needle haystack = `lastIndexOf needle haystack (size haystack)
lastIndexOf needle haystack = `lastIndexOf needle haystack (size haystack - 1)
where
`lastIndexOf needle haystack n
| n < 0 = -1
......@@ -68,6 +68,14 @@ instance Text String
| isSpace s.[size s - 1] = if (size s == 1) "" (rtrim (s % (0, size s - 2)))
= s
lpad :: !String !Int !Char -> String
lpad s w c
= let boundary = w - size s in {if (i < boundary) c s.[i - boundary] \\ i <- [0.. w - 1]}
rpad :: !String !Int !Char -> String
rpad s w c
= let boundary = size s in {if (i < boundary) s.[i] c \\ i <- [0.. w - 1]}
toLowerCase :: !String -> String
toLowerCase s = {toLower c \\ c <-: s}
......
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