diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-05-16 21:21:03 +0100 | 
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2021-05-20 19:05:09 +0100 | 
| commit | 3fe1ccd2393837c4e8bc788368c18b40f7dac918 (patch) | |
| tree | 787f1a4cd2d37e3933fd909d8c25ed05b3359836 /haddock-api/src/Haddock/Backends | |
| parent | 2fec1b44e0ee7e263286709aa528b4ecb99ac6c2 (diff) | |
Remove Maybe from HsQualTy
Match changes in GHC for #19845
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 13 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 16 | 
3 files changed, 17 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index e70a705f..3f913e09 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -280,7 +280,7 @@ ppCtor dflags _dat subdocs (ConDeclGADT { con_names = names          name = out dflags $ map unL names          con_sig_ty = HsSig noExtField outer_bndrs theta_ty where            theta_ty = case mcxt of -            Just theta -> noLocA (HsQualTy { hst_xqual = noExtField, hst_ctxt = Just theta, hst_body = tau_ty }) +            Just theta -> noLocA (HsQualTy { hst_xqual = noExtField, hst_ctxt = theta, hst_body = tau_ty })              Nothing -> tau_ty            tau_ty = foldr mkFunTy res_ty $              case args of PrefixConGADT pos_args -> map hsScaledThing pos_args diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index abf882f0..fbae13a3 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -983,11 +983,12 @@ ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)  ------------------------------------------------------------------------------- -ppLContext, ppLContextNoArrow :: Maybe (LHsContext DocNameI) -> Bool -> LaTeX -ppLContext        Nothing _ = empty -ppLContext        (Just ctxt) unicode  = ppContext        (unLoc ctxt) unicode -ppLContextNoArrow Nothing _ = empty -ppLContextNoArrow (Just ctxt) unicode = ppContextNoArrow (unLoc ctxt) unicode +ppLContext :: Maybe (LHsContext DocNameI) -> Bool -> LaTeX +ppLContext Nothing _ = empty +ppLContext (Just ctxt) unicode  = ppContext (unLoc ctxt) unicode + +ppLContextNoArrow :: LHsContext DocNameI -> Bool -> LaTeX +ppLContextNoArrow ctxt unicode = ppContextNoArrow (unLoc ctxt) unicode  ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX  ppContextNoLocsMaybe [] _ = Nothing @@ -1101,7 +1102,7 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode    = sep [ ppHsForAllTelescope tele unicode          , ppr_mono_lty ty unicode ]  ppr_mono_ty (HsQualTy _ ctxt ty) unicode -  = sep [ ppLContext ctxt unicode +  = sep [ ppLContext (Just ctxt) unicode          , ppr_mono_lty ty unicode ]  ppr_mono_ty (HsFunTy _ mult ty1 ty2)   u    = sep [ ppr_mono_lty ty1 u diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 8de1b1b8..8ac1ac81 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -167,7 +167,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_sig_args 0 sep          leader' = leader <+> ppForAllPart unicode qual tele      do_args n leader (HsQualTy _ lctxt ltype) -      | null (fromMaybeContext lctxt) +      | null (unLoc lctxt)        = do_largs n leader ltype        | otherwise        = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, []) @@ -436,12 +436,14 @@ ppTypeApp n ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT ts)  ------------------------------------------------------------------------------- -ppLContext, ppLContextNoArrow :: Maybe (LHsContext DocNameI) -> Unicode +ppLContext :: Maybe (LHsContext DocNameI) -> Unicode                                -> Qualification -> HideEmptyContexts -> Html  ppLContext        Nothing  u q h = ppContext        []        u q h  ppLContext        (Just c) u q h = ppContext        (unLoc c) u q h -ppLContextNoArrow Nothing  u q h = ppContextNoArrow []        u q h -ppLContextNoArrow (Just c) u q h = ppContextNoArrow (unLoc c) u q h + +ppLContextNoArrow :: LHsContext DocNameI -> Unicode +                              -> Qualification -> HideEmptyContexts -> Html +ppLContextNoArrow c u q h = ppContextNoArrow (unLoc c) u q h  ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html  ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $ @@ -1185,13 +1187,13 @@ patSigContext sig_typ | hasNonEmptyContext typ && isFirstContextEmpty typ =  Sho      hasNonEmptyContext t =        case unLoc t of          HsForAllTy _ _ s -> hasNonEmptyContext s -        HsQualTy _ cxt s -> if null (fromMaybeContext cxt) then hasNonEmptyContext s else True +        HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True          HsFunTy _ _ _ s    -> hasNonEmptyContext s          _ -> False      isFirstContextEmpty t =        case unLoc t of          HsForAllTy _ _ s -> isFirstContextEmpty s -        HsQualTy _ cxt _ -> null (fromMaybeContext cxt) +        HsQualTy _ cxt _ -> null (unLoc cxt)          HsFunTy _ _ _ s    -> isFirstContextEmpty s          _ -> False @@ -1230,7 +1232,7 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode qual emptyCtxts    = ppForAllPart unicode qual tele <+> ppr_mono_lty ty unicode qual emptyCtxts  ppr_mono_ty (HsQualTy _ ctxt ty) unicode qual emptyCtxts -  = ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts +  = ppLContext (Just ctxt) unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts  -- UnicodeSyntax alternatives  ppr_mono_ty (HsTyVar _ _ (L _ name)) True _ _  | 
