packages feed

simplest-sqlite 0.0.0.1 → 0.0.0.2

raw patch · 5 files changed

+143/−142 lines, 5 files

Files

simplest-sqlite.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8  name: simplest-sqlite-version: 0.0.0.1+version: 0.0.0.2 stability: Experimental author: YoshikuniJujo <PAF01143@nifty.ne.jp> maintainer: YoshikuniJujo <PAF01143@nifty.ne.jp>@@ -23,12 +23,12 @@ source-repository this     type: git     location: git://github.com/YoshikuniJujo/test_haskell-    tag: simplest-sqlite-0.0.0.1+    tag: simplest-sqlite-0.0.0.2  library     hs-source-dirs: src-    exposed-modules: Database.SQLite3-    other-modules: Database.SQLite3.Constants+    exposed-modules: Database.SmplstSQLite3+    other-modules: Database.SmplstSQLite3.Constants     build-depends: base == 4.*, bytestring == 0.10.*, text == 1.1.*     ghc-options: -Wall     extra-libraries: sqlite3
− src/Database/SQLite3.hs 
@@ -1,123 +0,0 @@-{-# 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 
@@ -1,15 +0,0 @@-#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
+ src/Database/SmplstSQLite3.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE TupleSections #-}++module Database.SmplstSQLite3 (+	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/SmplstSQLite3/Constants.hsc view
@@ -0,0 +1,15 @@+#include <sqlite3.h>++module Database.SmplstSQLite3.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