
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)