diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index 535137b4..3a0cb4af 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} @@ -160,6 +161,18 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- Since 1.2.0 maybeAuthId :: HandlerT master IO (Maybe (AuthId master)) +#if MIN_VERSION_persistent(2, 0, 0) + default maybeAuthId + :: ( YesodAuth master + , PersistEntityBackend val ~ YesodPersistBackend master + , Key val ~ AuthId master + , PersistStore (PersistEntityBackend val) + , PersistEntity val + , YesodPersist master + , Typeable val + ) + => HandlerT master IO (Maybe (AuthId master)) +#else default maybeAuthId :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val @@ -171,6 +184,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage , Typeable val ) => HandlerT master IO (Maybe (AuthId master)) +#endif maybeAuthId = defaultMaybeAuthId -- | Called on login error for HTTP requests. By default, calls @@ -192,6 +206,18 @@ credsKey = "_ID" -- 'maybeAuthIdRaw' for more information. -- -- Since 1.1.2 +#if MIN_VERSION_persistent(2, 0, 0) +defaultMaybeAuthId + :: ( YesodAuth master + , b ~ YesodPersistBackend master + , b ~ PersistEntityBackend val + , Key val ~ AuthId master + , PersistStore b + , PersistEntity val + , YesodPersist master + , Typeable val + ) => HandlerT master IO (Maybe (AuthId master)) +#else defaultMaybeAuthId :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val @@ -202,6 +228,7 @@ defaultMaybeAuthId , YesodPersist master , Typeable val ) => HandlerT master IO (Maybe (AuthId master)) +#endif defaultMaybeAuthId = do ms <- lookupSession credsKey case ms of @@ -211,6 +238,17 @@ defaultMaybeAuthId = do Nothing -> return Nothing Just aid -> fmap (fmap entityKey) $ cachedAuth aid +#if MIN_VERSION_persistent(2, 0, 0) +cachedAuth :: ( YesodAuth master + , b ~ YesodPersistBackend master + , b ~ PersistEntityBackend val + , Key val ~ AuthId master + , PersistStore b + , PersistEntity val + , YesodPersist master + , Typeable val + ) => AuthId master -> HandlerT master IO (Maybe (Entity val)) +#else cachedAuth :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master @@ -220,6 +258,7 @@ cachedAuth :: ( YesodAuth master , YesodPersist master , Typeable val ) => AuthId master -> HandlerT master IO (Maybe (Entity val)) +#endif cachedAuth aid = runMaybeT $ do a <- MaybeT $ fmap unCachedMaybeAuth $ cached @@ -372,6 +411,17 @@ handlePluginR plugin pieces = do -- assumes that you are using a Persistent database. -- -- Since 1.1.0 +#if MIN_VERSION_persistent(2, 0, 0) +maybeAuth :: ( YesodAuth master + , b ~ YesodPersistBackend master + , b ~ PersistEntityBackend val + , Key val ~ AuthId master + , PersistStore b + , PersistEntity val + , YesodPersist master + , Typeable val + ) => HandlerT master IO (Maybe (Entity val)) +#else maybeAuth :: ( YesodAuth master , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master @@ -381,6 +431,7 @@ maybeAuth :: ( YesodAuth master , YesodPersist master , Typeable val ) => HandlerT master IO (Maybe (Entity val)) +#endif maybeAuth = runMaybeT $ do aid <- MaybeT maybeAuthId MaybeT $ cachedAuth aid @@ -394,6 +445,18 @@ newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val } -- full informatin on a given user. -- -- Since 1.2.0 +#if MIN_VERSION_persistent(2, 0, 0) +type YesodAuthPersist master = + ( YesodAuth master + , YesodPersistBackend master + ~ PersistEntityBackend (AuthEntity master) + , Key (AuthEntity master) ~ AuthId master + , PersistStore (YesodPersistBackend master) + , PersistEntity (AuthEntity master) + , YesodPersist master + , Typeable (AuthEntity master) + ) +#else type YesodAuthPersist master = ( YesodAuth master , PersistMonadBackend (YesodPersistBackend master (HandlerT master IO)) @@ -404,6 +467,7 @@ type YesodAuthPersist master = , YesodPersist master , Typeable (AuthEntity master) ) +#endif -- | If the @AuthId@ for a given site is a persistent ID, this will give the -- value for that entity. E.g.: @@ -413,6 +477,10 @@ type YesodAuthPersist master = -- -- Since 1.2.0 type AuthEntity master = KeyEntity (AuthId master) +#if MIN_VERSION_persistent(2, 0, 0) +type family KeyEntity key +type instance KeyEntity (Key x) = x +#endif -- | Similar to 'maybeAuthId', but redirects to a login page if user is not -- authenticated. diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index cf8b2476..a5a40dd3 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -45,8 +45,8 @@ library , unordered-containers , yesod-form >= 1.3 && < 1.4 , transformers >= 0.2.2 - , persistent >= 1.2 && < 1.4 - , persistent-template >= 1.2 && < 1.4 + , persistent >= 1.2 && < 2.1 + , persistent-template >= 1.2 && < 2.1 , http-conduit >= 1.5 , aeson >= 0.7 , lifted-base >= 0.1 diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index f3861238..00f748b4 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -75,7 +75,11 @@ import Data.Maybe (listToMaybe, fromMaybe) import qualified Blaze.ByteString.Builder.Html.Utf8 as B import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder.Internal.Write (fromWriteList) +#if MIN_VERSION_persistent(2, 0, 0) +import Database.Persist (PersistEntityBackend) +#else import Database.Persist (PersistMonadBackend, PersistEntityBackend) +#endif import Text.Blaze.Html.Renderer.String (renderHtml) import qualified Data.ByteString as S @@ -555,12 +559,21 @@ optionsPairs opts = do optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] +#if MIN_VERSION_persistent(2, 0, 0) +optionsPersist :: ( YesodPersist site, PersistEntity a + , PersistQuery (PersistEntityBackend a) + , PathPiece (Key a) + , RenderMessage site msg + , YesodPersistBackend site ~ PersistEntityBackend a + ) +#else optionsPersist :: ( YesodPersist site, PersistEntity a , PersistQuery (YesodPersistBackend site (HandlerT site IO)) , PathPiece (Key a) , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO)) , RenderMessage site msg ) +#endif => [Filter a] -> [SelectOpt a] -> (a -> msg) @@ -578,13 +591,24 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do -- the entire @Entity@. -- -- Since 1.3.2 +#if MIN_VERSION_persistent(2, 0, 0) +optionsPersistKey + :: (YesodPersist site + , PersistEntity a + , PersistQuery (PersistEntityBackend a) + , PathPiece (Key a) + , RenderMessage site msg + , YesodPersistBackend site ~ PersistEntityBackend a + ) +#else optionsPersistKey :: (YesodPersist site , PersistEntity a , PersistQuery (YesodPersistBackend site (HandlerT site IO)) , PathPiece (Key a) , RenderMessage site msg - , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO))) + , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)) +#endif => [Filter a] -> [SelectOpt a] -> (a -> msg) diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 668e3c1a..ec6cd546 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -25,7 +25,7 @@ library , shakespeare , shakespeare-css >= 1.0 , shakespeare-js >= 1.0.2 - , persistent >= 1.2 && < 1.4 + , persistent >= 1.2 && < 2.1 , template-haskell , transformers >= 0.2.2 , data-default diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index 1a338f3f..7f9b6b05 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,8 +20,10 @@ module Yesod.Persist.Core ) where import Database.Persist +#if !MIN_VERSION_persistent(2, 0, 0) import Database.Persist.Sql (SqlPersistT, unSqlPersistT) -import Control.Monad.Trans.Reader (runReaderT) +#endif +import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Yesod.Core import Data.Conduit @@ -31,11 +34,25 @@ import Control.Exception (throwIO) import Yesod.Core.Types (HandlerContents (HCError)) import qualified Database.Persist.Sql as SQL -type YesodDB site = YesodPersistBackend site (HandlerT site IO) +#if MIN_VERSION_persistent(2, 0, 0) +unSqlPersistT :: a -> a +unSqlPersistT = id +#endif +#if MIN_VERSION_persistent(2, 0, 0) +type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerT site IO) +#else +type YesodDB site = YesodPersistBackend site (HandlerT site IO) +#endif + +#if MIN_VERSION_persistent(2, 0, 0) +class Monad (YesodDB site) => YesodPersist site where + type YesodPersistBackend site +#else class Monad (YesodPersistBackend site (HandlerT site IO)) => YesodPersist site where type YesodPersistBackend site :: (* -> *) -> * -> * - runDB :: YesodPersistBackend site (HandlerT site IO) a -> HandlerT site IO a +#endif + runDB :: YesodDB site a -> HandlerT site IO a -- | Helper for creating 'runDB'. -- @@ -71,13 +88,17 @@ class YesodPersist site => YesodPersistRunner site where getDBRunner :: HandlerT site IO (DBRunner site, HandlerT site IO ()) newtype DBRunner site = DBRunner - { runDBRunner :: forall a. YesodPersistBackend site (HandlerT site IO) a -> HandlerT site IO a + { runDBRunner :: forall a. YesodDB site a -> HandlerT site IO a } -- | Helper for implementing 'getDBRunner'. -- -- Since 1.2.0 +#if MIN_VERSION_persistent(2, 0, 0) +defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend +#else defaultGetDBRunner :: YesodPersistBackend site ~ SqlPersistT +#endif => (site -> Pool SQL.Connection) -> HandlerT site IO (DBRunner site, HandlerT site IO ()) defaultGetDBRunner getPool = do @@ -106,7 +127,7 @@ defaultGetDBRunner getPool = do -- -- Since 1.2.0 runDBSource :: YesodPersistRunner site - => Source (YesodPersistBackend site (HandlerT site IO)) a + => Source (YesodDB site) a -> Source (HandlerT site IO) a runDBSource src = do (dbrunner, cleanup) <- lift getDBRunner @@ -116,11 +137,16 @@ runDBSource src = do -- | Extends 'respondSource' to create a streaming database response body. respondSourceDB :: YesodPersistRunner site => ContentType - -> Source (YesodPersistBackend site (HandlerT site IO)) (Flush Builder) + -> Source (YesodDB site) (Flush Builder) -> HandlerT site IO TypedContent 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, 0, 0) +get404 :: (MonadIO m, PersistStore (PersistEntityBackend val), PersistEntity val) + => Key val + -> ReaderT (PersistEntityBackend val) m val +#else get404 :: ( PersistStore (t m) , PersistEntity val , Monad (t m) @@ -129,6 +155,7 @@ get404 :: ( PersistStore (t m) , PersistMonadBackend (t m) ~ PersistEntityBackend val ) => Key val -> t m val +#endif get404 key = do mres <- get key case mres of @@ -137,6 +164,11 @@ 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, 0, 0) +getBy404 :: (PersistUnique (PersistEntityBackend val), PersistEntity val, MonadIO m) + => Unique val + -> ReaderT (PersistEntityBackend val) m (Entity val) +#else getBy404 :: ( PersistUnique (t m) , PersistEntity val , m ~ HandlerT site IO @@ -145,6 +177,7 @@ getBy404 :: ( PersistUnique (t m) , PersistEntityBackend val ~ PersistMonadBackend (t m) ) => Unique val -> t m (Entity val) +#endif getBy404 key = do mres <- getBy key case mres of @@ -156,8 +189,10 @@ getBy404 key = do notFound' :: MonadIO m => m a notFound' = liftIO $ throwIO $ HCError NotFound +#if !MIN_VERSION_persistent(2, 0, 0) instance MonadHandler m => MonadHandler (SqlPersistT m) where type HandlerSite (SqlPersistT m) = HandlerSite m liftHandlerT = lift . liftHandlerT instance MonadWidget m => MonadWidget (SqlPersistT m) where liftWidgetT = lift . liftWidgetT +#endif diff --git a/yesod-persistent/test/Yesod/PersistSpec.hs b/yesod-persistent/test/Yesod/PersistSpec.hs index bf29910c..58cdb2c4 100644 --- a/yesod-persistent/test/Yesod/PersistSpec.hs +++ b/yesod-persistent/test/Yesod/PersistSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-} {-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Yesod.PersistSpec where import Test.Hspec @@ -27,7 +28,7 @@ mkYesod "App" [parseRoutes| instance Yesod App instance YesodPersist App where - type YesodPersistBackend App = SqlPersistT + type YesodPersistBackend App = SqlBackend runDB = defaultRunDB appConfig appPool instance YesodPersistRunner App where getDBRunner = defaultGetDBRunner appPool diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index b44499b6..a6ce68f7 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -15,8 +15,8 @@ description: Some helpers for using Persistent from Yesod. library build-depends: base >= 4 && < 5 , yesod-core >= 1.2.2 && < 1.3 - , persistent >= 1.2 && < 1.4 - , persistent-template >= 1.2 && < 1.4 + , persistent >= 1.2 && < 2.1 + , persistent-template >= 1.2 && < 2.1 , transformers >= 0.2.2 , blaze-builder , conduit