haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1157 from pseudonom/master

Browse Source 
Adjustments for split read and write DB
This commit is contained in:
Michael Snoyman 2016-04-19 07:40:00 +03:00
commit 1b5477bc78
6 changed files with 70 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
stack.yaml
View File

@ -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

10
yesod-auth/Yesod/Auth.hs
View File

@ -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

2
yesod-auth/yesod-auth.cabal
View File

@ -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

34
yesod-form/Yesod/Form/Fields.hs
View File

@ -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

23
yesod-persistent/Yesod/Persist/Core.hs
View File

@ -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

2
yesod-persistent/yesod-persistent.cabal
View File

@ -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