Database interface - would like advice on oracle library binding

[oleg at pobox.com]

The following code illustrates a _generic_ interface to low-level
database code. The left-fold iterator doQuery is completely generic
over any possible iterator -- no matter how many columns the query
returns, what are the types of these columns and what is the type of
the seed (accumulator). The code for doQuery remains the same. The
iterator allocates buffers for columns at the beginning and frees the
buffers at the very end. Again, this buffer handling is generic. There
is no longer need to write extraction/unmarshalling function for
specific types of rows. We only need fetching functions for specific
datatypes (not columns!). Again, the query and the row buffer
management code is completely generic. I guess I'm repeating
myself. The tests:

-- Query returns one column of type String
-- Never mind undefined: we return some static data in the buffers,
-- we don't have any oracle to bind to
test1 = doQuery undefined undefined iter1 ([]::[String])
  where
     iter1:: String -> [String] -> Either [String] [String]
     iter1 s acc = Right $ s:acc     


-- Query returns two columns of types String and Int
test2 = doQuery undefined undefined iter2 ([]::[(String,Int)])
  where
     iter2:: String -> Int -> [(String,Int)] -> 
             Either [(String,Int)] [(String,Int)]
     iter2 s i acc = Right $ (s,i):acc     


-- Query returns three columns of types Int, String and Int
test3 = doQuery undefined undefined iter3 ([]::[(Int,String,Int)])
  where
     iter3:: Int -> String -> Int -> [(Int,String,Int)] -> 
             Either [(Int,String,Int)] [(Int,String,Int)]
     iter3 i1 s i2 acc = Right $ (i1,s,i2):acc     

Use the function runtests to run either of these tests.


The code follows. Compiler flags: 
	-fglasgow-exts -fallow-overlapping-instances

-- DB column buffers

type BufferSize = Int
data BufferType = ORA_char | ORA_int
type Position = Int  -- column number of the result table

data Buffer = Buffer { bufptr :: String -- for this stub, just use String
                     , nullindptr :: String -- likewise
		     , retsizeptr :: String -- likewise
		     , size:: BufferSize 
		     , pos:: Position
		     , ora_type:: BufferType }

-- understandably, below is just a stub ...
alloc_buffer (siz, typ) ps = 
  return $ Buffer { bufptr = show ps, pos = ps,  size = siz, ora_type = typ}
  
-- In this stub, don't do anything
free ptr = return ()


-- DB Column types

class DBType a where
  alloc_buffer_hints:: a -> (BufferSize, BufferType)
  col_fetch:: Buffer -> IO a

instance DBType String where
  alloc_buffer_hints _ = (2000, ORA_char)
  col_fetch buffer = return (bufptr buffer)

instance DBType Int where
  alloc_buffer_hints _ = (4, ORA_int)
  col_fetch buffer = return (read $ bufptr buffer)
  
-- need to add more ...

-- Row iteratees. Note, the folowing two instances cover ALL possible
-- iteratees. No other instances are needed

class SQLIteratee iter seed where
    iter_apply:: [Buffer] -> seed -> iter -> IO (Either seed seed)
    alloc_buffers:: Position -> iter -> seed -> IO [Buffer]
    
instance (DBType a) => SQLIteratee (a->seed->Either seed seed) seed where
    iter_apply [buf] seed fn = col_fetch buf >>= (\v -> return$ fn v seed)
    alloc_buffers n _ _ = 
       sequence [alloc_buffer (alloc_buffer_hints (undefined::a)) n]

instance (SQLIteratee iter' seed, DBType a) => SQLIteratee (a->iter') seed 
 where
    iter_apply (buf:others) seed fn = 
      col_fetch buf >>= (\v -> iter_apply others seed (fn v))
    alloc_buffers n fn seed = do
      this_buffer <- alloc_buffer (alloc_buffer_hints (undefined::a)) n
      other_buffers <- alloc_buffers (n+1) (fn (undefined::a)) seed
      return (this_buffer:other_buffers)

free_buffers = mapM_ free

-- The left fold iterator -- the query executor

data Session   -- not relevant for this example
data SQLStmt

db_execute session query = return ()

db_fetch_row buffers = return ()  -- use static data

doQuery:: (SQLIteratee iter seed) => Session -> SQLStmt -> iter -> seed -> IO seed

-- In this example, we just allocate buffers, "fetch" two rows and terminate
-- with a clean-up

doQuery session query iteratee seed = do
  buffers <- alloc_buffers 0 iteratee seed
  db_execute session query
  db_fetch_row buffers
  (Right seed) <- iter_apply buffers seed iteratee
  db_fetch_row buffers
  (Right seed) <- iter_apply buffers seed iteratee
  free_buffers buffers
  return seed
  

-- Tests

-- Query returns one column of type String
test1 = doQuery undefined undefined iter1 ([]::[String])
  where
     iter1:: String -> [String] -> Either [String] [String]
     iter1 s acc = Right $ s:acc     


-- Query returns two columns of types String and Int
test2 = doQuery undefined undefined iter2 ([]::[(String,Int)])
  where
     iter2:: String -> Int -> [(String,Int)] -> 
             Either [(String,Int)] [(String,Int)]
     iter2 s i acc = Right $ (s,i):acc     


-- Query returns three columns of types Int, String and Int
test3 = doQuery undefined undefined iter3 ([]::[(Int,String,Int)])
  where
     iter3:: Int -> String -> Int -> [(Int,String,Int)] -> 
             Either [(Int,String,Int)] [(Int,String,Int)]
     iter3 i1 s i2 acc = Right $ (i1,s,i2):acc     

runtests test = test >>= (mapM_ $ putStrLn . show)