hsSqlite3 (empty) → 0.0.1

raw patch · 7 files changed

+300/−0 lines, 7 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

• COPYRIGHT +11/−0
• Setup.hs +5/−0
• hsSqlite3.cabal +23/−0
• src/Database/Sqlite3.hs +77/−0
• src/Database/Sqlite3/Low.hs +161/−0
• src/hs_sqlite3_test.hs +17/−0
• src/hs_sqlite3_test.sql +6/−0

@@ -0,0 +1,11 @@+hsSqlite3 in (c) copyright 2007+to the original authors and other contributors listed here.  If you add+or modify code, please add your name here.++Original authors:+	Evgeny Jukov+Contributors:++----+hsSqlite3 is licensed under the terms of the+GNU Lesser General Public Licence (LGPL)

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,23 @@+Name: hsSqlite3+Version: 0.0.1+License: LGPL+Maintainer: Evgeny Jukov <johnny@oleron.ru>+Author: Evgeny Jukov+Stability: Alpha+Copyright: Copyright (c) 2007 Evgeny Jukov+license-file: COPYRIGHT+Homepage: http://macode.sourceforge.net+Synopsis: Sqlite3 bindings+description: Bindings for Sqlite3+Category: Database+Hs-Source-Dirs: src+Exposed-Modules: +  Database.Sqlite3,+  Database.Sqlite3.Low+Build-Depends: base+GHC-Options: -O2++Executable: hs_sqlite3_test+Main-Is: hs_sqlite3_test.hs+HS-Source-Dirs: src+extra-libraries: sqlite3

@@ -0,0 +1,77 @@+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+

