Merge pull request #1157 from pseudonom/master

Adjustments for split read and write DB

stack.yaml

@@ -17,4 +17,7 @@ packages:
 # Needed for LTS 2
 extra-deps:
 - wai-app-static-3.1.4.1
+- http-api-data-0.2
 - yaml-0.8.17
+- nonce-1.0.2
+- persistent-2.5

yesod-auth/Yesod/Auth.hs

@@ -499,6 +499,15 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
 
     getAuthEntity :: AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
 
+#if MIN_VERSION_persistent(2,5,0)
+    default getAuthEntity
+        :: ( YesodPersistBackend master ~ backend
+           , PersistRecordBackend (AuthEntity master) backend
+           , Key (AuthEntity master) ~ AuthId master
+           , PersistStore backend
+           )
+        => AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+#else
     default getAuthEntity
         :: ( YesodPersistBackend master
                ~ PersistEntityBackend (AuthEntity master)
@@ -507,6 +516,7 @@ class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
            , PersistEntity (AuthEntity master)
            )
         => AuthId master -> HandlerT master IO (Maybe (AuthEntity master))
+#endif
     getAuthEntity = runDB . get
 
 

yesod-auth/yesod-auth.cabal

@@ -37,7 +37,7 @@ library
                    , unordered-containers
                    , yesod-form              >= 1.4       && < 1.5
                    , transformers            >= 0.2.2
-                   , persistent              >= 2.1       && < 2.3
+                   , persistent              >= 2.1       && < 2.6
                    , persistent-template     >= 2.1       && < 2.2
                    , http-client
                    , http-conduit            >= 2.1

yesod-form/Yesod/Form/Fields.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -74,7 +75,11 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Network.URI (parseURI)
 import Database.Persist.Sql (PersistField, PersistFieldSql (..))
+#if MIN_VERSION_persistent(2,5,0)
+import Database.Persist (Entity (..), SqlType (SqlString), PersistRecordBackend, PersistQueryRead)
+#else
 import Database.Persist (Entity (..), SqlType (SqlString))
+#endif
 import Text.HTML.SanitizeXSS (sanitizeBalance)
 import Control.Monad (when, unless)
 import Data.Either (partitionEithers)
@@ -645,6 +650,19 @@ optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 -- >         <$> areq (selectField countries) "Which country do you live in?" Nothing
 -- >         where
 -- >           countries = optionsPersist [] [Asc CountryName] countryName
+#if MIN_VERSION_persistent(2,5,0)
+optionsPersist :: ( YesodPersist site
+                  , PersistQueryRead backend
+                  , PathPiece (Key a)
+                  , RenderMessage site msg
+                  , YesodPersistBackend site ~ backend
+                  , PersistRecordBackend a backend
+                  )
+               => [Filter a]
+               -> [SelectOpt a]
+               -> (a -> msg)
+               -> HandlerT site IO (OptionList (Entity a))
+#else
 optionsPersist :: ( YesodPersist site, PersistEntity a
                   , PersistQuery (PersistEntityBackend a)
                   , PathPiece (Key a)
@@ -655,6 +673,7 @@ optionsPersist :: ( YesodPersist site, PersistEntity a
                -> [SelectOpt a]
                -> (a -> msg)
                -> HandlerT site IO (OptionList (Entity a))
+#endif
 optionsPersist filts ords toDisplay = fmap mkOptionList $ do
     mr <- getMessageRender
     pairs <- runDB $ selectList filts ords
@@ -668,6 +687,20 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do
 -- the entire 'Entity'.
 --
 -- Since 1.3.2
+#if MIN_VERSION_persistent(2,5,0)
+optionsPersistKey
+  :: (YesodPersist site
+     , PersistQueryRead backend
+     , PathPiece (Key a)
+     , RenderMessage site msg
+     , backend ~ YesodPersistBackend site
+     , PersistRecordBackend a backend
+     )
+  => [Filter a]
+  -> [SelectOpt a]
+  -> (a -> msg)
+  -> HandlerT site IO (OptionList (Key a))
+#else
 optionsPersistKey
   :: (YesodPersist site
      , PersistEntity a
@@ -680,6 +713,7 @@ optionsPersistKey
   -> [SelectOpt a]
   -> (a -> msg)
   -> HandlerT site IO (OptionList (Key a))
+#endif
 
 optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
     mr <- getMessageRender

yesod-persistent/Yesod/Persist/Core.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -20,7 +21,7 @@ module Yesod.Persist.Core
     ) where
 
 import Database.Persist
-import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
 
 import Yesod.Core
 import Data.Conduit
@@ -80,12 +81,18 @@ newtype DBRunner site = DBRunner
 -- | Helper for implementing 'getDBRunner'.
 --
 -- Since 1.2.0
+#if MIN_VERSION_persistent(2,5,0)
+defaultGetDBRunner :: (SQL.IsSqlBackend backend, YesodPersistBackend site ~ backend)
+                   => (site -> Pool backend)
+                   -> HandlerT site IO (DBRunner site, HandlerT site IO ())
+#else
 defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend
                    => (site -> Pool SQL.SqlBackend)
                    -> HandlerT site IO (DBRunner site, HandlerT site IO ())
+#endif
 defaultGetDBRunner getPool = do
     pool <- fmap getPool getYesod
-    let withPrep conn f = f conn (SQL.connPrepare conn)
+    let withPrep conn f = f (persistBackend conn) (SQL.connPrepare $ persistBackend conn)
     (relKey, (conn, local)) <- allocate
         (do
             (conn, local) <- takeResource pool
@@ -124,9 +131,15 @@ respondSourceDB :: YesodPersistRunner site
 respondSourceDB ctype = respondSource ctype . runDBSource
 
 -- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
+#if MIN_VERSION_persistent(2,5,0)
+get404 :: (MonadIO m, PersistStore backend, PersistRecordBackend val backend)
+       => Key val
+       -> ReaderT backend m val
+#else
 get404 :: (MonadIO m, PersistStore (PersistEntityBackend val), PersistEntity val)
        => Key val
        -> ReaderT (PersistEntityBackend val) m val
+#endif
 get404 key = do
     mres <- get key
     case mres of
@@ -135,9 +148,15 @@ get404 key = do
 
 -- | Get the given entity by unique key, or return a 404 not found if it doesn't
 --   exist.
+#if MIN_VERSION_persistent(2,5,0)
+getBy404 :: (PersistUnique backend, PersistRecordBackend val backend, MonadIO m)
+         => Unique val
+         -> ReaderT backend m (Entity val)
+#else
 getBy404 :: (PersistUnique (PersistEntityBackend val), PersistEntity val, MonadIO m)
          => Unique val
          -> ReaderT (PersistEntityBackend val) m (Entity val)
+#endif
 getBy404 key = do
     mres <- getBy key
     case mres of

yesod-persistent/yesod-persistent.cabal

@@ -16,7 +16,7 @@ extra-source-files: README.md ChangeLog.md
 library
     build-depends:   base                      >= 4        && < 5
                    , yesod-core                >= 1.4.0    && < 1.5
-                   , persistent                >= 2.1      && < 2.3
+                   , persistent                >= 2.1      && < 2.6
                    , persistent-template       >= 2.1      && < 2.2
                    , transformers              >= 0.2.2
                    , blaze-builder