postgresql-connector 0.1.0 → 0.2.0
raw patch · 2 files changed
+67/−29 lines, 2 filesdep +bytestringdep +exceptionsdep +stm
Dependencies added: bytestring, exceptions, stm
Files
postgresql-connector.cabal view
@@ -1,5 +1,5 @@ name: postgresql-connector-version: 0.1.0+version: 0.2.0 synopsis: Initial project postgresql-connector from stack description: Please see README.md homepage: http://github.com/mfine/postgresql-connector@@ -17,10 +17,13 @@ exposed-modules: Database.PostgreSQL.Connector ghc-options: -Wall build-depends: base >= 4.7 && < 5+ , bytestring+ , exceptions , lens , mtl , postgresql-simple , resourcet+ , stm , transformers-base default-language: Haskell2010
src/Database/PostgreSQL/Connector.hs view
@@ -15,11 +15,14 @@ module Database.PostgreSQL.Connector where -import Control.Lens-import Control.Monad.Base-import Control.Monad.Reader-import Control.Monad.Trans.Resource-import Data.Int+import Control.Concurrent+import Control.Lens+import Control.Monad.Base+import Control.Monad.Catch+import Control.Monad.Reader+import Control.Monad.Trans.Resource+import Data.ByteString+import Data.Int import qualified Database.PostgreSQL.Simple as PG newtype ConnectorT e m a = ConnectorT@@ -27,7 +30,9 @@ } deriving ( Functor , Applicative , Monad+ , MonadCatch , MonadIO+ , MonadMask , MonadReader e , MonadThrow )@@ -41,53 +46,83 @@ instance MonadResource m => MonadResource (ConnectorT r m) where liftResourceT = lift . liftResourceT -newtype Conn = Conn- { _connConnection :: PG.Connection+data Conn = Conn+ { _connDatabaseUrl :: ByteString+ , _connConnectionPool :: MVar [PG.Connection] } $(makeClassy ''Conn) type MonadConnector e m = ( MonadIO m+ , MonadMask m , MonadResource m , MonadReader e m , HasConn e ) +newConn :: MonadIO m => ByteString -> m Conn+newConn databaseUrl = do+ connectionPool <- liftIO $ newMVar []+ return Conn+ { _connDatabaseUrl = databaseUrl+ , _connConnectionPool = connectionPool+ }+ runConnectorT :: HasConn e => e -> ConnectorT e m a -> m a runConnectorT e (ConnectorT m) = runReaderT m e +connect :: MonadConnector e m => m PG.Connection+connect = do+ connectionPool <- view connConnectionPool+ databaseUrl <- view connDatabaseUrl+ liftIO $ modifyMVar connectionPool $ \connectionPool' ->+ case connectionPool' of+ (connection:connections) -> return (connections, connection)+ [] -> do+ connection <- PG.connectPostgreSQL databaseUrl+ return ([], connection)++restore :: MonadConnector e m => PG.Connection -> m ()+restore connection = do+ connectionPool <- view connConnectionPool+ liftIO $ modifyMVar_ connectionPool $ \connectionPool' ->+ return $ connection:connectionPool'++withConnection :: MonadConnector e m => (PG.Connection -> m a) -> m a+withConnection = bracket connect restore+ withTransaction :: MonadConnector e m => IO a -> m a-withTransaction action = do- connection <- view connConnection- liftIO $ PG.withTransaction connection action+withTransaction action =+ withConnection $ \connection ->+ liftIO $ PG.withTransaction connection action query :: (MonadConnector e m, PG.ToRow q, PG.FromRow r) => PG.Query -> q -> m [r]-query q params = do- connection <- view connConnection- liftIO $ PG.query connection q params+query q params =+ withConnection $ \connection ->+ liftIO $ PG.query connection q params query_ :: (MonadConnector e m, PG.FromRow r) => PG.Query -> m [r]-query_ q = do- connection <- view connConnection- liftIO $ PG.query_ connection q+query_ q =+ withConnection $ \connection ->+ liftIO $ PG.query_ connection q execute :: (MonadConnector e m, PG.ToRow q) => PG.Query -> q -> m Int64-execute q params = do- connection <- view connConnection- liftIO $ PG.execute connection q params+execute q params =+ withConnection $ \connection ->+ liftIO $ PG.execute connection q params executeMany :: (MonadConnector e m, PG.ToRow q) => PG.Query -> [q] -> m Int64-executeMany q params = do- connection <- view connConnection- liftIO $ PG.executeMany connection q params+executeMany q params =+ withConnection $ \connection ->+ liftIO $ PG.executeMany connection q params execute_ :: MonadConnector e m => PG.Query -> m Int64-execute_ q = do- connection <- view connConnection- liftIO $ PG.execute_ connection q+execute_ q =+ withConnection $ \connection ->+ liftIO $ PG.execute_ connection q returning :: (MonadConnector e m, PG.ToRow q, PG.FromRow r) => PG.Query -> [q] -> m [r]-returning q params = do- connection <- view connConnection- liftIO $ PG.returning connection q params+returning q params =+ withConnection $ \connection ->+ liftIO $ PG.returning connection q params