persistent-sqlite 0.0.0 → 0.1.0
raw patch · 3 files changed
+83/−68 lines, 3 filesdep −web-routes-quasidep ~persistent
Dependencies removed: web-routes-quasi
Dependency ranges changed: persistent
Files
- Database/Persist/Sqlite.hs +62/−46
- Database/Sqlite.hs +19/−19
- persistent-sqlite.cabal +2/−3
Database/Persist/Sqlite.hs view
@@ -1,67 +1,62 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PackageImports #-}-{-# LANGUAGE FlexibleContexts #-} -- | A sqlite backend for persistent. module Database.Persist.Sqlite ( SqliteReader- , persistSqlite , runSqlite , withSqlite- -- * Re-exports- , Database- , open- , close- , Int64- , module Database.Persist.Helper- , persist+ , Connection+ , Pool+ , module Database.Persist ) where -import Database.Persist (PersistValue (..))-import Database.Persist.Helper+import Database.Persist+import Database.Persist.Base import Control.Monad.Trans.Reader-import Language.Haskell.TH.Syntax hiding (lift) import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Class (MonadTrans (..)) import Data.List (intercalate) import "MonadCatchIO-transformers" Control.Monad.CatchIO import Database.Sqlite-import Database.Persist.Quasi-import Database.Persist.GenericSql---- | Generate data types and instances for the given entity definitions. Can--- deal directly with the output of the 'persist' quasi-quoter.-persistSqlite :: [EntityDef] -> Q [Dec]-persistSqlite = fmap concat . mapM derivePersistSqliteReader+import qualified Database.Persist.GenericSql as G+import Control.Applicative (Applicative)+import Data.Int (Int64)+import Database.Persist.Pool -- | A ReaderT monad transformer holding a sqlite database connection.-type SqliteReader = ReaderT Database+newtype SqliteReader m a = SqliteReader (ReaderT Connection m a)+ deriving (Monad, MonadIO, MonadTrans, MonadCatchIO, Functor,+ Applicative) -- | Handles opening and closing of the database connection automatically.-withSqlite :: MonadCatchIO m => String -> (Database -> m a) -> m a-withSqlite s f = bracket (liftIO $ open s) (liftIO . close) f+withSqlite :: MonadCatchIO m+ => String+ -> Int -- ^ number of connections to open+ -> (Pool Connection -> m a) -> m a+withSqlite s i f = createPool (open s) close i f --- | Run a series of database actions within a single transactions. On any+-- | Run a series of database actions within a single transaction. On any -- exception, the transaction is rolled back.-runSqlite :: MonadCatchIO m => SqliteReader m a -> Database -> m a-runSqlite r conn = do- Done <- liftIO begin- res <- onException (runReaderT r conn) $ liftIO rollback- Done <- liftIO commit- return res+runSqlite :: MonadCatchIO m => SqliteReader m a -> Pool Connection -> m a+runSqlite (SqliteReader r) pconn = withPool' pconn go where- begin = bracket (prepare conn "BEGIN") finalize step- commit = bracket (prepare conn "COMMIT") finalize step- rollback = bracket (prepare conn "ROLLBACK") finalize step+ go conn = do+ Done <- liftIO begin+ res <- onException (runReaderT r conn) $ liftIO rollback+ Done <- liftIO commit+ return res+ where+ begin = bracket (prepare conn "BEGIN") finalize step+ commit = bracket (prepare conn "COMMIT") finalize step+ rollback = bracket (prepare conn "ROLLBACK") finalize step withStmt :: MonadCatchIO m => String -> [PersistValue]- -> (RowPopper (SqliteReader m) -> SqliteReader m a)+ -> (G.RowPopper (SqliteReader m) -> SqliteReader m a) -> SqliteReader m a withStmt sql vals f = do- conn <- ask+ conn <- SqliteReader ask bracket (liftIO $ prepare conn sql) (liftIO . finalize) $ \stmt -> do liftIO $ bind stmt vals f $ go stmt@@ -76,15 +71,15 @@ execute :: MonadCatchIO m => String -> [PersistValue] -> SqliteReader m () execute sql vals = do- conn <- ask+ conn <- SqliteReader ask bracket (liftIO $ prepare conn sql) (liftIO . finalize) $ \stmt -> do liftIO $ bind stmt vals Done <- liftIO $ step stmt return () -insert :: MonadCatchIO m- => String -> [String] -> [PersistValue] -> SqliteReader m Int64-insert t cols vals = do+insert' :: MonadCatchIO m+ => String -> [String] -> [PersistValue] -> SqliteReader m Int64+insert' t cols vals = do let sql = "INSERT INTO " ++ t ++ "(" ++ intercalate "," cols ++ ") VALUES(" ++ intercalate "," (map (const "?") cols) ++ ")"@@ -100,8 +95,29 @@ where sql = "SELECT COUNT(*) FROM sqlite_master WHERE type='table' AND name=?" -derivePersistSqliteReader :: EntityDef -> Q [Dec]-derivePersistSqliteReader t = do- let wrap = ConT ''ReaderT `AppT` ConT ''Database- gs <- [|GenericSql withStmt execute insert tableExists "INTEGER PRIMARY KEY"|]- deriveGenericSql wrap gs t+genericSql :: MonadCatchIO m => G.GenericSql (SqliteReader m)+genericSql = G.GenericSql withStmt execute insert' tableExists+ "INTEGER PRIMARY KEY" showSqlType++instance MonadCatchIO m => PersistBackend (SqliteReader m) where+ initialize = G.initialize genericSql+ insert = G.insert genericSql+ get = G.get genericSql+ replace = G.replace genericSql+ select = G.select genericSql+ deleteWhere = G.deleteWhere genericSql+ update = G.update genericSql+ updateWhere = G.updateWhere genericSql+ getBy = G.getBy genericSql+ delete = G.delete genericSql+ deleteBy = G.deleteBy genericSql++showSqlType :: SqlType -> String+showSqlType SqlString = "VARCHAR"+showSqlType SqlInteger = "INTEGER"+showSqlType SqlReal = "REAL"+showSqlType SqlDay = "DATE"+showSqlType SqlTime = "TIME"+showSqlType SqlDayTime = "TIMESTAMP"+showSqlType SqlBlob = "BLOB"+showSqlType SqlBool = "BOOLEAN"
Database/Sqlite.hs view
@@ -2,7 +2,7 @@ -- | A port of the direct-sqlite package for dealing directly with -- 'PersistValue's. module Database.Sqlite (- Database,+ Connection, Statement, Error(..), StepResult(Row,@@ -32,10 +32,10 @@ import qualified Data.ByteString.UTF8 as UTF8 import Foreign import Foreign.C-import Database.Persist (PersistValue (..))+import Database.Persist.Base (PersistValue (..)) import Control.Concurrent.MVar -newtype Database = Database (Ptr ())+newtype Connection = Connection (Ptr ()) -- | The MVar is only used for insuring the statement is not double-finalized. -- It won't stop you from using a statement after it's been finalized. data Statement = Statement (Ptr ()) (MVar Bool)@@ -66,7 +66,7 @@ | ErrorAuthorization | ErrorFormat | ErrorRange- | ErrorNotADatabase+ | ErrorNotAConnection | ErrorRow | ErrorDone deriving (Eq, Show)@@ -107,7 +107,7 @@ decodeError 23 = ErrorAuthorization decodeError 24 = ErrorFormat decodeError 25 = ErrorRange-decodeError 26 = ErrorNotADatabase+decodeError 26 = ErrorNotAConnection decodeError 100 = ErrorRow decodeError 101 = ErrorDone decodeError i = Prelude.error $ "decodeError " ++ show i@@ -122,15 +122,15 @@ foreign import ccall "sqlite3_errmsg" errmsgC :: Ptr () -> IO CString-errmsg :: Database -> IO String-errmsg (Database database) = do+errmsg :: Connection -> IO String+errmsg (Connection 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+sqlError :: Maybe Connection -> String -> Error -> IO a+sqlError maybeConnection functionName error = do+ details <- case maybeConnection of Just database -> do details <- errmsg database return $ ": " ++ details@@ -141,7 +141,7 @@ foreign import ccall "sqlite3_open" openC :: CString -> Ptr (Ptr ()) -> IO Int-openError :: String -> IO (Either Database Error)+openError :: String -> IO (Either Connection Error) openError path' = do BS.useAsCString (UTF8.fromString path') (\path -> do@@ -151,9 +151,9 @@ case error of ErrorOK -> do database' <- peek database- return $ Left $ Database database'+ return $ Left $ Connection database' _ -> return $ Right error))-open :: String -> IO Database+open :: String -> IO Connection open path = do databaseOrError <- openError path case databaseOrError of@@ -162,11 +162,11 @@ foreign import ccall "sqlite3_close" closeC :: Ptr () -> IO Int-closeError :: Database -> IO Error-closeError (Database database) = do+closeError :: Connection -> IO Error+closeError (Connection database) = do error <- closeC database return $ decodeError error-close :: Database -> IO ()+close :: Connection -> IO () close database = do error <- closeError database case error of@@ -175,8 +175,8 @@ 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+prepareError :: Connection -> String -> IO (Either Statement Error)+prepareError (Connection database) text' = do BS.useAsCString (UTF8.fromString text') (\text -> do alloca (\statement -> do@@ -188,7 +188,7 @@ mvar <- newMVar True return $ Left $ Statement statement' mvar _ -> return $ Right error))-prepare :: Database -> String -> IO Statement+prepare :: Connection -> String -> IO Statement prepare database text = do statementOrError <- prepareError database text case statementOrError of
persistent-sqlite.cabal view
@@ -1,5 +1,5 @@ name: persistent-sqlite-version: 0.0.0+version: 0.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -25,9 +25,8 @@ bytestring >= 0.9.1 && < 0.10, transformers >= 0.2.1 && < 0.3, MonadCatchIO-transformers >= 0.2.2 && < 0.3,- web-routes-quasi >= 0.4.0 && < 0.5, utf8-string >= 0.3.4 && < 0.4,- persistent >= 0.0.0 && < 0.1+ persistent >= 0.1.0 && < 0.2 exposed-modules: Database.Sqlite Database.Persist.Sqlite ghc-options: -Wall