simplest-sqlite (empty) → 0.0.0.1

raw patch · 5 files changed

+201/−0 lines, 5 filesdep +basedep +bytestringdep +textsetup-changed

Dependencies added: base, bytestring, text

Files

LICENSE +27/−0
Setup.hs +1/−0
simplest-sqlite.cabal +35/−0
src/Database/SQLite3.hs +123/−0
src/Database/SQLite3/Constants.hsc +15/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2014, Yoshikuni Jujo+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 Yoshikuni Jujo 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 EVEN SHALL THE COPYRIGHT HOLDER 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.

+ Setup.hs view

@@ -0,0 +1,1 @@+import Distribution.Simple; main = defaultMain

+ simplest-sqlite.cabal view

@@ -0,0 +1,35 @@+build-type: Simple+cabal-version: >= 1.8++name: simplest-sqlite+version: 0.0.0.1+stability: Experimental+author: YoshikuniJujo <PAF01143@nifty.ne.jp>+maintainer: YoshikuniJujo <PAF01143@nifty.ne.jp>+homepage: comming soon++license: BSD3+license-file: LICENSE++category: Database+synopsis: Simplest SQLite3 binding+description:+    yet++source-repository head+    type: git+    location: git://github.com/YoshikuniJujo/test_haskell++source-repository this+    type: git+    location: git://github.com/YoshikuniJujo/test_haskell+    tag: simplest-sqlite-0.0.0.1++library+    hs-source-dirs: src+    exposed-modules: Database.SQLite3+    other-modules: Database.SQLite3.Constants+    build-depends: base == 4.*, bytestring == 0.10.*, text == 1.1.*+    ghc-options: -Wall+    extra-libraries: sqlite3+    extensions: ForeignFunctionInterface

+ src/Database/SQLite3.hs view

