From 62b9a7b23b20f5cf0a2de14251c2096098009f10 Mon Sep 17 00:00:00 2001
From: Zubin Duggal <zubin.duggal@gmail.com>
Date: Wed, 7 Dec 2022 19:24:59 +0530
Subject: Force the Docs structure to prevent leaks in GHCi with -haddock
 without -fwrite-interface

Involves adding many new NFData instances.

Without forcing Docs, references to the TcGblEnv for each module are retained
by the Docs structure. Usually these are forced when the ModIface is serialised
but not when we aren't writing the interface.
---
 compiler/GHC/Hs/DocString.hs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

(limited to 'compiler/GHC/Hs/DocString.hs')

diff --git a/compiler/GHC/Hs/DocString.hs b/compiler/GHC/Hs/DocString.hs
index c96165d178..8e42c4a8d8 100644
--- a/compiler/GHC/Hs/DocString.hs
+++ b/compiler/GHC/Hs/DocString.hs
@@ -1,5 +1,7 @@
 -- | An exactprintable structure for docstrings
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module GHC.Hs.DocString
   ( LHsDocString
@@ -27,6 +29,7 @@ import GHC.Utils.Binary
 import GHC.Utils.Encoding
 import GHC.Utils.Outputable as Outputable hiding ((<>))
 import GHC.Types.SrcLoc
+import Control.DeepSeq
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -59,6 +62,11 @@ data HsDocString
 instance Outputable HsDocString where
   ppr = text . renderHsDocString
 
+instance NFData HsDocString where
+  rnf (MultiLineDocString a b) = rnf a `seq` rnf b
+  rnf (NestedDocString a b) = rnf a `seq` rnf b
+  rnf (GeneratedDocString a) = rnf a
+
 -- | Annotate a pretty printed thing with its doc
 -- The docstring comes after if is 'HsDocStringPrevious'
 -- Otherwise it comes before.
@@ -101,6 +109,12 @@ data HsDocStringDecorator
 instance Outputable HsDocStringDecorator where
   ppr = text . printDecorator
 
+instance NFData HsDocStringDecorator where
+  rnf HsDocStringNext = ()
+  rnf HsDocStringPrevious = ()
+  rnf (HsDocStringNamed x) = rnf x
+  rnf (HsDocStringGroup x) = rnf x
+
 printDecorator :: HsDocStringDecorator -> String
 printDecorator HsDocStringNext = "|"
 printDecorator HsDocStringPrevious = "^"
@@ -126,7 +140,8 @@ type LHsDocStringChunk = Located HsDocStringChunk
 
 -- | A contiguous chunk of documentation
 newtype HsDocStringChunk = HsDocStringChunk ByteString
-  deriving (Eq,Ord,Data, Show)
+  deriving stock (Eq,Ord,Data, Show)
+  deriving newtype (NFData)
 
 instance Binary HsDocStringChunk where
   put_ bh (HsDocStringChunk bs) = put_ bh bs
@@ -135,7 +150,6 @@ instance Binary HsDocStringChunk where
 instance Outputable HsDocStringChunk where
   ppr = text . unpackHDSC
 
-
 mkHsDocStringChunk :: String -> HsDocStringChunk
 mkHsDocStringChunk s = HsDocStringChunk (utf8EncodeByteString s)
 
-- 
cgit v1.2.1