persistent-postgresql 0.0.0 → 0.1.0
raw patch · 2 files changed
+60/−37 lines, 2 filesdep ~persistent
Dependency ranges changed: persistent
Files
Database/Persist/Postgresql.hs view
@@ -1,52 +1,53 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} -- | A postgresql backend for persistent. module Database.Persist.Postgresql ( PostgresqlReader- , persistPostgresql , runPostgresql , withPostgresql- -- * Re-exports , Connection , connectPostgreSQL- , Int64- , module Database.Persist.Helper- , persist+ , Pool+ , module Database.Persist ) where -import Database.Persist (PersistValue (..))-import Database.Persist.Helper-import Database.Persist.GenericSql+import Database.Persist+import Database.Persist.Base+import qualified Database.Persist.GenericSql as G import Control.Monad.Trans.Reader-import Language.Haskell.TH.Syntax hiding (lift) import Control.Monad.IO.Class (MonadIO (..)) import Data.List (intercalate) import "MonadCatchIO-transformers" Control.Monad.CatchIO import qualified Database.HDBC as H import Database.HDBC.PostgreSQL import Data.Char (toLower)---- | Generate data types and instances for the given entity definitions. Can--- deal directly with the output of the 'persist' quasi-quoter.-persistPostgresql :: [EntityDef] -> Q [Dec]-persistPostgresql = fmap concat . mapM derivePersistPostgresqlReader+import Data.Int (Int64)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Applicative (Applicative)+import Database.Persist.Pool -- | A ReaderT monad transformer holding a postgresql database connection.-type PostgresqlReader = ReaderT Connection+newtype PostgresqlReader m a = PostgresqlReader (ReaderT Connection m a)+ deriving (Monad, MonadIO, MonadTrans, MonadCatchIO, Functor,+ Applicative) -- | Handles opening and closing of the database connection automatically.-withPostgresql :: MonadCatchIO m => String -> (Connection -> m a) -> m a-withPostgresql s f =- bracket (liftIO $ connectPostgreSQL s) (liftIO . H.disconnect) f+withPostgresql :: MonadCatchIO m+ => String -- ^ connection string+ -> Int -- ^ maximum number of connections in the pool+ -> (Pool Connection -> m a)+ -> m a+withPostgresql s i f =+ createPool (connectPostgreSQL s) H.disconnect i f -- | Run a series of database actions within a single transactions. On any -- exception, the transaction is rolled back.-runPostgresql :: MonadCatchIO m => PostgresqlReader m a -> Connection -> m a-runPostgresql r conn = do+runPostgresql :: MonadCatchIO m+ => PostgresqlReader m a+ -> Pool Connection+ -> m a+runPostgresql (PostgresqlReader r) pconn = withPool' pconn $ \conn -> do res <- onException (runReaderT r conn) $ liftIO (H.rollback conn) liftIO $ H.commit conn return res@@ -54,24 +55,24 @@ withStmt :: MonadIO m => String -> [PersistValue]- -> (RowPopper (PostgresqlReader m) -> PostgresqlReader m a)+ -> (G.RowPopper (PostgresqlReader m) -> PostgresqlReader m a) -> PostgresqlReader m a withStmt sql vals f = do- conn <- ask+ conn <- PostgresqlReader ask stmt <- liftIO $ H.prepare conn sql _ <- liftIO $ H.execute stmt $ map pToSql vals f $ liftIO $ (fmap . fmap) (map pFromSql) $ H.fetchRow stmt execute :: MonadIO m => String -> [PersistValue] -> PostgresqlReader m () execute sql vals = do- conn <- ask+ conn <- PostgresqlReader ask stmt <- liftIO $ H.prepare conn sql _ <- liftIO $ H.execute stmt $ map pToSql vals return () -insert :: MonadIO m- => String -> [String] -> [PersistValue] -> PostgresqlReader m Int64-insert t cols vals = do+insert' :: MonadIO m+ => String -> [String] -> [PersistValue] -> PostgresqlReader m Int64+insert' t cols vals = do let sql = "INSERT INTO " ++ t ++ "(" ++ intercalate "," cols ++ ") VALUES(" ++@@ -83,15 +84,14 @@ tableExists :: MonadIO m => String -> PostgresqlReader m Bool tableExists t = do- conn <- ask+ conn <- PostgresqlReader ask tables <- liftIO $ H.getTables conn return $ map toLower t `elem` tables -derivePersistPostgresqlReader :: EntityDef -> Q [Dec]-derivePersistPostgresqlReader t = do- let wrap = ConT ''ReaderT `AppT` ConT ''Connection- gs <- [|GenericSql withStmt execute insert tableExists "SERIAL UNIQUE"|]- deriveGenericSql wrap gs t+genericSql :: MonadIO m => G.GenericSql (PostgresqlReader m)+genericSql =+ G.GenericSql withStmt execute insert' tableExists+ "SERIAL UNIQUE" showSqlType pToSql :: PersistValue -> H.SqlValue pToSql (PersistString s) = H.SqlString s@@ -121,3 +121,26 @@ pFromSql (H.SqlUTCTime d) = PersistUTCTime d pFromSql H.SqlNull = PersistNull pFromSql x = PersistString $ H.fromSql x -- FIXME++instance MonadIO m => PersistBackend (PostgresqlReader 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 = "BYTEA"+showSqlType SqlBool = "BOOLEAN"
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 0.0.0+version: 0.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -19,7 +19,7 @@ transformers >= 0.2.1 && < 0.3, MonadCatchIO-transformers >= 0.2.2 && < 0.3, HDBC-postgresql >= 2.2.3.1 && < 2.3,- persistent >= 0.0.0 && < 0.1+ persistent >= 0.1.0 && < 0.2 exposed-modules: Database.Persist.Postgresql ghc-options: -Wall