@@ -0,0 +1,123 @@+{-# LANGUAGE TupleSections #-}++module Database.SQLite3 (SQLite3, withSQLite3, withPrepared, step, column) where++import Control.Applicative+import Control.Monad+import Control.Exception+import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Foreign+import Foreign.C.Types+import Foreign.C.String++import Database.SQLite3.Constants++data SQLite3 = SQLite3 (Ptr SQLite3) deriving Show+data SQLite3Stmt = SQLite3Stmt (Ptr SQLite3Stmt) deriving Show++foreign import ccall unsafe "sqlite3.h sqlite3_open" c_sqlite3_open ::+	CString -> Ptr (Ptr SQLite3) -> IO CInt+foreign import ccall unsafe "sqlite3.h sqlite3_close" c_sqlite3_close ::+	Ptr SQLite3 -> IO CInt+foreign import ccall unsafe "sqlite3.h sqlite3_errmsg" c_sqlite3_errmsg ::+	Ptr SQLite3 -> IO CString++withSQLite3 :: String -> (SQLite3 -> IO a) -> IO a+withSQLite3 fp = bracket (sqlite3Open fp) sqlite3Close++sqlite3Open :: String -> IO SQLite3+sqlite3Open fp = withCString fp $ \cfp -> alloca $ \ppDb -> do+	ret <- c_sqlite3_open cfp ppDb+	db <- peek ppDb+	let sq = SQLite3 db+	when (ret /= sQLITE_OK) $ do+		em <- sqlite3Errmsg sq+		sqlite3Close sq+		ioError . userError $ "Cannot open database: " ++ em+	return sq++sqlite3Close :: SQLite3 -> IO ()+sqlite3Close sq@(SQLite3 db) = do+	ret <- c_sqlite3_close db+	when (ret /= sQLITE_OK) $ do+		em <- sqlite3Errmsg sq+		ioError . userError $ "Cannot close database: " ++ em++sqlite3Errmsg :: SQLite3 -> IO String+sqlite3Errmsg (SQLite3 db) = peekCString =<< c_sqlite3_errmsg db++foreign import ccall unsafe "sqlite3.h sqlite3_prepare_v2"+	c_sqlite3_prepare_v2 ::+		Ptr SQLite3 -> CString -> CInt -> Ptr (Ptr SQLite3Stmt) ->+		(Ptr CString) -> IO CInt+foreign import ccall unsafe "sqlite3.h sqlite3_finalize" c_sqlite3_finalize ::+	Ptr SQLite3Stmt -> IO CInt++withPrepared :: SQLite3 -> String -> (SQLite3Stmt -> IO a) -> IO (a, String)+withPrepared db sql act =+	bracket (sqlite3PrepareV2 db sql) (sqlite3Finalize . fst) $+		\(sm, t) -> (, t) <$> act sm++sqlite3PrepareV2 :: SQLite3 -> String -> IO (SQLite3Stmt, String)+sqlite3PrepareV2 db@(SQLite3 pdb) sql =+	withCString sql $ \csql -> alloca $ \psm -> alloca $ \pt -> do+		ret <- c_sqlite3_prepare_v2 pdb csql (- 1) psm pt+		sm <- SQLite3Stmt <$> peek psm+		when (ret /= sQLITE_OK) $ do+			em <- sqlite3Errmsg db+			sqlite3Finalize sm+			ioError . userError $ "Cannot prepare: " ++ em+		(sm ,) <$> (peekCString =<< peek pt)++sqlite3Finalize :: SQLite3Stmt -> IO ()+sqlite3Finalize (SQLite3Stmt psm) = do+	ret <- c_sqlite3_finalize psm+	when (ret /= sQLITE_OK) $+		ioError . userError $+			"Cannot finalize stmt: error code (" ++ show ret ++ ")"++data ResultCode = SQLiteBusy | SQLiteRow | SQLiteDone deriving Show++foreign import ccall unsafe "sqlite3.h sqlite3_step" c_sqlite3_step ::+	Ptr SQLite3Stmt -> IO CInt++step :: SQLite3Stmt -> IO ResultCode+step (SQLite3Stmt psm) = do+	ret <- c_sqlite3_step psm+	case ret of+		_	| ret == sQLITE_BUSY -> return SQLiteBusy+			| ret == sQLITE_ROW -> return SQLiteRow+			| ret == sQLITE_DONE -> return SQLiteDone+		_ -> ioError . userError $+			"Error while step: error code (" ++ show ret ++ ")"++foreign import ccall unsafe "sqlite3.h sqlite3_column_int"+	c_sqlite3_column_int :: Ptr SQLite3Stmt -> CInt -> IO CInt+foreign import ccall unsafe "sqlite3.h sqlite3_column_text"+	c_sqlite3_column_text :: Ptr SQLite3Stmt -> CInt -> IO CString++class SQLite3DataList a where+	columnList :: SQLite3Stmt -> Int -> IO [a]++class SQLite3Data a where+	column :: SQLite3Stmt -> Int -> IO a++instance SQLite3DataList a => SQLite3Data [a] where+	column = columnList++instance SQLite3Data Int where+	column (SQLite3Stmt sm) i =+		fromIntegral <$> c_sqlite3_column_int sm (fromIntegral i)++instance SQLite3DataList Char where+	columnList (SQLite3Stmt sm) i =+		peekCString =<< c_sqlite3_column_text sm (fromIntegral i)++instance SQLite3Data BS.ByteString where+	column (SQLite3Stmt sm) i =+		BS.packCString =<< c_sqlite3_column_text sm (fromIntegral i)++instance SQLite3Data T.Text where+	column sm i = T.decodeUtf8 <$> column sm i

+ src/Database/SQLite3/Constants.hsc view

@@ -0,0 +1,15 @@+#include <sqlite3.h>++module Database.SQLite3.Constants (+	sQLITE_OK, sQLITE_ERROR, sQLITE_BUSY,+	sQLITE_ROW, sQLITE_DONE+	) where++import Foreign.C.Types++sQLITE_OK, sQLITE_ERROR, sQLITE_BUSY, sQLITE_ROW, sQLITE_DONE :: CInt+sQLITE_OK = #const SQLITE_OK+sQLITE_ERROR = #const SQLITE_ERROR+sQLITE_BUSY = #const SQLITE_BUSY+sQLITE_ROW = #const SQLITE_ROW+sQLITE_DONE = #const SQLITE_DONE