multipool-persistent 0.1.0.1 → 0.2.0.0

raw patch · 2 files changed

+22/−10 lines, 2 filesdep +resource-pool

Dependencies added: resource-pool

Files

• multipool-persistent.cabal +8/−5
• src/Data/MultiPool/Persist/Sql.hs +14/−5

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 6014faaead0269c48c2a038d33a400eca94bddd9aaa6060cb170e5e3ae7df30e+-- hash: ff4785686cbbd2aa3731d51f8468b78747766124387d369fff15a8990865fe7e  name:           multipool-persistent-version:        0.1.0.1+version:        0.2.0.0 synopsis:       Read and write from appropriate persistent sql instances in replicated environments. description:    Please see the README on GitHub at <https://github.com/iand675/multipool#readme> category:       Database@@ -17,10 +19,9 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:-    ChangeLog.md     README.md+    ChangeLog.md  source-repository head   type: git@@ -38,6 +39,7 @@     , mtl     , multipool     , persistent+    , resource-pool     , unliftio-core     , unordered-containers   default-language: Haskell2010@@ -56,6 +58,7 @@     , multipool     , multipool-persistent     , persistent+    , resource-pool     , unliftio-core     , unordered-containers   default-language: Haskell2010

@@ -10,29 +10,38 @@ import Control.Monad.IO.Unlift import Control.Monad.Reader import Data.MultiPool+import Data.Pool import Database.Persist.Sql import Database.Persist.Sql.Types.Internal import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM  instance MonadUnliftIO m => MultiPoolBackend m SqlBackend where-  type MasterConnection SqlBackend = SqlWriteBackend+  type PrimaryConnection SqlBackend = SqlWriteBackend   type ReplicaConnection SqlBackend = SqlReadBackend   type ReplicaIdentifier SqlBackend = InstanceName SqlReadBackend    runWriteAny b m = runWrite b () m-  runWrite b () m = runSqlPool m (multiPoolMaster b)+  runWrite b () m = runSqlPool m (multiPoolPrimary b) -  runReadMaster b () m = runReadAnyMaster b m-  runReadAnyMaster b m = runSqlPool (readToWrite m) (multiPoolMaster b)+  runReadPrimary b () m = runReadAnyPrimary b m+  runReadAnyPrimary b m = runSqlPool (readToWrite m) (multiPoolPrimary b)   runReadAny b m = do     mident <- liftIO $ multiPoolAnyReplicaSelector b b     case mident of-      Nothing -> runReadAnyMaster b m+      Nothing -> runReadAnyPrimary b m       Just ident -> runRead b ident m   runRead b ident m = case HM.lookup ident (multiPoolReplica b) of     Nothing -> throw (InstanceDoesNotExist ident)     Just repl -> runSqlPool m repl++  takePrimary b () = liftIO $ takeResource $ multiPoolPrimary b+  putPrimary _ l c = liftIO $ putResource l c++  takeReplica b ident = case HM.lookup ident (multiPoolReplica b) of+    Nothing -> throw (InstanceDoesNotExist ident)+    Just repl -> liftIO $ takeResource repl+  putReplica _ l c = liftIO $ putResource l c  unsafeRead :: ReaderT SqlBackend m a -> ReaderT SqlReadBackend m a unsafeRead = withReaderT persistBackend