    {-# LANGUAGE ScopedTypeVariables #-}
    {-| Module      :  Database.HSQL
        Copyright   :  (c) Krasimir Angelov 2003
        License     :  BSD-style

        Maintainer  :  ka2_mail@yahoo.com
        Stability   :  provisional
        Portability :  portable

        The module provides an abstract database interface
    -}
    module Database.HSQL
        (
        -- * Connect\/Disconnect
        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.
        , execute           -- :: Connection -> String -> IO ()
        , Statement
        , query             -- :: Connection -> String -> IO Statement
        , closeStatement    -- :: Statement -> IO ()
        , fetch             -- :: Statement -> IO Bool

        -- * Retrieving Statement values and types
        , SqlBind(..)
        , getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
        , getFieldValueMB
        , getFieldValue'    -- :: SqlBind a => Statement -> String -> a -> IO a
        , getFieldValueType -- :: Statement -> String -> (SqlType, Bool)
        , getFieldsTypes    -- :: Statement -> [(String, SqlType, Bool)]

        -- * Transactions
        , inTransaction     -- :: Connection -> (Connection -> IO a) -> IO a

        -- * Utilities
        , forEachRow        -- :: (Statement -> s -> IO s) -- ^ an action
        , forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
        , collectRows       -- :: (Statement -> IO a) -> Statement -> IO [a]

        -- * SQL Exceptions handling
        , SqlError(..)
        , catchSql
        , handleSql
        , sqlExceptions     -- :: Exception -> Maybe SqlError

        -- * Extra types
        , Point(..), Line(..), Path(..), Box(..), Circle(..), Polygon(..)
        , INetAddr(..), MacAddr(..)
        , SqlType(..)
        ) where

    import Prelude hiding(catch)
    import Control.Monad(when)
    import Control.Exception(SomeException,finally,throwIO,throw,catch)

    import DB.HSQL.Type
    import DB.HSQL.Type.Numeric
    import DB.HSQL.Type.Time
    import DB.HSQL.Type.Geometric
    import DB.HSQL.Type.NetAddress
    import DB.HSQL.Type.Diverse()
    import DB.HSQL.Error
    import DB.HSQL.Core
    import Database.HSQL.Types(SQL,TableId,ColDef,Connection(..),Statement(..)
                              ,SqlBind(fromSqlCStringLen))

    ------------------------------------------------------------------------------
    -- Operations on the connection
    ------------------------------------------------------------------------------
    -- | Closes the connection. Performing 'disconnect' on a connection that has
    -- already been closed has no effect.
    -- All other operations on a closed connection will fail.
    disconnect :: Connection -> IO ()
    disconnect conn =
        closeHandle (connClosed conn) (connDisconnect conn)

    -- | Submits a command to the database.
    execute :: Connection  -- ^ the database connection
            -> 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
          -> SQL        -- ^ the text of SQL query
          -> IO Statement  -- ^ the associated statement. Must be closed with
                           -- the 'closeStatement' function
    query conn query =
        checkHandle (connClosed conn) (connQuery conn query)

    -- | List all tables in the database.
    tables :: Connection   -- ^ Database connection
           -> 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
    	 -> TableId        -- ^ Name of a database table
    	 -> IO [ColDef] -- ^ The list of fields in the table
    describe conn table =
        checkHandle (connClosed conn) (connDescribe conn table)

    ------------------------------------------------------------------------------
    -- transactions
    ------------------------------------------------------------------------------

    -- | The 'inTransaction' function executes the specified action in transaction
    --  mode.
    -- If the action completes successfully then the transaction will be commited.
    -- If the action completes with an exception then the transaction will be
    -- rolled back and the exception will be throw again.
    -- A transaction is to catch ANY exception, so 'SomeException' is adequate.
    inTransaction :: Connection            -- ^ Database connection
                  -> (Connection -> IO a)  -- ^ an action
                  -> IO a                  -- ^ the returned value is the result
                                            -- returned from action
    inTransaction conn action = do
      checkHandle (connClosed conn) (connBeginTransaction conn)
      r <- catch (action conn)
                 (\(err::SomeException) -> do
                    checkHandle (connClosed conn)
                                (connRollbackTransaction conn)
    	        throwIO err)
      checkHandle (connClosed conn) (connCommitTransaction conn)
      return r

    ------------------------------------------------------------------------------
    -- Operations on the statements
    ------------------------------------------------------------------------------
    -- | 'fetch' fetches the next rowset of data from the result set.
    -- The values from columns can be retrieved with 'getFieldValue' function.
    fetch :: Statement -> IO Bool
    fetch stmt = checkHandle (stmtClosed stmt) (stmtFetch stmt)

    -- | 'closeStatement' stops processing associated with a specific statement,
    -- closes any open cursors associated with the statement, discards pending
    -- results, and frees all resources associated with the statement.
    -- Performing 'closeStatement' on a statement that has already been closed
    -- has no effect. All other operations on a closed statement will fail.
    closeStatement :: Statement -> IO ()
    closeStatement stmt = closeHandle (stmtClosed stmt) (stmtClose stmt)

    -- | Returns the type and the @nullable@ flag for field with specified name
    getFieldValueType :: Statement -> String -> (SqlType, Bool)
    getFieldValueType stmt name = (sqlType, nullable)
        where (sqlType,nullable,colNumber) =
                  findFieldInfo name (stmtFields stmt) 0

    -- | Returns the list of fields with their types and @nullable@ flags
    getFieldsTypes :: Statement -> [(String, SqlType, Bool)]
    getFieldsTypes stmt = stmtFields stmt

    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)
        | otherwise = findFieldInfo name fields $! (colNumber+1)

    ------------------------------------------------------------------------------
    -- binding
    ------------------------------------------------------------------------------
    -- | Retrieves the value of field with the specified name.
    getFieldValue :: SqlBind a => Statement    -- ^ result table data
                               -> String       -- ^ field name
                               -> IO a         -- ^ field value
    getFieldValue stmt name = do
      stmtGetCol stmt colNumber (name,sqlType,nullable) fromSqlCStringLen
      where (sqlType,nullable,colNumber) =
                findFieldInfo name (stmtFields stmt) 0

    {-# DEPRECATED getFieldValueMB "Use getFieldValue instead." #-}
    getFieldValueMB :: SqlBind a => Statement -> String -> IO (Maybe a)
    getFieldValueMB = getFieldValue

    -- | Retrieves the value of field with the specified name.
    -- If the field value is @null@ then the function will return the default value.
    getFieldValue' :: SqlBind a => Statement
                                -> String     -- ^ Field name
                                -> a          -- ^ Default field value
                                -> IO a       -- ^ Field value
    getFieldValue' stmt name def = do
      mb_v <- getFieldValue stmt name
      return (case mb_v of { Nothing -> def; Just a -> a })

    ------------------------------------------------------------------------------
    -- helpers
    ------------------------------------------------------------------------------
    -- | The 'forEachRow' function iterates through the result set in 'Statement'
    -- and executes the given action for each row in the set.
    -- The function closes the 'Statement' after the last row processing or if
    -- the given action raises an exception.
    forEachRow :: (Statement -> s -> IO s) -- ^ an action
               -> Statement                -- ^ the statement
               -> s                        -- ^ initial state
               -> IO s                     -- ^ final state
    forEachRow f stmt s = loop s `finally` closeStatement stmt
      where loop s = do success <- fetch stmt
                        if success then f stmt s >>= loop else return s

    -- | The 'forEachRow\'' function is analogous to 'forEachRow' but doesn't
    -- provide state.
    -- The function closes the 'Statement' after the last row processing or if the
    -- given action raises an exception.
    forEachRow' :: (Statement -> IO ()) -> Statement -> IO ()
    forEachRow' f stmt = loop `finally` closeStatement stmt
      where loop = do success <- fetch stmt
                      when success (f stmt >> loop)

    -- | The 'collectRows' function iterates through the result set in 'Statement'
    -- and executes the given action for each row in the set. The values returned
    -- from action are collected and returned as list. The function closes the
    -- 'Statement' after the last row processing or if the given action raises an
    -- exception.
    collectRows :: (Statement -> IO a) -> Statement -> IO [a]
    collectRows f stmt = loop `finally` closeStatement stmt
      where loop = do success <- fetch stmt
                      if success
                        then do x <- f stmt
                                xs <- loop
                                return (x:xs)
                        else return []