diff options
31 files changed, 277 insertions, 221 deletions
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c2aa9f3c..dafcdc74 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,7 +13,7 @@ jobs: strategy: matrix: os: [ubuntu-latest] - cabal: ["3.4.0.0"] + cabal: ["3.6"] ghc: - "head" @@ -41,12 +41,11 @@ jobs: cabal freeze - uses: actions/cache@v2 - name: Cache ~/.cabal/store and .ghcup + name: Cache ~/.cabal/store with: path: | ${{ steps.setup-haskell-cabal.outputs.cabal-store }} - .ghcup - key: ${{ runner.os }} + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} - name: Build run: | @@ -2,7 +2,7 @@ Haddock is the standard tool for generating documentation from Haskell code. Full documentation about Haddock itself can be found in the `doc/` subdirectory, -in [reStructedText format][ReST] format. +in [reStructuredText][reST] format. ## Project overview @@ -25,10 +25,10 @@ See [CONTRIBUTING.md](CONTRIBUTING.md) to see how to make contributions to the project. -[CI page]: https://travis-ci.org/haskell/haddock -[CI badge]: https://travis-ci.org/haskell/haddock.svg?branch=ghc-8.10 +[CI page]: https://github.com/haskell/haddock/actions/workflows/ci.yml +[CI badge]: https://github.com/haskell/haddock/actions/workflows/ci.yml/badge.svg [Hackage page]: https://hackage.haskell.org/package/haddock [Hackage badge]: https://img.shields.io/hackage/v/haddock.svg -[ReST]: http://www.sphinx-doc.org/en/stable/rest.html +[reST]: https://www.sphinx-doc.org/en/master/usage/restructuredtext/index.html [Documentation.Haddock]: http://hackage.haskell.org/package/haddock-api/docs/Documentation-Haddock.html -[cabal v2]: http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html +[cabal v2]: https://cabal.readthedocs.io/en/latest/nix-local-build-overview.html diff --git a/doc/common-errors.rst b/doc/common-errors.rst new file mode 100644 index 00000000..9afa4ea7 --- /dev/null +++ b/doc/common-errors.rst @@ -0,0 +1,19 @@ +Common Errors +============= + +``parse error on input ‘-- | xxx’`` +----------------------------------- + +This is probably caused by the ``-- | xxx`` comment not following a declaration. I.e. use ``-- xxx`` instead. See :ref:`top-level-declaration`. + +``parse error on input ‘-- $ xxx’`` +---------------------------------- + +You've probably commented out code like:: + + f x + $ xxx + +``-- $`` is a special syntax for named chunks, see :ref:`named-chunks`. You can fix this by escaping the ``$``:: + + -- \$ xxx diff --git a/doc/index.rst b/doc/index.rst index 0d1b8b48..f370e42f 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -12,6 +12,7 @@ Contents: intro invoking markup + common-errors multi-components diff --git a/doc/intro.rst b/doc/intro.rst index fc1269f9..1f4234cb 100644 --- a/doc/intro.rst +++ b/doc/intro.rst @@ -25,7 +25,7 @@ in mind: The easier it is to write documentation, the more likely the programmer is to do it. Haddock therefore uses lightweight markup in its annotations, taking several ideas from - `IDoc <http://www.cse.unsw.edu.au/~chak/haskell/idoc/>`__. In fact, + `IDoc <https://web.archive.org/web/20180621053227/http://www.cse.unsw.edu.au/~chak/haskell/idoc/>`__. In fact, Haddock can understand IDoc-annotated source code. - The documentation should not expose any of the structure of the @@ -59,8 +59,8 @@ in mind: Obtaining Haddock ----------------- -Distributions (source & binary) of Haddock can be obtained from its `web -site <http://www.haskell.org/haddock/>`__. +Haddock is distributed with GHC distributions, and will automatically be provided if you use +`ghcup <https://www.haskell.org/ghcup>`__, for instance. Up-to-date sources can also be obtained from our public GitHub repository. The Haddock sources are at @@ -72,77 +72,38 @@ License The following license covers this documentation, and the Haddock source code, except where otherwise indicated. - Copyright 2002-2010, Simon Marlow. All rights reserved. + Copyright (c) 2002-2010, Simon Marlow + All rights reserved. Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: + modification, are permitted provided that the following conditions are + met: - - Redistributions of source code must retain the above copyright + 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - - Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in - the documentation and/or other materials provided with the + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY - EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR - PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE - LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR - BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF - LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING - NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS - SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT + OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Contributors ------------ -Haddock was originally written by Simon Marlow. Since it is an open -source project, many people have contributed to its development over the -years. Below is a list of contributors in alphabetical order that we -hope is somewhat complete. If you think you are missing from this list, -please contact us. - -- Ashley Yakeley -- Benjamin Franksen -- Brett Letner -- Clemens Fruhwirth -- Conal Elliott -- David Waern -- Duncan Coutts -- George Pollard -- George Russel -- Hal Daume -- Ian Lynagh -- Isaac Dupree -- Joachim Breitner -- Krasimir Angelov -- Lennart Augustsson -- Luke Plant -- Malcolm Wallace -- Manuel Chakravarty -- Marcin Szamotulski -- Mark Lentczner -- Mark Shields -- Mateusz Kowalczyk -- Mike Thomas -- Neil Mitchell -- Oliver Brown -- Roman Cheplyaka -- Ross Paterson -- Sigbjorn Finne -- Simon Hengel -- Simon Marlow -- Simon Peyton-Jones -- Stefan O'Rear -- Sven Panne -- Thomas Schilling -- Wolfgang Jeltsch -- Yitzchak Gale +A list of contributors to the project can be seen at +``https://github.com/haskell/haddock/graphs/contributors``. Acknowledgements ---------------- @@ -150,11 +111,11 @@ Acknowledgements Several documentation systems provided the inspiration for Haddock, most notably: -- `IDoc <http://www.cse.unsw.edu.au/~chak/haskell/idoc/>`__ +- `IDoc <https://web.archive.org/web/20180621053227/http://www.cse.unsw.edu.au/~chak/haskell/idoc/>`__ -- `HDoc <http://www.fmi.uni-passau.de/~groessli/hdoc/>`__ +- `HDoc <https://mail.haskell.org/pipermail/haskelldoc/2001-April/000067.html>`__ -- `Doxygen <http://www.stack.nl/~dimitri/doxygen/>`__ +- `Doxygen <https://www.doxygen.nl/index.html>`__ and probably several others I've forgotten. diff --git a/doc/markup.rst b/doc/markup.rst index c0b08a40..abfeb52a 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -950,24 +950,30 @@ apostrophes themselves: to hyperlink ``foo'`` one would simply type -- | A prefix operator @'(++)'@ and an infix identifier @'`elem`'@. -Emphasis, Bold and Monospaced Text +Emphasis, Bold and Monospaced styled Text ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Emphasis may be added by surrounding text with ``/.../``. Other markup -is valid inside emphasis. To have a forward slash inside of emphasis, -just escape it: ``/fo\/o/`` +Text can be emphasized, made bold (strong) or monospaced (typewriter font) +by surrounding it with slashes, double-underscores or at-symbols: :: -Bold (strong) text is indicated by surrounding it with ``__...__``. -Other markup is valid inside bold. For example, ``__/foo/__`` will make -the emphasised text ``foo`` bold. You don't have to escape a single -underscore if you need it bold: -``__This_text_with_underscores_is_bold__``. + -- | This is /emphasized text/, __bold text__ and @monospaced text@. -Monospaced (or typewriter) text is indicated by surrounding it with -``@...@``. Other markup is valid inside a monospaced span: for example -``@'f' a b@`` will hyperlink the identifier ``f`` inside the code -fragment, but ``@__FILE__@`` will render ``FILE`` in bold with no -underscores, which may not be what you had in mind. +Note that those styled texts must be kept on the same line: :: + + -- | Styles /do not work + -- | when continuing on the next line/ + +Other markup is valid inside emphasized, bold and monospaced text. + +Frequent special cases: + +* To have a forward slash inside of emphasis, just escape it: ``/fo\/o/``. +* There's no need to escape a single underscore if you need it + bold: ``__This_text_with_underscores_is_bold__``. +* ``@'f' a b@`` will hyperlink the identifier ``f`` inside the code + fragment. +* ``@__FILE__@`` will render ``FILE`` in bold with no underscores, + which may not be what you had in mind. Linking to Modules ~~~~~~~~~~~~~~~~~~ @@ -1121,6 +1127,17 @@ followed by the URL enclosed in regular parentheses, for example: :: The link text is used as a description for the URL if the output format supports it. +Hint: There's a `known issue <https://github.com/haskell/haddock/issues/774>`_ +that any inline link at the beginning of a line within a multi-line comment +isn't rendered correctly: :: + + {-| Some multi-line comment that has a + [link](https://example.com) and a + [reference link]: https://example.com + -} + +Adding a space or a word in front of such a link can be used as a workaround. + Images ~~~~~~ diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index cd02bf25..9770061c 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: haddock-api -version: 2.24.0 +version: 2.26.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -13,7 +13,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -tested-with: GHC==9.0.* +tested-with: GHC==9.2.* extra-source-files: CHANGES.md @@ -180,11 +180,11 @@ test-suite spec Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Types - build-depends: ghc ^>= 9.1 + build-depends: ghc ^>= 9.3 , ghc-paths ^>= 0.1.0.12 , haddock-library ^>= 1.9.0 , xhtml ^>= 3000.2.2 - , hspec >= 2.4.4 && < 2.8 + , hspec ^>= 2.9 , parsec ^>= 3.1.13.0 , QuickCheck >= 2.11 && ^>= 2.14 @@ -201,10 +201,11 @@ test-suite spec , filepath , ghc-boot , ghc-boot-th + , mtl , transformers build-tool-depends: - hspec-discover:hspec-discover >= 2.4.4 && < 2.8 + hspec-discover:hspec-discover ^>= 2.9 source-repository head type: git diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 29c64a2d..221580cc 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -87,7 +87,7 @@ dropHsDocTy = drop_sig_ty drop_ty (HsFunTy x w a b) = HsFunTy x w (drop_lty a) (drop_lty b) drop_ty (HsListTy x a) = HsListTy x (drop_lty a) drop_ty (HsTupleTy x a b) = HsTupleTy x a (map drop_lty b) - drop_ty (HsOpTy x a b c) = HsOpTy x (drop_lty a) b (drop_lty c) + drop_ty (HsOpTy x p a b c) = HsOpTy x p (drop_lty a) b (drop_lty c) drop_ty (HsParTy x a) = HsParTy x (drop_lty a) drop_ty (HsKindSig x a b) = HsKindSig x (drop_lty a) b drop_ty (HsDocTy _ a _) = drop_ty $ unL a diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 68e03fd5..89828e30 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -114,4 +114,3 @@ highlightScript = "highlight.js" -- | Path to default CSS file. defaultCssFile :: FilePath -> FilePath defaultCssFile libdir = libdir </> "html" </> "solarized.css" - diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 3929c286..9f28d72a 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -238,6 +238,7 @@ classify tok = ITrequires -> TkKeyword ITinline_prag {} -> TkPragma + ITopaque_prag {} -> TkPragma ITspec_prag {} -> TkPragma ITspec_inline_prag {} -> TkPragma ITsource_prag {} -> TkPragma @@ -268,6 +269,7 @@ classify tok = ITequal -> TkGlyph ITlam -> TkGlyph ITlcase -> TkGlyph + ITlcases -> TkGlyph ITvbar -> TkGlyph ITlarrow {} -> TkGlyph ITrarrow {} -> TkGlyph @@ -355,10 +357,7 @@ classify tok = ITeof -> TkUnknown ITlineComment {} -> TkComment - ITdocCommentNext {} -> TkComment - ITdocCommentPrev {} -> TkComment - ITdocCommentNamed {} -> TkComment - ITdocSection {} -> TkComment + ITdocComment {} -> TkComment ITdocOptions {} -> TkComment -- The lexer considers top-level pragmas as comments (see `pragState` in @@ -379,6 +378,7 @@ inPragma True _ = True inPragma False tok = case tok of ITinline_prag {} -> True + ITopaque_prag {} -> True ITspec_prag {} -> True ITspec_inline_prag {} -> True ITsource_prag {} -> True diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index eb524ec7..349c6e8e 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -24,7 +24,7 @@ import Haddock.GhcUtils import GHC.Utils.Ppr hiding (Doc, quote) import qualified GHC.Utils.Ppr as Pretty -import GHC.Types.Basic ( PromotionFlag(..) ) +import GHC.Types.Basic ( PromotionFlag(..), isPromoted ) import GHC hiding (fromMaybeContext ) import GHC.Types.Name.Occurrence import GHC.Types.Name ( nameOccName ) @@ -1133,9 +1133,13 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode = hsep [ppr_mono_lty fun_ty unicode, atSign unicode <> ppr_mono_lty arg_ki unicode] -ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode - = ppr_mono_lty ty1 unicode <+> ppr_op <+> ppr_mono_lty ty2 unicode +ppr_mono_ty (HsOpTy _ prom ty1 op ty2) unicode + = ppr_mono_lty ty1 unicode <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode where + ppr_op_prom | isPromoted prom + = char '\'' <> ppr_op + | otherwise + = ppr_op ppr_op | isSymOcc (getOccName op) = ppLDocName op | otherwise = char '`' <> ppLDocName op <> char '`' diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 336f23ac..a54bb0aa 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -1281,15 +1281,15 @@ ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode qual _ = hsep [ppr_mono_lty fun_ty unicode qual HideEmptyContexts , atSign unicode <> ppr_mono_lty arg_ki unicode qual HideEmptyContexts] -ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode qual _ - = ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts +ppr_mono_ty (HsOpTy _ prom ty1 op ty2) unicode qual _ + = ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts where - -- `(:)` is valid in type signature only as constructor to promoted list - -- and needs to be quoted in code so we explicitly quote it here too. - ppr_op - | (getOccString . getName . unL) op == ":" = promoQuote ppr_op' - | otherwise = ppr_op' - ppr_op' = ppLDocName qual Infix op + ppr_op_prom + | isPromoted prom + = promoQuote ppr_op + | otherwise + = ppr_op + ppr_op = ppLDocName qual Infix op ppr_mono_ty (HsParTy _ ty) unicode qual emptyCtxts = parens (ppr_mono_lty ty unicode qual emptyCtxts) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 29e0957b..ceefedf3 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -411,6 +411,7 @@ synifyDataCon use_gadt_syntax dc = return $ noLocA $ ConDeclGADT { con_g_ext = noAnn , con_names = [name] + , con_dcolon = noHsUniTok , con_bndrs = noLocA outer_bndrs , con_mb_cxt = ctx , con_g_args = hat @@ -606,7 +607,7 @@ synifyType _ vs (TyConApp tc tys) tTy | L _ (HsExplicitListTy _ IsPromoted tTy') <- stripKindSig tTy -> noLocA $ HsExplicitListTy noExtField IsPromoted (hTy : tTy') | otherwise - -> noLocA $ HsOpTy noExtField hTy (noLocA $ getName tc) tTy + -> noLocA $ HsOpTy noAnn IsPromoted hTy (noLocA $ getName tc) tTy -- ditto for implicit parameter tycons | tc `hasKey` ipClassKey , [name, ty] <- tys @@ -615,14 +616,16 @@ synifyType _ vs (TyConApp tc tys) -- and equalities | tc `hasKey` eqTyConKey , [ty1, ty2] <- tys - = noLocA $ HsOpTy noExtField + = noLocA $ HsOpTy noAnn + NotPromoted (synifyType WithinType vs ty1) (noLocA eqTyConName) (synifyType WithinType vs ty2) -- and infix type operators | isSymOcc (nameOccName (getName tc)) , ty1:ty2:tys_rest <- vis_tys - = mk_app_tys (HsOpTy noExtField + = mk_app_tys (HsOpTy noAnn + prom (synifyType WithinType vs ty1) (noLocA $ getName tc) (synifyType WithinType vs ty2)) diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 599404a0..7c1dc73b 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns, StandaloneDeriving, FlexibleInstances, ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -95,7 +96,7 @@ ifTrueJust True = Just ifTrueJust False = const Nothing sigName :: LSig GhcRn -> [IdP GhcRn] -sigName (L _ sig) = sigNameNoLoc sig +sigName (L _ sig) = sigNameNoLoc emptyOccEnv sig -- | Was this signature given by the user? isUserLSig :: forall p. UnXRec p => LSig p -> Bool @@ -114,7 +115,7 @@ pretty = showPpr -- instantiated at DocNameI instead of (GhcPass _). -- | Like 'hsTyVarName' from GHC API, but not instantiated at (GhcPass _) -hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ NoExtCon, UnXRec n) +hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ DataConCantHappen, UnXRec n) => HsTyVarBndr flag n -> IdP n hsTyVarBndrName (UserTyVar _ _ name) = unXRec @n name hsTyVarBndrName (KindedTyVar _ _ name _) = unXRec @n name @@ -192,7 +193,7 @@ getMainDeclBinderI (ValD _ d) = case collectHsBindBinders CollNoDictBinders d of [] -> [] (name:_) -> [name] -getMainDeclBinderI (SigD _ d) = sigNameNoLoc d +getMainDeclBinderI (SigD _ d) = sigNameNoLoc emptyOccEnv d getMainDeclBinderI (ForD _ (ForeignImport _ name _ _)) = [unLoc name] getMainDeclBinderI (ForD _ (ForeignExport _ _ _ _)) = [] getMainDeclBinderI _ = [] @@ -228,7 +229,7 @@ addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype)) = L loc (HsQualTy { hst_xqual = noExtField , hst_ctxt = add_ctxt (noLocA []), hst_body = L loc ty }) - extra_pred = nlHsTyConApp Prefix cls (lHsQTyVarsToTypes tvs0) + extra_pred = nlHsTyConApp NotPromoted Prefix cls (lHsQTyVarsToTypes tvs0) add_ctxt (L loc preds) = L loc (extra_pred : preds) @@ -364,8 +365,8 @@ reparenTypePrec = go = paren p PREC_CON $ HsAppTy x (goL PREC_FUN fun_ty) (goL PREC_CON arg_ty) go p (HsAppKindTy x fun_ty arg_ki) = paren p PREC_CON $ HsAppKindTy x (goL PREC_FUN fun_ty) (goL PREC_CON arg_ki) - go p (HsOpTy x ty1 op ty2) - = paren p PREC_FUN $ HsOpTy x (goL PREC_OP ty1) op (goL PREC_OP ty2) + go p (HsOpTy x prom ty1 op ty2) + = paren p PREC_FUN $ HsOpTy x prom (goL PREC_OP ty1) op (goL PREC_OP ty2) go p (HsParTy _ t) = unXRec @a $ goL p t -- pretend the paren doesn't exist - it will be added back if needed go _ t@HsTyVar{} = t go _ t@HsStarTy{} = t diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index ba7d9d30..19113107 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -56,11 +56,11 @@ import qualified Data.Set as Set import GHC hiding (verbosity) import GHC.Data.FastString (unpackFS) import GHC.Data.Graph.Directed -import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units) +import GHC.Driver.Env import GHC.Driver.Monad (modifySession, withTimingM) import GHC.Driver.Session hiding (verbosity) import GHC.HsToCore.Docs (getMainDeclBinder) -import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource) +import GHC.Plugins import GHC.Tc.Types (TcGblEnv (..), TcM) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) @@ -69,7 +69,7 @@ import GHC.Types.Name.Occurrence (isTcOcc) import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK) import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet) import GHC.Unit.Module.Graph -import GHC.Unit.Module.ModSummary (emsModSummary, isBootSummary) +import GHC.Unit.Module.ModSummary (isBootSummary) import GHC.Unit.Types (IsBootInterface (..)) import GHC.Utils.Error (withTiming) @@ -145,10 +145,12 @@ createIfaces verbosity modules flags instIfaceMap = do let installHaddockPlugin :: HscEnv -> HscEnv - installHaddockPlugin hsc_env = hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) $ hsc_env - { hsc_static_plugins = - haddockPlugin : hsc_static_plugins hsc_env - } + installHaddockPlugin hsc_env = + let + old_plugins = hsc_plugins hsc_env + new_plugins = old_plugins { staticPlugins = haddockPlugin : staticPlugins old_plugins } + hsc_env' = hsc_env { hsc_plugins = new_plugins } + in hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) hsc_env' -- Note that we would rather use withTempSession but as long as we -- have the separate attachInstances step we need to keep the session @@ -210,8 +212,8 @@ createIfaces verbosity modules flags instIfaceMap = do -- i.e. if module A imports B, then B is preferred over A, -- but if module A {-# SOURCE #-} imports B, then we can't say the same. -- - go (AcyclicSCC (ModuleNode ems)) - | NotBoot <- isBootSummary (emsModSummary ems) = [ems] + go (AcyclicSCC (ModuleNode _ ms)) + | NotBoot <- isBootSummary ms = [ms] | otherwise = [] go (AcyclicSCC _) = [] go (CyclicSCC _) = error "haddock: module graph cyclic even with boot files" @@ -220,9 +222,9 @@ createIfaces verbosity modules flags instIfaceMap = do ifaces = [ Map.findWithDefault (error "haddock:iface") - (ms_mod (emsModSummary ems)) + (ms_mod ms) ifaceMap - | ems <- concatMap go $ topSortModuleGraph False modGraph Nothing + | ms <- concatMap go $ topSortModuleGraph False modGraph Nothing ] return (ifaces, moduleSet) @@ -360,7 +362,7 @@ processModule1 verbosity flags ifaces inst_ifaces hsc_env mod_summary tc_gbl_env ] where formatName :: SrcSpan -> HsDecl GhcRn -> String - formatName loc n = p (getMainDeclBinder n) ++ case loc of + formatName loc n = p (getMainDeclBinder emptyOccEnv n) ++ case loc of RealSrcSpan rss _ -> " (" ++ unpackFS (srcSpanFile rss) ++ ":" ++ show (srcSpanStartLine rss) ++ ")" _ -> "" diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index e8a79b2b..dc8afa31 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -136,12 +136,12 @@ attachToExportItem index expInfo getInstDoc getFixity export = , expItemSubDocs = subDocs } = e { expItemFixities = nubByName fst $ expItemFixities e ++ - [ (n',f) | n <- getMainDeclBinder d + [ (n',f) | n <- getMainDeclBinder emptyOccEnv d , n' <- n : (map fst subDocs ++ patsyn_names) , f <- maybeToList (getFixity n') ] } where - patsyn_names = concatMap (getMainDeclBinder . fst) patsyns + patsyn_names = concatMap (getMainDeclBinder emptyOccEnv . fst) patsyns attachFixities e = e -- spanName: attach the location to the name that is the same file as the instance location diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 4d746405..dbd4a9b2 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -35,7 +35,7 @@ import Documentation.Haddock.Doc (metaDocAppend) import Haddock.Convert (PrintRuntimeReps (..), tyThingToLHsDecl) import Haddock.GhcUtils (addClassContext, filterSigNames, lHsQTyVarsToTypes, mkEmptySigType, moduleString, parents, pretty, restrictTo, sigName, unL) -import Haddock.Interface.LexParseRn (processDocString, processDocStringParas, processDocStrings, processModuleHeader) +import Haddock.Interface.LexParseRn import Haddock.Options (Flag (..), modulePackageInfo) import Haddock.Types hiding (liftErrMsg) import Haddock.Utils (replace) @@ -57,7 +57,7 @@ import GHC.Core.Class (ClassMinimalDef, classMinimalDef) import GHC.Core.ConLike (ConLike (..)) import GHC.Data.FastString (bytesFS, unpackFS) import GHC.Driver.Ppr (showSDoc) -import GHC.HsToCore.Docs hiding (mkMaps) +import GHC.HsToCore.Docs hiding (mkMaps, unionArgMaps) import GHC.IORef (readIORef) import GHC.Stack (HasCallStack) import GHC.Tc.Types hiding (IfM) @@ -65,7 +65,7 @@ import GHC.Tc.Utils.Monad (finalSafeMode) import GHC.Types.Avail hiding (avail) import qualified GHC.Types.Avail as Avail import GHC.Types.Basic (PromotionFlag (..)) -import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName) +import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName, emptyOccEnv) import GHC.Types.Name.Env (lookupNameEnv) import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv) import GHC.Types.Name.Set (elemNameSet, mkNameSet) @@ -79,6 +79,7 @@ import GHC.Unit.State (PackageName (..), UnitState, lookupModuleInAllUnits) import qualified GHC.Utils.Outputable as O import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.Warnings +import GHC.Types.Unique.Map newtype IfEnv m = IfEnv { @@ -255,7 +256,7 @@ createInterface1 flags unit_state mod_sum tc_gbl_env ifaces inst_ifaces = do -- Process the top-level module header documentation. (!info, header_doc) <- liftErrMsg $ processModuleHeader dflags pkg_name - tcg_rdr_env safety (thMbDocStr <|> (unLoc <$> tcg_doc_hdr)) + tcg_rdr_env safety (fmap hsDocString thMbDocStr <|> (hsDocString . unLoc <$> tcg_doc_hdr)) -- Warnings on declarations in this module decl_warnings <- liftErrMsg (mkWarningMap dflags tcg_warns tcg_rdr_env exported_names) @@ -405,7 +406,7 @@ lookupModuleDyn state pkg_qual mdlName = case pkg_qual of -- Warnings ------------------------------------------------------------------------------- -mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap +mkWarningMap :: DynFlags -> Warnings a -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap mkWarningMap dflags warnings gre exps = case warnings of NoWarnings -> pure M.empty WarnAll _ -> pure M.empty @@ -416,18 +417,18 @@ mkWarningMap dflags warnings gre exps = case warnings of , let n = greMangledName elt, n `elem` exps ] in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws' -moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name)) +moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings a -> ErrMsgM (Maybe (Doc Name)) moduleWarning _ _ NoWarnings = pure Nothing moduleWarning _ _ (WarnSome _) = pure Nothing moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w -parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name) +parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt a -> ErrMsgM (Doc Name) parseWarning dflags gre w = case w of - DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (bytesFS . sl_fs . unLoc) msg) - WarningTxt _ msg -> format "Warning: " (foldMap (bytesFS . sl_fs . unLoc) msg) + DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (unpackFS . sl_fs . hsDocString . unLoc) msg) + WarningTxt _ msg -> format "Warning: " (foldMap (unpackFS . sl_fs . hsDocString . unLoc) msg) where format x bs = DocWarning . DocParagraph . DocAppend (DocString x) - <$> processDocString dflags gre (mkHsDocStringUtf8ByteString bs) + <$> processDocStringFromString dflags gre bs ------------------------------------------------------------------------------- @@ -479,7 +480,7 @@ mkMaps :: DynFlags -> Maybe Package -- this package -> GlobalRdrEnv -> [Name] - -> [(LHsDecl GhcRn, [HsDocString])] + -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -> ExtractedTHDocs -- ^ Template Haskell putDoc docs -> ErrMsgM Maps mkMaps dflags pkgName gre instances decls thDocs = do @@ -512,36 +513,40 @@ mkMaps dflags pkgName gre instances decls thDocs = do thMappings = do let ExtractedTHDocs _ - (DeclDocMap declDocs) - (ArgDocMap argDocs) - (DeclDocMap instDocs) = thDocs - ds2mdoc :: HsDocString -> ErrMsgM (MDoc Name) - ds2mdoc = processDocStringParas dflags pkgName gre - - declDocs' <- mapM ds2mdoc declDocs - argDocs' <- mapM (mapM ds2mdoc) argDocs - instDocs' <- mapM ds2mdoc instDocs + declDocs + argDocs + instDocs = thDocs + ds2mdoc :: (HsDoc GhcRn) -> ErrMsgM (MDoc Name) + ds2mdoc = processDocStringParas dflags pkgName gre . hsDocString + + let cvt = M.fromList . nonDetEltsUniqMap + + declDocs' <- mapM ds2mdoc (cvt declDocs) + argDocs' <- mapM (mapM ds2mdoc) (cvt argDocs) + instDocs' <- mapM ds2mdoc (cvt instDocs) return (declDocs' <> instDocs', argDocs') - mappings :: (LHsDecl GhcRn, [HsDocString]) + mappings :: (LHsDecl GhcRn, [HsDoc GhcRn]) -> ErrMsgM ( [(Name, MDoc Name)] , [(Name, IntMap (MDoc Name))] , [(Name, [LHsDecl GhcRn])] ) - mappings (ldecl@(L (SrcSpanAnn _ (RealSrcSpan l _)) decl), docStrs) = do - let declDoc :: [HsDocString] -> IntMap HsDocString + mappings (ldecl@(L (SrcSpanAnn _ (RealSrcSpan l _)) decl), hs_docStrs) = do + let docStrs = map hsDocString hs_docStrs + declDoc :: [HsDocString] -> IntMap HsDocString -> ErrMsgM (Maybe (MDoc Name), IntMap (MDoc Name)) declDoc strs m = do doc' <- processDocStrings dflags pkgName gre strs m' <- traverse (processDocStringParas dflags pkgName gre) m pure (doc', m') - (doc, args) <- declDoc docStrs (declTypeDocs decl) + (doc, args) <- declDoc docStrs (fmap hsDocString (declTypeDocs decl)) let subs :: [(Name, [HsDocString], IntMap HsDocString)] - subs = subordinates instanceMap decl + subs = map (\(n, ds, im) -> (n, map hsDocString ds, fmap hsDocString im)) + $ subordinates emptyOccEnv instanceMap decl (subDocs, subArgs) <- unzip <$> traverse (\(_, strs, m) -> declDoc strs m) subs @@ -572,7 +577,23 @@ mkMaps dflags pkgName gre instances decls thDocs = do TyFamInstD _ (TyFamInstDecl _ d') -> getLocA (feqn_tycon d') _ -> getInstLoc d names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2]. - names _ decl = getMainDeclBinder decl + names _ decl = getMainDeclBinder emptyOccEnv decl + +-- | Unions together two 'ArgDocMaps' (or ArgMaps in haddock-api), such that two +-- maps with values for the same key merge the inner map as well. +-- Left biased so @unionArgMaps a b@ prefers @a@ over @b@. + +unionArgMaps :: forall b . Map Name (IntMap b) + -> Map Name (IntMap b) + -> Map Name (IntMap b) +unionArgMaps a b = M.foldrWithKey go b a + where + go :: Name -> IntMap b + -> Map Name (IntMap b) -> Map Name (IntMap b) + go n newArgMap acc + | Just oldArgMap <- M.lookup n acc = + M.insert n (newArgMap `IM.union` oldArgMap) acc + | otherwise = M.insert n newArgMap acc -- Note [2]: ------------ @@ -634,11 +655,11 @@ mkExportItems Just exports -> liftM concat $ mapM lookupExport exports where lookupExport (IEGroup _ lev docStr, _) = liftErrMsg $ do - doc <- processDocString dflags gre docStr + doc <- processDocString dflags gre (hsDocString . unLoc $ docStr) return [ExportGroup lev "" doc] lookupExport (IEDoc _ docStr, _) = liftErrMsg $ do - doc <- processDocStringParas dflags pkgName gre docStr + doc <- processDocStringParas dflags pkgName gre (hsDocString . unLoc $ docStr) return [ExportDoc doc] lookupExport (IEDocNamed _ str, _) = liftErrMsg $ @@ -706,7 +727,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap return [export] (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds -> - let declNames = getMainDeclBinder (unL decl) + let declNames = getMainDeclBinder emptyOccEnv (unL decl) in case () of _ -- We should not show a subordinate by itself if any of its @@ -785,7 +806,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames let patSynNames = - concatMap (getMainDeclBinder . fst) bundledPatSyns + concatMap (getMainDeclBinder emptyOccEnv . fst) bundledPatSyns fixities = [ (n, f) @@ -1007,17 +1028,17 @@ fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNam (concat . concat) `fmap` (for decls $ \decl -> do case decl of (L _ (DocD _ (DocGroup lev docStr))) -> do - doc <- liftErrMsg (processDocString dflags gre docStr) + doc <- liftErrMsg (processDocString dflags gre (hsDocString . unLoc $ docStr)) return [[ExportGroup lev "" doc]] (L _ (DocD _ (DocCommentNamed _ docStr))) -> do - doc <- liftErrMsg (processDocStringParas dflags pkgName gre docStr) + doc <- liftErrMsg (processDocStringParas dflags pkgName gre (hsDocString . unLoc $ docStr)) return [[ExportDoc doc]] (L _ (ValD _ valDecl)) | name:_ <- collectHsBindBinders CollNoDictBinders valDecl , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap -> return [] _ -> - for (getMainDeclBinder (unLoc decl)) $ \nm -> do + for (getMainDeclBinder emptyOccEnv (unLoc decl)) $ \nm -> do case lookupNameEnv availEnv nm of Just avail -> availExportItem is_sig modMap thisMod @@ -1042,7 +1063,7 @@ extractDecl -> LHsDecl GhcRn -- ^ parent declaration -> Either ErrMsg (LHsDecl GhcRn) extractDecl declMap name decl - | name `elem` getMainDeclBinder (unLoc decl) = pure decl + | name `elem` getMainDeclBinder emptyOccEnv (unLoc decl) = pure decl | otherwise = case unLoc decl of TyClD _ d@ClassDecl { tcdLName = L _ clsNm @@ -1197,10 +1218,10 @@ mkVisibleNames (_, _, _, instMap) exports opts where exportName e@ExportDecl {} = name ++ subs ++ patsyns where subs = map fst (expItemSubDocs e) - patsyns = concatMap (getMainDeclBinder . fst) (expItemPats e) + patsyns = concatMap (getMainDeclBinder emptyOccEnv . fst) (expItemPats e) name = case unLoc $ expItemDecl e of InstD _ d -> maybeToList $ SrcLoc.lookupSrcSpan (getInstLoc d) instMap - decl -> getMainDeclBinder decl + decl -> getMainDeclBinder emptyOccEnv decl exportName ExportNoDecl {} = [] -- we don't count these as visible, since -- we don't want links to go to them. exportName _ = [] @@ -1217,6 +1238,7 @@ findNamedDoc name = search tell ["Cannot find documentation for: $" ++ name] return Nothing search (DocD _ (DocCommentNamed name' doc) : rest) - | name == name' = return (Just doc) + | name == name' = return (Just (hsDocString . unLoc $ doc)) + | otherwise = search rest search (_other_decl : rest) = search rest diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index a827cf66..f3b57792 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -15,6 +15,7 @@ ----------------------------------------------------------------------------- module Haddock.Interface.LexParseRn ( processDocString + , processDocStringFromString , processDocStringParas , processDocStrings , processModuleHeader @@ -38,6 +39,7 @@ import GHC.Parser.PostProcess import GHC.Driver.Ppr ( showPpr, showSDoc ) import GHC.Types.Name.Reader import GHC.Data.EnumSet as EnumSet +import GHC.Utils.Trace processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (MDoc Name)) @@ -52,11 +54,15 @@ processDocStrings dflags pkg gre strs = do processDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name) processDocStringParas dflags pkg gre hds = - overDocF (rename dflags gre) $ parseParas dflags pkg (unpackHDS hds) + overDocF (rename dflags gre) $ parseParas dflags pkg (renderHsDocString hds) processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name) processDocString dflags gre hds = - rename dflags gre $ parseString dflags (unpackHDS hds) + processDocStringFromString dflags gre (renderHsDocString hds) + +processDocStringFromString :: DynFlags -> GlobalRdrEnv -> String -> ErrMsgM (Doc Name) +processDocStringFromString dflags gre hds = + rename dflags gre $ parseString dflags hds processModuleHeader :: DynFlags -> Maybe Package -> GlobalRdrEnv -> SafeHaskellMode -> Maybe HsDocString -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name)) @@ -65,7 +71,7 @@ processModuleHeader dflags pkgName gre safety mayStr = do case mayStr of Nothing -> return failure Just hds -> do - let str = unpackHDS hds + let str = renderHsDocString hds (hmi, doc) = parseModuleHeader dflags pkgName str !descr <- case hmi_description hmi of Just hmi_descr -> Just <$> rename dflags gre hmi_descr diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 98c39859..cbc7e58f 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -191,8 +191,8 @@ renameDocumentation (Documentation mDoc mWarning) = Documentation <$> mapM renameDoc mDoc <*> mapM renameDoc mWarning -renameLDocHsSyn :: LHsDocString -> RnM LHsDocString -renameLDocHsSyn = return +renameLDocHsSyn :: Located (WithHsDocIdentifiers HsDocString a) -> RnM (Located (WithHsDocIdentifiers HsDocString b)) +renameLDocHsSyn (L l doc) = return (L l (WithHsDocIdentifiers (hsDocString doc) [])) renameDoc :: Traversable t => t (Wrap Name) -> RnM (t (Wrap DocName)) @@ -290,11 +290,11 @@ renameType t = case t of HsTupleTy _ b ts -> return . HsTupleTy noAnn b =<< mapM renameLType ts HsSumTy _ ts -> HsSumTy noAnn <$> mapM renameLType ts - HsOpTy _ a (L loc op) b -> do + HsOpTy _ prom a (L loc op) b -> do op' <- rename op a' <- renameLType a b' <- renameLType b - return (HsOpTy noAnn a' (L loc op') b') + return (HsOpTy noAnn prom a' (L loc op') b') HsParTy _ ty -> return . (HsParTy noAnn) =<< renameLType ty @@ -317,6 +317,7 @@ renameType t = case t of HsSpliceTy _ s -> renameHsSpliceTy s HsWildCardTy _ -> pure (HsWildCardTy noAnn) + renameSigType :: HsSigType GhcRn -> RnM (HsSigType DocNameI) renameSigType (HsSig { sig_bndrs = bndrs, sig_body = body }) = do bndrs' <- renameOuterTyVarBndrs bndrs @@ -511,13 +512,14 @@ renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars ltyvars' <- mapM renameLTyVarBndr ltyvars lcontext' <- traverse renameLContext lcontext details' <- renameH98Details details - mbldoc' <- mapM renameLDocHsSyn mbldoc + mbldoc' <- mapM (renameLDocHsSyn) mbldoc return (decl { con_ext = noExtField, con_name = lname', con_ex_tvs = ltyvars' , con_mb_cxt = lcontext' , con_forall = forall_ -- Remove when #18311 is fixed , con_args = details', con_doc = mbldoc' }) renameCon ConDeclGADT { con_names = lnames, con_bndrs = bndrs + , con_dcolon = dcol , con_mb_cxt = lcontext, con_g_args = details , con_res_ty = res_ty , con_doc = mbldoc } = do @@ -528,7 +530,8 @@ renameCon ConDeclGADT { con_names = lnames, con_bndrs = bndrs res_ty' <- renameLType res_ty mbldoc' <- mapM renameLDocHsSyn mbldoc return (ConDeclGADT - { con_g_ext = noExtField, con_names = lnames', con_bndrs = bndrs' + { con_g_ext = noExtField, con_names = lnames' + , con_dcolon = dcol, con_bndrs = bndrs' , con_mb_cxt = lcontext', con_g_args = details' , con_res_ty = res_ty', con_doc = mbldoc' }) diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 399e5d0d..d1164858 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -16,6 +16,7 @@ import Haddock.Syb import Haddock.Types import GHC +import GHC.Types.Basic ( PromotionFlag(..) ) import GHC.Types.Name import GHC.Data.FastString import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName ) @@ -132,8 +133,8 @@ sugarTuples typ = sugarOperators :: HsType GhcRn -> HsType GhcRn -sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb) - | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb +sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ prom (L l name))) la)) lb) + | isSymOcc $ getOccName name' = mkHsOpTy prom la (L l name) lb | unrestrictedFunTyConName == name' = HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) la lb where name' = getName name @@ -293,8 +294,8 @@ renameType (HsFunTy x w la lr) = HsFunTy x <$> renameHsArrow w <*> renameLType l renameType (HsListTy x lt) = HsListTy x <$> renameLType lt renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt renameType (HsSumTy x lt) = HsSumTy x <$> mapM renameLType lt -renameType (HsOpTy x la lop lb) = - HsOpTy x <$> renameLType la <*> locatedN renameName lop <*> renameLType lb +renameType (HsOpTy x prom la lop lb) = + HsOpTy x prom <$> renameLType la <*> locatedN renameName lop <*> renameLType lb renameType (HsParTy x lt) = HsParTy x <$> renameLType lt renameType (HsIParamTy x ip lt) = HsIParamTy x ip <$> renameLType lt renameType (HsKindSig x lt lk) = HsKindSig x <$> renameLType lt <*> pure lk diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 9c4308a6..aabb904a 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -85,8 +85,8 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,4,0) -binaryInterfaceVersion = 39 +#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,6,0) +binaryInterfaceVersion = 41 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 05375185..7d00c5ec 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PartialTypeSignatures #-} @@ -319,7 +320,8 @@ type instance NoGhcTc DocNameI = DocNameI type instance IdP DocNameI = DocName instance CollectPass DocNameI where - collectXXPat _ _ ext = noExtCon ext + collectXXPat _ ext = dataConCantHappen ext + collectXXHsBindsLR ext = dataConCantHappen ext instance NamedThing DocName where getName (Documented name _) = name @@ -760,11 +762,11 @@ type instance XXType DocNameI = HsCoreTy type instance XHsForAllVis DocNameI = NoExtField type instance XHsForAllInvis DocNameI = NoExtField -type instance XXHsForAllTelescope DocNameI = NoExtCon +type instance XXHsForAllTelescope DocNameI = DataConCantHappen type instance XUserTyVar DocNameI = NoExtField type instance XKindedTyVar DocNameI = NoExtField -type instance XXTyVarBndr DocNameI = NoExtCon +type instance XXTyVarBndr DocNameI = DataConCantHappen type instance XCFieldOcc DocNameI = DocName type instance XXFieldOcc DocNameI = NoExtField @@ -780,7 +782,7 @@ type instance XForeignExport DocNameI = NoExtField type instance XForeignImport DocNameI = NoExtField type instance XConDeclGADT DocNameI = NoExtField type instance XConDeclH98 DocNameI = NoExtField -type instance XXConDecl DocNameI = NoExtCon +type instance XXConDecl DocNameI = DataConCantHappen type instance XDerivD DocNameI = NoExtField type instance XInstD DocNameI = NoExtField @@ -791,10 +793,10 @@ type instance XTyClD DocNameI = NoExtField type instance XNoSig DocNameI = NoExtField type instance XCKindSig DocNameI = NoExtField type instance XTyVarSig DocNameI = NoExtField -type instance XXFamilyResultSig DocNameI = NoExtCon +type instance XXFamilyResultSig DocNameI = DataConCantHappen type instance XCFamEqn DocNameI _ = NoExtField -type instance XXFamEqn DocNameI _ = NoExtCon +type instance XXFamEqn DocNameI _ = DataConCantHappen type instance XCClsInstDecl DocNameI = NoExtField type instance XCDerivDecl DocNameI = NoExtField @@ -811,23 +813,24 @@ type instance XClassDecl DocNameI = NoExtField type instance XDataDecl DocNameI = NoExtField type instance XSynDecl DocNameI = NoExtField type instance XFamDecl DocNameI = NoExtField -type instance XXFamilyDecl DocNameI = NoExtCon -type instance XXTyClDecl DocNameI = NoExtCon +type instance XXFamilyDecl DocNameI = DataConCantHappen +type instance XXTyClDecl DocNameI = DataConCantHappen type instance XHsWC DocNameI _ = NoExtField type instance XHsOuterExplicit DocNameI _ = NoExtField type instance XHsOuterImplicit DocNameI = NoExtField -type instance XXHsOuterTyVarBndrs DocNameI = NoExtCon +type instance XXHsOuterTyVarBndrs DocNameI = DataConCantHappen type instance XHsSig DocNameI = NoExtField -type instance XXHsSigType DocNameI = NoExtCon +type instance XXHsSigType DocNameI = DataConCantHappen type instance XHsQTvs DocNameI = NoExtField type instance XConDeclField DocNameI = NoExtField -type instance XXConDeclField DocNameI = NoExtCon +type instance XXConDeclField DocNameI = DataConCantHappen -type instance XXPat DocNameI = NoExtCon +type instance XXPat DocNameI = DataConCantHappen +type instance XXHsBindsLR DocNameI a = DataConCantHappen type instance XCInjectivityAnn DocNameI = NoExtField diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 72c11f75..f6d88c81 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -28,6 +28,7 @@ tested-with: GHC == 7.4.2 , GHC == 8.8.3 , GHC == 8.10.1 , GHC == 9.0.1 + , GHC == 9.2.0 extra-source-files: CHANGES.md @@ -39,10 +40,8 @@ common lib-defaults build-depends: , base >= 4.5 && < 4.17 - , bytestring ^>= 0.9.2.1 || ^>= 0.10.0.0 || ^>= 0.11.0.0 , containers ^>= 0.4.2.1 || ^>= 0.5.0.0 || ^>= 0.6.0.1 - , transformers ^>= 0.3.0.0 || ^>= 0.4.1.0 || ^>= 0.5.0.0 - , text ^>= 1.2.3.0 + , text ^>= 1.2.3.0 || ^>= 2.0 , parsec ^>= 3.1.13.0 ghc-options: -funbox-strict-fields -Wall @@ -87,7 +86,7 @@ test-suite spec Documentation.Haddock.Parser.Identifier build-depends: - , QuickCheck ^>= 2.11 || ^>= 2.13.2 || ^>= 2.14 + , QuickCheck ^>= 2.11 || ^>= 2.13.2 || ^>= 2.14 , deepseq ^>= 1.3.0.0 || ^>= 1.4.0.0 -- NB: build-depends & build-tool-depends have independent @@ -95,10 +94,10 @@ test-suite spec -- version of `hspec` & `hspec-discover` to ensure -- intercompatibility build-depends: - , hspec >= 2.4.4 && < 2.8 + , hspec >= 2.4.4 && < 2.10 build-tool-depends: - , hspec-discover:hspec-discover >= 2.4.4 && < 2.8 + , hspec-discover:hspec-discover >= 2.4.4 && < 2.10 test-suite fixtures type: exitcode-stdio-1.0 @@ -116,7 +115,7 @@ test-suite fixtures , directory ^>= 1.3.0.2 , filepath ^>= 1.4.1.2 , optparse-applicative ^>= 0.15 - , tree-diff ^>= 0.1 + , tree-diff ^>= 0.2 source-repository head type: git diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs index 7c73a168..2fa79961 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} -- | diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index e4829588..2905dc8f 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -18,7 +18,7 @@ import Data.Maybe import Distribution.Text import Distribution.Types.PackageName import Distribution.InstalledPackageInfo -import Distribution.Simple.Compiler +import Distribution.Simple.Compiler (PackageDB(..)) import Distribution.Simple.GHC import Distribution.Simple.PackageIndex import Distribution.Simple.Program diff --git a/haddock.cabal b/haddock.cabal index dfb4e9a9..672420bd 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: haddock -version: 2.24.0 +version: 2.26.0 synopsis: A documentation-generation tool for Haskell libraries description: This is Haddock, a tool for automatically generating documentation @@ -33,7 +33,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -tested-with: GHC==9.0.* +tested-with: GHC==9.2.* extra-source-files: CHANGES.md @@ -81,7 +81,7 @@ executable haddock xhtml >= 3000.2 && < 3000.3, ghc-boot, ghc-boot-th, - ghc == 9.3.*, + ghc == 9.5.*, bytestring, parsec, text, @@ -148,7 +148,7 @@ executable haddock else -- in order for haddock's advertised version number to have proper meaning, -- we pin down to a single haddock-api version. - build-depends: haddock-api == 2.24.0 + build-depends: haddock-api == 2.26.0 test-suite html-test type: exitcode-stdio-1.0 diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index 2fac6d4e..855f1b89 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -230,7 +230,9 @@ ><td class="src" >:: <span class="keyword" >forall</span - > a (b :: ()) d. d ~ '<a href="#" title="GHC.Tuple" + > a (b :: ()) d. d <a href="#" title="Data.Type.Equality" + >~</a + > '<a href="#" title="GHC.Tuple" >()</a ></td ><td class="doc empty" diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html index b177266d..76487140 100644 --- a/html-test/ref/Identifiers.html +++ b/html-test/ref/Identifiers.html @@ -147,7 +147,7 @@ ></code >, <code ><a href="#" title="Data.Foldable" - >Foldable</a + >elem</a ></code ></li ><li @@ -169,7 +169,7 @@ >++</code >, <code ><a href="#" title="Data.Foldable" - >Foldable</a + >elem</a ></code >, <code >elem</code @@ -238,14 +238,14 @@ >Unqualified: <code >1 <code ><a href="#" title="Data.Foldable" - >`Foldable`</a + >`elem`</a ></code > [-3..3]</code ></li ><li >Qualified: <code >1 <code - ><a href="#" title="GHC.List" + ><a href="#" title="Data.Foldable" >`elem`</a ></code > [-3..3]</code @@ -253,7 +253,7 @@ ><li >Namespaced: <code ><a href="#" title="Data.Foldable" - >`Foldable`</a + >`elem`</a ></code >, <code >`elem`</code diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index e99f82e4..109e866c 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -262,7 +262,9 @@ ></span > <a href="#" title="Instances" >Foo</a - > []</span + > <a href="#" title="GHC.List" + >List</a + ></span > <a href="#" class="selflink" >#</a ></td @@ -900,7 +902,9 @@ ></span > <a href="#" title="Instances" >Bar</a - > [] (a, a)</span + > <a href="#" title="GHC.List" + >List</a + > (a, a)</span > <a href="#" class="selflink" >#</a ></td diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index ff79e6be..f4882f1a 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -147,7 +147,9 @@ ><p class="src" ><a id="v:f" class="def" >f</a - > :: a ~ b => a -> b <a href="#" class="selflink" + > :: a <a href="#" title="Data.Type.Equality" + >~</a + > b => a -> b <a href="#" class="selflink" >#</a ></p ></div @@ -155,7 +157,11 @@ ><p class="src" ><a id="v:g" class="def" >g</a - > :: (a ~ b, b ~ c) => a -> c <a href="#" class="selflink" + > :: (a <a href="#" title="Data.Type.Equality" + >~</a + > b, b <a href="#" title="Data.Type.Equality" + >~</a + > c) => a -> c <a href="#" class="selflink" >#</a ></p ></div diff --git a/hypsrc-test/ref/src/Quasiquoter.html b/hypsrc-test/ref/src/Quasiquoter.html index 53dc3474..76faac5a 100644 --- a/hypsrc-test/ref/src/Quasiquoter.html +++ b/hypsrc-test/ref/src/Quasiquoter.html @@ -80,8 +80,10 @@ </span ><span id="line-7" ></span + ><span class="annot" ><span class="hs-comment" - >-- | Quoter for constructing multiline string literals</span + >-- | Quoter for constructing multiline string literals</span + ></span ><span > </span |