diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,47 @@ +# ChangeLog for yesod-persistent + +## 1.6.0.9 + +* Support `yesod-core` 1.7 + +## 1.6.0.8 + +* Add support for `persistent-2.14` [#1706](https://github.com/yesodweb/yesod/pull/1760) + +## 1.6.0.7 + +* Add support for persistent 2.13. [#1723](https://github.com/yesodweb/yesod/pull/1723) + +## 1.6.0.6 + +* Add support for persistent 2.12 + +## 1.6.0.5 + +* Add support for Persistent 2.11 [#1701](https://github.com/yesodweb/yesod/pull/1701) + +## 1.6.0.4 + +* Fix test suite to be compatible with latest `persistent-template` +* See https://github.com/yesodweb/persistent/pull/1002 +* [#1649](https://github.com/yesodweb/yesod/pull/1649/files) + +## 1.6.0.3 + +* Replace call to `connPrepare` with `getStmtConn`. [#1635](https://github.com/yesodweb/yesod/issues/1635) + +## 1.6.0.2 + +* Add support for persistent 2.10 + +## 1.6.0.1 + +* Add support for persistent 2.9 [#1516](https://github.com/yesodweb/yesod/pull/1516), [#1561](https://github.com/yesodweb/yesod/pull/1561) + +## 1.6.0 + +* Upgrade to yesod-core 1.6.0 + ## 1.4.3 * Fix overly powerful constraints on get404 and getBy404. diff --git a/Yesod/Persist/Core.hs b/Yesod/Persist/Core.hs --- a/Yesod/Persist/Core.hs +++ b/Yesod/Persist/Core.hs @@ -1,9 +1,11 @@ {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + -- | Defines the core functionality of this package. This package is -- distinguished from Yesod.Persist in that the latter additionally exports the -- persistent modules themselves. @@ -33,15 +35,28 @@ import Control.Exception (throwIO) import Yesod.Core.Types (HandlerContents (HCError)) import qualified Database.Persist.Sql as SQL +#if MIN_VERSION_persistent(2,13,0) +import Data.List.NonEmpty (toList) +import qualified Database.Persist.SqlBackend.Internal as SQL +#endif unSqlPersistT :: a -> a unSqlPersistT = id -type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerT site IO) +type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerFor site) class Monad (YesodDB site) => YesodPersist site where type YesodPersistBackend site - runDB :: YesodDB site a -> HandlerT site IO a + -- | Allows you to execute database actions within Yesod Handlers. For databases that support it, code inside the action will run as an atomic transaction. + -- + -- + -- ==== __Example Usage__ + -- + -- > userId <- runDB $ do + -- > userId <- insert $ User "username" "email@example.com" + -- > insert_ $ UserPreferences userId True + -- > pure userId + runDB :: YesodDB site a -> HandlerFor site a -- | Helper for creating 'runDB'. -- @@ -49,8 +64,8 @@ defaultRunDB :: PersistConfig c => (site -> c) -> (site -> PersistConfigPool c) - -> PersistConfigBackend c (HandlerT site IO) a - -> HandlerT site IO a + -> PersistConfigBackend c (HandlerFor site) a + -> HandlerFor site a defaultRunDB getConfig getPool f = do master <- getYesod Database.Persist.runPool @@ -74,31 +89,29 @@ -- least, a rollback will be used instead. -- -- Since 1.2.0 - getDBRunner :: HandlerT site IO (DBRunner site, HandlerT site IO ()) + getDBRunner :: HandlerFor site (DBRunner site, HandlerFor site ()) newtype DBRunner site = DBRunner - { runDBRunner :: forall a. YesodDB site a -> HandlerT site IO a + { runDBRunner :: forall a. YesodDB site a -> HandlerFor site a } -- | 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 + -> HandlerFor site (DBRunner site, HandlerFor site ()) defaultGetDBRunner getPool = do pool <- fmap getPool getYesod - let withPrep conn f = f (persistBackend conn) (SQL.connPrepare $ persistBackend conn) + let withPrep conn f = f (persistBackend conn) (SQL.getStmtConn $ persistBackend conn) (relKey, (conn, local)) <- allocate (do (conn, local) <- takeResource pool +#if MIN_VERSION_persistent(2,9,0) + withPrep conn (\c f -> SQL.connBegin c f Nothing) +#else withPrep conn SQL.connBegin +#endif return (conn, local) ) (\(conn, local) -> do @@ -118,8 +131,8 @@ -- -- Since 1.2.0 runDBSource :: YesodPersistRunner site - => Source (YesodDB site) a - -> Source (HandlerT site IO) a + => ConduitT () a (YesodDB site) () + -> ConduitT () a (HandlerFor site) () runDBSource src = do (dbrunner, cleanup) <- lift getDBRunner transPipe (runDBRunner dbrunner) src @@ -128,20 +141,14 @@ -- | Extends 'respondSource' to create a streaming database response body. respondSourceDB :: YesodPersistRunner site => ContentType - -> Source (YesodDB site) (Flush Builder) - -> HandlerT site IO TypedContent + -> ConduitT () (Flush Builder) (YesodDB site) () + -> HandlerFor site 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,5,0) get404 :: (MonadIO m, PersistStoreRead 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 @@ -150,15 +157,9 @@ -- | 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 :: (PersistUniqueRead 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 @@ -170,34 +171,46 @@ -- is violated. -- -- @since 1.4.1 -#if MIN_VERSION_persistent(2,5,0) -insert400 :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend) - => val - -> ReaderT backend m (Key val) -#else -insert400 :: (MonadIO m, PersistUnique (PersistEntityBackend val), PersistEntity val) - => val - -> ReaderT (PersistEntityBackend val) m (Key val) +insert400 + :: ( MonadIO m + , PersistUniqueWrite backend + , PersistRecordBackend val backend +#if MIN_VERSION_persistent(2,14,0) + , SafeToInsert val #endif + ) + => val + -> ReaderT backend m (Key val) insert400 datum = do conflict <- checkUnique datum case conflict of Just unique -> - badRequest' $ map (unHaskellName . fst) $ persistUniqueToFieldNames unique + badRequest' $ map (getName . fst) $ mkList $ persistUniqueToFieldNames unique Nothing -> insert datum + where +#if MIN_VERSION_persistent(2,12,0) + getName = unFieldNameHS +#else + getName = unHaskellName +#endif +#if MIN_VERSION_persistent(2,13,0) + mkList = toList +#else + mkList = id +#endif -- | Same as 'insert400', but doesn’t return a key. -- -- @since 1.4.1 -#if MIN_VERSION_persistent(2,5,0) -insert400_ :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend) +insert400_ :: ( MonadIO m + , PersistUniqueWrite backend + , PersistRecordBackend val backend +#if MIN_VERSION_persistent(2,14,0) + , SafeToInsert val +#endif + ) => val -> ReaderT backend m () -#else -insert400_ :: (MonadIO m, PersistUnique (PersistEntityBackend val), PersistEntity val) - => val - -> ReaderT (PersistEntityBackend val) m () -#endif insert400_ datum = insert400 datum >> return () -- | Should be equivalent to @lift . notFound@, but there's an apparent bug in diff --git a/test/Yesod/PersistSpec.hs b/test/Yesod/PersistSpec.hs --- a/test/Yesod/PersistSpec.hs +++ b/test/Yesod/PersistSpec.hs @@ -1,8 +1,19 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-} -{-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + module Yesod.PersistSpec where import Test.Hspec @@ -45,7 +56,7 @@ insert_ $ Person "Charlie" insert_ $ Person "Alice" insert_ $ Person "Bob" - respondSourceDB typePlain $ selectSource [] [Asc PersonName] $= awaitForever toBuilder + respondSourceDB typePlain $ selectSource [] [Asc PersonName] .| awaitForever toBuilder where toBuilder (Entity _ (Person name)) = do yield $ Chunk $ fromText name diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal --- a/yesod-persistent.cabal +++ b/yesod-persistent.cabal @@ -1,55 +1,51 @@ -name: yesod-persistent -version: 1.4.3 -cabal-version: >=1.8 -build-type: Simple -license: MIT -license-file: LICENSE -maintainer: Michael Snoyman -stability: Stable -homepage: http://www.yesodweb.com/ -synopsis: Some helpers for using Persistent from Yesod. -description: - API docs and the README are available at -category: Web, Yesod, Database -author: Michael Snoyman -extra-source-files: - README.md - ChangeLog.md - -source-repository head - type: git - location: https://github.com/yesodweb/yesod +cabal-version: >= 1.10 +name: yesod-persistent +version: 1.6.0.9 +license: MIT +license-file: LICENSE +author: Michael Snoyman +maintainer: Michael Snoyman +synopsis: Some helpers for using Persistent from Yesod. +category: Web, Yesod, Database +stability: Stable +build-type: Simple +homepage: http://www.yesodweb.com/ +description: API docs and the README are available at +extra-source-files: README.md ChangeLog.md library - exposed-modules: - Yesod.Persist - Yesod.Persist.Core - build-depends: - base ==4.*, - yesod-core >=1.4.0 && <1.5, - persistent >=2.1 && <2.8, - persistent-template >=2.1 && <2.8, - transformers >=0.2.2, - blaze-builder -any, - conduit -any, - resourcet >=0.4.5, - resource-pool -any - ghc-options: -Wall + default-language: Haskell2010 + build-depends: base >= 4.10 && < 5 + , yesod-core >= 1.6 && < 1.8 + , persistent >= 2.8 + , persistent-template >= 2.1 + , transformers >= 0.2.2 + , blaze-builder + , conduit + , resourcet >= 0.4.5 + , resource-pool + exposed-modules: Yesod.Persist + Yesod.Persist.Core + ghc-options: -Wall -test-suite test +test-suite test + default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Spec.hs - build-depends: - base -any, - hspec -any, - wai-extra -any, - yesod-core -any, - persistent-sqlite -any, - yesod-persistent -any, - conduit -any, - blaze-builder -any, - persistent -any, - text -any hs-source-dirs: test - other-modules: - Yesod.PersistSpec + other-modules: Yesod.PersistSpec + build-tool-depends: hspec-discover:hspec-discover + build-depends: base + , hspec + , wai-extra + , yesod-core + , persistent-sqlite >= 2.8 + , yesod-persistent + , conduit + , blaze-builder + , persistent + , text + +source-repository head + type: git + location: https://github.com/yesodweb/yesod