summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs/DocString.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Hs/DocString.hs')
-rw-r--r--compiler/GHC/Hs/DocString.hs18
1 files changed, 16 insertions, 2 deletions
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)