Remove Maybe from Context in HsQualTywip/az/T19845

Updates haddock submodule

Closes #19845

10 files changed, 46 insertions, 47 deletions

diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index c3b83eefe8..17d84c2d02 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -662,7 +662,7 @@ splitLHsQualTy ty
 -- parentheses, hence the suffix @_KP@ (short for \"Keep Parentheses\").
 splitLHsQualTy_KP :: LHsType (GhcPass pass) -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
 splitLHsQualTy_KP (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body }))
-                       = (ctxt, body)
+                       = (Just ctxt, body)
 splitLHsQualTy_KP body = (Nothing, body)
 
 -- | Decompose a type class instance type (of the form
@@ -983,13 +983,12 @@ pprLHsContext :: (OutputableBndrId p)
 pprLHsContext Nothing = empty
 pprLHsContext (Just lctxt)
   | null (unLoc lctxt) = empty
-  | otherwise          = pprLHsContextAlways (Just lctxt)
+  | otherwise          = pprLHsContextAlways lctxt
 
 -- For use in a HsQualTy, which always gets printed if it exists.
 pprLHsContextAlways :: (OutputableBndrId p)
-                    => Maybe (LHsContext (GhcPass p)) -> SDoc
-pprLHsContextAlways Nothing = parens empty <+> darrow
-pprLHsContextAlways (Just (L _ ctxt))
+                    => LHsContext (GhcPass p) -> SDoc
+pprLHsContextAlways (L _ ctxt)
   = case ctxt of
       []       -> parens empty             <+> darrow
       [L _ ty] -> ppr_mono_ty ty           <+> darrow
@@ -1177,7 +1176,7 @@ lhsTypeHasLeadingPromotionQuote ty
 
     go (HsForAllTy{})        = False
     go (HsQualTy{ hst_ctxt = ctxt, hst_body = body})
-      | Just (L _ (c:_)) <- ctxt = goL c
+      | (L _ (c:_)) <- ctxt = goL c
       | otherwise            = goL body
     go (HsBangTy{})          = False
     go (HsRecTy{})           = False
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index f9f7acc0fa..7775e9202a 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2104,7 +2104,7 @@ ctype   :: { LHsType GhcPs }
                                                          , hst_xforall = noExtField
                                                          , hst_body = $2 } }
         | context '=>' ctype          {% acsA (\cs -> (sLL (reLoc $1) (reLoc $>) $
-                                            HsQualTy { hst_ctxt = Just (addTrailingDarrowC $1 $2 cs)
+                                            HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs
                                                      , hst_xqual = NoExtField
                                                      , hst_body = $3 })) }
 
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 393e2ed349..189ddce29c 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -979,10 +979,10 @@ instance HasHaddock (LocatedA (HsType GhcPs)) where
         pure $ L l (HsForAllTy x tele body')
 
       -- (Eq a, Num a) => t
-      HsQualTy x mlhs rhs -> do
-        traverse_ registerHdkA mlhs
+      HsQualTy x lhs rhs -> do
+        registerHdkA lhs
         rhs' <- addHaddock rhs
-        pure $ L l (HsQualTy x mlhs rhs')
+        pure $ L l (HsQualTy x lhs rhs')
 
       -- arg -> res
       HsFunTy u mult lhs rhs -> do
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index a598deeca0..f912ce84fa 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -12,7 +12,7 @@
 
 module GHC.Rename.HsType (
         -- Type related stuff
-        rnHsType, rnLHsType, rnLHsTypes, rnContext,
+        rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext,
         rnHsKind, rnLHsKind, rnLHsTypeArgs,
         rnHsSigType, rnHsWcType, rnHsPatSigTypeBindingVars,
         HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
@@ -254,34 +254,27 @@ rnWcBody ctxt nwc_rdrs hs_ty
                                 , hst_tele = tele', hst_body = hs_body' }
                     , fvs) }
 
-    rn_ty env (HsQualTy { hst_ctxt = m_ctxt
+    rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt
                         , hst_body = hs_ty })
-      | Just (L cx hs_ctxt) <- m_ctxt
-      , Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
+      | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
       , L lx (HsWildCardTy _)  <- ignoreParens hs_ctxt_last
       = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
            ; setSrcSpanA lx $ checkExtraConstraintWildCard env hs_ctxt1
            ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy noExtField)]
            ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
            ; return (HsQualTy { hst_xqual = noExtField
-                              , hst_ctxt = Just (L cx hs_ctxt')
+                              , hst_ctxt = L cx hs_ctxt'
                               , hst_body = hs_ty' }
                     , fvs1 `plusFV` fvs2) }
 
-      | Just (L cx hs_ctxt) <- m_ctxt
+      | otherwise
       = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt
            ; (hs_ty', fvs2)   <- rnLHsTyKi env hs_ty
            ; return (HsQualTy { hst_xqual = noExtField
-                              , hst_ctxt = Just (L cx hs_ctxt')
+                              , hst_ctxt = L cx hs_ctxt'
                               , hst_body = hs_ty' }
                     , fvs1 `plusFV` fvs2) }
 
-      | Nothing <- m_ctxt
-      = do { (hs_ty', fvs2)   <- rnLHsTyKi env hs_ty
-           ; return (HsQualTy { hst_xqual = noExtField
-                              , hst_ctxt = Nothing
-                              , hst_body = hs_ty' }
-                    , fvs2) }
 
     rn_ty env hs_ty = rnHsTyKi env hs_ty
 
@@ -574,19 +567,27 @@ rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]
 rnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args
 
 --------------
-rnTyKiContext :: RnTyKiEnv -> Maybe (LHsContext GhcPs)
-              -> RnM (Maybe (LHsContext GhcRn), FreeVars)
-rnTyKiContext _ Nothing = return (Nothing, emptyFVs)
-rnTyKiContext env (Just (L loc cxt))
+rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
+              -> RnM (LHsContext GhcRn, FreeVars)
+rnTyKiContext env (L loc cxt)
   = do { traceRn "rncontext" (ppr cxt)
        ; let env' = env { rtke_what = RnConstraint }
        ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt
-       ; return (Just $ L loc cxt', fvs) }
+       ; return (L loc cxt', fvs) }
 
-rnContext :: HsDocContext -> Maybe (LHsContext GhcPs)
-          -> RnM (Maybe (LHsContext GhcRn), FreeVars)
+rnContext :: HsDocContext -> LHsContext GhcPs
+          -> RnM (LHsContext GhcRn, FreeVars)
 rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta
 
+rnMaybeContext :: HsDocContext -> Maybe (LHsContext GhcPs)
+          -> RnM (Maybe (LHsContext GhcRn), FreeVars)
+rnMaybeContext _ Nothing = return (Nothing, emptyFVs)
+rnMaybeContext doc (Just theta)
+  = do { (theta', fvs) <- rnContext doc theta
+       ; return (Just theta', fvs)
+       }
+
+
 --------------
 rnLHsTyKi  :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
 rnLHsTyKi env (L loc ty)
@@ -1906,9 +1907,8 @@ extractDataDefnKindVars :: HsDataDefn GhcPs ->  FreeKiTyVars
 extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
   = maybe [] extractHsTyRdrTyVars ksig
 
-extract_lctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> FreeKiTyVars
-extract_lctxt Nothing     = id
-extract_lctxt (Just ctxt) = extract_ltys (unLoc ctxt)
+extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
+extract_lctxt ctxt = extract_ltys (unLoc ctxt)
 
 extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)]
                     -> FreeKiTyVars -> FreeKiTyVars
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index e91901ae50..8a453a0158 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1827,7 +1827,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
         ; ((tyvars', context', fds', ats'), stuff_fvs)
             <- bindHsQTyVars cls_doc Nothing kvs tyvars $ \ tyvars' _ -> do
                   -- Checks for distinct tyvars
-             { (context', cxt_fvs) <- rnContext cls_doc context
+             { (context', cxt_fvs) <- rnMaybeContext cls_doc context
              ; fds'  <- rnFds fds
                          -- The fundeps have no free variables
              ; (ats', fv_ats) <- rnATDecls cls' ats
@@ -1924,7 +1924,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
         ; (m_sig', sig_fvs) <- case m_sig of
              Just sig -> first Just <$> rnLHsKind doc sig
              Nothing  -> return (Nothing, emptyFVs)
-        ; (context', fvs1) <- rnContext doc context
+        ; (context', fvs1) <- rnMaybeContext doc context
         ; (derivs',  fvs3) <- rn_derivs derivs
 
         -- For the constructor declarations, drop the LocalRdrEnv
@@ -2360,7 +2360,7 @@ rnConDecl (ConDeclGADT { con_names   = names
 rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
             -> RnM (Maybe (LHsContext GhcRn), FreeVars)
 rnMbContext _    Nothing    = return (Nothing, emptyFVs)
-rnMbContext doc cxt = do { (ctx',fvs) <- rnContext doc cxt
+rnMbContext doc cxt = do { (ctx',fvs) <- rnMaybeContext doc cxt
                          ; return (ctx',fvs) }
 
 rnConDeclH98Details ::
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 75cece7b2d..83cfad2a1e 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1179,7 +1179,7 @@ tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
        ; return (mkForAllTys tv_bndrs ty') }
 
 tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind
-  | null (fromMaybeContext ctxt)
+  | null (unLoc ctxt)
   = tc_lhs_type mode rn_ty exp_kind
 
   -- See Note [Body kind of a HsQualTy]
@@ -1933,14 +1933,14 @@ checkExpectedKind hs_ty ty act_kind exp_kind
 ---------------------------
 
 tcHsContext :: Maybe (LHsContext GhcRn) -> TcM [PredType]
-tcHsContext cxt = tc_hs_context typeLevelMode cxt
+tcHsContext Nothing    = return []
+tcHsContext (Just cxt) = tc_hs_context typeLevelMode cxt
 
 tcLHsPredType :: LHsType GhcRn -> TcM PredType
 tcLHsPredType pred = tc_lhs_pred typeLevelMode pred
 
-tc_hs_context :: TcTyMode -> Maybe (LHsContext GhcRn) -> TcM [PredType]
-tc_hs_context _ Nothing = return []
-tc_hs_context mode (Just ctxt) = mapM (tc_lhs_pred mode) (unLoc ctxt)
+tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType]
+tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt)
 
 tc_lhs_pred :: TcTyMode -> LHsType GhcRn -> TcM PredType
 tc_lhs_pred mode pred = tc_lhs_type mode pred constraintKind
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 3319c2699f..ffe2e4ecdd 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -258,7 +258,7 @@ lhsSigWcTypeContextSpan (HsWC { hswc_body = sigType }) = lhsSigTypeContextSpan s
 lhsSigTypeContextSpan :: LHsSigType GhcRn -> ReportRedundantConstraints
 lhsSigTypeContextSpan (L _ HsSig { sig_body = sig_ty }) = go sig_ty
   where
-    go (L _ (HsQualTy { hst_ctxt = Just (L span _) })) = WantRRC $ locA span -- Found it!
+    go (L _ (HsQualTy { hst_ctxt = L span _ })) = WantRRC $ locA span -- Found it!
     go (L _ (HsForAllTy { hst_body = hs_ty })) = go hs_ty  -- Look under foralls
     go (L _ (HsParTy _ hs_ty)) = go hs_ty  -- Look under parens
     go _ = NoRRC  -- Did not find it
@@ -304,7 +304,7 @@ no_anon_wc_ty lty = go lty
                  , hst_body = ty } -> no_anon_wc_tele tele
                                         && go ty
       HsQualTy { hst_ctxt = ctxt
-               , hst_body = ty }  -> gos (fromMaybeContext ctxt) && go ty
+               , hst_body = ty }  -> gos (unLoc ctxt) && go ty
       HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpanA ty
       HsSpliceTy{} -> True
       HsTyLit{} -> True
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index f8efa8f28d..fa558f41ae 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1816,7 +1816,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
                                ; let l = noAnnSrcSpan l'
                                ; ty' <- cvtType (ForallT exis provs ty)
                                ; return $ L l $ mkHsImplicitSigType
-                                        $ L l (HsQualTy { hst_ctxt = Nothing
+                                        $ L l (HsQualTy { hst_ctxt = noLocA []
                                                         , hst_xqual = noExtField
                                                         , hst_body = ty' }) }
   | null reqs             = do { l'      <- getL
@@ -1824,7 +1824,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
                                ; univs' <- cvtTvs univs
                                ; ty'    <- cvtType (ForallT exis provs ty)
                                ; let forTy = mkHsExplicitSigType noAnn univs' $ L l'' cxtTy
-                                     cxtTy = HsQualTy { hst_ctxt = Nothing
+                                     cxtTy = HsQualTy { hst_ctxt = noLocA []
                                                       , hst_xqual = noExtField
                                                       , hst_body = ty' }
                                ; return $ L (noAnnSrcSpan l') forTy }
@@ -1910,7 +1910,7 @@ mkHsQualTy :: TH.Cxt
 mkHsQualTy ctxt loc ctxt' ty
   | null ctxt = ty
   | otherwise = L loc $ HsQualTy { hst_xqual = noExtField
-                                 , hst_ctxt  = Just ctxt'
+                                 , hst_ctxt  = ctxt'
                                  , hst_body  = ty }
 
 mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 0829e9a637..1b945c9c1e 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -733,7 +733,7 @@ data HsType pass
 
   | HsQualTy   -- See Note [HsType binders]
       { hst_xqual :: XQualTy pass
-      , hst_ctxt  :: Maybe (LHsContext pass)  -- Context C => blah
+      , hst_ctxt  :: LHsContext pass  -- Context C => blah
       , hst_body  :: LHsType pass }
 
   | HsTyVar  (XTyVar pass)
diff --git a/utils/haddock b/utils/haddock
-Subproject 2fec1b44e0ee7e263286709aa528b4ecb99ac6c
+Subproject 3fe1ccd2393837c4e8bc788368c18b40f7dac91