@@ -0,0 +1,161 @@+{-# options -ffi #-}++module Database.Sqlite3.Low where++import System.IO+import Data.Word+import Foreign+import Foreign.C+import qualified Data.ByteString as B++foreign import ccall unsafe "sqlite3_open" open' + :: CString -> Ptr (Ptr Void) -> IO Int++foreign import ccall unsafe "sqlite3_close" close'+ :: Ptr Void -> IO Int++foreign import ccall unsafe "sqlite3_errmsg" errmsg'+ :: Ptr Void -> IO CString++foreign import ccall unsafe "sqlite3_prepare_v2" prepare'+ :: Ptr Void -> CString -> Int -> Ptr (Ptr Void) -> Ptr CString -> IO Int++foreign import ccall unsafe "sqlite3_finalize" finalize'+ :: Ptr Void -> IO Int++foreign import ccall unsafe "sqlite3_reset" reset'+ :: Ptr Void -> IO Int++foreign import ccall unsafe "sqlite3_bind_int" bind_int'+ :: Ptr Void -> Int -> Int -> IO Int++foreign import ccall unsafe "sqlite3_bind_text" bind_text'+ :: Ptr Void -> Int -> CString -> Int -> Int -> IO Int++foreign import ccall unsafe "sqlite3_step" step'+ :: Ptr Void -> IO Int++foreign import ccall unsafe "sqlite3_column_blob" column_blob'+ :: Ptr Void -> Int -> IO CString++foreign import ccall unsafe "sqlite3_column_bytes" column_bytes'+ :: Ptr Void -> Int -> IO Int++foreign import ccall unsafe "sqlite3_column_count" column_count'+ :: Ptr Void -> IO Int++foreign import ccall unsafe "sqlite3_column_int" column_int'+ :: Ptr Void -> Int -> IO Int++foreign import ccall unsafe "sqlite3_column_double" column_double'+ :: Ptr Void -> Int -> IO Double++foreign import ccall unsafe "sqlite3_column_text" column_text'+ :: Ptr Void -> Int -> IO CString++foreign import ccall unsafe "sqlite3_column_type" column_type'+ :: Ptr Void -> Int -> IO Int++--++type Bytes = B.ByteString+type Void = Word8+data DB = DB (Ptr Void)+data Stmt = Stmt (Ptr Void)++open :: String -> IO DB+open path = do+ pptr <- malloc+ rc <- withCString path $ \cstr -> open' cstr pptr+ ptr <- peek pptr+ dbErrRc rc ptr "open"+ return (DB ptr)++close :: DB -> IO ()+close (DB db) = do+ rc <- close' db+ dbErrRc rc db "close"++prepare :: DB -> String -> IO Stmt+prepare (DB db) sql = do+ pptr <- malloc+ rc <- withCStringLen sql $ \(sql',len) ->+      prepare' db sql' len pptr nullPtr+ dbErrRc rc db "prepare"+ ptr <- peek pptr+ return (Stmt ptr)++finalize :: Stmt -> IO ()+finalize (Stmt st) = do+ rc <- finalize' st+ errRc rc "finalize"++reset :: Stmt -> IO ()+reset (Stmt st) = do+ rc <- reset' st+ errRc rc "reset"++step :: Stmt -> IO Bool+step (Stmt st) = do+ rc <- step' st+ errIf (rc /= 100 && rc /= 101) ("step: "++show rc)+ return (if rc == 101 then True else False)++bind_int :: Stmt -> Int -> Int -> IO ()+bind_int (Stmt st) num val = do+ debug ("bind_int",st,num,val)+ rc <- bind_int' st num val+ errRc rc "bind_int"++bind_text :: Stmt -> Int -> String -> IO ()+bind_text (Stmt st) num str' =+ (debug ("bind_text",st,num,str') >>) $+ withCStringLen str' $ \(str,len) -> do+  rc <- bind_text' st num str len (-1)+  errRc rc "bind_text"++column_blob :: Stmt -> Int -> IO Bytes+column_blob (Stmt st) num = do+ by <- column_bytes' st num+ bl <- column_blob'  st num+ return $ B.packCStringLen (bl,by)++column_bytes :: Stmt -> Int -> IO Int+column_bytes (Stmt st) num = column_bytes' st num++column_count :: Stmt -> IO Int+column_count (Stmt st) = column_count' st++column_int :: Stmt -> Int -> IO Int+column_int (Stmt st) num = column_int' st num++column_double :: Stmt -> Int -> IO Double+column_double (Stmt st) = column_double' st++column_text :: Stmt -> Int -> IO String+column_text (Stmt st) num = do+ by <- column_bytes' st num+ tx <- column_text'  st num+ peekCStringLen (tx,by)++column_type :: Stmt -> Int -> IO Int+column_type (Stmt st) num = column_type' st num++--++debug :: Show a => a -> IO ()+--debug = hPutStr stderr . ("DEBUG: "++) . (++"\n") . show+debug _ = return ()++err msg = ioError $ userError $ "Sqlite3: "++msg++errIf False _ = return ()+errIf True msg = err $ "Foreign: "++msg++errRc 0 _ = return ()+errRc rc msg = err $ "Foreign: "++msg++": rc="++show rc++dbErrRc 0 _ _ = return ()+dbErrRc rc db msg = do+ reason <- errmsg' db >>= peekCString+ err $ "Foreign: "++msg++": (rc="++show rc++") "++reason

@@ -0,0 +1,17 @@+import Data.Char+import Database.Sqlite3 (Val (IntV,TextV))+import qualified Database.Sqlite3 as S+import qualified Data.ByteString as B++main = do+ db <- S.open "test"+ S.bind db ins tab+ (st,row) <- S.fetchOne db "SELECT * FROM test_tab" 400+ putStr $ show row+ S.finalize st+ S.close db+ where+  ins = "INSERT INTO test_tab VALUES (?,?,?)"+  tab = replicate 500 row+  row = [TextV "test A",TextV "B test",TextV "test C test"]+ 

@@ -0,0 +1,6 @@+CREATE TABLE IF NOT EXISTS test_tab (+ --id INTEGER PRIMARY KEY AUTOINCREMENT,+ a TEXT NOT NULL,+ b TEXT NOT NULL,+ c TEXT NOT NULL+);