hsql-sqlite3-1.8.2/0000755000175000017500000000000011735632357011331 5ustar iihsql-sqlite3-1.8.2/ChangeLog0000644000175000017500000000020511330655622013067 0ustar ii2010-1-29 1.8.1: uses updated exception handling of hsql-1.8.1; refactorings 2009-9-6 1.7.1: Fix to make it run on GHC 6.10. hsql-sqlite3-1.8.2/DB/0000755000175000017500000000000011330636314011602 5ustar iihsql-sqlite3-1.8.2/DB/HSQL/0000755000175000017500000000000011330636551012354 5ustar iihsql-sqlite3-1.8.2/DB/HSQL/SQLite3/0000755000175000017500000000000011735605621013603 5ustar iihsql-sqlite3-1.8.2/DB/HSQL/SQLite3/Functions.hsc0000644000175000017500000000166711735605403016262 0ustar iimodule DB.HSQL.SQLite3.Functions where import Foreign(Ptr,FunPtr) import Foreign.C(CString,CInt(..)) #include #include type SQLite3 = Ptr () foreign import ccall sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int foreign import ccall sqlite3_errmsg :: SQLite3 -> IO CString foreign import ccall sqlite3_close :: SQLite3 -> IO () foreign import ccall sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt foreign import ccall sqlite3_get_table :: SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt foreign import ccall sqlite3_free_table :: Ptr CString -> IO () foreign import ccall sqlite3_free :: CString -> IO () -- | foreign import ccall "strlen" strlen :: CString -> IO CInt -- | sqliteOk:: Int sqliteOk = #const SQLITE_OK oRdOnly = #const O_RDONLY oWrOnly = #const O_WRONLY oRdWr = #const O_RDWR oAppend = #const O_APPENDhsql-sqlite3-1.8.2/LICENSE0000644000175000017500000000274311145152653012333 0ustar iiCopyright (c) 2009, Krasimir Angelov 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 author 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. hsql-sqlite3-1.8.2/Database/0000755000175000017500000000000010606505665013032 5ustar iihsql-sqlite3-1.8.2/Database/HSQL/0000755000175000017500000000000011735605625013602 5ustar iihsql-sqlite3-1.8.2/Database/HSQL/SQLite3.hs0000644000175000017500000001201511735605475015364 0ustar ii{-# LANGUAGE ScopedTypeVariables #-} {-| Module : Database.HSQL.SQLite3 Copyright : (c) Krasimir Angelov 2005 License : BSD-style Maintainer : kr.angelov@gmail.com Stability : provisional Portability : portable The module provides interface to SQLite3 -} module Database.HSQL.SQLite3(connect ,module Database.HSQL) where import Foreign(Ptr,alloca,peek,nullPtr,peekElemOff,nullFunPtr) import Foreign.C(CString,CInt,peekCString,withCString) import System.IO(IOMode(..)) import Control.Monad(when) import Control.Exception(throw) import Control.Concurrent.MVar(newMVar,modifyMVar,readMVar) import Database.HSQL import Database.HSQL.Types(Connection(..),Statement(..)) import DB.HSQL.SQLite3.Functions ------------------------------------------------------------------------------ -- Connect ------------------------------------------------------------------------------ -- | connect :: FilePath -> IOMode -> IO Connection connect fpath mode = alloca $ \psqlite -> withCString fpath $ \pFPath -> do res <- sqlite3_open pFPath psqlite sqlite <- peek psqlite when (res /= sqliteOk) $ do pMsg <- sqlite3_errmsg sqlite msg <- peekCString pMsg throw SqlError { seState = "C" , seNativeError = 0 , seErrorMsg = msg } refFalse <- newMVar False let connection = Connection { connDisconnect = sqlite3_close sqlite , connClosed = refFalse , connExecute = sqlite3Execute sqlite , connQuery = sqlite3Query connection sqlite , connTables = sqlite3Tables connection sqlite , connDescribe = sqlite3Describe connection sqlite , connBeginTransaction = sqlite3Execute sqlite "BEGIN TRANSACTION" , connCommitTransaction = sqlite3Execute sqlite "COMMIT TRANSACTION" , connRollbackTransaction = sqlite3Execute sqlite "ROLLBACK TRANSACTION" } return connection where oflags1 = case mode of ReadMode -> oRdOnly WriteMode -> oWrOnly ReadWriteMode -> oRdWr AppendMode -> oAppend -- | sqlite3Tables :: Connection -> SQLite3 -> IO [String] sqlite3Tables connection sqlite = do stmt <- sqlite3Query connection sqlite "SELECT tbl_name FROM sqlite_master" collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt -- | sqlite3Describe :: Connection -> SQLite3 -> String -> IO [ColDef] sqlite3Describe connection sqlite table = do stmt <- sqlite3Query connection sqlite ("pragma table_info("++table++")") collectRows getRow stmt -- | sqlite3Query :: Connection -> SQLite3 -> String -> IO Statement sqlite3Query connection sqlite query = do withCString query $ \pQuery -> do alloca $ \ppResult -> do alloca $ \pnRow -> do alloca $ \pnColumn -> do alloca $ \ppMsg -> do res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg handleSqlResult res ppMsg pResult <- peek ppResult rows <- fmap fromIntegral (peek pnRow) columns <- fmap fromIntegral (peek pnColumn) defs <- getFieldDefs pResult 0 columns refFalse <- newMVar False refIndex <- newMVar 0 return Statement { stmtConn = connection , stmtClose = sqlite3_free_table pResult , stmtFetch = sqlite3Fetch refIndex rows , stmtGetCol = getColValue pResult refIndex columns rows , stmtFields = defs , stmtClosed = refFalse } -- | getRow stmt = do name <- getFieldValue stmt "name" notnull <- getFieldValue stmt "notnull" return (name, SqlText, notnull=="0") -- | getFieldDefs :: Ptr CString -> Int -> Int -> IO [ColDef] getFieldDefs pResult index count | index >= count = return [] | otherwise = do name <- peekElemOff pResult index >>= peekCString defs <- getFieldDefs pResult (index+1) count return ((name,SqlText,True):defs) -- | sqlite3Fetch tupleIndex countTuples = modifyMVar tupleIndex (\index -> return (index+1,index < countTuples)) -- | getColValue pResult refIndex columns rows colNumber fieldDef f = do index <- readMVar refIndex when (index > rows) (throw SqlNoMoreData) pStr <- peekElemOff pResult (columns*index+colNumber) if pStr == nullPtr then f fieldDef pStr 0 else do strLen <- strlen pStr f fieldDef pStr (fromIntegral strLen) -- | sqlite3Execute :: SQLite3 -> String -> IO () sqlite3Execute sqlite query = withCString query $ \pQuery -> do alloca $ \ppMsg -> do res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg handleSqlResult res ppMsg ------------------------------------------------------------------------------ -- routines for handling exceptions ------------------------------------------------------------------------------ -- | handleSqlResult :: CInt -> Ptr CString -> IO () handleSqlResult res ppMsg | fromIntegral res == sqliteOk = return () | otherwise = do pMsg <- peek ppMsg msg <- peekCString pMsg sqlite3_free pMsg throw (SqlError "E" (fromIntegral res) msg) hsql-sqlite3-1.8.2/hsql-sqlite3.cabal0000600000175000017500000000112411735632357014634 0ustar iiName: hsql-sqlite3 Version: 1.8.2 Synopsis: SQLite3 driver for HSQL. License: BSD3 License-File: LICENSE Author: Krasimir Angelov Maintainer: nick.rudnick@googlemail.com Category: Database Description: A Haskell Interface to SQLite 3 via libsqlite3 in the standard library path. Exposed-modules: Database.HSQL.SQLite3 DB.HSQL.SQLite3.Functions build-depends: base >= 4 && < 5, hsql >= 1.8.2 Extensions: ForeignFunctionInterface, CPP Build-type: Simple Extra-libraries: sqlite3 hsql-sqlite3-1.8.2/Setup.lhs0000600000175000017500000001037511330637717013133 0ustar ii#!/usr/bin/runghc \begin{code} import Control.Monad(when) import Control.Exception(SomeException,try) import System.Directory(removeFile,findExecutable) import System.Exit(ExitCode(ExitSuccess) ,exitWith) import System.IO(hClose, hGetContents, hPutStr, stderr) import System.Process(runInteractiveProcess, waitForProcess) import Distribution.PackageDescription (PackageDescription ,HookedBuildInfo ,emptyHookedBuildInfo ,BuildInfo(extraLibs ,extraLibDirs ,ldOptions ,includeDirs ,ccOptions) ,emptyBuildInfo) import Distribution.PackageDescription.Parse(writeHookedBuildInfo) import Distribution.Simple(UserHooks(preConf,postConf) ,simpleUserHooks ,defaultMainWithHooks) import Distribution.Simple.LocalBuildInfo(LocalBuildInfo) import Distribution.Simple.Setup(ConfigFlags(configVerbosity),Flag) import Distribution.Verbosity(Verbosity) main:: IO () main = defaultMainWithHooks simpleUserHooks{ preConf=preConf , postConf=postConf} where preConf:: [String] -> ConfigFlags -> IO HookedBuildInfo preConf args flags = do try (removeFile "SQLite3.buildinfo"):: IO (Either SomeException ()) return emptyHookedBuildInfo postConf:: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () postConf args flags _ localbuildinfo = do mb_bi <- pkgConfigBuildInfo (configVerbosity flags) "sqlite3" let bi = case mb_bi of Just bi -> bi Nothing -> emptyBuildInfo{ extraLibs=["sqlite3"] } writeHookedBuildInfo "SQLite3.buildinfo" (Just bi,[]) \end{code} The following code is derived from Distribution.Simple.Configure \begin{code} findProgram:: String -- ^ program name -> Maybe FilePath -- ^ optional explicit path -> IO (Maybe FilePath) findProgram name Nothing = do mb_path <- findExecutable name case mb_path of Nothing -> message ("No " ++ name ++ " found") Just path -> message ("Using " ++ name ++ ": " ++ path) return mb_path findProgram name (Just path) = do message ("Using " ++ name ++ ": " ++ path) return (Just path) -- | rawSystemGrabOutput:: Int -> FilePath -> [String] -> IO String rawSystemGrabOutput verbose path args = do when (verbose > 0) $ putStrLn (path ++ concatMap (' ':) args) (inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing exitCode <- waitForProcess pid if exitCode /= ExitSuccess then do errMsg <- hGetContents err hPutStr stderr errMsg exitWith exitCode else return () hClose inp hClose err hGetContents out -- | message:: String -> IO () message s = putStrLn $ "configure: " ++ s \end{code} Populate BuildInfo using pkg-config tool. \begin{code} pkgConfigBuildInfo:: Flag Verbosity -> String -> IO (Maybe BuildInfo) pkgConfigBuildInfo verbosity pkgName = do let verbose= -1 mb_pkg_config_path <- findProgram "pkg-config" Nothing case mb_pkg_config_path of Just pkg_config_path -> do message ("configuring "++pkgName++" package using pkg-config") res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-l"] let libs = map (tail.tail) (words res) res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-L"] let lib_dirs = map (tail.tail) (words res) res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-other"] let ld_opts = words res res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--cflags-only-I"] let inc_dirs = map (tail.tail) (words res) res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--cflags-only-other"] let cc_opts = words res let bi = emptyBuildInfo{ extraLibs=libs , extraLibDirs=lib_dirs , ldOptions=ld_opts , includeDirs=inc_dirs , ccOptions=cc_opts} return (Just bi) Nothing -> do message ("The package will be built using default settings for "++pkgName) return Nothing \end{code}