From a014c1d1145f91b2d8a609829a5a26e50f784ea4 Mon Sep 17 00:00:00 2001
From: David Beacham <dbeacham@dbeacham.co.uk>
Date: Tue, 20 Feb 2024 13:21:40 +0000
Subject: [PATCH] NFData1,NFData2 instances (#767)

---
 containers/changelog.md                  |  3 +++
 containers/src/Data/Graph.hs             |  7 +++++-
 containers/src/Data/IntMap/Internal.hs   | 10 ++++++++-
 containers/src/Data/Map/Internal.hs      | 16 +++++++++++++-
 containers/src/Data/Sequence/Internal.hs | 28 +++++++++++++++++++++++-
 containers/src/Data/Set/Internal.hs      |  9 +++++++-
 containers/src/Data/Tree.hs              |  8 ++++++-
 7 files changed, 75 insertions(+), 6 deletions(-)

diff --git a/containers/changelog.md b/containers/changelog.md
index c0e00aa83..cb42a9b1a 100644
--- a/containers/changelog.md
+++ b/containers/changelog.md
@@ -45,6 +45,9 @@
 
 * Add `Data.Graph.flattenSCC1`. (Andreas Abel)
 
+* `NFData1`, `NFData2` instances for `SCC`, `IntMap`, `Map`, `Sequence`, `Set`,
+  `Tree` and relevant internal dependencies (David Beacham)
+
 ## 0.7
 
 ### Breaking changes
diff --git a/containers/src/Data/Graph.hs b/containers/src/Data/Graph.hs
index 2c6417f53..619948688 100644
--- a/containers/src/Data/Graph.hs
+++ b/containers/src/Data/Graph.hs
@@ -118,7 +118,7 @@ import Data.Foldable as F
 #if MIN_VERSION_base(4,18,0)
 import qualified Data.Foldable1 as F1
 #endif
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
 import Data.Maybe
 import Data.Array
 #if USE_UNBOXED_ARRAYS
@@ -235,6 +235,11 @@ instance NFData a => NFData (SCC a) where
     rnf (AcyclicSCC v) = rnf v
     rnf (NECyclicSCC vs) = rnf vs
 
+-- | @since 0.7.1
+instance NFData1 SCC where
+    liftRnf rnfx (AcyclicSCC v)   = rnfx v
+    liftRnf rnfx (NECyclicSCC vs) = liftRnf rnfx vs
+
 -- | @since 0.5.4
 instance Functor SCC where
     fmap f (AcyclicSCC v) = AcyclicSCC (f v)
diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index d1d483b44..41e4e1e20 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -294,7 +294,7 @@ import Data.Semigroup (Semigroup((<>)))
 import Data.Semigroup (stimesIdempotentMonoid)
 import Data.Functor.Classes
 
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
 import Data.Bits
 import qualified Data.Foldable as Foldable
 import Data.Maybe (fromMaybe)
@@ -518,6 +518,14 @@ instance NFData a => NFData (IntMap a) where
     rnf (Tip _ v) = rnf v
     rnf (Bin _ l r) = rnf l `seq` rnf r
 
+-- | @since 0.7.1
+instance NFData1 IntMap where
+    liftRnf rnfx = go
+      where
+      go Nil         = ()
+      go (Tip _ v)   = rnfx v
+      go (Bin _ l r) = go l `seq` go r
+
 #if __GLASGOW_HASKELL__
 
 {--------------------------------------------------------------------
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index 9263fff2f..51c8775f7 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -387,7 +387,7 @@ import Data.Semigroup (Arg(..), Semigroup(stimes))
 import Data.Semigroup (Semigroup((<>)))
 #endif
 import Control.Applicative (Const (..))
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf),NFData2(liftRnf2))
 import Data.Bits (shiftL, shiftR)
 import qualified Data.Foldable as Foldable
 import Data.Bifoldable
@@ -4413,6 +4413,20 @@ instance (NFData k, NFData a) => NFData (Map k a) where
     rnf Tip = ()
     rnf (Bin _ kx x l r) = rnf kx `seq` rnf x `seq` rnf l `seq` rnf r
 
+-- | @since 0.7.1
+instance NFData k => NFData1 (Map k) where
+  liftRnf rnfx = go
+    where
+    go Tip              = ()
+    go (Bin _ kx x l r) = rnf kx `seq` rnfx x `seq` go l `seq` go r
+
+-- | @since 0.7.1
+instance NFData2 Map where
+  liftRnf2 rnfkx rnfx = go
+    where
+    go Tip              = ()
+    go (Bin _ kx x l r) = rnfkx kx `seq` rnfx x `seq` go l `seq` go r
+
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index 2f9266ff1..1a6309b84 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -207,7 +207,7 @@ import Prelude ()
 import Control.Applicative ((<$>), (<**>),  Alternative,
                             liftA3)
 import qualified Control.Applicative as Applicative
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
 import Control.Monad (MonadPlus(..))
 import Data.Monoid (Monoid(..))
 import Data.Functor (Functor(..))
