|
Module      :  Database.Stub.Enumerator
Copyright   :  (c) 2004 Oleg Kiselyov, Alistair Bayley
License     :  BSD-style
Maintainer  :  oleg@pobox.com, alistair@abayley.org
Stability   :  experimental
Portability :  non-portable

Stub implementation of Database.Enumerator.
Useful for people who can't or won't install a DBMS,
so that they can try out the Enumerator interface.

Currently last last row of any fetch will have a null in its Int columns
(this makes it easier to test handling of nulls and DBUnexpectedNull).
See fetchIntVal.



> {-# OPTIONS -fglasgow-exts #-}
> {-# OPTIONS -fallow-undecidable-instances #-}
> {-# OPTIONS -fallow-overlapping-instances #-}

> module Database.Stub.Enumerator
>   -- Only the type constructor of Session is exported
>   -- (so the end user could write type signatures). 
>   (  Session, ConnParm(..), connect, sql, prefetch
>    , QueryResourceUsage(..)
>   )
> where


> import Database.InternalEnumerator
> import Foreign
> import Foreign.C
> import Foreign.C.Types
> import Control.Monad
> import Control.Exception (catchDyn, throwDyn, throwIO)
> import System.Time
> import Data.IORef
> import Data.Dynamic



> data ConnParm = ConnParm{ user, pswd, dbname :: String }


> data Session = Session
> data StmtHandle = StmtHandle
> data QueryString = QueryString String
> data QueryStringTuned = QueryStringTuned QueryResourceUsage String

 data PreparedStatement = PreparedStatement
   { stmtSession :: Session, stmtHandle :: StmtHandle }

> data Query = Query
>   { querySess :: Session
>   , queryStmt :: StmtHandle
>   , queryCounter :: IORef (IORef Int)
>   }

> data DBColumnType =
>     DBTypeInt
>   | DBTypeString
>   | DBTypeDouble
>   | DBTypeDatetime

> type BufferSize = Int

|At present the only resource tuning we support is the number of rows
prefetched by the FFI library.
We use a record to (hopefully) make it easy to add other 
tuning parameters later.

> data QueryResourceUsage = QueryResourceUsage { prefetchRowCount :: Int }

> defaultResourceUsage :: QueryResourceUsage
> defaultResourceUsage = QueryResourceUsage 100


--------------------------------------------------------------------
-- Sessions
--------------------------------------------------------------------

> connect :: ConnParm -> ConnectA Session
> connect connparm = ConnectA (return Session)

> instance ISession Session where
>   disconnect sess = return ()
>   beginTransaction sess isol  = return ()
>   commit sess = return ()
>   rollback sess = return ()

--------------------------------------------------------------------
-- Statements
--------------------------------------------------------------------

-- Simple statements: just a string

> sql :: String -> QueryString
> sql str = QueryString str

> instance Command QueryString Session where
>   executeCommand s q  = return 0

> instance Statement QueryString Session Query where
>   makeQuery sess stmt = do
>       -- Leave one counter in to ensure the fetch terminates
>     counter <- newIORef numberOfRowsToPretendToFetch
>     refc <- newIORef counter
>     return (Query sess StmtHandle refc)

-- Statements with resource usage

> prefetch :: Int -> String -> QueryStringTuned
> prefetch count str = QueryStringTuned (QueryResourceUsage count) str

> instance Command QueryStringTuned Session where
>   executeCommand s (QueryStringTuned _ str) = executeCommand s (QueryString str)

> instance Statement QueryStringTuned Session Query where
>   -- Currently just ignore the tuning parameter. This is the stub
>   -- anyway. We only wish to test different types of statements
>   makeQuery s (QueryStringTuned _ str) = makeQuery s (QueryString str)


--------------------------------------------------------------------
-- Queries
--------------------------------------------------------------------

See makeQuery below for use of this:

> numberOfRowsToPretendToFetch :: Int
> numberOfRowsToPretendToFetch = 3

See fetchIntVal below for use of this:
Note that rows are counted down from numberOfRowsToPretendToFetch,
so this will throw on the last row.

> throwNullIntOnRow :: Int
> throwNullIntOnRow = 1


> instance IQuery Query Session ColumnBuffer
>   where
>
>   fetchOneRow q = do
>     -- We'll pretend that we're going to fetch a finite number of rows.
>     refCounter <- readIORef (queryCounter q)
>     counter <- readIORef refCounter
>     if counter > 0
>       then (modifyIORef refCounter pred >> return True)
>       else return False
>
>
>   currentRowNum q = do
>     refCounter <- readIORef (queryCounter q)
>     counter <- readIORef refCounter
>     return counter
>
>   freeBuffer q buffer = return ()
>   destroyQuery q      = return ()


--------------------------------------------------------------------
-- result-set data buffers implementation
--------------------------------------------------------------------

> data ColumnBuffer = ColumnBuffer
>   { colPos :: Int
>   }

> buffer_pos q buffer = 
>     do 
>     let col = colPos buffer
>     row <- currentRowNum q
>     return (row,col)

An auxiliary function: buffer allocation

> allocBuffer q bufsize buftype colpos = do
>     return $ ColumnBuffer
>       { colPos = colpos
>       }

> bufferToString :: ColumnBuffer -> IO (Maybe String)
> bufferToString buffer = return $ Just "boo"

> bufferToDatetime :: ColumnBuffer -> IO (Maybe CalendarTime)
> bufferToDatetime colbuf = do
>       return $ Just $ CalendarTime
>         { ctYear = 1971
>         , ctMonth = toEnum 6
>         , ctDay = 1
>         , ctHour = 12
>         , ctMin = 1
>         , ctSec = 1
>         , ctPicosec = 0
>         , ctWDay = Sunday
>         , ctYDay = -1
>         , ctTZName = "UTC"
>         , ctTZ = 0
>         , ctIsDST = False
>         }

> bufferToInt :: ColumnBuffer -> IO (Maybe Int)
> bufferToInt buffer = return $ Just 1

> bufferToDouble :: ColumnBuffer -> IO (Maybe Double)
> bufferToDouble buffer = return $ Just 1.1

> {-
> instance DBBind (Maybe a) SessionM PreparedStatement
>     => DBBind a SessionM PreparedStatement where
>   bindPos v q p = return ()

> instance DBBind (Maybe String) SessionM PreparedStatement where
>   bindPos v q p = return ()

> instance DBBind (Maybe Int) SessionM PreparedStatement where
>   bindPos v q p = return ()

> instance DBBind (Maybe Double) SessionM PreparedStatement where
>   bindPos v q p = return ()

> instance DBBind (Maybe CalendarTime) SessionM PreparedStatement where
>   bindPos v q p = return ()

> instance (Show a, Read a) => DBBind (Maybe a) SessionM PreparedStatement where
>   bindPos v q p = return ()
> -}

> instance DBType (Maybe a) Query ColumnBuffer
>     => DBType a Query ColumnBuffer where
>   allocBufferFor _ = allocBufferFor (undefined::Maybe a)
>   fetchCol q buffer = throwIfDBNull (buffer_pos q buffer) $ fetchCol q buffer

> instance DBType (Maybe String) Query ColumnBuffer where
>   allocBufferFor _ q n = allocBuffer q 4000 DBTypeString n
>   fetchCol q buffer = bufferToString buffer

> instance DBType (Maybe Int) Query ColumnBuffer where
>   allocBufferFor _ q n = allocBuffer q 4 DBTypeInt n
>   fetchCol query buffer = do
>     refCounter <- readIORef (queryCounter query)
>     counter <- readIORef refCounter
>     -- last row returns null rather than 1
>     if counter == throwNullIntOnRow
>       then return Nothing
>       else bufferToInt buffer

> instance DBType (Maybe Double) Query ColumnBuffer where
>   allocBufferFor _ q n = allocBuffer q 8 DBTypeDouble n
>   fetchCol q buffer = bufferToDouble buffer

> instance DBType (Maybe CalendarTime) Query ColumnBuffer where
>   allocBufferFor _ q n = allocBuffer q 8 DBTypeDatetime n
>   fetchCol q buffer = bufferToDatetime buffer

A polymorphic instance which assumes that the value is in a String column,
and uses Read to convert the String to a Haskell data value.

> instance (Show a, Read a) => DBType (Maybe a) Query ColumnBuffer where
>   allocBufferFor _  = allocBufferFor (undefined::String)
>   fetchCol q buffer = do
>     v <- bufferToString buffer
>     case v of
>       Just s -> if s == "" then return Nothing else return (Just (read s))
>       Nothing -> return Nothing