EPA: DotFieldOcc does not have exact print annotations

For the code

    {-# LANGUAGE OverloadedRecordUpdate #-}

    operatorUpdate f = f{(+) = 1}

There are no exact print annotations for the parens around the +
symbol, nor does normal ppr print them.

This MR fixes that.

Closes #21805

Updates haddock submodule

3 files changed, 14 insertions, 7 deletions

diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 204114bb5b..6a4eb7f6f1 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -37,6 +37,7 @@ import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Unify
 import GHC.Types.Basic
 import GHC.Types.Error
+import GHC.Types.FieldLabel
 import GHC.Types.Unique.Map ( UniqMap, listToUniqMap, lookupUniqMap )
 import GHC.Core.Multiplicity
 import GHC.Core.UsageEnv
@@ -84,6 +85,8 @@ import Control.Monad
 import GHC.Core.Class(classTyCon)
 import GHC.Types.Unique.Set ( UniqSet, mkUniqSet, elementOfUniqSet, nonDetEltsUniqSet )
 
+import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+
 import Data.Function
 import Data.List (partition, sortBy, groupBy, intersect)
 
@@ -1208,7 +1211,7 @@ desugarRecordUpd record_expr rbnds res_ty
        -- After this we know that rbinds is unambiguous
        ; rbinds <- disambiguateRecordBinds record_expr record_rho rbnds res_ty
        ; let upd_flds = map (unLoc . hfbLHS . unLoc) rbinds
-             upd_fld_occs = map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) upd_flds
+             upd_fld_occs = map (FieldLabelString . occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) upd_flds
              sel_ids      = map selectorAmbiguousFieldOcc upd_flds
              upd_fld_names = map idName sel_ids
 
@@ -1355,7 +1358,7 @@ desugarRecordUpd record_expr rbnds res_ty
                  Just (upd_id, _) -> (genWildPat, genLHsVar (idName upd_id))
                  -- Field is not being updated: LHS = variable pattern, RHS = that same variable.
                  _  -> let fld_nm = mkInternalName (mkBuiltinUnique i)
-                                      (mkVarOccFS (flLabel fld_lbl))
+                                      (mkVarOccFS (field_label $ flLabel fld_lbl))
                                       generatedSrcSpan
                        in (genVarPat fld_nm, genLHsVar fld_nm)
 
@@ -1599,7 +1602,7 @@ tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs
       = do { addErrTc (badFieldConErr (getName con_like) field_lbl)
            ; return Nothing }
   where
-        field_lbl = occNameFS $ rdrNameOcc (unLoc lbl)
+        field_lbl = FieldLabelString $ occNameFS $ rdrNameOcc (unLoc lbl)
 
 
 checkMissingFields ::  ConLike -> HsRecordBinds GhcRn -> [Scaled TcType] -> TcM ()
@@ -1705,7 +1708,7 @@ badFieldsUpd rbinds data_cons
     membership :: [(FieldLabelString, [Bool])]
     membership = sortMembership $
         map (\fld -> (fld, map (fld `elementOfUniqSet`) fieldLabelSets)) $
-          map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) rbinds
+          map (FieldLabelString . occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) rbinds
 
     fieldLabelSets :: [UniqSet FieldLabelString]
     fieldLabelSets = map (mkUniqSet . map flLabel . conLikeFieldLabels) data_cons
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index b5c6b4c5c5..4df4307737 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -37,6 +37,7 @@ import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags )
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Instantiate
 import GHC.Types.Error
+import GHC.Types.FieldLabel
 import GHC.Types.Id
 import GHC.Types.Var
 import GHC.Types.Name
@@ -70,8 +71,10 @@ import GHC.Utils.Panic.Plain
 import qualified GHC.LanguageExtensions as LangExt
 import Control.Arrow  ( second )
 import Control.Monad
+import GHC.Data.FastString
 import qualified Data.List.NonEmpty as NE
 import GHC.Data.List.SetOps ( getNth )
+import Language.Haskell.Syntax.Basic (FieldLabelString(..))
 
 {-
 ************************************************************************
@@ -1296,7 +1299,7 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
                                                                         pun), res) }
 
 
-      find_field_ty :: Name -> FieldLabelString -> TcM (Scaled TcType)
+      find_field_ty :: Name -> FastString -> TcM (Scaled TcType)
       find_field_ty sel lbl
         = case [ty | (fl, ty) <- field_tys, flSelector fl == sel ] of
 
@@ -1306,7 +1309,7 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
                 --      f (R { foo = (a,b) }) = a+b
                 -- If foo isn't one of R's fields, we don't want to crash when
                 -- typechecking the "a+b".
-           [] -> failWith (badFieldConErr (getName con_like) lbl)
+           [] -> failWith (badFieldConErr (getName con_like) (FieldLabelString lbl))
 
                 -- The normal case, when the field comes from the right constructor
            (pat_ty : extras) -> do
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 52205cd944..251d17c27f 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -132,6 +132,7 @@ import GHC.Data.FastString
 import GHC.Data.Maybe( MaybeErr(..) )
 import qualified GHC.Data.EnumSet as EnumSet
 
+import Language.Haskell.Syntax.Basic (FieldLabelString(..))
 import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
 import qualified Language.Haskell.TH.Syntax as TH
@@ -2762,7 +2763,7 @@ reifyFieldLabel fl
     mod     = assert (isExternalName name) $ nameModule name
     pkg_str = unitString (moduleUnit mod)
     mod_str = moduleNameString (moduleName mod)
-    occ_str = unpackFS (flLabel fl)
+    occ_str = unpackFS (field_label $ flLabel fl)
 
 reifySelector :: Id -> TyCon -> TH.Name
 reifySelector id tc