@@ -504,6 +504,10 @@ instance Traversable Seq where
 instance NFData a => NFData (Seq a) where
     rnf (Seq xs) = rnf xs
 
+-- | @since 0.7.1
+instance NFData1 Seq where
+    liftRnf rnfx (Seq xs) = liftRnf (liftRnf rnfx) xs
+
 instance Monad Seq where
     return = pure
     xs >>= f = foldl' add empty xs
@@ -1170,6 +1174,12 @@ instance NFData a => NFData (FingerTree a) where
     rnf (Single x) = rnf x
     rnf (Deep _ pr m sf) = rnf pr `seq` rnf sf `seq` rnf m
 
+-- | @since 0.7.1
+instance NFData1 FingerTree where
+    liftRnf _ EmptyT = ()
+    liftRnf rnfx (Single x) = rnfx x
+    liftRnf rnfx (Deep _ pr m sf) = liftRnf rnfx pr `seq` liftRnf (liftRnf rnfx) m `seq` liftRnf rnfx sf
+
 {-# INLINE deep #-}
 deep            :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
 deep pr m sf    =  Deep (size pr + size m + size sf) pr m sf
@@ -1272,6 +1282,13 @@ instance NFData a => NFData (Digit a) where
     rnf (Three a b c) = rnf a `seq` rnf b `seq` rnf c
     rnf (Four a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d
 
+-- | @since 0.7.1
+instance NFData1 Digit where
+    liftRnf rnfx (One a) = rnfx a
+    liftRnf rnfx (Two a b) = rnfx a `seq` rnfx b
+    liftRnf rnfx (Three a b c) = rnfx a `seq` rnfx b `seq` rnfx c
+    liftRnf rnfx (Four a b c d) = rnfx a `seq` rnfx b `seq` rnfx c `seq` rnfx d
+
 instance Sized a => Sized (Digit a) where
     {-# INLINE size #-}
     size = foldl1 (+) . fmap size
@@ -1350,6 +1367,11 @@ instance NFData a => NFData (Node a) where
     rnf (Node2 _ a b) = rnf a `seq` rnf b
     rnf (Node3 _ a b c) = rnf a `seq` rnf b `seq` rnf c
 
+-- | @since 0.7.1
+instance NFData1 Node where
+    liftRnf rnfx (Node2 _ a b) = rnfx a `seq` rnfx b
+    liftRnf rnfx (Node3 _ a b c) = rnfx a `seq` rnfx b `seq` rnfx c
+
 instance Sized (Node a) where
     size (Node2 v _ _)      = v
     size (Node3 v _ _ _)    = v
@@ -1410,6 +1432,10 @@ instance Traversable Elem where
 instance NFData a => NFData (Elem a) where
     rnf (Elem x) = rnf x
 
+-- | @since 0.7.1
+instance NFData1 Elem where
+    liftRnf rnfx (Elem x) = rnfx x
+
 -------------------------------------------------------
 -- Applicative construction
 -------------------------------------------------------
diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
index f1ec29c3a..38943fa63 100644
--- a/containers/src/Data/Set/Internal.hs
+++ b/containers/src/Data/Set/Internal.hs
@@ -248,7 +248,7 @@ import Data.Semigroup (stimesIdempotentMonoid, stimesIdempotent)
 import Data.Functor.Classes
 import Data.Functor.Identity (Identity)
 import qualified Data.Foldable as Foldable
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
 
 import Utils.Containers.Internal.StrictPair
 import Utils.Containers.Internal.PtrEquality
@@ -1334,6 +1334,13 @@ instance NFData a => NFData (Set a) where
     rnf Tip           = ()
     rnf (Bin _ y l r) = rnf y `seq` rnf l `seq` rnf r
 
+-- | @since 0.7.1
+instance NFData1 Set where
+    liftRnf rnfx = go
+      where
+      go Tip           = ()
+      go (Bin _ y l r) = rnfx y `seq` go l `seq` go r
+
 {--------------------------------------------------------------------
   Split
 --------------------------------------------------------------------}
diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs
index a03926c27..949c1cfd8 100644
--- a/containers/src/Data/Tree.hs
+++ b/containers/src/Data/Tree.hs
@@ -61,7 +61,7 @@ import Control.Monad (liftM)
 import Control.Monad.Fix (MonadFix (..), fix)
 import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,
             ViewL(..), ViewR(..), viewl, viewr)
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
 
 #ifdef __GLASGOW_HASKELL__
 import Data.Data (Data)
@@ -300,6 +300,12 @@ foldlMap1 f g =  -- Use a lambda to allow inlining with two arguments
 instance NFData a => NFData (Tree a) where
     rnf (Node x ts) = rnf x `seq` rnf ts
 
+-- | @since 0.7.1
+instance NFData1 Tree where
+    liftRnf rnfx = go
+      where
+      go (Node x ts) = rnfx x `seq` liftRnf go ts
+
 -- | @since 0.5.10.1
 instance MonadZip Tree where
   mzipWith f (Node a as) (Node b bs)