diff --git a/DB/HSQL/Core.hs b/DB/HSQL/Core.hs --- a/DB/HSQL/Core.hs +++ b/DB/HSQL/Core.hs @@ -1,5 +1,6 @@ +{-| Management of handles and exception handling. +-} module DB.HSQL.Core where - import Prelude hiding(catch) import Control.Monad(when,unless) import Control.Exception(Exception,throw,catch,handle) @@ -8,7 +9,7 @@ import DB.HSQL.Error(SqlError(SqlClosedHandle)) --- | if closed, nothing to do: +-- | if closed, no action. closeHandle :: MVar Bool -- ^ closing state ref -> IO () -- ^ DB action to do if not closed -> IO () @@ -16,7 +17,7 @@ modifyMVar_ ref (\closed -> unless closed action >> return True) --- | if closed, exception: +-- | if closed, throws `SqlClosedHandle' exception. checkHandle :: MVar Bool -- ^ closing state ref -> IO a -- ^ DB action to do if not closed -> IO a @@ -28,18 +29,18 @@ ------------------------------------------------------------------------------ -- routines for exception handling ------------------------------------------------------------------------------ --- | Casts, if possible, an Exception to an SqlError: +-- | Casts, if possible, an `Exception' to an `SqlError'. sqlExceptions :: Exception x - => x -- ^ the exception thinc to cast to SQLError + => x -- ^ the exception thinc to be cast -> Maybe SqlError sqlExceptions = cast --- | DEPRECATED: catchSql: Use Control.Exception.catch instead. +-- | Deprecated: Use `Control.Exception.catch' instead. {-# DEPRECATED catchSql "Use Control.Exception.catch instead." #-} catchSql :: IO a -> (SqlError -> IO a) -> IO a catchSql = catch --- | DEPRECATED: handleSql: Use Control.Exception.handle instead. +-- | Deprecated: Use `Control.Exception.handle' instead. {-# DEPRECATED handleSql "Use Control.Exception.handle instead." #-} handleSql :: (SqlError -> IO a) -> IO a -> IO a handleSql = handle diff --git a/DB/HSQL/Error.hs b/DB/HSQL/Error.hs --- a/DB/HSQL/Error.hs +++ b/DB/HSQL/Error.hs @@ -1,46 +1,57 @@ {-# LANGUAGE CPP,DeriveDataTypeable #-} -{-| Differentiation of DB specific error conditions. +{-| `SqlError' type for a variety of DB specific error conditions, +with appropriate `Show', `Typeable', and `Exception' instances. -} -module DB.HSQL.Error(SqlError(..),sqlErrorTc) where +module DB.HSQL.Error(SqlError(..)) where import Control.Exception(Exception(..),SomeException(..)) -import Data.Dynamic(Typeable,TyCon,mkTyCon,cast) - +import Data.Dynamic(Typeable,TyCon,mkTyCon3,cast) import DB.HSQL.Type(SqlType) -- | data SqlError - = SqlError { seState :: String - , seNativeError :: Int - , seErrorMsg :: String } - | SqlNoData - | SqlInvalidHandle - | SqlStillExecuting - | SqlNeedData - | SqlBadTypeCast { seFieldName :: String - , seFieldType :: SqlType } - | SqlFetchNull { seFieldName :: String } - | SqlUnknownField { seFieldName :: String } - | SqlUnsupportedOperation - | SqlClosedHandle + = SqlError + { seState :: String + , seNativeError :: Int + , seErrorMsg :: String + } -- ^ generic error condition, with further specification + | SqlNoMoreData -- ^ no more data was available + | SqlInvalidHandle -- ^ requested handle is invalid + | SqlStillExecuting -- ^ connection is blocked by running transaction + | SqlNeedMoreData -- ^ more data is needed, e.g. additional connection + -- specs + | SqlBadTypeCast + { seFieldName :: String + , seFieldType :: SqlType + } -- ^ requested field can't be converted to requested type + | SqlFetchNull + { seFieldName :: String } -- ^ requested field returns NULL + | SqlUnknownField + { seFieldName :: String } -- ^ requested field isn't known + | SqlUnsupportedOperation -- ^ requested operation isn't supported + | SqlClosedHandle -- ^ referenced handle is already closed #ifdef __GLASGOW_HASKELL__ - deriving Typeable + deriving (Eq,Ord,Typeable) #else + deriving (Eq,Ord) instance Typeable SqlError where typeOf _ = mkAppTy sqlErrorTc [] #endif +-- | The `TyCon' of `SqlError'. sqlErrorTc :: TyCon -sqlErrorTc = mkTyCon "Database.HSQL.SqlError" +sqlErrorTc = mkTyCon3 "DB.HSQL" "Error" "SqlError" -- | instance Show SqlError where showsPrec _ (SqlError{seErrorMsg=msg}) = showString msg - showsPrec _ SqlNoData = showString "No data" + showsPrec _ SqlNoMoreData = + showString "No more data was available" showsPrec _ SqlInvalidHandle = showString "Invalid handle" - showsPrec _ SqlStillExecuting = showString "Stlll executing" - showsPrec _ SqlNeedData = showString "Need data" + showsPrec _ SqlStillExecuting = showString "Still executing" + showsPrec _ SqlNeedMoreData = + showString "More data is needed, e.g. additional connection specs" showsPrec _ (SqlBadTypeCast name tp) = showString ("The type of "++name++" field can't be converted to " ++show tp++" type") diff --git a/DB/HSQL/Type.hs b/DB/HSQL/Type.hs --- a/DB/HSQL/Type.hs +++ b/DB/HSQL/Type.hs @@ -1,7 +1,7 @@ module DB.HSQL.Type where -{-| Differentiation of data types used in DBs. --} +{-| Variety of common data types used in databases. +-} data SqlType -- numeric: = SqlInteger -- ODBC, MySQL, PostgreSQL, MSI @@ -9,8 +9,14 @@ | SqlSmallInt -- ODBC, MySQL, PostgreSQL | SqlTinyInt -- ODBC, MySQL, PostgreSQL | SqlMedInt -- , MySQL, - | SqlDecimal Int Int -- ODBC, MySQL, PostgreSQL - | SqlNumeric Int Int -- ODBC, MySQL, PostgreSQL + | SqlDecimal + { typeSize:: Int + , typeDecimals:: Int } + -- ODBC, MySQL, PostgreSQL + | SqlNumeric + { typeSize:: Int + , typeDecimals:: Int } + -- ODBC, MySQL, PostgreSQL | SqlReal -- ODBC, MySQL, PostgreSQL | SqlDouble -- ODBC, MySQL, PostgreSQL | SqlFloat -- ODBC @@ -19,13 +25,13 @@ | SqlMoney -- , , PostgreSQL -- character: - | SqlChar Int -- ODBC, MySQL, PostgreSQL - | SqlVarChar Int -- ODBC, MySQL, PostgreSQL, MSI - | SqlLongVarChar Int -- ODBC + | SqlChar { typeSize:: Int } -- ODBC, MySQL, PostgreSQL + | SqlVarChar { typeSize:: Int } -- ODBC, MySQL, PostgreSQL, MSI + | SqlLongVarChar { typeSize:: Int } -- ODBC | SqlText -- , , PostgreSQL, MSI - | SqlWChar Int -- ODBC - | SqlWVarChar Int -- ODBC - | SqlWLongVarChar Int -- ODBC + | SqlWChar { typeSize:: Int } -- ODBC + | SqlWVarChar { typeSize:: Int } -- ODBC + | SqlWLongVarChar { typeSize:: Int } -- ODBC -- date / time: | SqlDate -- ODBC, MySQL, PostgreSQL @@ -61,9 +67,9 @@ | SqlMacAddr -- , , PostgreSQL -- bit strings: - | SqlBinary Int -- ODBC, , PostgreSQL - | SqlVarBinary Int -- ODBC, , PostgreSQL - | SqlLongVarBinary Int -- ODBC + | SqlBinary { typeSize:: Int } -- ODBC, , PostgreSQL + | SqlVarBinary { typeSize:: Int } -- ODBC, , PostgreSQL + | SqlLongVarBinary { typeSize:: Int } -- ODBC -- collections: | SqlSET -- , MySQL @@ -72,9 +78,10 @@ | SqlBLOB -- , MySQL, , MSI -- unknown: - | SqlUnknown Int -- ^ HSQL returns @SqlUnknown tp@ for all - -- columns for which it cannot determine - -- the right type. The @tp@ here is the - -- internal type code returned from the - -- backend library - deriving (Eq, Show) + | SqlUnknown { typeCode:: Int } + -- ^ HSQL returns `SqlUnknown' for all + -- columns for which it cannot determine + -- the right type. The `backendTypeCode' here is the + -- internal type code returned from the + -- backend library + deriving (Eq,Ord,Show,Read) diff --git a/DB/HSQL/Type/Diverse.hs b/DB/HSQL/Type/Diverse.hs --- a/DB/HSQL/Type/Diverse.hs +++ b/DB/HSQL/Type/Diverse.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-| `SqlBind' instances for `String', `Bool' and `Maybe'. +-} module DB.HSQL.Type.Diverse where - import Foreign(nullPtr) - import DB.HSQL.Type(SqlType(SqlBit)) import Database.HSQL.Types(SqlBind(..)) diff --git a/DB/HSQL/Type/Geometric.hs b/DB/HSQL/Type/Geometric.hs --- a/DB/HSQL/Type/Geometric.hs +++ b/DB/HSQL/Type/Geometric.hs @@ -1,13 +1,15 @@ +{-| Geometric 2D types, equipped with `SqlBind' instances. +-} module DB.HSQL.Type.Geometric where import DB.HSQL.Type (SqlType(SqlPoint,SqlLSeg,SqlPath,SqlBox,SqlPolygon,SqlCircle)) import Database.HSQL.Types(SqlBind(..)) --- | +-- | A 2D point. data Point - = Point Double Double - deriving (Eq, Show) + = Point { pointX:: Double, pointY:: Double } + deriving (Eq,Ord,Show,Read) instance SqlBind Point where fromSqlValue SqlPoint s = case read s of @@ -18,10 +20,10 @@ '\'' : shows (x,y) "'" --- | +-- | A 2D straight line. data Line - = Line Point Point - deriving (Eq, Show) + = Line { lineBegin:: Point, lineEnd:: Point } + deriving (Eq, Show,Read) instance SqlBind Line where fromSqlValue SqlLSeg s = @@ -32,12 +34,13 @@ toSqlValue (Line (Point x1 y1) (Point x2 y2)) = '\'' : shows [(x1,y1),(x2,y2)] "'" - --- | +-- | A 2D path, either open, or closed (looping). data Path - = OpenPath [Point] - | ClosedPath [Point] - deriving (Eq, Show) + = OpenPath { pathPoints:: [Point] } + -- ^ An open path + | ClosedPath { pathPoints:: [Point] } + -- ^ A looping path + deriving (Eq, Show,Read) instance SqlBind Path where fromSqlValue SqlPath ('(':s) = @@ -57,11 +60,13 @@ toSqlValue (OpenPath ps) = '\'' : shows ps "'" toSqlValue (ClosedPath ps) = "'(" ++ init (tail (show ps)) ++ "')" - --- | +-- | A 2D rectangle. data Box - = Box Double Double Double Double - deriving (Eq, Show) + = Box { boxX1:: Double + , boxY1:: Double + , boxX2:: Double + , boxY2:: Double } + deriving (Eq, Show,Read) instance SqlBind Box where fromSqlValue SqlBox s = case read ("("++s++")") of @@ -72,10 +77,10 @@ '\'' : shows ((x1,y1),(x2,y2)) "'" --- | +-- | A 2D polygon (without holes). data Polygon - = Polygon [Point] - deriving (Eq, Show) + = Polygon { polygonPoints:: [Point] } + deriving (Eq, Show,Read) instance SqlBind Polygon where fromSqlValue SqlPolygon s = @@ -87,10 +92,11 @@ "'(" ++ init (tail (show ps)) ++ "')" --- | +-- | A 2D circle data Circle - = Circle Point Double - deriving (Eq, Show) + = Circle { circleCenter:: Point + , circleRadius:: Double } + deriving (Eq, Show,Read) instance SqlBind Circle where fromSqlValue SqlCircle s = case read ("("++init (tail s)++")") of diff --git a/DB/HSQL/Type/NetAddress.hs b/DB/HSQL/Type/NetAddress.hs --- a/DB/HSQL/Type/NetAddress.hs +++ b/DB/HSQL/Type/NetAddress.hs @@ -1,3 +1,5 @@ +{-| Network addresses, equipped with `SqlBind' instances. +-} module DB.HSQL.Type.NetAddress where import Data.Char(intToDigit) @@ -6,10 +8,14 @@ import DB.HSQL.Type(SqlType(SqlINetAddr,SqlCIDRAddr,SqlMacAddr)) import Database.HSQL.Types(SqlBind(..)) --- | +-- | An IP4 address with netmask in CIDR notation. data INetAddr - = INetAddr Int Int Int Int Int - deriving (Eq,Show) + = INetAddr { ip4Octet1:: Int + , ip4Octet2:: Int + , ip4Octet3:: Int + , ip4Octet4:: Int + , cidrMaskBits:: Int } + deriving (Eq,Ord,Show,Read) instance SqlBind INetAddr where fromSqlValue t s @@ -37,10 +43,15 @@ slash = showChar '/' --- | +-- | A MAC network address. data MacAddr - = MacAddr Int Int Int Int Int Int - deriving (Eq,Show) + = MacAddr { macOctet1:: Int + , macOctet2:: Int + , macOctet3:: Int + , macOctet4:: Int + , macOctet5:: Int + , macOctet6:: Int } + deriving (Eq,Ord,Show,Read) instance SqlBind MacAddr where fromSqlValue SqlMacAddr s = diff --git a/DB/HSQL/Type/Numeric.hs b/DB/HSQL/Type/Numeric.hs --- a/DB/HSQL/Type/Numeric.hs +++ b/DB/HSQL/Type/Numeric.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP,ForeignFunctionInterface #-} -module DB.HSQL.Type.Numeric where +{-| `SqlBind' instances for `Int', `Int64', `Integer', `Double', and `Float'. +-} +module DB.HSQL.Type.Numeric() where import Control.Exception(throw) import Data.Int(Int64) diff --git a/DB/HSQL/Type/Time.hsc b/DB/HSQL/Type/Time.hsc --- a/DB/HSQL/Type/Time.hsc +++ b/DB/HSQL/Type/Time.hsc @@ -1,5 +1,7 @@ {-# LANGUAGE CPP,ForeignFunctionInterface #-} -module DB.HSQL.Type.Time where +{-| `SqlBind' instance for `ClockTime'. +-} +module DB.HSQL.Type.Time() where import Control.Monad(mplus) import System.IO.Unsafe(unsafePerformIO) @@ -8,7 +10,7 @@ import Text.ParserCombinators.ReadP(ReadP,char,skipSpaces,readP_to_S) import Text.Read.Lex(readDecP) import Foreign(Ptr,allocaBytes,pokeByteOff) -import Foreign.C(CTime,CInt) +import Foreign.C.Types(CTime(CTime),CInt) import DB.HSQL.Type (SqlType(SqlTimeTZ,SqlTime,SqlDate,SqlDateTimeTZ,SqlDateTime @@ -18,6 +20,63 @@ #include -- | +instance SqlBind ClockTime where + fromSqlValue SqlTimeTZ s = f_read getTimeTZ s + where getTimeTZ :: ReadP ClockTime + getTimeTZ = do + (hour, minutes, seconds) <- readHMS + (char '.' >> readDecP) `mplus` (return 0) + tz <- parseTZ + return (mkClockTime 1970 1 1 hour minutes seconds (tz*3600)) + fromSqlValue SqlTime s = f_read getTime s + where getTime :: ReadP ClockTime + getTime = do + (hour, minutes, seconds) <- readHMS + return (mkClockTime 1970 1 1 hour minutes seconds currTZ) + fromSqlValue SqlDate s = f_read getDate s + where getDate :: ReadP ClockTime + getDate = do + (year, month, day) <- readYMD + return (mkClockTime year month day 0 0 0 currTZ) + fromSqlValue SqlDateTimeTZ s = f_read getDateTimeTZ s + where getDateTimeTZ :: ReadP ClockTime + getDateTimeTZ = do + (year, month, day, hour, minutes, seconds) <- readDateTime + char '.' >> readDecP -- ) `mplus` (return 0) + tz <- parseTZ + return (mkClockTime year month day + hour minutes seconds + (tz*3600)) + -- The only driver which seems to report the type as SqlTimeStamp seems + -- to be the MySQL driver. MySQL (at least 4.1) uses the same format for + -- datetime and timestamp columns. + -- Allow SqlText to support SQLite, which reports everything as SqlText + fromSqlValue t s + | t == SqlDateTime || t == SqlTimeStamp || t == SqlText = + f_read getDateTime s + where getDateTime :: ReadP ClockTime + getDateTime = do + (year, month, day, hour, minutes, seconds) <- + readDateTime + return (mkClockTime year month day + hour minutes seconds + currTZ) + fromSqlValue _ _ = Nothing + + toSqlValue ct = + '\'' : (shows (ctYear t) . score . + shows (ctMonth t) . score . + shows (ctDay t) . space . + shows (ctHour t) . colon . + shows (ctMin t) . colon . + shows (ctSec t)) "'" + where t = toUTCTime ct + score = showChar '-' + space = showChar ' ' + colon = showChar ':' + + +-- | mkClockTime :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> ClockTime mkClockTime year mon mday hour min sec tz = unsafePerformIO $ do @@ -84,60 +143,3 @@ skipSpaces (hour, minutes, seconds) <- readHMS return (year, month, day, hour, minutes, seconds) - - --- | -instance SqlBind ClockTime where - fromSqlValue SqlTimeTZ s = f_read getTimeTZ s - where getTimeTZ :: ReadP ClockTime - getTimeTZ = do - (hour, minutes, seconds) <- readHMS - (char '.' >> readDecP) `mplus` (return 0) - tz <- parseTZ - return (mkClockTime 1970 1 1 hour minutes seconds (tz*3600)) - fromSqlValue SqlTime s = f_read getTime s - where getTime :: ReadP ClockTime - getTime = do - (hour, minutes, seconds) <- readHMS - return (mkClockTime 1970 1 1 hour minutes seconds currTZ) - fromSqlValue SqlDate s = f_read getDate s - where getDate :: ReadP ClockTime - getDate = do - (year, month, day) <- readYMD - return (mkClockTime year month day 0 0 0 currTZ) - fromSqlValue SqlDateTimeTZ s = f_read getDateTimeTZ s - where getDateTimeTZ :: ReadP ClockTime - getDateTimeTZ = do - (year, month, day, hour, minutes, seconds) <- readDateTime - char '.' >> readDecP -- ) `mplus` (return 0) - tz <- parseTZ - return (mkClockTime year month day - hour minutes seconds - (tz*3600)) - -- The only driver which seems to report the type as SqlTimeStamp seems - -- to be the MySQL driver. MySQL (at least 4.1) uses the same format for - -- datetime and timestamp columns. - -- Allow SqlText to support SQLite, which reports everything as SqlText - fromSqlValue t s - | t == SqlDateTime || t == SqlTimeStamp || t == SqlText = - f_read getDateTime s - where getDateTime :: ReadP ClockTime - getDateTime = do - (year, month, day, hour, minutes, seconds) <- - readDateTime - return (mkClockTime year month day - hour minutes seconds - currTZ) - fromSqlValue _ _ = Nothing - - toSqlValue ct = - '\'' : (shows (ctYear t) . score . - shows (ctMonth t) . score . - shows (ctDay t) . space . - shows (ctHour t) . colon . - shows (ctMin t) . colon . - shows (ctSec t)) "'" - where t = toUTCTime ct - score = showChar '-' - space = showChar ' ' - colon = showChar ':' diff --git a/Database/HSQL.hs b/Database/HSQL.hs --- a/Database/HSQL.hs +++ b/Database/HSQL.hs @@ -15,7 +15,12 @@ Connection , disconnect -- :: Connection -> IO () + -- * Metadata + , tables -- :: Connection -> IO [String] + , ColDef, describe -- :: Connection -> String -> IO [ColDef] + -- * Command Execution Functions + , SQL -- | Once a connection to a database has been successfully established, -- the functions described here are used to perform -- SQL queries and commands. @@ -26,7 +31,7 @@ , fetch -- :: Statement -> IO Bool -- * Retrieving Statement values and types - , FieldDef, SqlBind(..) + , SqlBind(..) , getFieldValue -- :: SqlBind a => Statement -> String -> IO a , getFieldValueMB , getFieldValue' -- :: SqlBind a => Statement -> String -> a -> IO a @@ -46,10 +51,6 @@ , catchSql , handleSql , sqlExceptions -- :: Exception -> Maybe SqlError - - -- * Metadata - , tables -- :: Connection -> IO [String] - , describe -- :: Connection -> String -> IO [FieldDef] -- * Extra types , Point(..), Line(..), Path(..), Box(..), Circle(..), Polygon(..) @@ -69,7 +70,7 @@ import DB.HSQL.Type.Diverse() import DB.HSQL.Error import DB.HSQL.Core -import Database.HSQL.Types(FieldDef,Connection(..),Statement(..) +import Database.HSQL.Types(SQL,TableId,ColDef,Connection(..),Statement(..) ,SqlBind(fromSqlCStringLen)) ------------------------------------------------------------------------------ @@ -84,14 +85,14 @@ -- | Submits a command to the database. execute :: Connection -- ^ the database connection - -> String -- ^ the text of SQL command + -> SQL -- ^ the text of SQL command -> IO () execute conn query = checkHandle (connClosed conn) (connExecute conn query) -- | Executes a query and returns a result set query :: Connection -- ^ the database connection - -> String -- ^ the text of SQL query + -> SQL -- ^ the text of SQL query -> IO Statement -- ^ the associated statement. Must be closed with -- the 'closeStatement' function query conn query = @@ -99,14 +100,14 @@ -- | List all tables in the database. tables :: Connection -- ^ Database connection - -> IO [String] -- ^ The names of all tables in the database. + -> IO [TableId] -- ^ The names of all tables in the database. tables conn = checkHandle (connClosed conn) (connTables conn) -- | List all columns in a table along with their types and @nullable@ flags describe :: Connection -- ^ Database connection - -> String -- ^ Name of a database table - -> IO [FieldDef] -- ^ The list of fields in the table + -> TableId -- ^ Name of a database table + -> IO [ColDef] -- ^ The list of fields in the table describe conn table = checkHandle (connClosed conn) (connDescribe conn table) @@ -160,7 +161,7 @@ getFieldsTypes :: Statement -> [(String, SqlType, Bool)] getFieldsTypes stmt = stmtFields stmt -findFieldInfo :: String -> [FieldDef] -> Int -> (SqlType,Bool,Int) +findFieldInfo :: String -> [ColDef] -> Int -> (SqlType,Bool,Int) findFieldInfo name [] colNumber = throw (SqlUnknownField name) findFieldInfo name (fieldDef@(name',sqlType,nullable):fields) colNumber | name == name' = (sqlType,nullable,colNumber) diff --git a/Database/HSQL/Types.hs b/Database/HSQL/Types.hs --- a/Database/HSQL/Types.hs +++ b/Database/HSQL/Types.hs @@ -3,20 +3,33 @@ {-| Basic type class & type definitions for DB interfacing. -} module Database.HSQL.Types - (FieldDef,SqlType(..),SqlError(..),sqlErrorTc - ,Connection(..),Statement(..),SqlBind(..)) where + (SQL,TableId,Connection(..) + ,ColId,Nullability,ColDef,FieldReader,FieldReading,Statement(..) + ,SqlBind(..),SqlType(..),SqlError(..)) where import Control.Concurrent.MVar(MVar) import Control.Exception(throw) import Foreign(nullPtr) import Foreign.C(CString,peekCStringLen) -import DB.HSQL.Type -import DB.HSQL.Error +import DB.HSQL.Type(SqlType(..)) +import DB.HSQL.Error(SqlError(..)) --- | -type FieldDef = (String, SqlType, Bool) +-- | A table column ID. +type ColId = String +-- | Whether fields of a table col may be NULL. +type Nullability = Bool + +-- | Description of the properties of a table column. +type ColDef = (ColId, SqlType, Nullability) + +-- | An SQL Query. +type SQL = String + +-- | A table ID. +type TableId = String + -- | A 'Connection' type represents a connection to a database, -- through which you can operate on the it. -- In order to create the connection you need to use the @connect@ function @@ -26,13 +39,13 @@ -- | disconnect action connDisconnect :: IO (), -- | query execution action (without return value) - connExecute :: String -> IO (), + connExecute :: SQL -> IO (), -- | query action with return value - connQuery :: String -> IO Statement, + connQuery :: SQL -> IO Statement, -- | retrieval of the names of the tables in reach - connTables :: IO [String], + connTables :: IO [TableId], -- | retrieval of the field defs of a table - connDescribe :: String -> IO [FieldDef], + connDescribe :: TableId -> IO [ColDef], -- | begin of a transaction connBeginTransaction :: IO (), -- | commit of a pending transaction @@ -42,46 +55,56 @@ -- | closing state of the connection connClosed :: MVar Bool } +-- | A DB generic field extraction function, specifiable by +-- field definition, receiving the content code and its length. +type FieldReader t = ColDef -- ^ field type spec + -> CString -- ^ field content code + -> Int -- ^ field content length + -> IO t -- ^ field read action +-- | An extraction of a field of type to be specified by requester, +-- from a row index with source `ColDef', applying an appropriate +-- `FieldReader'. +type FieldReading = forall t + . Int -- ^ field (column) index + -> ColDef -- ^ source field type spec + -> FieldReader t -- ^ field reader to be applied + -> IO t -- ^ field read action + -- | The 'Statement' type represents a result from the execution of given -- SQL query. data Statement = Statement { - -- | field descriptors + -- | DB connection the statement depends on stmtConn :: Connection, - -- | closing action + -- | close action stmtClose :: IO (), -- | incrementation of the row pointer and indication -- whether this is still in range of available rows stmtFetch :: IO Bool, - -- | extraction of a field from the current result row, with - -- - -- * a column index - -- - -- * a column field definition - -- - -- * a generic field extraction function, specifiable by - -- a field definition, a C string and its length - stmtGetCol :: forall a . Int -- column index - -> FieldDef -- column field definition - -> (FieldDef->CString->Int->IO a) - -- generic field extraction function, - -- specifiable by field definition, - -- receiving the C string and its length - -> IO a, - -- | field descriptors - stmtFields :: [FieldDef], - -- | closing state of the statement + -- | a `FieldReading' function applicable for each row + stmtGetCol :: FieldReading, + -- | field descriptors for each result table column + stmtFields :: [ColDef], + -- | check whether the statement is closed stmtClosed :: MVar Bool } --- | +-- | Equivalent to Show and Read adapted to SQL expressions. class SqlBind a where - toSqlValue :: a -> String - fromSqlValue :: SqlType -> String -> Maybe a - -- | This allows for faster conversion for eq. integral numeric types, - -- etc. Default version uses fromSqlValue. - fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a + -- | show as an SQL expression + toSqlValue:: a-> SQL + -- | read from an SQL expression in text representation, + -- by support of its `SqlType' + fromSqlValue:: SqlType-> SQL-> Maybe a + -- | read from SQL expression in binary representation, + -- by support of its `ColDef' and code size info. + -- This allows for faster conversion for e.g. integral numeric types, + -- etc. + fromSqlCStringLen:: ColDef + -> CString -- ^ binary content of SQL expression + -> Int -- ^ size of binary content + -> IO a fromSqlCStringLen (name,sqlType,_) cstr cstrLen | cstr == nullPtr = throw (SqlFetchNull name) | otherwise = do diff --git a/hsql.cabal b/hsql.cabal --- a/hsql.cabal +++ b/hsql.cabal @@ -1,25 +1,44 @@ -name: hsql -version: 1.8.1 -license: BSD3 -author: Krasimir Angelov -maintainer: Nick Rudnick -category: Database -synopsis: Simple library for database access from Haskell. -description: Simple library for database access from Haskell. -exposed-modules: - DB.HSQL.Core, - DB.HSQL.Error, - DB.HSQL.Type, - DB.HSQL.Type.Diverse, - DB.HSQL.Type.Geometric, - DB.HSQL.Type.Numeric, - DB.HSQL.Type.Time, - DB.HSQL.Type.NetAddress, - Database.HSQL, - Database.HSQL.Types -build-depends: base==4.*, old-time -extensions: CPP, ForeignFunctionInterface, DeriveDataTypeable, RankNTypes, - ScopedTypeVariables -build-type: Simple -license-file: LICENSE -cabal-version: >= 1.6 +Name: hsql +Version: 1.8.2 +Cabal-Version: >=1.10 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Author: Krasimir Angelov +Maintainer: Nick Rudnick +Category: Database +Synopsis: Database access from Haskell. +Description: Simple library for database access from Haskell. + +Library { + Build-Depends: base==4.*, old-time + Exposed-Modules: DB.HSQL.Core, + DB.HSQL.Error, + DB.HSQL.Type, + DB.HSQL.Type.Diverse, + DB.HSQL.Type.Geometric, + DB.HSQL.Type.Numeric, + DB.HSQL.Type.Time, + DB.HSQL.Type.NetAddress, + Database.HSQL, + Database.HSQL.Types + Exposed: True + Other-Modules: + Hs-Source-Dirs: . + Default-Extensions: + Other-Extensions: CPP, DeriveDataTypeable, FlexibleInstances, + ForeignFunctionInterface, RankNTypes, ScopedTypeVariables + Buildable: True + GHC-Options: + Includes: + Install-includes: + Include-Dirs: + C-Sources: + Extra-Libraries: + Extra-Lib-Dirs: + CC-Options: + LD-Options: + PkgConfig-Depends: + Frameworks: + Default-Language: Haskell2010 +}