multipool-postgresql-simple 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+32/−5 lines, 2 filesdep +bytestring

Dependencies added: bytestring

Files

• multipool-postgresql-simple.cabal +7/−5
• src/Data/MultiPool/PostgreSQLSimple.hs +25/−0

@@ -4,13 +4,13 @@ -- -- see: https://github.com/sol/hpack ----- hash: f2bcbf30da1024a0caf8fbeb2fd53d077c9e959a4a278b878d870e5e485bec9c+-- hash: 304274c5ff58ce1332b1894a0b87afacaf378ec9fbd51f7a53ce9450e08dbdde  name:           multipool-postgresql-simple-version:        0.1.0.0+version:        0.1.0.1 description:    Please see the README on GitHub at <https://github.com/iand675/multipool-postgresql-simple#readme>-homepage:       https://github.com/iand675/multipool-postgresql-simple#readme-bug-reports:    https://github.com/iand675/multipool-postgresql-simple/issues+homepage:       https://github.com/iand675/multipool#readme+bug-reports:    https://github.com/iand675/multipool/issues author:         Ian Duncan maintainer:     ian@iankduncan.com copyright:      Ian Duncan@@ -23,7 +23,7 @@  source-repository head   type: git-  location: https://github.com/iand675/multipool-postgresql-simple+  location: https://github.com/iand675/multipool  library   exposed-modules:@@ -34,6 +34,7 @@       src   build-depends:       base >=4.7 && <5+    , bytestring     , mtl     , multipool     , postgresql-simple@@ -52,6 +53,7 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5+    , bytestring     , mtl     , multipool     , multipool-postgresql-simple

@@ -16,11 +16,36 @@ import Control.Exception import Control.Monad.IO.Unlift import Control.Monad.Reader+import Data.ByteString.Char8 (ByteString) import Data.Pool import Data.MultiPool import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Database.PostgreSQL.Simple++initMultiPool ::+     (MonadUnliftIO m)+  => ByteString+  -> Int+  -> [(InstanceName Connection, ByteString, Int)]+  -> m (MultiPool Connection)+initMultiPool mc mn rl = do+  rr <- roundRobin $ map (\(i, _, _) -> i) rl+  initMultiPool' rr mc mn rl++initMultiPool' ::+     (MonadUnliftIO m)+  => (MultiPool Connection -> IO (Maybe (InstanceName Connection))) -- Strategy for selectin the replica instance when calling 'runReadAny'. 'roundRobin' is the current default.+  -> ByteString -- ^ Master connection string+  -> Int -- ^ Max number of connections to master instance+  -> [(InstanceName Connection, ByteString, Int)] -- ^ Replica connection details+  -> m (MultiPool Connection)+initMultiPool' multiPoolAnyReplicaSelector str n is = do+  multiPoolMaster <- liftIO $ createPool (connectPostgreSQL str) close n 15 1+  replicas <- liftIO $ mapM (\(inst, connStr, numConns) -> (,) <$> pure inst <*> createPool (connectPostgreSQL connStr) close numConns 15 1) is+  let multiPoolReplica = HM.fromList replicas+      multiPoolAnyMasterSelector = const $ pure ()+  return $ MultiPool {..}  withResource' :: MonadUnliftIO m => Pool a -> (a -> m b) -> m b withResource' pool action =