packages feed

hsSqlite3 0.0.4 → 0.0.5.20081031

raw patch · 11 files changed

+303/−275 lines, 11 filesdep −mtldep −statedep −utf8-stringsetup-changednew-component:exe:5minutesnew-uploader

Dependencies removed: mtl, state, utf8-string

Files

@@ -1,11 +0,0 @@-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)
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2007, Evgeny Jukov+Copyright (c) 2008, Maurício C. Antunes+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in+      the documentation and/or other materials provided with the+      distribution.++    * Neither the name of the <ORGANIZATION> nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,46 @@++** 0.0.5 **++As  of this  release,  maintainer changed  from  original author  Evgeny+to Maurício.++The  new plan  is  to build  a  compreensive binding  to  all sqlite3  C+library, and then rewrite the  high level code after that, following the+original ideas.++A new  example was  added, '5minutes.hs', a  close translation of  the C+example  code found  in sqlite3  site at  page “SQLite  In 5  Minutes Or+Less”.++This is an experimental  release, important only for maintainer, license+and  repository  change. For  the  sake  of  documentation, here  is  an+abridgement  of the  exchange of  messages  between the  author and  new+maintainer:++    M> Dear Evgeny,+    M>+    M> I've tried  your package in hackage, 'hsSqlite3',  and from darcs+    M> list of changes  it seems you have no longer update  it for a lot+    M> of time. Would  you like to give me  maintenance of that project?+    M> I'll need sqlite3 in my job  work, so I'll have to write at least+    M> enough to get  it running, but it seems you already  did a lot of+    M> nice  work  there  and  I  think that  package  should  be  keept+    M> alive. (...)+    M>+    M> Thanks,+    M> Maurício+    +    E> I agree :) What is required?+    +    M> Great. I'll check what is needed and let you know. I think I just+    M> need to get  a password for hackagedb (I've  just applied to one)+    M> and upload a new package, (...)+    M>+    M> About   the  license:   (...)   sqlite3   itself  is   in  public+    M> domain. Since this is a wrapper, although a high level one, would+    M> you mind changing the license  for public domain?  (Or (...) BSD3+    M> (...))?+    M>+    M> (...)+    +    E> GPL or BSD is ok :)
Setup.hs view
@@ -1,5 +1,3 @@ #!/usr/bin/env runhaskell- import Distribution.Simple--main = defaultMainWithHooks defaultUserHooks+main = defaultMain
hsSqlite3.cabal view
@@ -1,23 +1,30 @@-Name: hsSqlite3-Version: 0.0.4-License: LGPL-Maintainer: Evgeny Jukov <masloed@gmail.com>-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, utf8-string, mtl, state-GHC-Options: -O2+cabal-version: >= 1.2+build-type: Custom+name: hsSqlite3+version: 0.0.5.20081031+author: Evgeny Jukov+maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com>+stability: experimental+homepage: http://code.haskell.org/hsSqlite3+synopsis: sqlite3 bindings+data-files: README, src/Examples/hs_sqlite3_test.sql+license: BSD3+license-file: LICENSE+category: database+extra-source-files: src/Examples/hs_sqlite3_test.hs+flag examples+  description: build example programs+  default: False+library+  hs-source-dirs: src+  extensions: ForeignFunctionInterface+  build-depends: base+  exposed-modules: Database.Sqlite3.Low+  pkgconfig-depends: sqlite3+executable 5minutes+  hs-source-dirs: src/Examples+  main-is: 5minutes.hs+--  build-depends: base+--  other-modules: Database.Sqlite3.Low+  buildable: False -Executable: hs_sqlite3_test-Main-Is: hs_sqlite3_test.hs-HS-Source-Dirs: src-extra-libraries: sqlite3
− src/Database/Sqlite3.hs 
@@ -1,192 +0,0 @@-{-# options -fglasgow-exts -farrows #-}--module Database.Sqlite3- ( module Database.Sqlite3.Low- , Val ( IntV, Int64V, DoubleV, TextV, BlobV, NullV )- , fetch- , bind- , row- , test- , sql- ) where--import Data.Char-import Control.Monad-import Data.Int-import Database.Sqlite3.Low-import qualified Data.ByteString as B-import Control.Arrow--import Control.Monad.Trans-import Control.Monad.Error-import Control.Monad.State.Lazy--import Data.Monoid--import Data.State hiding (fetch)--import qualified Codec.Binary.UTF8.String as UTF8------class ValID a where- valID  :: a -> Int--class ValFetch a where- valFetch :: (Int,Int) -> DbIO a--class ValBind a where- valBind :: (Int,a) -> DbIO ()--class ValID a => ValCast a b where- valCast :: a -> b--data Val- = IntV    Int- | Int64V  Int64- | DoubleV Double- | TextV   String- | BlobV   B.ByteString- | NullV- deriving Show--instance ValID Val where- valID (IntV    _) = 1- valID (Int64V  _) = 1- valID (DoubleV _) = 2- valID (TextV   _) = 3- valID (BlobV   _) = 4- valID  NullV      = 5--instance ValFetch Val where- valFetch (t,n) = do-  case t of-   1 -> liftM IntV    $ column_int n-   2 -> liftM DoubleV $ column_double n-   3 -> liftM TextV   $ column_text n-   4 -> liftM BlobV   $ column_blob n-   5 -> return NullV--instance ValBind Val where- valBind (t,v) = do-  case v of-   IntV a -> bind_int (t,a)-   TextV a -> bind_text (t,a)--instance ValCast Val Int where- valCast (IntV a) = a--instance ValCast Val Double where- valCast (DoubleV a) = a--instance ValCast Val String where- valCast (TextV a) = a--instance ValCast Val B.ByteString where- valCast (BlobV a) = a--instance ValCast Val () where- valCast NullV = ()--instance ValID Int          where valID _ = 1-instance ValID Double       where valID _ = 2-instance ValID String       where valID _ = 3-instance ValID B.ByteString where valID _ = 4-instance ValID ()           where valID _ = 5--reqType :: Int -> (Int -> DbIO a) -> (Int,Int) -> DbIO a-reqType t' a (t,v) =  do- errIf (t'/=t) "ValFetch"- a v--instance ValFetch Int where- valFetch = reqType 1 column_int--instance ValFetch Double where- valFetch = reqType 2 column_double--instance ValFetch String where- valFetch = reqType 3 column_text--instance ValFetch B.ByteString where- valFetch = reqType 4 column_blob--instance ValFetch () where- valFetch = reqType 5 (\_ -> return ())--instance ValBind Int where- valBind = bind_int--instance ValBind String where- valBind = bind_text--instance ValCast Int Val where- valCast a = IntV a--instance ValCast Double Val where- valCast a = DoubleV a--instance ValCast String Val where- valCast a = TextV a--instance ValCast B.ByteString Val where- valCast a = BlobV a--instance ValCast () Val where- valCast a = NullV------fetch :: ValFetch a => String -> DbIO [[a]]-fetch sql = do- liftIO $ putStr $ UTF8.encodeString $ sql++"\n"- prepare sql- stat <- step- case stat of-  True -> finalize >> return []-  False -> do-   cn <- column_count-   ty <- mapM column_type [0..cn-1]-   let ft = mapM valFetch (zip ty [0..])-   x <- ft-   xs <- fetchRow ft-   finalize-   return (x:xs)- where-  fetchRow ft = do-   end <- step-   case end of-    True -> return []-    False -> do-     x <- ft-     xs <- fetchRow ft-     return (x:xs)--sql :: String -> DbIO ()-sql sql = do- liftIO $ putStr $ UTF8.encodeString $ sql++"\n"- prepare sql- step- finalize--bind :: String -> [[Val]] -> DbIO ()-bind sql tab = do- liftIO $ putStr $ UTF8.encodeString $ sql++"\n"- debug tab- prepare sql- mapM_ (\row -> mapM_ (\(v,n) -> valBind (n,v)) (zip row [1..]) >> step >> reset) tab- finalize--fetchOne' :: ValFetch a => String -> Int -> DbIO [[a]]-fetchOne' sql num = fetch sql'- where sql' = concat [sql," LIMIT 1 OFFSET ", show num]--row :: ValFetch a => String -> Int -> DbIO [a]-row sql num = liftM head $ fetchOne' sql num--test :: String -> DbIO Bool-test sql = do- tab :: [[Val]] <- fetchOne' sql 0- case length tab of-  1 -> return True-  _ -> return False
src/Database/Sqlite3/Low.hs view
@@ -1,34 +1,176 @@-{-# options -fglasgow-exts -ffi #-}+-- | This is intended to be a low level wrapper over sqlite3+-- library. These design decisions guide this module:+--+-- * Portability.+--+-- * It is meant to be as  close as possible to a bijection over sqlite3+-- objects, constants and functions.  The original documentation for any+-- sqlite3 name should be sufficient to understand its wrapper.+--+-- * Everything not UTF-8 has been removed in favor of UTF-8.+--+-- * @sqlite3_@  prefix has  been removed from  all object  and function+-- names since it can be mapped to a qualified module import.+--+-- * Mutex related  names are not wrapped, as  they would just duplicate+-- existing functionality.+--+-- * All  sqlite3 experimental  or obsolete code  (marked with  @exp@ or+-- @obs@ in the official documentation) has not been wrapped, as well as+-- the testing interface (@sqlite3_test_control@ and related constants).+--+-- *  Preprocessor  constant definitions  have  been  replaced by  equal+-- values.  All  were  typed  to  CInt,  except  for  SQLITE_STATIC  and+-- SQLITE_TRANSIENT (mapped  to sqliteStatic and  sqliteTransient) which+-- were  typed as  function pointers  as faithfully  as possible  to the+-- underline C  code. Version information  constants are not  mapped for+-- portability,  and   the  user  can   always  call  the   mappings  of+-- sqlite3_libversion and sqlite3_libversion_number functions instead.  module Database.Sqlite3.Low where- import Foreign import Foreign.C+import Data.Bits -import System.IO-import System.IO.Unsafe-import System.IO.Error hiding (try)+-- * Objects -import Control.Monad.Trans-import Control.Monad.Error-import Control.Monad.State.Lazy hiding (get,put)-import qualified Control.Monad.State.Lazy as ST+data Sqlite3 = Sqlite3+data Blob = Blob+data Context = Context+data File = File+data Int64 = Int64+data Uint64 = Uint64+data IoMethods = IoMethods+data Stmt = Stmt+data Value = Value+data Vfs = Vfs -import qualified Codec.Binary.UTF8.String as UTF8-import qualified Data.ByteString as B+foreign import ccall "&sqlite3_temp_directory" tempDirectory+ :: Ptr CString -import Data.State+-- * Constants -import Data.Typeable+-- | Error codes -type Void = Word8+[sqliteOk, sqliteError, sqliteInternal, sqlitePerm, sqliteAbort,+ sqliteBusy, sqliteLocked, sqliteNoMem, sqliteReadOnly,+ sqliteInterrupt, sqliteIoErr, sqliteCorrupt, sqliteNotFound,+ sqliteFull, sqliteCantOpen, sqliteProtocol, sqliteEmpty,+ sqliteSchema, sqliteTooBig, sqliteConstraint, sqliteMismatch,+ sqliteMisuse, sqliteNoLfs, sqliteAuth, sqliteFormat, sqliteRange,+ sqliteNotADb, sqliteRow, sqliteDone] = [0..26] ++ [100,101] ::+ [CInt] -foreign import ccall unsafe "sqlite3_open" c_open- :: CString -> Ptr (Ptr Void) -> IO Int+-- | Flags for the xAccess VFS method -foreign import ccall unsafe "sqlite3_close" c_close- :: Ptr Void -> IO Int+[sqliteAccessExists, sqliteAccessReadWrite, sqliteAccessRead] =+ [0..2] :: [CInt] +-- | Authorizer Action Codes++[sqliteCreateIndex, sqliteCreateTable, sqliteCreateTempIndex,+ sqliteCreateTempTable, sqliteCreateTempTrigger,+ sqliteCreateTempView, sqliteCreateTrigger, sqliteCreateView,+ sqliteDelete, sqliteDropIndex, sqliteDropTable,+ sqliteDropTempIndex, sqliteDropTempTable, sqliteDropTempTrigger,+ sqliteDropTempView, sqliteDropTrigger, sqliteDropView,+ sqliteInsert, sqlitePragma, sqliteRead, sqliteSelect,+ sqliteTransaction, sqliteUpdate, sqliteAttach, sqliteDetach,+ sqliteAlterTable, sqliteReindex, sqliteAnalyze,+ sqliteCreateVtable, sqliteDropVtable, sqliteFunction] = [1..31] ::+ [CInt]++-- | Text Encodings++sqliteUtf8 = 1 :: CInt++-- | Fundamental Datatypes++[sqliteInteger, sqliteFloat, sqliteText, sqliteBlob, sqliteNull] =+ [1..5] :: [CInt]++-- | Authorizer Return Codes++[sqliteDeny, sqliteIgnore] = [1,2] :: [CInt]++-- | Standard File Control Opcodes++sqliteFcntlLockstate = 1 :: CInt++-- | Device Characteristics++[sqliteIocapAtomic, sqliteIocapAtomic512, sqliteIocapAtomic1K,+ sqliteIocapAtomic2K, sqliteIocapAtomic4K, sqliteIocapAtomic8K,+ sqliteIocapAtomic16K, sqliteIocapAtomic32K, sqliteIocapAtomic64K,+ sqliteIocapSafeAppend, sqliteIocapSequential] = map bit [0..10] ::+ [CInt]++-- | Extended Result Codes++[sqliteIoErrRead, sqliteIoErrShortRead, sqliteIoErrWrite,+ sqliteIoErrFsync, sqliteIoErrDirFsync, sqliteIoErrTruncate,+ sqliteIoErrFstat, sqliteIoErrUnlock, sqliteIoErrRdlock,+ sqliteIoErrDelete, sqliteIoErrBlocked, sqliteIoErrNomem,+ sqliteIoErrAccess, sqliteIoErrCheckreservedlock, sqliteIoErrLock]+ = map ( (sqliteIoErr .|.) . (flip shift $ 8) ) [1..15] :: [CInt]++-- | Run-Time Limit Categories++[sqliteLimitLength, sqliteLimitSqlLength, sqliteLimitColumn,+ sqliteLimitExprDepth, sqliteLimitCompoundSelect,+ sqliteLimitVdbeOp, sqliteLimitFunctionArg, sqliteLimitAttached,+ sqliteLimitLikePatternLength, sqliteLimitVariableNumber] = [0..9]+ :: [CInt]++-- | File Locking Levels++[sqliteLockNone, sqliteLockShared, sqliteLockReserved,+ sqliteLockPending, sqliteLockExclusive] = [0..4] :: [CInt]++-- | Flags For File Open Operations++[sqliteOpenReadOnly, sqliteOpenReadWrite, sqliteOpenCreate,+ sqliteOpenDeleteOnClose, sqliteOpenExclusive, sqliteOpenMainDb,+ sqliteOpenTempDb, sqliteOpenTransientDb, sqliteOpenMainJournal,+ sqliteOpenTempJournal, sqliteOpenSubjournal,+ sqliteOpenMasterJournal, sqliteOpenNoMutex, sqliteOpenFullMutex] =+ map bit $ [0..4] ++ [8..16] :: [CInt]++-- | Constants Defining Special Destructor Behavior++[sqliteStatic, sqliteTransient] = map cast [0,-1]+  where+    cast :: IntPtr -> FunPtr (Ptr () -> ())+    cast n = (castPtrToFunPtr . intPtrToPtr) n++-- | Synchronization Type Flags++[sqliteSyncNormal, sqliteSyncFull, sqliteSyncDataonly] = [0x2,+ 0x3, 0x10] :: [CInt]++-- * Functions++foreign import ccall "sqlite3_close" close+ :: Ptr Sqlite3 -> IO CInt++foreign import ccall "sqlite3_exec" exec+ :: Ptr Sqlite3 -> CString -> FunPtr (Ptr () -> CInt -> Ptr CString+        -> Ptr CString -> IO CInt) -> Ptr () -> Ptr CString -> IO CInt++foreign import ccall "sqlite3_free" free+ :: Ptr a -> IO ()++foreign import ccall "sqlite3_open" open+ :: CString -> (Ptr (Ptr Sqlite3)) -> IO CInt++++++++{- Code not yet adapted to new version+ foreign import ccall unsafe "sqlite3_errmsg" c_errmsg  :: Ptr Void -> IO CString @@ -217,7 +359,7 @@ prepare :: String -> DbIO () prepare sql = do  pptr <- i malloc- (cstr,len) <- i$ newCStringLen sql+ (cstr,len) <- i$ newCStringLen $ UTF8.encodeString sql  debug (sql,cstr,len,pptr,"prepare")  ptr <- getDB  rc <- i$ c_prepare ptr cstr len pptr nullPtr@@ -314,3 +456,5 @@  by <- column_bytes num  bl <- liftIO $ c_column_blob ptr num  return $ B.packCStringLen (bl,by)++-}
+ src/Examples/hs_sqlite3_test.hs view
@@ -0,0 +1,27 @@+-- Not yet updated, and so should+-- not be built (yet).++import Data.Char+import Database.Sqlite3 (Val (IntV,TextV))+import qualified Database.Sqlite3 as S+import qualified Data.ByteString as B++import Control.Monad.Trans+import Control.Monad.Error+import Control.Monad.State.Lazy+import Data.State++instance LocalState a a where+ getState = id+ putState a _ = a++main = do+  x <- (`runStateT` (zeroState :: S.StateDb)) $ do+    S.open "db"+    tab :: [[Val]] <- S.fetch "SELECT * FROM test_tab"+    S.bind "INSERT INTO test_tab VALUES (?,?,?)" $+       replicate 4+        [IntV 5,TextV "B test",TextV "test C test"]+    S.close+    return tab+  putStr $ "end"++ show x ++"\n"
+ src/Examples/hs_sqlite3_test.sql view
@@ -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+);
− src/hs_sqlite3_test.hs 
@@ -1,22 +0,0 @@-{-# options -fglasgow-exts -farrows #-}--import Data.Char-import Database.Sqlite3 (Val (IntV,TextV))-import qualified Database.Sqlite3 as S-import qualified Data.ByteString as B--import Control.Monad.Trans-import Control.Monad.Error-import Control.Monad.State.Lazy-import Data.State--main = do-  x <- (`runStateT` (zeroState :: S.StateDb)) $ do-    S.open "db"-    tab :: [[Val]] <- S.fetch "SELECT * FROM test_tab"-    S.bind "INSERT INTO test_tab VALUES (?,?,?)" $-       replicate 4-        [IntV 5,TextV "B test",TextV "test C test"]-    S.close-    return tab-  putStr $ "end"++ show x ++"\n"
− src/hs_sqlite3_test.sql 
@@ -1,6 +0,0 @@-CREATE TABLE IF NOT EXISTS test_tab (- --id INTEGER PRIMARY KEY AUTOINCREMENT,- a TEXT NOT NULL,- b TEXT NOT NULL,- c TEXT NOT NULL-);