{-# LANGUAGE CPP,DeriveDataTypeable #-}
{-| Differentiation of DB specific error conditions.
-}
module DB.HSQL.Error(SqlError(..),sqlErrorTc) where

import Control.Exception(Exception(..),SomeException(..))
import Data.Dynamic(Typeable,TyCon,mkTyCon,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
#ifdef __GLASGOW_HASKELL__
   deriving Typeable
#else

instance Typeable SqlError where
	typeOf _ = mkAppTy sqlErrorTc []
#endif

sqlErrorTc :: TyCon
sqlErrorTc = mkTyCon "Database.HSQL.SqlError"

-- |
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"

-- |
instance Exception SqlError where
    toException = SomeException
    fromException (SomeException exception) =
        cast exception