direct-sqlite (empty) → 1.0
raw patch · 4 files changed
+493/−0 lines, 4 filesdep +basedep +bytestringdep +utf8-stringsetup-changed
Dependencies added: base, bytestring, utf8-string
Files
- Database/SQLite3.hsc +443/−0
- LICENSE +22/−0
- Setup.hs +5/−0
- direct-sqlite.cabal +23/−0
+ Database/SQLite3.hsc view
@@ -0,0 +1,443 @@+{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}+module Database.SQLite3 (+ Database,+ Statement,+ Error(..),+ StepResult(Row,+ Done),+ SQLData(SQLInteger,+ SQLFloat,+ SQLText,+ SQLBlob,+ SQLNull),+ open,+ close,+ prepare,+ step,+ reset,+ finalize,+ bindBlob,+ bindDouble,+ bindInt,+ bindInt64,+ bindNull,+ bindText,+ bind,+ column,+ columns+ )+ where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.UTF8 as UTF8+import Data.Typeable+import Foreign+import Foreign.C+++newtype Database = Database (Ptr ())+newtype Statement = Statement (Ptr ())++data Error = ErrorOK+ | ErrorError+ | ErrorInternal+ | ErrorPermission+ | ErrorAbort+ | ErrorBusy+ | ErrorLocked+ | ErrorNoMemory+ | ErrorReadOnly+ | ErrorInterrupt+ | ErrorIO+ | ErrorNotFound+ | ErrorCorrupt+ | ErrorFull+ | ErrorCan'tOpen+ | ErrorProtocol+ | ErrorEmpty+ | ErrorSchema+ | ErrorTooBig+ | ErrorConstraint+ | ErrorMismatch+ | ErrorMisuse+ | ErrorNoLargeFileSupport+ | ErrorAuthorization+ | ErrorFormat+ | ErrorRange+ | ErrorNotADatabase+ | ErrorRow+ | ErrorDone+ deriving (Eq, Show)++data StepResult = Row | Done deriving (Eq, Show)++data ColumnType = IntegerColumn+ | FloatColumn+ | TextColumn+ | BlobColumn+ | NullColumn+ deriving (Eq, Show)++data SQLData = SQLInteger Int64+ | SQLFloat Double+ | SQLText String+ | SQLBlob BS.ByteString+ | SQLNull+ deriving (Eq, Show, Typeable)+++encodeError :: Error -> Int+encodeError ErrorOK = 0+encodeError ErrorError = 1+encodeError ErrorInternal = 2+encodeError ErrorPermission = 3+encodeError ErrorAbort = 4+encodeError ErrorBusy = 5+encodeError ErrorLocked = 6+encodeError ErrorNoMemory = 7+encodeError ErrorReadOnly = 8+encodeError ErrorInterrupt = 9+encodeError ErrorIO = 10+encodeError ErrorNotFound = 11+encodeError ErrorCorrupt = 12+encodeError ErrorFull = 13+encodeError ErrorCan'tOpen = 14+encodeError ErrorProtocol = 15+encodeError ErrorEmpty = 16+encodeError ErrorSchema = 17+encodeError ErrorTooBig = 18+encodeError ErrorConstraint = 19+encodeError ErrorMismatch = 20+encodeError ErrorMisuse = 21+encodeError ErrorNoLargeFileSupport = 22+encodeError ErrorAuthorization = 23+encodeError ErrorFormat = 24+encodeError ErrorRange = 25+encodeError ErrorNotADatabase = 26+encodeError ErrorRow = 100+encodeError ErrorDone = 101+++decodeError :: Int -> Error+decodeError 0 = ErrorOK+decodeError 1 = ErrorError+decodeError 2 = ErrorInternal+decodeError 3 = ErrorPermission+decodeError 4 = ErrorAbort+decodeError 5 = ErrorBusy+decodeError 6 = ErrorLocked+decodeError 7 = ErrorNoMemory+decodeError 8 = ErrorReadOnly+decodeError 9 = ErrorInterrupt+decodeError 10 = ErrorIO+decodeError 11 = ErrorNotFound+decodeError 12 = ErrorCorrupt+decodeError 13 = ErrorFull+decodeError 14 = ErrorCan'tOpen+decodeError 15 = ErrorProtocol+decodeError 16 = ErrorEmpty+decodeError 17 = ErrorSchema+decodeError 18 = ErrorTooBig+decodeError 19 = ErrorConstraint+decodeError 20 = ErrorMismatch+decodeError 21 = ErrorMisuse+decodeError 22 = ErrorNoLargeFileSupport+decodeError 23 = ErrorAuthorization+decodeError 24 = ErrorFormat+decodeError 25 = ErrorRange+decodeError 26 = ErrorNotADatabase+decodeError 100 = ErrorRow+decodeError 101 = ErrorDone+++decodeColumnType :: Int -> ColumnType+decodeColumnType 1 = IntegerColumn+decodeColumnType 2 = FloatColumn+decodeColumnType 3 = TextColumn+decodeColumnType 4 = BlobColumn+decodeColumnType 5 = NullColumn+++foreign import ccall "sqlite3_errmsg"+ errmsgC :: Ptr () -> IO CString+errmsg :: Database -> IO String+errmsg (Database database) = do+ message <- errmsgC database+ byteString <- BS.packCString message+ return $ UTF8.toString byteString++sqlError :: Maybe Database -> String -> Error -> IO a+sqlError maybeDatabase functionName error = do+ details <- case maybeDatabase of+ Just database -> do+ details <- errmsg database+ return $ ": " ++ details+ Nothing -> return "."+ fail $ "SQLite3 returned " ++ (show error)+ ++ " while attempting to perform " ++ functionName+ ++ details++foreign import ccall "sqlite3_open"+ openC :: CString -> Ptr (Ptr ()) -> IO Int+openError :: String -> IO (Either Database Error)+openError path = do+ BS.useAsCString (UTF8.fromString path)+ (\path -> do+ alloca (\database -> do+ error <- openC path database+ error <- return $ decodeError error+ case error of+ ErrorOK -> do+ database <- peek database+ return $ Left $ Database database+ _ -> return $ Right error))+open :: String -> IO Database+open path = do+ databaseOrError <- openError path+ case databaseOrError of+ Left database -> return database+ Right error -> sqlError Nothing ("open " ++ show path) error++foreign import ccall "sqlite3_close"+ closeC :: Ptr () -> IO Int+closeError :: Database -> IO Error+closeError (Database database) = do+ error <- closeC database+ return $ decodeError error+close :: Database -> IO ()+close database = do+ error <- closeError database+ case error of+ ErrorOK -> return ()+ _ -> sqlError (Just database) "close" error++foreign import ccall "sqlite3_prepare_v2"+ prepareC :: Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int+prepareError :: Database -> String -> IO (Either Statement Error)+prepareError (Database database) text = do+ BS.useAsCString (UTF8.fromString text)+ (\text -> do+ alloca (\statement -> do+ error <- prepareC database text (-1) statement nullPtr+ error <- return $ decodeError error+ case error of+ ErrorOK -> do+ statement <- peek statement+ return $ Left $ Statement statement+ _ -> return $ Right error))+prepare :: Database -> String -> IO Statement+prepare database text = do+ statementOrError <- prepareError database text+ case statementOrError of+ Left statement -> return statement+ Right error -> sqlError (Just database) ("prepare " ++ (show text)) error++foreign import ccall "sqlite3_step"+ stepC :: Ptr () -> IO Int+stepError :: Statement -> IO Error+stepError (Statement statement) = do+ error <- stepC statement+ return $ decodeError error+step :: Statement -> IO StepResult+step statement = do+ error <- stepError statement+ case error of+ ErrorRow -> return Row+ ErrorDone -> return Done+ _ -> sqlError Nothing "step" error++foreign import ccall "sqlite3_reset"+ resetC :: Ptr () -> IO Int+resetError :: Statement -> IO Error+resetError (Statement statement) = do+ error <- resetC statement+ return $ decodeError error+reset :: Statement -> IO ()+reset statement = do+ error <- resetError statement+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "reset" error++foreign import ccall "sqlite3_finalize"+ finalizeC :: Ptr () -> IO Int+finalizeError :: Statement -> IO Error+finalizeError (Statement statement) = do+ error <- finalizeC statement+ return $ decodeError error+finalize :: Statement -> IO ()+finalize statement = do+ error <- finalizeError statement+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "finalize" error++foreign import ccall "sqlite3_bind_blob"+ bindBlobC :: Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int+bindBlobError :: Statement -> Int -> BS.ByteString -> IO Error+bindBlobError (Statement statement) parameterIndex byteString = do+ size <- return $ BS.length byteString+ BS.useAsCString byteString+ (\dataC -> do+ error <- bindBlobC statement parameterIndex (castPtr dataC) size+ (intPtrToPtr (-1))+ return $ decodeError error)+bindBlob :: Statement -> Int -> BS.ByteString -> IO ()+bindBlob statement parameterIndex byteString = do+ error <- bindBlobError statement parameterIndex byteString+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind blob" error++foreign import ccall "sqlite3_bind_double"+ bindDoubleC :: Ptr () -> Int -> Double -> IO Int+bindDoubleError :: Statement -> Int -> Double -> IO Error+bindDoubleError (Statement statement) parameterIndex datum = do+ error <- bindDoubleC statement parameterIndex datum+ return $ decodeError error+bindDouble :: Statement -> Int -> Double -> IO ()+bindDouble statement parameterIndex datum = do+ error <- bindDoubleError statement parameterIndex datum+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind double" error++foreign import ccall "sqlite3_bind_int"+ bindIntC :: Ptr () -> Int -> Int -> IO Int+bindIntError :: Statement -> Int -> Int -> IO Error+bindIntError (Statement statement) parameterIndex datum = do+ error <- bindIntC statement parameterIndex datum+ return $ decodeError error+bindInt :: Statement -> Int -> Int -> IO ()+bindInt statement parameterIndex datum = do+ error <- bindIntError statement parameterIndex datum+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind int" error++foreign import ccall "sqlite3_bind_int64"+ bindInt64C :: Ptr () -> Int -> Int64 -> IO Int+bindInt64Error :: Statement -> Int -> Int64 -> IO Error+bindInt64Error (Statement statement) parameterIndex datum = do+ error <- bindInt64C statement parameterIndex datum+ return $ decodeError error+bindInt64 :: Statement -> Int -> Int64 -> IO ()+bindInt64 statement parameterIndex datum = do+ error <- bindInt64Error statement parameterIndex datum+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind int64" error++foreign import ccall "sqlite3_bind_null"+ bindNullC :: Ptr () -> Int -> IO Int+bindNullError :: Statement -> Int -> IO Error+bindNullError (Statement statement) parameterIndex = do+ error <- bindNullC statement parameterIndex+ return $ decodeError error+bindNull :: Statement -> Int -> IO ()+bindNull statement parameterIndex = do+ error <- bindNullError statement parameterIndex+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind null" error++foreign import ccall "sqlite3_bind_text"+ bindTextC :: Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int+bindTextError :: Statement -> Int -> String -> IO Error+bindTextError (Statement statement) parameterIndex text = do+ byteString <- return $ UTF8.fromString text+ size <- return $ BS.length byteString+ BS.useAsCString byteString+ (\dataC -> do+ error <- bindTextC statement parameterIndex dataC size+ (intPtrToPtr (-1))+ return $ decodeError error)+bindText :: Statement -> Int -> String -> IO ()+bindText statement parameterIndex text = do+ error <- bindTextError statement parameterIndex text+ case error of+ ErrorOK -> return ()+ _ -> sqlError Nothing "bind text" error++bind :: Statement -> [SQLData] -> IO ()+bind statement sqlData = do+ mapM (\(parameterIndex, datum) -> do+ case datum of+ SQLInteger int64 -> bindInt64 statement parameterIndex int64+ SQLFloat double -> bindDouble statement parameterIndex double+ SQLText text -> bindText statement parameterIndex text+ SQLBlob blob -> bindBlob statement parameterIndex blob+ SQLNull -> bindNull statement parameterIndex)+ $ zip [1..] sqlData+ return ()++foreign import ccall "sqlite3_column_type"+ columnTypeC :: Ptr () -> Int -> IO Int+columnType :: Statement -> Int -> IO ColumnType+columnType (Statement statement) columnIndex = do+ result <- columnTypeC statement columnIndex+ return $ decodeColumnType result++foreign import ccall "sqlite3_column_bytes"+ columnBytesC :: Ptr () -> Int -> IO Int++foreign import ccall "sqlite3_column_blob"+ columnBlobC :: Ptr () -> Int -> IO (Ptr ())+columnBlob :: Statement -> Int -> IO BS.ByteString+columnBlob (Statement statement) columnIndex = do+ size <- columnBytesC statement columnIndex+ BSI.create size (\resultPtr -> do+ dataPtr <- columnBlobC statement columnIndex+ if dataPtr /= nullPtr+ then BSI.memcpy resultPtr (castPtr dataPtr) (fromIntegral size)+ else return ())++foreign import ccall "sqlite3_column_int64"+ columnInt64C :: Ptr () -> Int -> IO Int64+columnInt64 :: Statement -> Int -> IO Int64+columnInt64 (Statement statement) columnIndex = do+ columnInt64C statement columnIndex++foreign import ccall "sqlite3_column_double"+ columnDoubleC :: Ptr () -> Int -> IO Double+columnDouble :: Statement -> Int -> IO Double+columnDouble (Statement statement) columnIndex = do+ columnDoubleC statement columnIndex++foreign import ccall "sqlite3_column_text"+ columnTextC :: Ptr () -> Int -> IO CString+columnText :: Statement -> Int -> IO String+columnText (Statement statement) columnIndex = do+ text <- columnTextC statement columnIndex+ byteString <- BS.packCString text+ return $ UTF8.toString byteString++foreign import ccall "sqlite3_column_count"+ columnCountC :: Ptr () -> IO Int+columnCount :: Statement -> IO Int+columnCount (Statement statement) = do+ columnCountC statement++column :: Statement -> Int -> IO SQLData+column statement columnIndex = do+ theType <- columnType statement columnIndex+ case theType of+ IntegerColumn -> do+ int64 <- columnInt64 statement columnIndex+ return $ SQLInteger int64+ FloatColumn -> do+ double <- columnDouble statement columnIndex+ return $ SQLFloat double+ TextColumn -> do+ text <- columnText statement columnIndex+ return $ SQLText text+ BlobColumn -> do+ byteString <- columnBlob statement columnIndex+ return $ SQLBlob byteString+ NullColumn -> return SQLNull++columns :: Statement -> IO [SQLData]+columns statement = do+ count <- columnCount statement+ mapM (\i -> column statement i) [0..count-1]
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2009 Dan Knapp++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMain
+ direct-sqlite.cabal view
@@ -0,0 +1,23 @@+name: direct-sqlite+version: 1.0+cabal-version: >= 1.2+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Copyright (c) 2009 Dan Knapp+author: Dan Knapp+maintainer: dankna@gmail.com+homepage: http://www.dankna.com/software/+bug-reports: http://www.dankna.com/issues/create/+category: Database+synopsis: Low-level binding to SQLite3. Includes UTF8 and BLOB support.+description:+ This package is not very different from the other SQLite3 bindings out there, but+ it fixes a few deficiencies I was finding. It is not as complete as bindings-sqlite3,+ but is slightly higher-level, in that it supports marshalling of data values to and+ from the database. In particular, it supports strings encoded as UTF8, and BLOBs+ represented as ByteStrings.++Library+ exposed-modules: Database.SQLite3+ build-depends: bytestring, base >= 4.1 && < 5, utf8-string >= 0.3.5