Add tabulateEntityApply

persistent-test/ChangeLog.md

@@ -1,5 +1,9 @@
 ## Unreleased changes
 
+## 2.13.1.4
+
+* Support `persistent-2.17`
+
 ## 2.13.1.3
 
 * Support persistent-2.14 with `SafeToInsert` class

persistent-test/persistent-test.cabal

@@ -1,5 +1,5 @@
 name:               persistent-test
-version:            2.13.1.3
+version:            2.13.1.4
 license:            MIT
 license-file:       LICENSE
 author:             Michael Snoyman <[email protected]>
@@ -77,7 +77,7 @@ library
     , monad-logger          >=0.3.25
     , mtl
     , path-pieces           >=0.2
-    , persistent            >=2.14   && <2.17
+    , persistent            >=2.14   && <2.18
     , QuickCheck            >=2.9
     , quickcheck-instances  >=0.3
     , random                >=1.1

persistent/ChangeLog.md

@@ -1,5 +1,13 @@
 # Changelog for persistent
 
+# 2.17.0.0
+
+* [#1595](https://github.com/yesodweb/persistent/pull/1595)
+    * Add `tabulateEntityApply` to `PersistEntity` class similar to
+      `tabulateEntityA` but that works on `Apply` type instead of `Applicative`.
+      This allows you to use `foldMap1` and other non-empty structures with
+      tabulating and manipulating records.
+
 # 2.16.0.0
 
 * [#1584](https://github.com/yesodweb/persistent/pull/1584)

persistent/Database/Persist/Class/PersistEntity.hs

@@ -41,6 +41,7 @@ module Database.Persist.Class.PersistEntity
     ) where
 
 import Data.Functor.Constant
+import Data.Functor.Apply (Apply)
 
 import Data.Aeson
        ( FromJSON(..)
@@ -160,6 +161,16 @@ class ( PersistField (Key record), ToJSON (Key record), FromJSON (Key record)
         -- 'Applicative' context.
         -> f (Entity record)
 
+    -- | Like 'tabulateEntityA', but works with any 'Apply' f. This works
+    -- because all entities have at least one field, and so we can tabulate
+    -- things into semigroup-like shapes instead.
+    --
+    -- @since 2.17.0.0
+    tabulateEntityApply
+        :: (Apply f)
+        => (forall a. EntityField record a -> f a)
+        -> f (Entity record)
+
     -- | Unique keys besides the 'Key'.
     data Unique record
     -- | A meta operation to retrieve all the 'Unique' keys.