Sqlite3.hs

module Database.Sqlite3
 ( module Database.Sqlite3.Low
 , Val ( IntV, Int64V, DoubleV, TextV, BlobV, NullV )
 , fetch
 , bind
 , fetchOne
 ) where

import Data.Char
import Control.Monad
import Data.Int
import Database.Sqlite3.Low
import qualified Data.ByteString as B
import System.IO.Unsafe
import Control.Arrow

data Val
 = IntV    Int
 | Int64V  Int64
 | DoubleV Double
 | TextV   String
 | BlobV   Bytes
 | NullV
 deriving Show

fetch :: DB -> String -> IO (Stmt, [[Val]])
fetch db sql = do
 st <- prepare db sql
 end <- step st
 tab <- case end of
  True -> err "oneStep: no result"
  False -> do
   cn <- column_count st
   ty <- mapM (column_type st) [0..cn-1]
   let ft = sequence $ map (conv st) (zip ty [0..])
   x <- ft
   xs <- fetchRow st ft
   return (x:xs)
 return (st,tab)
 where
  conv st (1,n) = uns $ liftM IntV    $ column_int    st n
  conv st (2,n) = uns $ liftM DoubleV $ column_double st n
  conv st (3,n) = uns $ liftM TextV   $ column_text   st n
  conv st (4,n) = uns $ liftM BlobV   $ column_blob   st n
  conv st (5,_) = return NullV

  fetchRow :: Stmt -> IO [Val] -> IO [[Val]]
  fetchRow st ft = uns $ do
   end <- step st
   case end of
    True -> return []
    False -> do
     x <- uns ft
     xs <- fetchRow st ft
     return (x:xs)

bind :: DB -> String -> [[Val]] -> IO ()
bind db sql tab = do
 st <- prepare db sql
 let f row = sequence $ map (conv st) $ zip3 (head tab) row [1..]
 f (head tab) >> step st
 mapM_ (\a -> reset st >> f a >> step st) (tail tab)
 finalize st
 where
  conv st (IntV  _,IntV  v,n) = bind_int  st n v
  conv st (TextV _,TextV v,n) = bind_text st n v

--

fetchOne :: DB -> String -> Int -> IO (Stmt,[Val])
fetchOne db sql num = liftM (second head) $ fetch db sql'
 where sql' = concat [sql," LIMIT 1 OFFSET ",show num]
 
--

uns = unsafeInterleaveIO