module Database.HSQL.Types where
import Control.Concurrent.MVar
import Control.Exception
import Data.Dynamic
import Foreign
import Foreign.C
type FieldDef = (String, SqlType, Bool)
data SqlType
= SqlChar Int
| SqlVarChar Int
| SqlLongVarChar Int
| SqlText
| SqlWChar Int
| SqlWVarChar Int
| SqlWLongVarChar Int
| SqlDecimal Int Int
| SqlNumeric Int Int
| SqlSmallInt
| SqlMedInt
| SqlInteger
| SqlReal
| SqlFloat
| SqlDouble
| SqlBit
| SqlTinyInt
| SqlBigInt
| SqlBinary Int
| SqlVarBinary Int
| SqlLongVarBinary Int
| SqlDate
| SqlTime
| SqlTimeTZ
| SqlAbsTime
| SqlRelTime
| SqlTimeInterval
| SqlAbsTimeInterval
| SqlTimeStamp
| SqlDateTime
| SqlDateTimeTZ
| SqlYear
| SqlSET
| SqlENUM
| SqlBLOB
| SqlMoney
| SqlINetAddr
| SqlCIDRAddr
| SqlMacAddr
| SqlPoint
| SqlLSeg
| SqlPath
| SqlBox
| SqlPolygon
| SqlLine
| SqlCircle
| SqlUnknown Int
deriving (Eq, Show)
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
#ifdef __GLASGOW_HASKELL__
deriving Typeable
#endif
sqlErrorTc :: TyCon
sqlErrorTc = mkTyCon "Database.HSQL.SqlError"
#ifndef __GLASGOW_HASKELL__
instance Typeable SqlError where
typeOf _ = mkAppTy sqlErrorTc []
#endif
instance Show SqlError where
showsPrec _ (SqlError{seErrorMsg=msg}) = showString msg
showsPrec _ SqlNoData = showString "No data"
showsPrec _ SqlInvalidHandle = showString "Invalid handle"
showsPrec _ SqlStillExecuting = showString "Stlll executing"
showsPrec _ SqlNeedData = showString "Need data"
showsPrec _ (SqlBadTypeCast name tp) = showString ("The type of " ++ name ++ " field can't be converted to " ++ show tp ++ " type")
showsPrec _ (SqlFetchNull name) = showString ("The value of " ++ name ++ " field is null")
showsPrec _ (SqlUnknownField name) = showString ("Unknown field name: " ++ name)
showsPrec _ SqlUnsupportedOperation = showString "Unsupported operation"
showsPrec _ SqlClosedHandle = showString "The referenced handle is already closed"
data Connection
= Connection
{ connDisconnect :: IO ()
, connExecute :: String -> IO ()
, connQuery :: String -> IO Statement
, connTables :: IO [String]
, connDescribe :: String -> IO [FieldDef]
, connBeginTransaction :: IO ()
, connCommitTransaction :: IO ()
, connRollbackTransaction :: IO ()
, connClosed :: MVar Bool
}
data Statement
= Statement
{ stmtConn :: Connection
, stmtClose :: IO ()
, stmtFetch :: IO Bool
, stmtGetCol :: forall a . Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a
, stmtFields :: [FieldDef]
, stmtClosed :: MVar Bool
}
class SqlBind a where
fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a
fromSqlCStringLen (name,sqlType,_) cstr cstrLen
| cstr == nullPtr = throwDyn (SqlFetchNull name)
| otherwise = do
str <- peekCStringLen (cstr, cstrLen)
case fromSqlValue sqlType str of
Nothing -> throwDyn (SqlBadTypeCast name sqlType)
Just v -> return v
fromSqlValue :: SqlType -> String -> Maybe a
toSqlValue :: a -> String