diff options
114 files changed, 2143 insertions, 1038 deletions
diff --git a/.authorspellings b/.authorspellings deleted file mode 100644 index 570c548e..00000000 --- a/.authorspellings +++ /dev/null @@ -1,10 +0,0 @@ -Simon Marlow <simonmar@microsoft.com>, marlowsd@gmail.com, simonmar -Simon Hengel <simon.hengel@wiktory.org> -David Waern <david.waern@gmail.com>, davve@dtek.chalmers.se, david.waern@gmail.com, David Waern -Sven Panne <sven.panne@aedion.de>, panne -Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>, Neil Mitchell -Ross Paterson <ross@soi.city.ac.uk>, ross -Simon Peyton-Jones <simonpj@microsoft.com> -Wolfgang Jeltsch <g9ks157k@acme.softbase.org>, wolfgang -Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk> -Benjamin Franksen <benjamin.franksen@bessy.de> @@ -1 +1 @@ -:set -isrc -itest -idist/build -idist/build/autogen -packageghc -optP-include -optPdist/build/autogen/cabal_macros.h +:set --itest -idist/build -idist/build/autogen -packageghc -optP-include -optPdist/build/autogen/cabal_macros.h @@ -1,5 +1,6 @@ /dist/ -/haddock-library/dist +/haddock-api/dist/ +/haddock-library/dist/ /html-test/out/ /latex-test/out/ diff --git a/.travis.yml b/.travis.yml index 45614110..ad1331f8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,41 +1,22 @@ language: haskell -notifications: - email: - on_success: never - on_failure: change - env: - - GHCVER=7.4.1 - - GHCVER=7.4.2 - - GHCVER=7.6.3 - - GHCVER=7.8.1 - - GHCVER=7.8.2 - - GHCVER=7.8.3 - - GHCVER=head + # - GHCVER=7.8.2 + # - GHCVER=7.8.3 before_install: - sudo add-apt-repository -y ppa:hvr/ghc - sudo apt-get update - sudo apt-get install ghc-$GHCVER - export PATH=/opt/ghc/$GHCVER/bin:$PATH - -install: - - case "$GHCVER" in - "head") (cd haddock-library/ && cabal install --enable-tests - && cd .. && cabal install --only-dependencies --enable-tests) ;; - *) - (cd haddock-library/ && cabal install --only-dependencies --enable-tests) ;; - - esac + - cd haddock-library + - cabal install --only-dependencies --enable-tests + - cabal install doctest + - cabal configure --enable-tests --ghc-options=-Werror && cabal build && cabal test + - doctest -isrc -i$(echo vendor/attoparsec-*) -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs + - cabal install + - cd .. + - (cd haddock-api/ && cabal install --only-dependencies --enable-tests && cabal configure --enable-tests --ghc-options=-Werror && cabal build && cabal test && cabal install) script: - # Yes, in case of HEAD we do end up building haddock-library twice - # but we want to see the test results. - - (cd haddock-library/ && cabal configure --enable-tests --ghc-options=-Werror - && cabal build && cabal test && cabal install && cabal install doctest - && doctest -isrc -ivendor/attoparsec-0.10.4.0 -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs) - - case "$GHCVER" in - "head") (cabal configure --enable-tests --ghc-options=-Werror && cabal build && cabal test) ;; - *) ;; - esac + - cabal configure --enable-tests --ghc-options=-Werror && cabal build && cabal test diff --git a/ANNOUNCE b/ANNOUNCE deleted file mode 100644 index 8069437f..00000000 --- a/ANNOUNCE +++ /dev/null @@ -1,60 +0,0 @@ --------------------------------------------- --- Haddock 2.13.1 --------------------------------------------- - -A new versions of Haddock has been uploaded to Hackage. - --------------------------------------------- --- Changes in version 2.13.1 --------------------------------------------- - - * Hide instances that are "internal" to a module - - * Add support for properties in documentation - - * Fix a bug with spurious superclass constraints - - * Fix and extend the Haddock API - --------------------------------------------- --- Links --------------------------------------------- - -Homepage: - http://www.haskell.org/haddock - -Hackage page: - http://hackage.haskell.org/package/haddock - -Bugtracker and wiki: - http://trac.haskell.org/haddock - -Mailing list: - haddock@projects.haskell.org - -Code repository: - http://darcs.haskell.org/haddock.git - --------------------------------------------- --- Contributors --------------------------------------------- - -The following people contributed patches to this release: - -Kazu Yamamoto -Roman Cheplyaka -David Waern -Simon Hengel - --------------------------------------------- --- Get Involved --------------------------------------------- - -We would be very happy to get more contributors. To get involved, start by -grabbing the code: - - http://darcs.haskell.org/haddock.git - -Then take a look at the bug and feature tracker for things to work on: - - http://trac.haskell.org/haddock @@ -1,3 +1,31 @@ +Changes in version 2.16.0 + + * Experimental collapsible header support (#335) + + * Add support for markdown links and images + + * Allow an optional colon after the closing bracket of definition lists. + This is to disambiguate them from markdown links and will be require with a + future release. + + * Fix re-exports of built-in type families (#310) + + * Fix parsing of infix identifiers such as ``elem``. + + * Print missing docs by default and add --no-print-missing-docs + + * parser: now parses out some meta data too, breaking the API + + * parser: markdown syntax for images and URLs is now accepted: + <<foo>> style for images and <foo bar> style for links is now + considered deprecated. <foo> for links is still OK. + + * parser: add support for @since element: this is paragraph-level + element of the form ‘@since x.y.z’ where x.y.z is the version + number. The way it is rendered is subject to change. + + * properly render package ID (not package key) in index (#329) + Changes in version 2.15.0 * Always read in prologue files as UTF8 (#286 and Cabal #1721) @@ -6,6 +34,28 @@ Changes in version 2.15.0 * parser: don't mangle append order for nested lists (pandoc #1346) + * parser: preserve list ordering in certain scenarios (#313) + + * parser: update the attoparsec version used internally giving slight + parsing performance boost. + + * Move development to be against latest GHC release and not GHC HEAD. + + * Further split up the package to separate the executable from the + library, necessary by things like GHCJS. We now have + ‘haddock-library’ which are the parts that don't use GHC API, + ‘haddock-api’ which are (some of) the parts that do use GHC API and + ‘haddock’ which merely provides the executable. + + * Export few extra functions in the API. + + * Add compatibility with GHC 7.8.2. + + * Omit unnecessary ‘forall’s (#315 and #86) + + * Remove some files which were really old or did not belong in the + repository in the first place. + Changes in version 2.14.3 * Fix parsing of identifiers with ^ or ⋆ in them (#298) diff --git a/CONTRIBUTING b/CONTRIBUTING new file mode 100644 index 00000000..45f74789 --- /dev/null +++ b/CONTRIBUTING @@ -0,0 +1,17 @@ +If you're filing an issue, here are the things which will help us a lot: + +* State your GHC version. + +* State your platform, OS and distribution if applicable. + +* State your cabal version if applicable. + +* Tell us how to replicate the problem. If we can't replicate it, we + can't fix it. + +* If the problem involves running Haddock on some source, please + include the sample on which we can replicate, the smaller/cleaner + the better. Include some images if you think it will help us. + +* Include any other info you think might be relevant (sandbox? unusual + setup?). @@ -5,11 +5,11 @@ modification, are permitted provided that the following conditions are met: - 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 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 diff --git a/doc/haddock.xml b/doc/haddock.xml index 39a947ca..2ffd7d78 100644 --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -1,6 +1,14 @@ <?xml version="1.0" encoding="iso-8859-1"?> <!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN" - "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd"> + "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [ + <!ENTITY nbsp ' '> + <!ENTITY frac12 '½'> + <!ENTITY mdash '—'> + <!ENTITY lsquo '’'> + <!ENTITY rsquo '‚'> + <!ENTITY ldquo '“'> + <!ENTITY rdquo '”'> +] > <book id="haddock"> <bookinfo> @@ -21,7 +29,7 @@ <holder>Simon Marlow, David Waern</holder> </copyright> <abstract> - <para>This document describes Haddock version 2.15.0, a Haskell + <para>This document describes Haddock version 2.15.1, a Haskell documentation tool.</para> </abstract> </bookinfo> @@ -1033,6 +1041,18 @@ $ pdflatex <replaceable>package</replaceable>.tex</screen> </para> </listitem> </varlistentry> + + <varlistentry> + <term> + <indexterm><primary><option>--print-missing-docs</option></primary></indexterm> + <option>--print-missing-docs</option> + </term> + <listitem> + <para> + Print extra information about any undocumented entities. + </para> + </listitem> + </varlistentry> </variablelist> <section id="cpp"> @@ -1877,7 +1897,9 @@ module A where <para>Nothing special is needed to hyperlink identifiers which contain apostrophes themselves: to hyperlink <literal>foo'</literal> one would simply type - <literal>'foo''</literal>.</para> + <literal>'foo''</literal>. To hyperlink identifiers written in + infix form, simply put them in quotes as always: + <literal>'`elem`'</literal>.</para> <para>For compatibility with other systems, the following alternative form of markup is accepted<footnote><para> @@ -2018,9 +2040,9 @@ This belongs to the list above! <programlisting> -- | This is a definition list: -- --- [@foo@] The description of @foo@. +-- [@foo@]: The description of @foo@. -- --- [@bar@] The description of @bar@. +-- [@bar@]: The description of @bar@. </programlisting> <para>To produce output something like this:</para> @@ -2041,13 +2063,8 @@ This belongs to the list above! </variablelist> <para>Each paragraph should be preceded by the - “definition term” enclosed in square brackets. - The square bracket characters have no special meaning outside - the beginning of a definition paragraph. That is, if a - paragraph begins with a <literal>[</literal> character, then - it is assumed to be a definition paragraph, and the next - <literal>]</literal> character found will close the definition - term. Other markup operators may be used freely within the + “definition term” enclosed in square brackets and followed by a colon. + Other markup operators may be used freely within the definition term. You can escape <literal>]</literal> with a backslash as usual.</para> <para>Same rules about nesting and no newline separation as for bulleted and numbered lists apply. @@ -2058,37 +2075,60 @@ This belongs to the list above! <section> <title>URLs</title> - <para>A URL can be included in a documentation comment by - surrounding it in angle brackets: - <literal><...></literal>. If the output format supports - it, the URL will be turned into a hyperlink when - rendered.</para> + <para> + A URL can be included in a documentation comment by surrounding it in + angle brackets, for example: + </para> - <para>The URL can be followed by an optional label:</para> <programlisting> -<http://example.com label> +<http://example.com> </programlisting> - <para>The label is then used as a descriptive text for the hyperlink, if the - output format supports it.</para> - <para>If Haddock sees something that looks like a URL (such as something starting with - <literal>http://</literal> or <literal>ssh://</literal>) where the URL markup is valid, - it will automatically make it a hyperlink.</para> + <para> + If the output format supports it, the URL will be turned into a + hyperlink when rendered. + </para> + + <para>If Haddock sees something that looks like a URL (such as something starting with + <literal>http://</literal> or <literal>ssh://</literal>) where the URL markup is valid, + it will automatically make it a hyperlink.</para> </section> <section> - <title>Images</title> + <title>Links</title> - <para>An image can be included in a documentation comment by - surrounding it in double angle brackets: - <literal><<...>></literal>. If the output format supports - it, the image will be rendered inside the documentation.</para> + <para> + Haddock supports Markdown syntax for inline links. A link consists + of a link text and a URL. The link text is enclosed in square + brackets and followed by the URL enclosed in regular parentheses, for + example: + </para> - <para>Title text can be included using an optional label:</para> <programlisting> -<<pathtoimage.png title>> +[some link](http://example.com) </programlisting> + <para> + The link text is used as a descriptive text for the URL, if the + output format supports it. + </para> + </section> + <section> + <title>Images</title> + <para> + Haddock supports Markdown syntax for inline images. This resembles + the syntax for links, but starts with an exclamation mark. An + example looks like this: + </para> + +<programlisting> + +</programlisting> + <para> + If the output format supports it, the image will be rendered inside + the documentation. The image description is used as relpacement text + and/or image title. + </para> </section> <section> @@ -2123,7 +2163,7 @@ This belongs to the list above! <programlisting> -- | --- = Heading level 1 with some __bold__ +-- = Heading level 1 with some /emphasis/ -- Something underneath the heading. -- -- == /Subheading/ @@ -2149,6 +2189,59 @@ This belongs to the list above! -- >>> examples are only allowed at the start of paragraphs </programlisting> + <para>As of 2.15.1, there's experimental (read: subject to + change or get removed) support for collapsible headers: simply + wrap your existing header title in underscores, as per bold + syntax. The collapsible section will stretch until the end of + the comment or until a header of equal or smaller number of + <literal>=</literal>s.</para> + +<programlisting> +-- | +-- === __Examples:__ +-- >>> Some very long list of examples +-- +-- ==== This still falls under the collapse +-- Some specialised examples +-- +-- === This is does not go into the collapsable section. +-- More content. +</programlisting> + + </section> + + <section> + <title>Metadata</title> + <para>Since Haddock 2.16.0, some support for embedding + metadata in the comments has started to appear. The use of + such data aims to standardise various community conventions in + how such information is conveyed and to provide uniform + rendering. + </para> + + <section> + <title>Since</title> + <para><literal>@since</literal> annotation can be used to + convey information about when the function was introduced or + when it has changed in the way significant to the user. + <literal>@since</literal> is a paragraph-level element. + While multiple such annotations are not an error, only the + one to appear in the comment last will be used. + <literal>@since</literal> has to be followed with a version + number, no further description is currently allowed. The + meaning of this feature is subject to change in the future + per user feedback. + </para> + +<programlisting> +-- | +-- Some comment +-- +-- @since 1.2.3 +</programlisting> + + </section> + </section> </section> @@ -26,16 +26,29 @@ $(INPLACE_BIN)/$(utils/haddock_dist_PROG): $(INPLACE_LIB)/html $(INPLACE_LIB)/la $(INPLACE_LIB)/html: $(call removeTrees,$@) - "$(CP)" -RL utils/haddock/resources/html $@ + "$(CP)" -RL utils/haddock/haddock-api/resources/html $@ $(INPLACE_LIB)/latex: $(call removeTrees,$@) - "$(CP)" -RL utils/haddock/resources/latex $@ + "$(CP)" -RL utils/haddock/haddock-api/resources/latex $@ endif utils/haddock_dist_MODULES += Paths_haddock +utils/haddock_dist_DATA_FILES += html/frames.html +utils/haddock_dist_DATA_FILES += html/haddock-util.js +utils/haddock_dist_DATA_FILES += html/Classic.theme/haskell_icon.gif +utils/haddock_dist_DATA_FILES += html/Classic.theme/minus.gif +utils/haddock_dist_DATA_FILES += html/Classic.theme/plus.gif +utils/haddock_dist_DATA_FILES += html/Classic.theme/xhaddock.css +utils/haddock_dist_DATA_FILES += html/Ocean.std-theme/hslogo-16.png +utils/haddock_dist_DATA_FILES += html/Ocean.std-theme/minus.gif +utils/haddock_dist_DATA_FILES += html/Ocean.std-theme/ocean.css +utils/haddock_dist_DATA_FILES += html/Ocean.std-theme/plus.gif +utils/haddock_dist_DATA_FILES += html/Ocean.std-theme/synopsis.png +utils/haddock_dist_DATA_FILES += latex/haddock.sty + ifeq "$(HADDOCK_DOCS)" "YES" install: install_utils/haddock_data ifeq "$(Windows_Host)" "NO" @@ -48,12 +61,11 @@ install_utils/haddock_data: $(foreach i,$(sort $(dir $(utils/haddock_dist_DATA_FILES))), \ $(call make-command,$(call INSTALL_DIR,"$(DESTDIR)$(ghclibdir)/$i"))) $(foreach i,$(utils/haddock_dist_DATA_FILES), \ - $(call make-command,$(call INSTALL_DATA,$(INSTALL_OPTS),utils/haddock/resources/$i,"$(DESTDIR)$(ghclibdir)/$(dir $i)"))) + $(call make-command,$(call INSTALL_DATA,$(INSTALL_OPTS),utils/haddock/haddock-api/resources/$i,"$(DESTDIR)$(ghclibdir)/$(dir $i)"))) .PHONY: install_utils/haddock_link install_utils/haddock_link: $(call removeFiles,"$(DESTDIR)$(bindir)/haddock") $(LN_S) $(utils/haddock_dist_INSTALL_SHELL_WRAPPER_NAME) "$(DESTDIR)$(bindir)/haddock" -BINDIST_EXTRAS += $(addprefix utils/haddock/resources/,$(utils/haddock_dist_DATA_FILES)) - +BINDIST_EXTRAS += $(addprefix utils/haddock/haddock-api/resources/,$(utils/haddock_dist_DATA_FILES)) diff --git a/haddock-api/.ghci b/haddock-api/.ghci new file mode 100644 index 00000000..62e7c5d2 --- /dev/null +++ b/haddock-api/.ghci @@ -0,0 +1 @@ +:set -isrc -idist/build -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h diff --git a/haddock-api/LICENSE b/haddock-api/LICENSE new file mode 100644 index 00000000..460decfc --- /dev/null +++ b/haddock-api/LICENSE @@ -0,0 +1,23 @@ +Copyright 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: + +- 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 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. diff --git a/haddock-api/Setup.lhs b/haddock-api/Setup.lhs new file mode 100755 index 00000000..5bde0de9 --- /dev/null +++ b/haddock-api/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal new file mode 100644 index 00000000..b2199c68 --- /dev/null +++ b/haddock-api/haddock-api.cabal @@ -0,0 +1,94 @@ +name: haddock-api +version: 2.16.0 +synopsis: A documentation-generation tool for Haskell libraries +description: Haddock is a documentation-generation tool for Haskell + libraries +license: BSD3 +license-file: LICENSE +author: Simon Marlow, David Waern +maintainer: Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> +homepage: http://www.haskell.org/haddock/ +bug-reports: https://github.com/haskell/haddock/issues +copyright: (c) Simon Marlow, David Waern +category: Documentation +build-type: Simple +cabal-version: >= 1.10 +stability: experimental + +data-dir: + resources +data-files: + html/frames.html + html/haddock-util.js + html/Classic.theme/haskell_icon.gif + html/Classic.theme/minus.gif + html/Classic.theme/plus.gif + html/Classic.theme/xhaddock.css + html/Ocean.std-theme/hslogo-16.png + html/Ocean.std-theme/minus.gif + html/Ocean.std-theme/ocean.css + html/Ocean.std-theme/plus.gif + html/Ocean.std-theme/synopsis.png + latex/haddock.sty + +library + default-language: + Haskell2010 + + build-depends: + base >= 4.3 && < 4.9 + , bytestring + , filepath + , directory + , containers + , deepseq + , array + , xhtml >= 3000.2 && < 3000.3 + , Cabal >= 1.10 + , ghc == 7.9.* + + , ghc-paths + , haddock-library == 1.2.0.* + + hs-source-dirs: + src + + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 + + exposed-modules: + Documentation.Haddock + + other-modules: + Haddock + Haddock.Interface + Haddock.Interface.Rename + Haddock.Interface.Create + Haddock.Interface.AttachInstances + Haddock.Interface.LexParseRn + Haddock.Interface.ParseModuleHeader + Haddock.Parser + Haddock.Utils + Haddock.Backends.Xhtml + Haddock.Backends.Xhtml.Decl + Haddock.Backends.Xhtml.DocMarkup + Haddock.Backends.Xhtml.Layout + Haddock.Backends.Xhtml.Names + Haddock.Backends.Xhtml.Themes + Haddock.Backends.Xhtml.Types + Haddock.Backends.Xhtml.Utils + Haddock.Backends.LaTeX + Haddock.Backends.HaddockDB + Haddock.Backends.Hoogle + Haddock.ModuleTree + Haddock.Types + Haddock.Doc + Haddock.Version + Haddock.InterfaceFile + Haddock.Options + Haddock.GhcUtils + Haddock.Convert + Paths_haddock_api + +source-repository head + type: git + location: https://github.com/haskell/haddock.git diff --git a/resources/html/Classic.theme/haskell_icon.gif b/haddock-api/resources/html/Classic.theme/haskell_icon.gif Binary files differindex 10589f91..10589f91 100644 --- a/resources/html/Classic.theme/haskell_icon.gif +++ b/haddock-api/resources/html/Classic.theme/haskell_icon.gif diff --git a/resources/html/Classic.theme/minus.gif b/haddock-api/resources/html/Classic.theme/minus.gif Binary files differindex 1deac2fe..1deac2fe 100644 --- a/resources/html/Classic.theme/minus.gif +++ b/haddock-api/resources/html/Classic.theme/minus.gif diff --git a/resources/html/Classic.theme/plus.gif b/haddock-api/resources/html/Classic.theme/plus.gif Binary files differindex 2d15c141..2d15c141 100644 --- a/resources/html/Classic.theme/plus.gif +++ b/haddock-api/resources/html/Classic.theme/plus.gif diff --git a/resources/html/Classic.theme/xhaddock.css b/haddock-api/resources/html/Classic.theme/xhaddock.css index ed231b5a..ed231b5a 100644 --- a/resources/html/Classic.theme/xhaddock.css +++ b/haddock-api/resources/html/Classic.theme/xhaddock.css diff --git a/resources/html/Ocean.std-theme/hslogo-16.png b/haddock-api/resources/html/Ocean.std-theme/hslogo-16.png Binary files differindex 0ff8579f..0ff8579f 100644 --- a/resources/html/Ocean.std-theme/hslogo-16.png +++ b/haddock-api/resources/html/Ocean.std-theme/hslogo-16.png diff --git a/resources/html/Ocean.std-theme/minus.gif b/haddock-api/resources/html/Ocean.std-theme/minus.gif Binary files differindex 1deac2fe..1deac2fe 100644 --- a/resources/html/Ocean.std-theme/minus.gif +++ b/haddock-api/resources/html/Ocean.std-theme/minus.gif diff --git a/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index de436324..de436324 100644 --- a/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css diff --git a/resources/html/Ocean.std-theme/plus.gif b/haddock-api/resources/html/Ocean.std-theme/plus.gif Binary files differindex 2d15c141..2d15c141 100644 --- a/resources/html/Ocean.std-theme/plus.gif +++ b/haddock-api/resources/html/Ocean.std-theme/plus.gif diff --git a/resources/html/Ocean.std-theme/synopsis.png b/haddock-api/resources/html/Ocean.std-theme/synopsis.png Binary files differindex 85fb86ec..85fb86ec 100644 --- a/resources/html/Ocean.std-theme/synopsis.png +++ b/haddock-api/resources/html/Ocean.std-theme/synopsis.png diff --git a/resources/html/frames.html b/haddock-api/resources/html/frames.html index 1b4e38d4..1b4e38d4 100644 --- a/resources/html/frames.html +++ b/haddock-api/resources/html/frames.html diff --git a/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js index 9a6fccf7..9a6fccf7 100644 --- a/resources/html/haddock-util.js +++ b/haddock-api/resources/html/haddock-util.js diff --git a/resources/latex/haddock.sty b/haddock-api/resources/latex/haddock.sty index 6e031a98..6e031a98 100644 --- a/resources/latex/haddock.sty +++ b/haddock-api/resources/latex/haddock.sty diff --git a/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs index 655a9723..1ff5cf75 100644 --- a/src/Documentation/Haddock.hs +++ b/haddock-api/src/Documentation/Haddock.hs @@ -57,8 +57,14 @@ module Documentation.Haddock ( Flag(..), DocOption(..), + -- * Error handling + HaddockException(..), + -- * Program entry point haddock, + haddockWithGhc, + getGhcDirs, + withGhc ) where @@ -79,5 +85,5 @@ createInterfaces -> [String] -- ^ File or module names -> IO [Interface] -- ^ Resulting list of interfaces createInterfaces flags modules = do - (_, ifaces, _) <- withGhc' flags (readPackagesAndProcessModules flags modules) + (_, ifaces, _) <- withGhc flags (readPackagesAndProcessModules flags modules) return ifaces diff --git a/src/Haddock.hs b/haddock-api/src/Haddock.hs index c0a6714b..915ad47a 100644 --- a/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wwarn #-} -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables, Rank2Types #-} {-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | @@ -17,8 +17,13 @@ -- -- Program entry point and top-level code. ----------------------------------------------------------------------------- -module Haddock (haddock, readPackagesAndProcessModules, withGhc') where - +module Haddock ( + haddock, + haddockWithGhc, + getGhcDirs, + readPackagesAndProcessModules, + withGhc +) where import Haddock.Backends.Xhtml import Haddock.Backends.Xhtml.Themes (getThemes) @@ -53,12 +58,13 @@ import Data.Int import System.FilePath #else import qualified GHC.Paths as GhcPaths -import Paths_haddock +import Paths_haddock_api (getDataDir) +import System.Directory (doesDirectoryExist) #endif import GHC hiding (verbosity) import Config -import DynFlags hiding (verbosity) +import DynFlags hiding (projectVersion, verbosity) import StaticFlags (discardStaticFlags) import Panic (handleGhcException) import Module @@ -130,7 +136,10 @@ handleGhcExceptions = -- -- > main = getArgs >>= haddock haddock :: [String] -> IO () -haddock args = handleTopExceptions $ do +haddock args = haddockWithGhc withGhc args + +haddockWithGhc :: (forall a. [Flag] -> Ghc a -> IO a) -> [String] -> IO () +haddockWithGhc ghc args = handleTopExceptions $ do -- Parse command-line flags and handle some of them initially. -- TODO: unify all of this (and some of what's in the 'render' function), @@ -141,7 +150,7 @@ haddock args = handleTopExceptions $ do qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q} -- inject dynamic-too into flags before we proceed - flags' <- withGhc' flags $ do + flags' <- ghc flags $ do df <- getDynFlags case lookup "GHC Dynamic" (compilerInfo df) of Just "YES" -> return $ Flag_OptGhc "-dynamic-too" : flags @@ -151,7 +160,7 @@ haddock args = handleTopExceptions $ do forM_ (warnings args) $ \warning -> do hPutStrLn stderr warning - withGhc' flags' $ do + ghc flags' $ do dflags <- getDynFlags @@ -185,8 +194,8 @@ warnings = map format . filter (isPrefixOf "-optghc") format arg = concat ["Warning: `", arg, "' means `-o ", drop 2 arg, "', did you mean `-", arg, "'?"] -withGhc' :: [Flag] -> Ghc a -> IO a -withGhc' flags action = do +withGhc :: [Flag] -> Ghc a -> IO a +withGhc flags action = do libDir <- fmap snd (getGhcDirs flags) -- Catches all GHC source errors, then prints and re-throws them. @@ -194,7 +203,7 @@ withGhc' flags action = do printException err liftIO exitFailure - withGhc libDir (ghcFlags flags) (\_ -> handleSrcErrors action) + withGhc' libDir (ghcFlags flags) (\_ -> handleSrcErrors action) readPackagesAndProcessModules :: [Flag] -> [String] @@ -276,15 +285,18 @@ render dflags flags qual ifaces installedIfaces srcMap = do pretty copyHtmlBits odir libDir themes + -- TODO: we throw away Meta for both Hoogle and LaTeX right now, + -- might want to fix that if/when these two get some work on them when (Flag_Hoogle `elem` flags) $ do let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title | otherwise = unpackFS pkgNameFS where PackageName pkgNameFS = pkgName - ppHoogle dflags pkgNameStr pkgVer title prologue visibleIfaces odir + ppHoogle dflags pkgNameStr pkgVer title (fmap _doc prologue) visibleIfaces + odir when (Flag_LaTeX `elem` flags) $ do - ppLaTeX title pkgStr visibleIfaces odir prologue opt_latex_style + ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style libDir ------------------------------------------------------------------------------- @@ -317,8 +329,8 @@ readInterfaceFiles name_cache_accessor pairs = do -- | Start a GHC session with the -haddock flag set. Also turn off -- compilation and linking. Then run the given 'Ghc' action. -withGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a -withGhc libDir flags ghcActs = runGhc (Just libDir) $ do +withGhc' :: String -> [String] -> (DynFlags -> Ghc a) -> IO a +withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do dynflags <- getSessionDynFlags dynflags' <- parseGhcFlags (gopt_set dynflags Opt_Haddock) { hscTarget = HscNothing, @@ -444,7 +456,7 @@ updateHTMLXRefs packages = do mapping' = [ (moduleName m, html) | (m, html) <- mapping ] -getPrologue :: DynFlags -> [Flag] -> IO (Maybe (Doc RdrName)) +getPrologue :: DynFlags -> [Flag] -> IO (Maybe (MDoc RdrName)) getPrologue dflags flags = case [filename | Flag_Prologue filename <- flags ] of [] -> return Nothing diff --git a/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs index 1c248bfb..1c248bfb 100644 --- a/src/Haddock/Backends/HaddockDB.hs +++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs diff --git a/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 1df6d9b1..dd10bb0a 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -17,7 +17,7 @@ module Haddock.Backends.Hoogle ( import Haddock.GhcUtils -import Haddock.Types +import Haddock.Types hiding (Version) import Haddock.Utils hiding (out) import GHC import Outputable @@ -210,18 +210,20 @@ ppCtor dflags dat subdocs con -- DOCUMENTATION ppDocumentation :: Outputable o => DynFlags -> Documentation o -> [String] -ppDocumentation dflags (Documentation d w) = doc dflags d ++ doc dflags w +ppDocumentation dflags (Documentation d w) = mdoc dflags d ++ doc dflags w doc :: Outputable o => DynFlags -> Maybe (Doc o) -> [String] doc dflags = docWith dflags "" +mdoc :: Outputable o => DynFlags -> Maybe (MDoc o) -> [String] +mdoc dflags = docWith dflags "" . fmap _doc docWith :: Outputable o => DynFlags -> String -> Maybe (Doc o) -> [String] docWith _ [] Nothing = [] docWith dflags header d = ("":) $ zipWith (++) ("-- | " : repeat "-- ") $ - [header | header /= ""] ++ ["" | header /= "" && isJust d] ++ + lines header ++ ["" | header /= "" && isJust d] ++ maybe [] (showTags . markup (markupTag dflags)) d diff --git a/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 801f3138..b717fc01 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -235,7 +235,7 @@ processExport (ExportNoDecl y subs) processExport (ExportModule mdl) = declWithDoc (text "module" <+> text (moduleString mdl)) Nothing processExport (ExportDoc doc) - = docToLaTeX doc + = docToLaTeX $ _doc doc ppDocGroup :: Int -> LaTeX -> LaTeX @@ -390,7 +390,7 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0) where do_largs n leader (L _ t) = do_args n leader t - arg_doc n = rDoc (Map.lookup n argDocs) + arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs do_args :: Int -> LaTeX -> (HsType DocName) -> LaTeX do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype) @@ -552,7 +552,7 @@ isUndocdInstance _ = Nothing -- style. ppDocInstance :: Bool -> DocInstance DocName -> LaTeX ppDocInstance unicode (instHead, doc) = - declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX doc) + declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc) ppInstDecl :: Bool -> InstHead DocName -> LaTeX @@ -680,7 +680,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = mbDoc = case con_names con of [] -> panic "empty con_names" (cn:_) -> lookup (unLoc cn) subdocs >>= - combineDocumentation . fst + fmap _doc . combineDocumentation . fst mkFunTy a b = noLoc (HsFunTy a b) @@ -691,7 +691,7 @@ ppSideBySideField subdocs unicode (ConDeclField names ltype _) = where -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation - mbDoc = lookup (unL $ head names) subdocs >>= combineDocumentation . fst + mbDoc = lookup (unL $ head names) subdocs >>= fmap _doc . combineDocumentation . fst -- {- -- ppHsFullConstr :: HsConDecl -> LaTeX @@ -1119,7 +1119,7 @@ docToLaTeX doc = markup latexMarkup doc Plain documentationToLaTeX :: Documentation DocName -> Maybe LaTeX -documentationToLaTeX = fmap docToLaTeX . combineDocumentation +documentationToLaTeX = fmap docToLaTeX . fmap _doc . combineDocumentation rdrDocToLaTeX :: Doc RdrName -> LaTeX diff --git a/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 49f835c8..65a7e6c4 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -35,9 +35,6 @@ import Text.XHtml hiding ( name, title, p, quote ) import Haddock.GhcUtils import Control.Monad ( when, unless ) -#if !MIN_VERSION_base(4,7,0) -import Control.Monad.Instances ( ) -- for Functor Either a -#endif import Data.Char ( toUpper ) import Data.Functor ( (<$>) ) import Data.List ( sortBy, groupBy, intercalate, isPrefixOf ) @@ -65,7 +62,7 @@ ppHtml :: DynFlags -> Maybe String -- ^ Package -> [Interface] -> FilePath -- ^ Destination directory - -> Maybe (Doc GHC.RdrName) -- ^ Prologue text, maybe + -> Maybe (MDoc GHC.RdrName) -- ^ Prologue text, maybe -> Themes -- ^ Themes -> SourceURLs -- ^ The source URL (--source) -> WikiURLs -- ^ The wiki URL (--wiki) @@ -248,7 +245,7 @@ ppHtmlContents -> Maybe String -> SourceURLs -> WikiURLs - -> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName) + -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName) -> Bool -> Qualification -- ^ How to qualify names -> IO () @@ -272,7 +269,7 @@ ppHtmlContents dflags odir doctitle _maybe_package ppHtmlContentsFrame odir doctitle themes ifaces debug -ppPrologue :: Qualification -> String -> Maybe (Doc GHC.RdrName) -> Html +ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html ppPrologue _ _ Nothing = noHtml ppPrologue qual title (Just doc) = divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc)) @@ -591,7 +588,7 @@ processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0 map (ppNameMini Prefix mdl . nameOccName . getName . unLoc) lnames _ -> [] processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) = - [groupTag lvl << docToHtml Nothing qual txt] + [groupTag lvl << docToHtml Nothing qual (mkMeta txt)] processForMiniSynopsis _ _ _ _ = [] @@ -626,7 +623,7 @@ ppModuleContents qual exports | otherwise = ( html:secs, rest2 ) where html = linkedAnchor (groupId id0) - << docToHtmlNoAnchors (Just id0) qual doc +++ mk_subsections ssecs + << docToHtmlNoAnchors (Just id0) qual (mkMeta doc) +++ mk_subsections ssecs (ssecs, rest1) = process lev rest (secs, rest2) = process n rest1 process n (_ : rest) = process n rest @@ -650,7 +647,7 @@ processExport :: Bool -> LinksInfo -> Bool -> Qualification -> ExportItem DocName -> Maybe Html processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances processExport summary _ _ qual (ExportGroup lev id0 doc) - = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) qual doc + = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) qual (mkMeta doc) processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities splice) = processDecl summary $ ppDecl summary links decl doc insts fixities subdocs splice unicode qual processExport summary _ _ qual (ExportNoDecl y []) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 85e00e91..3bf4322d 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -132,27 +132,26 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) do_largs n leader (L _ t) = do_args n leader t do_args :: Int -> Html -> HsType DocName -> [SubDecl] - do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype) - = (leader <+> - hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+> - ppLContextNoArrow lctxt unicode qual, - Nothing, []) - : do_largs n (darrow unicode) ltype - do_args n leader (HsForAllTy Implicit _ _ lctxt ltype) - | not (null (unLoc lctxt)) - = (leader <+> ppLContextNoArrow lctxt unicode qual, - Nothing, []) - : do_largs n (darrow unicode) ltype - -- if we're not showing any 'forall' or class constraints or - -- anything, skip having an empty line for the context. - | otherwise - = do_largs n leader ltype + do_args n leader (HsForAllTy _ _ tvs lctxt ltype) + = case unLoc lctxt of + [] -> do_largs n leader' ltype + _ -> (leader' <+> ppLContextNoArrow lctxt unicode qual, Nothing, []) + : do_largs n (darrow unicode) ltype + where leader' = leader <+> ppForAll tvs unicode qual do_args n leader (HsFunTy lt r) = (leader <+> ppLFunLhType unicode qual lt, argDoc n, []) : do_largs (n+1) (arrow unicode) r do_args n leader t = [(leader <+> ppType unicode qual t, argDoc n, [])] +ppForAll :: LHsTyVarBndrs DocName -> Unicode -> Qualification -> Html +ppForAll tvs unicode qual = + case [ppKTv n k | L _ (KindedTyVar n k) <- hsQTvBndrs tvs] of + [] -> noHtml + ts -> forallSymbol unicode <+> hsep ts +++ dot + where ppKTv n k = parens $ + ppTyName (getName n) <+> dcolon unicode <+> ppLKind unicode qual k + ppFixities :: [(DocName, Fixity)] -> Qualification -> Html ppFixities [] _ = noHtml ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge @@ -619,7 +618,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of -- (except each field gets its own line in docs, to match -- non-GADT records) RecCon fields -> (ppOcc <+> dcolon unicode <+> - ppForAll forall_ ltvs lcontext unicode qual <+> char '{', + ppForAllCon forall_ ltvs lcontext unicode qual <+> char '{', doRecordFields fields, char '}' <+> arrow unicode <+> ppLType unicode qual resTy) InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml) @@ -627,7 +626,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of where doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) (map unLoc fields)) doGADTCon args resTy = ppOcc <+> dcolon unicode <+> hsep [ - ppForAll forall_ ltvs lcontext unicode qual, + ppForAllCon forall_ ltvs lcontext unicode qual, ppLType unicode qual (foldr mkFunTy resTy args) ] header_ = ppConstrHdr forall_ tyVars context @@ -698,7 +697,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field (map (ppSideBySideField subdocs unicode qual) (map unLoc fields)) doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html doGADTCon args resTy = ppOcc <+> dcolon unicode - <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual, + <+> hsep [ppForAllCon forall_ ltvs (con_cxt con) unicode qual, ppLType unicode qual (foldr mkFunTy resTy args) ] <+> fixity @@ -827,10 +826,10 @@ ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell -ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName +ppForAllCon :: HsExplicitFlag -> LHsTyVarBndrs DocName -> Located (HsContext DocName) -> Unicode -> Qualification -> Html -ppForAll expl tvs cxt unicode qual - = forall_part <+> ppLContext cxt unicode qual +ppForAllCon expl tvs cxt unicode qual = + forall_part <+> ppLContext cxt unicode qual where forall_part = ppLTyVarBndrs expl tvs unicode qual @@ -851,8 +850,8 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual - = maybeParen ctxt_prec pREC_FUN $ - hsep [ppForAll expl tvs ctxt' unicode qual, ppr_mono_lty pREC_TOP ty unicode qual] + = maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt' unicode qual + <+> ppr_mono_lty pREC_TOP ty unicode qual where ctxt' = case extra of Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt Nothing -> ctxt diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index a1f56adf..96d734eb 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -21,11 +21,13 @@ module Haddock.Backends.Xhtml.DocMarkup ( import Control.Applicative ((<$>)) +import Data.List import Haddock.Backends.Xhtml.Names import Haddock.Backends.Xhtml.Utils import Haddock.Types import Haddock.Utils -import Haddock.Doc (combineDocumentation) +import Haddock.Doc (combineDocumentation, emptyMetaDoc, + metaDocAppend, metaConcat) import Text.XHtml hiding ( name, p, quote ) import Data.Maybe (fromMaybe) @@ -93,8 +95,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup { -- from changing if it is possible to recover the layout information -- we won't need after the fact. data Hack a id = - UntouchedDoc (DocH a id) - | CollapsingHeader (Header (DocH a id)) (DocH a id) Int (Maybe String) + UntouchedDoc (MetaDoc a id) + | CollapsingHeader (Header (DocH a id)) (MetaDoc a id) Int (Maybe String) | HackAppend (Hack a id) (Hack a id) deriving Eq @@ -110,15 +112,15 @@ toHack :: Int -- ^ Counter for header IDs which serves to assign -- this should work more or less fine: it is in fact the -- implicit assumption the collapse/expand mechanism makes for -- things like ‘Instances’ boxes. - -> [DocH a id] -> Hack a id -toHack _ _ [] = UntouchedDoc DocEmpty + -> [MetaDoc a id] -> Hack a id +toHack _ _ [] = UntouchedDoc emptyMetaDoc toHack _ _ [x] = UntouchedDoc x -toHack n nm (DocHeader (Header l (DocBold x)):xs) = +toHack n nm (MetaDoc { _doc = DocHeader (Header l (DocBold x)) }:xs) = let -- Header with dropped bold h = Header l x -- Predicate for takeWhile, grab everything including ‘smaller’ -- headers - p (DocHeader (Header l' _)) = l' > l + p (MetaDoc { _doc = DocHeader (Header l' _) }) = l' > l p _ = True -- Stuff ‘under’ this header r = takeWhile p xs @@ -128,16 +130,18 @@ toHack n nm (DocHeader (Header l (DocBold x)):xs) = app y ys = HackAppend y (toHack (n + 1) nm ys) in case r of -- No content under this header - [] -> CollapsingHeader h DocEmpty n nm `app` r' + [] -> CollapsingHeader h emptyMetaDoc n nm `app` r' -- We got something out, stitch it back together into one chunk - y:ys -> CollapsingHeader h (foldl DocAppend y ys) n nm `app` r' + y:ys -> CollapsingHeader h (foldl metaDocAppend y ys) n nm `app` r' toHack n nm (x:xs) = HackAppend (UntouchedDoc x) (toHack n nm xs) -- | Remove ‘top-level’ 'DocAppend's turning them into a flat list. -- This lends itself much better to processing things in order user -- might look at them, such as in 'toHack'. -flatten :: DocH a id -> [DocH a id] -flatten (DocAppend x y) = flatten x ++ flatten y +flatten :: MetaDoc a id -> [MetaDoc a id] +flatten MetaDoc { _meta = m, _doc = DocAppend x y } = + let f z = MetaDoc { _meta = m, _doc = z } + in flatten (f x) ++ flatten (f y) flatten x = [x] -- | Generate the markup needed for collapse to happen. For @@ -146,24 +150,40 @@ flatten x = [x] -- 'CollapsingHeader', we attach extra info to the generated 'Html' -- that allows us to expand/collapse the content. hackMarkup :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> Html -hackMarkup fmt h = case h of - UntouchedDoc d -> markup fmt d - CollapsingHeader (Header lvl titl) par n nm -> - let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n - col' = collapseControl id_ False "caption" - instTable = (thediv ! collapseSection id_ False [] <<) - lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6] - getHeader = fromMaybe caption (lookup lvl lvs) - subCation = getHeader ! col' << markup fmt titl - in (subCation +++) . instTable $ markup fmt par - HackAppend d d' -> markupAppend fmt (hackMarkup fmt d) (hackMarkup fmt d') +hackMarkup fmt' h' = + let (html, ms) = hackMarkup' fmt' h' + in html +++ renderMeta fmt' (metaConcat ms) + where + hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id + -> (Html, [Meta]) + hackMarkup' fmt h = case h of + UntouchedDoc d -> (markup fmt $ _doc d, [_meta d]) + CollapsingHeader (Header lvl titl) par n nm -> + let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n + col' = collapseControl id_ True "caption" + instTable = (thediv ! collapseSection id_ False [] <<) + lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6] + getHeader = fromMaybe caption (lookup lvl lvs) + subCaption = getHeader ! col' << markup fmt titl + in ((subCaption +++) . instTable $ markup fmt (_doc par), [_meta par]) + HackAppend d d' -> let (x, m) = hackMarkup' fmt d + (y, m') = hackMarkup' fmt d' + in (markupAppend fmt x y, m ++ m') + +renderMeta :: DocMarkup id Html -> Meta -> Html +renderMeta fmt (Meta { _version = Just x }) = + markupParagraph fmt . markupEmphasis fmt . toHtml $ + "Since: " ++ formatVersion x + where + formatVersion v = concat . intersperse "." $ map show v +renderMeta _ _ = noHtml -- | Goes through 'hackMarkup' to generate the 'Html' rather than -- skipping straight to 'markup': this allows us to employ XHtml --- specific hacks to the tree before first. +-- specific hacks to the tree first. markupHacked :: DocMarkup id Html -> Maybe String - -> Doc id + -> MDoc id -> Html markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten @@ -171,23 +191,23 @@ markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten -- ugly extra whitespace with some browsers). FIXME: Does this still apply? docToHtml :: Maybe String -- ^ Name of the thing this doc is for. See -- comments on 'toHack' for details. - -> Qualification -> Doc DocName -> Html + -> Qualification -> MDoc DocName -> Html docToHtml n qual = markupHacked fmt n . cleanup where fmt = parHtmlMarkup qual True (ppDocName qual Raw) -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element -- in links. This is used to generate the Contents box elements. docToHtmlNoAnchors :: Maybe String -- ^ See 'toHack' - -> Qualification -> Doc DocName -> Html + -> Qualification -> MDoc DocName -> Html docToHtmlNoAnchors n qual = markupHacked fmt n . cleanup where fmt = parHtmlMarkup qual False (ppDocName qual Raw) -origDocToHtml :: Qualification -> Doc Name -> Html +origDocToHtml :: Qualification -> MDoc Name -> Html origDocToHtml qual = markupHacked fmt Nothing . cleanup where fmt = parHtmlMarkup qual True (const $ ppName Raw) -rdrDocToHtml :: Qualification -> Doc RdrName -> Html +rdrDocToHtml :: Qualification -> MDoc RdrName -> Html rdrDocToHtml qual = markupHacked fmt Nothing . cleanup where fmt = parHtmlMarkup qual True (const ppRdrName) @@ -205,13 +225,13 @@ docSection n qual = maybe noHtml (docSection_ n qual) . combineDocumentation docSection_ :: Maybe Name -- ^ Name of the thing this doc is for - -> Qualification -> Doc DocName -> Html + -> Qualification -> MDoc DocName -> Html docSection_ n qual = (docElement thediv <<) . docToHtml (getOccString <$> n) qual -cleanup :: Doc a -> Doc a -cleanup = markup fmtUnParagraphLists +cleanup :: MDoc a -> MDoc a +cleanup = overDoc (markup fmtUnParagraphLists) where -- If there is a single paragraph, then surrounding it with <P>..</P> -- can add too much whitespace in some browsers (eg. IE). However if diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 64930ef9..b2c60534 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -115,7 +115,7 @@ divTopDecl :: Html -> Html divTopDecl = thediv ! [theclass "top"] -type SubDecl = (Html, Maybe (Doc DocName), [Html]) +type SubDecl = (Html, Maybe (MDoc DocName), [Html]) divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index cf12da40..cf12da40 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs diff --git a/src/Haddock/Backends/Xhtml/Themes.hs b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs index 79b093ec..79b093ec 100644 --- a/src/Haddock/Backends/Xhtml/Themes.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs diff --git a/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs index 3d1db887..3d1db887 100644 --- a/src/Haddock/Backends/Xhtml/Types.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index cbcbbd6d..cbcbbd6d 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs diff --git a/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index dd769c21..1b1a8a88 100644 --- a/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE CPP, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Haddock.Convert @@ -16,35 +16,37 @@ module Haddock.Convert where -- Some other functions turned out to be useful for converting -- instance heads, which aren't TyThings, so just export everything. - -import HsSyn -import TcType ( tcSplitSigmaTy ) -import TypeRep -import Type ( isStrLitTy, mkFunTys ) -import Kind ( splitKindFunTys, synTyConResKind, isKind ) -import Name -import Var +import Bag ( emptyBag ) +import BasicTypes ( TupleSort(..) ) import Class -import TyCon import CoAxiom import ConLike +import Data.Either (lefts, rights) +import Data.List( partition ) +import Data.Monoid (mempty) import DataCon -import PatSyn import FamInstEnv -import BasicTypes ( TupleSort(..) ) +import Haddock.Types +import HsSyn +import Kind ( splitKindFunTys, synTyConResKind, isKind ) +import Name +import PatSyn +import PrelNames (ipClassName) +import SrcLoc ( Located, noLoc, unLoc ) +import TcType ( tcSplitSigmaTy ) +import TyCon +import Type (isStrLitTy, mkFunTys) +import TypeRep import TysPrim ( alphaTyVars ) import TysWiredIn ( listTyConName, eqTyCon ) -import PrelNames (ipClassName) -import Bag ( emptyBag ) import Unique ( getUnique ) -import SrcLoc ( Located, noLoc, unLoc ) -import Data.List( partition ) -import Haddock.Types +import Var + -- the main function here! yay! -tyThingToLHsDecl :: TyThing -> LHsDecl Name -tyThingToLHsDecl t = noLoc $ case t of +tyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl Name)) +tyThingToLHsDecl t = case t of -- ids (functions and zero-argument a.k.a. CAFs) get a type signature. -- Including built-in functions like seq. -- foreign-imported functions could be represented with ForD @@ -53,20 +55,22 @@ tyThingToLHsDecl t = noLoc $ case t of -- in a future code version we could turn idVarDetails = foreign-call -- into a ForD instead of a SigD if we wanted. Haddock doesn't -- need to care. - AnId i -> SigD (synifyIdSig ImplicitizeForAll i) + AnId i -> allOK $ SigD (synifyIdSig ImplicitizeForAll i) -- type-constructors (e.g. Maybe) are complicated, put the definition -- later in the file (also it's used for class associated-types too.) ATyCon tc | Just cl <- tyConClass_maybe tc -- classes are just a little tedious - -> let extractFamilyDecl :: TyClDecl a -> LFamilyDecl a - extractFamilyDecl (FamDecl d) = noLoc d + -> let extractFamilyDecl :: TyClDecl a -> Either ErrMsg (LFamilyDecl a) + extractFamilyDecl (FamDecl d) = return $ noLoc d extractFamilyDecl _ = - error "tyThingToLHsDecl: impossible associated tycon" + Left "tyThingToLHsDecl: impossible associated tycon" atTyClDecls = [synifyTyCon Nothing at_tc | ATI at_tc _ <- classATItems cl] - atFamDecls = map extractFamilyDecl atTyClDecls in - TyClD $ ClassDecl + atFamDecls = map extractFamilyDecl (rights atTyClDecls) + tyClErrors = lefts atTyClDecls + famDeclErrors = lefts atFamDecls + in withErrs (tyClErrors ++ famDeclErrors) . TyClD $ ClassDecl { tcdCtxt = synifyCtx (classSCTheta cl) , tcdLName = synifyName cl , tcdTyVars = synifyTyVars (classTyVars cl) @@ -78,30 +82,33 @@ tyThingToLHsDecl t = noLoc $ case t of (classMethods cl) , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature -- class associated-types are a subset of TyCon: - , tcdATs = atFamDecls + , tcdATs = rights atFamDecls , tcdATDefs = [] --ignore associated type defaults , tcdDocs = [] --we don't have any docs at this point , tcdFVs = placeHolderNamesTc } | otherwise - -> TyClD (synifyTyCon Nothing tc) + -> synifyTyCon Nothing tc >>= allOK . TyClD -- type-constructors (e.g. Maybe) are complicated, put the definition -- later in the file (also it's used for class associated-types too.) - ACoAxiom ax -> synifyAxiom ax + ACoAxiom ax -> synifyAxiom ax >>= allOK -- a data-constructor alone just gets rendered as a function: - AConLike (RealDataCon dc) -> SigD (TypeSig [synifyName dc] + AConLike (RealDataCon dc) -> allOK $ SigD (TypeSig [synifyName dc] (synifyType ImplicitizeForAll (dataConUserType dc)) []) AConLike (PatSynCon ps) -> let (univ_tvs, ex_tvs, req_theta, prov_theta, arg_tys, res_ty) = patSynSig ps qtvs = univ_tvs ++ ex_tvs ty = mkFunTys arg_tys res_ty - in SigD $ PatSynSig (synifyName ps) + in allOK . SigD $ PatSynSig (synifyName ps) (Implicit, synifyTyVars qtvs) (synifyCtx req_theta) (synifyCtx prov_theta) (synifyType WithinType ty) + where + withErrs e x = return (e, x) + allOK x = return (mempty, x) synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn Name synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) @@ -116,34 +123,37 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) , hswb_wcs = [] } , tfe_rhs = hs_rhs } -synifyAxiom :: CoAxiom br -> HsDecl Name +synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl Name) synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) | isOpenTypeFamilyTyCon tc , Just branch <- coAxiomSingleBranch_maybe ax - = InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch - , tfid_fvs = placeHolderNamesTc })) + = return $ InstD (TyFamInstD + (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch + , tfid_fvs = placeHolderNamesTc })) | Just ax' <- isClosedSynFamilyTyCon_maybe tc , getUnique ax' == getUnique ax -- without the getUniques, type error - = TyClD (synifyTyCon (Just ax) tc) + = synifyTyCon (Just ax) tc >>= return . TyClD | otherwise - = error "synifyAxiom: closed/open family confusion" + = Left "synifyAxiom: closed/open family confusion" -synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> TyClDecl Name +-- | Turn type constructors into type class declarations +synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl Name) synifyTyCon coax tc - | isFunTyCon tc || isPrimTyCon tc - = DataDecl { tcdLName = synifyName tc + | isFunTyCon tc || isPrimTyCon tc + = return $ + DataDecl { tcdLName = synifyName tc , tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up: - let mk_hs_tv realKind fakeTyVar - = noLoc $ KindedTyVar (getName fakeTyVar) + let mk_hs_tv realKind fakeTyVar + = noLoc $ KindedTyVar (getName fakeTyVar) (synifyKindSig realKind) in HsQTvs { hsq_kvs = [] -- No kind polymorphism , hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc))) alphaTyVars --a, b, c... which are unfortunately all kind * } - - , tcdDataDefn = HsDataDefn { dd_ND = DataType -- arbitrary lie, they are neither + + , tcdDataDefn = HsDataDefn { dd_ND = DataType -- arbitrary lie, they are neither -- algebraic data nor newtype: , dd_ctxt = noLoc [] , dd_cType = Nothing @@ -157,28 +167,34 @@ synifyTyCon coax tc = case famTyConFlav_maybe tc of Just rhs -> let info = case rhs of - OpenSynFamilyTyCon -> OpenTypeFamily - ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) -> - ClosedTypeFamily (brListMap (noLoc . synifyAxBranch tc) branches) - _ -> error "synifyTyCon: type/data family confusion" - in FamDecl (FamilyDecl { fdInfo = info + OpenSynFamilyTyCon -> return OpenTypeFamily + ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) -> + return $ ClosedTypeFamily + (brListMap (noLoc . synifyAxBranch tc) branches) + BuiltInSynFamTyCon {} -> return $ ClosedTypeFamily [] + AbstractClosedSynFamilyTyCon {} -> return $ ClosedTypeFamily [] + in info >>= \i -> + return (FamDecl + (FamilyDecl { fdInfo = i , fdLName = synifyName tc , fdTyVars = synifyTyVars (tyConTyVars tc) - , fdKindSig = Just (synifyKindSig (synTyConResKind tc)) }) - Nothing -> error "synifyTyCon: impossible open type synonym?" + , fdKindSig = + Just (synifyKindSig (synTyConResKind tc)) + })) + Nothing -> Left "synifyTyCon: impossible open type synonym?" - | isDataFamilyTyCon tc + | isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?) case algTyConRhs tc of - DataFamilyTyCon -> + DataFamilyTyCon -> return $ FamDecl (FamilyDecl DataFamily (synifyName tc) (synifyTyVars (tyConTyVars tc)) Nothing) --always kind '*' - _ -> error "synifyTyCon: impossible open data type?" + _ -> Left "synifyTyCon: impossible open data type?" | Just ty <- synTyConRhs_maybe tc - = SynDecl { tcdLName = synifyName tc - , tcdTyVars = synifyTyVars (tyConTyVars tc) - , tcdRhs = synifyType WithinType ty - , tcdFVs = placeHolderNamesTc } + = return $ SynDecl { tcdLName = synifyName tc + , tcdTyVars = synifyTyVars (tyConTyVars tc) + , tcdRhs = synifyType WithinType ty + , tcdFVs = placeHolderNamesTc } | otherwise = -- (closed) newtype and data let @@ -207,25 +223,29 @@ synifyTyCon coax tc -- in prefix position), since, otherwise, the logic (at best) gets much more -- complicated. (would use dataConIsInfix.) use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc) - cons = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc) + consRaw = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc) + cons = rights consRaw -- "deriving" doesn't affect the signature, no need to specify any. alg_deriv = Nothing defn = HsDataDefn { dd_ND = alg_nd , dd_ctxt = alg_ctx , dd_cType = Nothing , dd_kindSig = fmap synifyKindSig kindSig - , dd_cons = cons + , dd_cons = cons , dd_derivs = alg_deriv } - in DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn - , tcdFVs = placeHolderNamesTc } + in case lefts consRaw of + [] -> return $ + DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn + , tcdFVs = placeHolderNamesTc } + dataConErrs -> Left $ unlines dataConErrs -- User beware: it is your responsibility to pass True (use_gadt_syntax) -- for any constructor that would be misrepresented by omitting its -- result-type. -- But you might want pass False in simple enough cases, -- if you think it looks better. -synifyDataCon :: Bool -> DataCon -> LConDecl Name -synifyDataCon use_gadt_syntax dc = noLoc $ +synifyDataCon :: Bool -> DataCon -> Either ErrMsg (LConDecl Name) +synifyDataCon use_gadt_syntax dc = let -- dataConIsInfix allegedly tells us whether it was declared with -- infix *syntax*. @@ -258,20 +278,21 @@ synifyDataCon use_gadt_syntax dc = noLoc $ [synifyName field] synTy Nothing) (dataConFieldLabels dc) linear_tys hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of - (True,True) -> error "synifyDataCon: contradiction!" - (True,False) -> RecCon field_tys - (False,False) -> PrefixCon linear_tys + (True,True) -> Left "synifyDataCon: contradiction!" + (True,False) -> return $ RecCon field_tys + (False,False) -> return $ PrefixCon linear_tys (False,True) -> case linear_tys of - [a,b] -> InfixCon a b - _ -> error "synifyDataCon: infix with non-2 args?" + [a,b] -> return $ InfixCon a b + _ -> Left "synifyDataCon: infix with non-2 args?" hs_res_ty = if use_gadt_syntax then ResTyGADT (synifyType WithinType res_ty) else ResTyH98 -- finally we get synifyDataCon's result! - in ConDecl [name] Implicit{-we don't know nor care-} - qvars ctx hs_arg_tys hs_res_ty Nothing - False --we don't want any "deprecated GADT syntax" warnings! - + in hs_arg_tys >>= + \hat -> return . noLoc $ ConDecl [name] Implicit -- we don't know nor care + qvars ctx hat hs_res_ty Nothing + -- we don't want any "deprecated GADT syntax" warnings! + False synifyName :: NamedThing n => n -> Located Name synifyName = noLoc . getName @@ -290,7 +311,7 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs , hsq_tvs = map synifyTyVar tvs } where (kvs, tvs) = partition isKindVar ktvs - synifyTyVar tv + synifyTyVar tv | isLiftedTypeKind kind = noLoc (UserTyVar name) | otherwise = noLoc (KindedTyVar name (synifyKindSig kind)) where @@ -350,18 +371,16 @@ synifyType _ (FunTy t1 t2) = let in noLoc $ HsFunTy s1 s2 synifyType s forallty@(ForAllTy _tv _ty) = let (tvs, ctx, tau) = tcSplitSigmaTy forallty - in case s of - DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau - _ -> let - forallPlicitness = case s of - WithinType -> Explicit - ImplicitizeForAll -> Implicit - _ -> error "synifyType: impossible case!!!" sTvs = synifyTyVars tvs sCtx = synifyCtx ctx sTau = synifyType WithinType tau - in noLoc $ - HsForAllTy forallPlicitness Nothing sTvs sCtx sTau + mkHsForAllTy forallPlicitness = + noLoc $ HsForAllTy forallPlicitness Nothing sTvs sCtx sTau + in case s of + DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau + WithinType -> mkHsForAllTy Explicit + ImplicitizeForAll -> mkHsForAllTy Implicit + synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t synifyTyLit :: TyLit -> HsTyLit @@ -381,14 +400,14 @@ synifyInstHead (_, preds, cls, types) = where (ks,ts) = break (not . isKind) types -- Convert a family instance, this could be a type family or data family -synifyFamInst :: FamInst -> Bool -> InstHead Name +synifyFamInst :: FamInst -> Bool -> Either ErrMsg (InstHead Name) synifyFamInst fi opaque = - ( fi_fam fi - , map (unLoc . synifyType WithinType) ks - , map (unLoc . synifyType WithinType) ts - , case fi_flavor fi of - SynFamilyInst | opaque -> TypeInst Nothing - SynFamilyInst -> TypeInst . Just . unLoc . synifyType WithinType $ fi_rhs fi - DataFamilyInst c -> DataInst $ synifyTyCon (Just $ famInstAxiom fi) c - ) + let fff = case fi_flavor fi of + SynFamilyInst | opaque -> return $ TypeInst Nothing + SynFamilyInst -> + return . TypeInst . Just . unLoc . synifyType WithinType $ fi_rhs fi + DataFamilyInst c -> + synifyTyCon (Just $ famInstAxiom fi) c >>= return . DataInst + in fff >>= \f' -> return (fi_fam fi , map (unLoc . synifyType WithinType) ks, + map (unLoc . synifyType WithinType) ts , f') where (ks,ts) = break (not . isKind) $ fi_tys fi diff --git a/src/Haddock/Doc.hs b/haddock-api/src/Haddock/Doc.hs index 79a59ac2..9c21015a 100644 --- a/src/Haddock/Doc.hs +++ b/haddock-api/src/Haddock/Doc.hs @@ -5,14 +5,16 @@ module Haddock.Doc ( module Documentation.Haddock.Doc ) where import Data.Maybe -import Data.Monoid import Documentation.Haddock.Doc import Haddock.Types +import Haddock.Utils (mkMeta) -combineDocumentation :: Documentation name -> Maybe (Doc name) +combineDocumentation :: Documentation name -> Maybe (MDoc name) combineDocumentation (Documentation Nothing Nothing) = Nothing combineDocumentation (Documentation mDoc mWarning) = - Just (fromMaybe mempty mWarning <> fromMaybe mempty mDoc) + Just (maybe emptyMetaDoc mkMeta mWarning + `metaDocAppend` + fromMaybe emptyMetaDoc mDoc) -- Drop trailing whitespace from @..@ code blocks. Otherwise this: -- diff --git a/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 5aa9b818..5aa9b818 100644 --- a/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs diff --git a/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 60a20fe5..1bb04ed3 100644 --- a/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -195,7 +195,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do else n out verbosity normal coverageMsg - when (Flag_PrintMissingDocs `elem` flags + when (Flag_NoPrintMissingDocs `notElem` flags && not (null undocumentedExports && header)) $ do out verbosity normal " Missing documentation for:" unless header $ out verbosity normal " Module header" diff --git a/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index a0bac8fc..1341e57f 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -18,7 +18,7 @@ import Haddock.Types import Haddock.Convert import Haddock.GhcUtils -import Control.Arrow +import Control.Arrow hiding ((<+>)) import Data.List import Data.Ord (comparing) import Data.Function (on) @@ -26,6 +26,8 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Class +import DynFlags +import ErrUtils import FamInstEnv import FastString import GHC @@ -34,6 +36,7 @@ import Id import InstEnv import MonadUtils (liftIO) import Name +import Outputable (text, sep, (<+>)) import PrelNames import TcRnDriver (tcRnGetInfo) import TcType (tcSplitSigmaTy) @@ -60,32 +63,37 @@ attachInstances expInfo ifaces instIfaceMap = mapM attach ifaces return $ iface { ifaceExportItems = newItems } -attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name) +attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap + -> ExportItem Name + -> Ghc (ExportItem Name) attachToExportItem expInfo iface ifaceMap instIfaceMap export = case attachFixities export of e@ExportDecl { expItemDecl = L _ (TyClD d) } -> do mb_info <- getAllInfo (tcdName d) - let export' = - e { - expItemInstances = - case mb_info of - Just (_, _, cls_instances, fam_instances) -> - let fam_insts = [ (synifyFamInst i opaque, n) - | i <- sortBy (comparing instFam) fam_instances - , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap - , not $ isNameHidden expInfo (fi_fam i) - , not $ any (isTypeHidden expInfo) (fi_tys i) - , let opaque = isTypeHidden expInfo (fi_rhs i) - ] - cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap) - | let is = [ (instanceHead' i, getName i) | i <- cls_instances ] - , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is - , not $ isInstanceHidden expInfo cls tys - ] - in cls_insts ++ fam_insts - Nothing -> [] - } - return export' + insts <- case mb_info of + Just (_, _, cls_instances, fam_instances) -> + let fam_insts = [ (synifyFamInst i opaque, n) + | i <- sortBy (comparing instFam) fam_instances + , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap + , not $ isNameHidden expInfo (fi_fam i) + , not $ any (isTypeHidden expInfo) (fi_tys i) + , let opaque = isTypeHidden expInfo (fi_rhs i) + ] + cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap) + | let is = [ (instanceHead' i, getName i) | i <- cls_instances ] + , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is + , not $ isInstanceHidden expInfo cls tys + ] + -- fam_insts but with failing type fams filtered out + cleanFamInsts = [ (fi, n) | (Right fi, n) <- fam_insts ] + famInstErrs = [ errm | (Left errm, _) <- fam_insts ] + in do + dfs <- getDynFlags + let mkBug = (text "haddock-bug:" <+>) . text + liftIO $ putMsg dfs (sep $ map mkBug famInstErrs) + return $ cls_insts ++ cleanFamInsts + Nothing -> return [] + return $ e { expItemInstances = insts } e -> return e where attachFixities e@ExportDecl{ expItemDecl = L _ d } = e { expItemFixities = @@ -126,7 +134,7 @@ dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta -- | Like GHC's getInfo but doesn't cut things out depending on the -- interative context, which we don't set sufficiently anyway. getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst])) -getAllInfo name = withSession $ \hsc_env -> do +getAllInfo name = withSession $ \hsc_env -> do (_msgs, r) <- liftIO $ tcRnGetInfo hsc_env name return r diff --git a/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 396c138f..98a715a9 100644 --- a/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections, BangPatterns, LambdaCase #-} +{-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-} {-# OPTIONS_GHC -Wwarn #-} ----------------------------------------------------------------------------- -- | @@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- module Haddock.Interface.Create (createInterface) where - +import Documentation.Haddock.Doc (metaDocAppend) import Haddock.Types import Haddock.Options import Haddock.GhcUtils @@ -45,7 +45,7 @@ import Bag import RdrName import TcRnTypes import FastString (concatFS) - +import qualified Outputable as O -- | Use a 'TypecheckedModule' to produce an 'Interface'. -- To do this, we need access to already processed modules in the topological @@ -249,21 +249,24 @@ mkMaps :: DynFlags -> Maps mkMaps dflags gre instances decls = let (a, b, c, d) = unzip4 $ map mappings decls - in (f $ map (nubBy ((==) `on` fst)) a , f b, f c, f d, instanceMap) + in (f' $ map (nubBy ((==) `on` fst)) a , f b, f c, f d, instanceMap) where f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b f = M.fromListWith (<>) . concat + f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name) + f' = M.fromListWith metaDocAppend . concat + mappings :: (LHsDecl Name, [HsDocString]) - -> ( [(Name, Doc Name)] - , [(Name, Map Int (Doc Name))] + -> ( [(Name, MDoc Name)] + , [(Name, Map Int (MDoc Name))] , [(Name, [Name])] , [(Name, [LHsDecl Name])] ) mappings (ldecl, docStrs) = let L l decl = ldecl declDoc :: [HsDocString] -> Map Int HsDocString - -> (Maybe (Doc Name), Map Int (Doc Name)) + -> (Maybe (MDoc Name), Map Int (MDoc Name)) declDoc strs m = let doc' = processDocStrings dflags gre strs m' = M.map (processDocStringParas dflags gre) m @@ -607,8 +610,15 @@ hiDecl dflags t = do Nothing -> do liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty dflags t] return Nothing - Just x -> return (Just (tyThingToLHsDecl x)) - + Just x -> case tyThingToLHsDecl x of + Left m -> liftErrMsg (tell [bugWarn m]) >> return Nothing + Right (m, t') -> liftErrMsg (tell $ map bugWarn m) + >> return (Just $ noLoc t') + where + warnLine x = O.text "haddock-bug:" O.<+> O.text x O.<> + O.comma O.<+> O.quotes (O.ppr t) O.<+> + O.text "-- Please report this on Haddock issue tracker!" + bugWarn = O.showSDoc dflags . warnLine hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> Bool -> Maybe Fixity -> ErrMsgGhc (ExportItem Name) hiValExportItem dflags name doc splice fixity = do @@ -623,7 +633,8 @@ hiValExportItem dflags name doc splice fixity = do -- | Lookup docs for a declaration from maps. -lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)]) +lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap + -> (DocForDecl Name, [(Name, DocForDecl Name)]) lookupDocs n warnings docMap argMap subMap = let lookupArgDoc x = M.findWithDefault M.empty x argMap in let doc = (lookupDoc n, lookupArgDoc n) in diff --git a/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 54c7351d..35abf8a6 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -21,7 +21,7 @@ module Haddock.Interface.LexParseRn import Control.Applicative import Data.IntSet (toList) import Data.List -import Data.Monoid (mconcat) +import Documentation.Haddock.Doc (metaDocConcat) import DynFlags (ExtensionFlag(..), languageExtensions) import FastString import GHC @@ -32,31 +32,26 @@ import Name import Outputable (showPpr) import RdrName -processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Maybe (Doc Name) +processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] + -> Maybe (MDoc Name) processDocStrings dflags gre strs = - case mconcat $ map (processDocStringParas dflags gre) strs of - DocEmpty -> Nothing + case metaDocConcat $ map (processDocStringParas dflags gre) strs of + -- We check that we don't have any version info to render instead + -- of just checking if there is no comment: there may not be a + -- comment but we still want to pass through any meta data. + MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> Nothing x -> Just x - -processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name -processDocStringParas = process parseParas - +processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> MDoc Name +processDocStringParas dflags gre (HsDocString fs) = + overDoc (rename dflags gre) $ parseParas dflags (unpackFS fs) processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name -processDocString = process parseString - -process :: (DynFlags -> String -> Doc RdrName) - -> DynFlags - -> GlobalRdrEnv - -> HsDocString - -> Doc Name -process parse dflags gre (HsDocString fs) = - rename dflags gre $ parse dflags (unpackFS fs) - +processDocString dflags gre (HsDocString fs) = + rename dflags gre $ parseString dflags (unpackFS fs) processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString - -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name)) + -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name)) processModuleHeader dflags gre safety mayStr = do (hmi, doc) <- case mayStr of @@ -66,7 +61,7 @@ processModuleHeader dflags gre safety mayStr = do (hmi, doc) = parseModuleHeader dflags str !descr = rename dflags gre <$> hmi_description hmi hmi' = hmi { hmi_description = descr } - doc' = rename dflags gre doc + doc' = overDoc (rename dflags gre) doc return (hmi', Just doc') let flags :: [ExtensionFlag] diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs index 6848dc63..d92e8b2a 100644 --- a/src/Haddock/Interface/ParseModuleHeader.hs +++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs @@ -25,7 +25,7 @@ import RdrName -- NB. The headers must be given in the order Module, Description, -- Copyright, License, Maintainer, Stability, Portability, except that -- any or all may be omitted. -parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, Doc RdrName) +parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, MDoc RdrName) parseModuleHeader dflags str0 = let getKey :: String -> String -> (Maybe String,String) diff --git a/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index b08cd275..1ea212f5 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -13,7 +13,7 @@ module Haddock.Interface.Rename (renameInterface) where -import Data.Traversable (traverse) +import Data.Traversable (traverse, Traversable) import Haddock.GhcUtils import Haddock.Types @@ -163,10 +163,9 @@ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString renameLDocHsSyn = return -renameDoc :: Doc Name -> RnM (Doc DocName) +renameDoc :: Traversable t => t Name -> RnM (t DocName) renameDoc = traverse rename - renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName) renameFnArgsDoc = mapM renameDoc diff --git a/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 4673f868..b0df5491 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -76,8 +76,8 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if __GLASGOW_HASKELL__ == 709 -binaryInterfaceVersion = 25 +#if (__GLASGOW_HASKELL__ >= 709) && (__GLASGOW_HASKELL__ < 711) +binaryInterfaceVersion = 27 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] @@ -455,6 +455,19 @@ instance Binary a => Binary (Header a) where t <- get bh return (Header l t) +instance Binary Meta where + put_ bh Meta { _version = v } = put_ bh v + get bh = (\v -> Meta { _version = v }) <$> get bh + +instance (Binary mod, Binary id) => Binary (MetaDoc mod id) where + put_ bh MetaDoc { _meta = m, _doc = d } = do + put_ bh m + put_ bh d + get bh = do + m <- get bh + d <- get bh + return $ MetaDoc { _meta = m, _doc = d } + {-* Generated by DrIFT : Look, but Don't Touch. *-} instance (Binary mod, Binary id) => Binary (DocH mod id) where put_ bh DocEmpty = do diff --git a/src/Haddock/ModuleTree.hs b/haddock-api/src/Haddock/ModuleTree.hs index cb926685..eec1342e 100644 --- a/src/Haddock/ModuleTree.hs +++ b/haddock-api/src/Haddock/ModuleTree.hs @@ -12,7 +12,7 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where -import Haddock.Types ( Doc ) +import Haddock.Types ( MDoc ) import GHC ( Name ) import Module ( Module, moduleNameString, moduleName, modulePackageKey ) @@ -21,10 +21,10 @@ import Packages ( lookupPackage ) import PackageConfig ( sourcePackageIdString ) -data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree] +data ModuleTree = Node String Bool (Maybe String) (Maybe (MDoc Name)) [ModuleTree] -mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree] +mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree] mkModuleTree dflags showPkgs mods = foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ] where @@ -34,7 +34,7 @@ mkModuleTree dflags showPkgs mods = fn (mod_,pkg,short) = addToTrees mod_ pkg short -addToTrees :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] -> [ModuleTree] +addToTrees :: [String] -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree] -> [ModuleTree] addToTrees [] _ _ ts = ts addToTrees ss pkg short [] = mkSubTree ss pkg short addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) @@ -46,7 +46,7 @@ addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) this_short = if null ss then short else node_short -mkSubTree :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] +mkSubTree :: [String] -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree] mkSubTree [] _ _ = [] mkSubTree [s] pkg short = [Node s True pkg short []] mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)] diff --git a/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index b166de46..3fa6397f 100644 --- a/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -82,7 +82,7 @@ data Flag | Flag_NoTmpCompDir | Flag_Qualification String | Flag_PrettyHtml - | Flag_PrintMissingDocs + | Flag_NoPrintMissingDocs deriving (Eq) @@ -170,8 +170,8 @@ options backwardsCompat = "do not re-direct compilation output to a temporary directory", Option [] ["pretty-html"] (NoArg Flag_PrettyHtml) "generate html with newlines and indenting (for use with --html)", - Option [] ["print-missing-docs"] (NoArg Flag_PrintMissingDocs) - "print information about any undocumented entities" + Option [] ["no-print-missing-docs"] (NoArg Flag_NoPrintMissingDocs) + "don't print information about any undocumented entities" ] diff --git a/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs index ea4b7a3f..47bf814b 100644 --- a/src/Haddock/Parser.hs +++ b/haddock-api/src/Haddock/Parser.hs @@ -28,8 +28,8 @@ import RdrName (RdrName) import SrcLoc (mkRealSrcLoc, unLoc) import StringBuffer (stringToStringBuffer) -parseParas :: DynFlags -> String -> DocH mod RdrName -parseParas d = P.overIdentifier (parseIdent d) . P.parseParas +parseParas :: DynFlags -> String -> MetaDoc mod RdrName +parseParas d = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas parseString :: DynFlags -> String -> DocH mod RdrName parseString d = P.overIdentifier (parseIdent d) . P.parseString diff --git a/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 7a66e16d..e93294a0 100644 --- a/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -44,8 +44,8 @@ import Control.Monad (ap) type IfaceMap = Map Module Interface type InstIfaceMap = Map Module InstalledInterface -- TODO: rename -type DocMap a = Map Name (Doc a) -type ArgMap a = Map Name (Map Int (Doc a)) +type DocMap a = Map Name (MDoc a) +type ArgMap a = Map Name (Map Int (MDoc a)) type SubMap = Map Name [Name] type DeclMap = Map Name [LHsDecl Name] type InstMap = Map SrcSpan Name @@ -128,7 +128,7 @@ data Interface = Interface , ifaceWarningMap :: !WarningMap } -type WarningMap = DocMap Name +type WarningMap = Map Name (Doc Name) -- | A subset of the fields of 'Interface' that we store in the interface @@ -233,20 +233,20 @@ data ExportItem name } -- | Some documentation. - | ExportDoc !(Doc name) + | ExportDoc !(MDoc name) -- | A cross-reference to another module. | ExportModule !Module data Documentation name = Documentation - { documentationDoc :: Maybe (Doc name) + { documentationDoc :: Maybe (MDoc name) , documentationWarning :: !(Maybe (Doc name)) } deriving Functor -- | Arguments and result are indexed by Int, zero-based from the left, -- because that's the easiest to use when recursing over types. -type FnArgsDoc name = Map Int (Doc name) +type FnArgsDoc name = Map Int (MDoc name) type DocForDecl name = (Documentation name, FnArgsDoc name) @@ -301,7 +301,7 @@ instance OutputableBndr a => Outputable (InstType a) where ppr (DataInst a) = text "DataInst" <+> ppr a -- | An instance head that may have documentation. -type DocInstance name = (InstHead name, Maybe (Doc name)) +type DocInstance name = (InstHead name, Maybe (MDoc name)) -- | The head of an instance. Consists of a class name, a list of kind -- parameters, a list of type parameters and an instance type @@ -315,6 +315,7 @@ type InstHead name = (name, [HsType name], [HsType name], InstType name) type LDoc id = Located (Doc id) type Doc id = DocH (ModuleName, OccName) id +type MDoc id = MetaDoc (ModuleName, OccName) id instance (NFData a, NFData mod) => NFData (DocH mod a) where diff --git a/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index ecf58b34..9a821b2e 100644 --- a/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -39,6 +39,7 @@ module Haddock.Utils ( -- * Doc markup markup, idMarkup, + mkMeta, -- * List utilities replace, @@ -56,6 +57,7 @@ module Haddock.Utils ( ) where +import Documentation.Haddock.Doc (emptyMetaDoc) import Haddock.Types import Haddock.GhcUtils @@ -110,14 +112,16 @@ out progVerbosity msgVerbosity msg -- | Extract a module's short description. -toDescription :: Interface -> Maybe (Doc Name) -toDescription = hmi_description . ifaceInfo +toDescription :: Interface -> Maybe (MDoc Name) +toDescription = fmap mkMeta . hmi_description . ifaceInfo -- | Extract a module's short description. -toInstalledDescription :: InstalledInterface -> Maybe (Doc Name) -toInstalledDescription = hmi_description . instInfo +toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name) +toInstalledDescription = fmap mkMeta . hmi_description . instInfo +mkMeta :: Doc a -> MDoc a +mkMeta x = emptyMetaDoc { _doc = x } -------------------------------------------------------------------------------- -- * Making abstract declarations diff --git a/src/Haddock/Version.hs b/haddock-api/src/Haddock/Version.hs index f4729c7d..2ef3a257 100644 --- a/src/Haddock/Version.hs +++ b/haddock-api/src/Haddock/Version.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Haddock.Version @@ -12,11 +13,17 @@ module Haddock.Version ( projectName, projectVersion, projectUrl ) where +#ifdef IN_GHC_TREE import Paths_haddock ( version ) +#else +import Paths_haddock_api ( version ) +#endif import Data.Version ( showVersion ) -projectName, projectUrl :: String +projectName :: String projectName = "Haddock" + +projectUrl :: String projectUrl = "http://www.haskell.org/haddock/" projectVersion :: String diff --git a/src/haddock.sh b/haddock-api/src/haddock.sh index f1ad0191..f1ad0191 100644 --- a/src/haddock.sh +++ b/haddock-api/src/haddock.sh diff --git a/haddock-library/.ghci b/haddock-library/.ghci index f0bc9104..78950a5b 100644 --- a/haddock-library/.ghci +++ b/haddock-library/.ghci @@ -1 +1 @@ -:set -isrc -ivendor/attoparsec-0.12.1.1 -itest -idist/build -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -fobject-code +:set -isrc -ivendor/attoparsec-0.12.1.1 -itest -idist/build -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 30db3e8a..b0f886cd 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.1.0 +version: 1.2.0 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it @@ -21,15 +21,17 @@ library default-language: Haskell2010 build-depends: - base >= 4.3 && < 4.8, - bytestring, - deepseq + base >= 4.3 && < 4.9 + , bytestring + , transformers + , deepseq hs-source-dirs: src, vendor/attoparsec-0.12.1.1 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: Documentation.Haddock.Parser + Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc @@ -68,10 +70,12 @@ test-suite spec build-depends: base - , base-compat - , hspec , bytestring + , transformers , deepseq + + , base-compat + , hspec , QuickCheck == 2.* source-repository head diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs index 4d6c10a4..66bd1c97 100644 --- a/haddock-library/src/Documentation/Haddock/Doc.hs +++ b/haddock-library/src/Documentation/Haddock/Doc.hs @@ -1,21 +1,50 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Documentation.Haddock.Doc (docParagraph) where +module Documentation.Haddock.Doc (docParagraph, docAppend, + docConcat, metaDocConcat, + metaDocAppend, emptyMetaDoc, + metaAppend, metaConcat) where -import Data.Monoid +import Control.Applicative ((<|>), empty) import Documentation.Haddock.Types import Data.Char (isSpace) --- We put it here so that we can avoid a circular import --- anything relevant imports this module anyway -instance Monoid (DocH mod id) where - mempty = DocEmpty - mappend = docAppend +docConcat :: [DocH mod id] -> DocH mod id +docConcat = foldr docAppend DocEmpty + +-- | Concat using 'metaAppend'. +metaConcat :: [Meta] -> Meta +metaConcat = foldr metaAppend emptyMeta + +-- | Like 'docConcat' but also joins the 'Meta' info. +metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id +metaDocConcat = foldr metaDocAppend emptyMetaDoc + +-- | We do something perhaps unexpected here and join the meta info +-- in ‘reverse’: this results in the metadata from the ‘latest’ +-- paragraphs taking precedence. +metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id +metaDocAppend (MetaDoc { _meta = m, _doc = d }) + (MetaDoc { _meta = m', _doc = d' }) = + MetaDoc { _meta = m' `metaAppend` m, _doc = d `docAppend` d' } + +-- | This is not a monoidal append, it uses '<|>' for the '_version'. +metaAppend :: Meta -> Meta -> Meta +metaAppend (Meta { _version = v }) (Meta { _version = v' }) = + Meta { _version = v <|> v' } + +emptyMetaDoc :: MetaDoc mod id +emptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty } + +emptyMeta :: Meta +emptyMeta = Meta { _version = empty } docAppend :: DocH mod id -> DocH mod id -> DocH mod id docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2) docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d docAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2) +docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) = DocAppend (DocOrderedList (ds1++ds2)) d docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2) +docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) = DocAppend (DocUnorderedList (ds1++ds2)) d docAppend DocEmpty d = d docAppend d DocEmpty = d docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index e8bc2761..b7ab85b0 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -1,8 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Documentation.Haddock.Parser -- Copyright : (c) Mateusz Kowalczyk 2013-2014, @@ -24,14 +21,14 @@ module Documentation.Haddock.Parser ( parseString, parseParas import Control.Applicative import Control.Arrow (first) -import Control.Monad (void, mfilter) -import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine) +import Control.Monad import qualified Data.ByteString.Char8 as BS import Data.Char (chr, isAsciiUpper) import Data.List (stripPrefix, intercalate, unfoldr) import Data.Maybe (fromMaybe) import Data.Monoid import Documentation.Haddock.Doc +import Documentation.Haddock.Parser.Monad hiding (take, endOfLine) import Documentation.Haddock.Parser.Util import Documentation.Haddock.Types import Documentation.Haddock.Utf8 @@ -81,7 +78,7 @@ overIdentifier f d = g d g (DocExamples x) = DocExamples x g (DocHeader (Header l x)) = DocHeader . Header l $ g x -parse :: Parser a -> BS.ByteString -> a +parse :: Parser a -> BS.ByteString -> (ParserState, a) parse p = either err id . parseOnly (p <* endOfInput) where err = error . ("Haddock.Parser.parse: " ++) @@ -89,11 +86,21 @@ parse p = either err id . parseOnly (p <* endOfInput) -- | Main entry point to the parser. Appends the newline character -- to the input string. parseParas :: String -- ^ String to parse - -> DocH mod Identifier -parseParas = parse (p <* skipSpace) . encodeUtf8 . (++ "\n") + -> MetaDoc mod Identifier +parseParas input = case parseParasState input of + (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state } + , _doc = a + } + +parseParasState :: String -> (ParserState, DocH mod Identifier) +parseParasState = parse (p <* skipSpace) . encodeUtf8 . (++ "\n") where p :: Parser (DocH mod Identifier) - p = mconcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n") + p = docConcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n") + +parseParagraphs :: String -> Parser (DocH mod Identifier) +parseParagraphs input = case parseParasState input of + (state, a) -> setParserState state >> return a -- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which -- drops leading whitespace and encodes the string to UTF8 first. @@ -101,19 +108,19 @@ parseString :: String -> DocH mod Identifier parseString = parseStringBS . encodeUtf8 . dropWhile isSpace parseStringBS :: BS.ByteString -> DocH mod Identifier -parseStringBS = parse p +parseStringBS = snd . parse p where p :: Parser (DocH mod Identifier) - p = mconcat <$> many (monospace <|> anchor <|> identifier <|> moduleName - <|> picture <|> hyperlink <|> bold - <|> emphasis <|> encodedChar <|> string' - <|> skipSpecialChar) + p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName + <|> picture <|> markdownImage <|> hyperlink <|> bold + <|> emphasis <|> encodedChar <|> string' + <|> skipSpecialChar) -- | Parses and processes -- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references> -- --- >>> parseOnly encodedChar "A" --- Right (DocString "A") +-- >>> parseString "A" +-- DocString "A" encodedChar :: Parser (DocH mod a) encodedChar = "&#" *> c <* ";" where @@ -145,16 +152,16 @@ skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar) -- | Emphasis parser. -- --- >>> parseOnly emphasis "/Hello world/" --- Right (DocEmphasis (DocString "Hello world")) +-- >>> parseString "/Hello world/" +-- DocEmphasis (DocString "Hello world") emphasis :: Parser (DocH mod Identifier) emphasis = DocEmphasis . parseStringBS <$> mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/") -- | Bold parser. -- --- >>> parseOnly bold "__Hello world__" --- Right (DocBold (DocString "Hello world")) +-- >>> parseString "__Hello world__" +-- DocBold (DocString "Hello world") bold :: Parser (DocH mod Identifier) bold = DocBold . parseStringBS <$> disallowNewline ("__" *> takeUntil "__") @@ -176,19 +183,23 @@ takeWhile1_ = mfilter (not . BS.null) . takeWhile_ -- | Text anchors to allow for jumping around the generated documentation. -- --- >>> parseOnly anchor "#Hello world#" --- Right (DocAName "Hello world") +-- >>> parseString "#Hello world#" +-- DocAName "Hello world" anchor :: Parser (DocH mod a) anchor = DocAName . decodeUtf8 <$> disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#") -- | Monospaced strings. -- --- >>> parseOnly monospace "@cruel@" --- Right (DocMonospaced (DocString "cruel")) +-- >>> parseString "@cruel@" +-- DocMonospaced (DocString "cruel") monospace :: Parser (DocH mod Identifier) -monospace = DocMonospaced . parseStringBS <$> ("@" *> takeWhile1_ (/= '@') <* "@") +monospace = DocMonospaced . parseStringBS + <$> ("@" *> takeWhile1_ (/= '@') <* "@") +-- | Module names: we try our reasonable best to only allow valid +-- Haskell module names, with caveat about not matching on technically +-- valid unicode symbols. moduleName :: Parser (DocH mod a) moduleName = DocModule <$> (char '"' *> modid <* char '"') where @@ -204,26 +215,45 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"') -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. -- --- >>> parseOnly picture "<<hello.png>>" --- Right (DocPic (Picture {pictureUri = "hello.png", pictureTitle = Nothing})) --- >>> parseOnly picture "<<hello.png world>>" --- Right (DocPic (Picture {pictureUri = "hello.png", pictureTitle = Just "world"})) +-- >>> parseString "<<hello.png>>" +-- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Nothing}) +-- >>> parseString "<<hello.png world>>" +-- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Just "world"}) picture :: Parser (DocH mod a) picture = DocPic . makeLabeled Picture . decodeUtf8 <$> disallowNewline ("<<" *> takeUntil ">>") +markdownImage :: Parser (DocH mod a) +markdownImage = fromHyperlink <$> ("!" *> linkParser) + where + fromHyperlink (Hyperlink url label) = DocPic (Picture url label) + -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) -paragraph = examples <|> skipSpace *> (list <|> birdtracks <|> codeblock - <|> property <|> header - <|> textParagraph) +paragraph = examples <|> skipSpace *> ( + since + <|> unorderedList + <|> orderedList + <|> birdtracks + <|> codeblock + <|> property + <|> header + <|> textParagraphThatStartsWithMarkdownLink + <|> definitionList + <|> docParagraph <$> textParagraph + ) + +since :: Parser (DocH mod a) +since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty + where + version = decimal `sepBy1'` "." -- | Headers inside the comment denoted with @=@ signs, up to 6 levels -- deep. -- --- >>> parseOnly header "= Hello" +-- >>> snd <$> parseOnly header "= Hello" -- Right (DocHeader (Header {headerLevel = 1, headerTitle = DocString "Hello"})) --- >>> parseOnly header "== World" +-- >>> snd <$> parseOnly header "== World" -- Right (DocHeader (Header {headerLevel = 2, headerTitle = DocString "World"})) header :: Parser (DocH mod Identifier) header = do @@ -231,26 +261,37 @@ header = do pser = foldl1 (<|>) psers delim <- decodeUtf8 <$> pser line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString - rest <- paragraph <|> return mempty - return $ DocHeader (Header (length delim) line) <> rest + rest <- paragraph <|> return DocEmpty + return $ DocHeader (Header (length delim) line) `docAppend` rest textParagraph :: Parser (DocH mod Identifier) -textParagraph = docParagraph . parseString . intercalate "\n" <$> many1 nonEmptyLine +textParagraph = parseString . intercalate "\n" <$> many1 nonEmptyLine --- | List parser, called by 'paragraph'. -list :: Parser (DocH mod Identifier) -list = DocUnorderedList <$> unorderedList - <|> DocOrderedList <$> orderedList - <|> DocDefList <$> definitionList +textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier) +textParagraphThatStartsWithMarkdownLink = docParagraph <$> (docAppend <$> markdownLink <*> optionalTextParagraph) + where + optionalTextParagraph :: Parser (DocH mod Identifier) + optionalTextParagraph = (docAppend <$> whitespace <*> textParagraph) <|> pure DocEmpty + + whitespace :: Parser (DocH mod a) + whitespace = DocString <$> (f <$> takeHorizontalSpace <*> optional "\n") + where + f :: BS.ByteString -> Maybe BS.ByteString -> String + f xs (fromMaybe "" -> x) + | BS.null (xs <> x) = "" + | otherwise = " " -- | Parses unordered (bullet) lists. -unorderedList :: Parser [DocH mod Identifier] -unorderedList = ("*" <|> "-") *> innerList unorderedList +unorderedList :: Parser (DocH mod Identifier) +unorderedList = DocUnorderedList <$> p + where + p = ("*" <|> "-") *> innerList p -- | Parses ordered lists (numbered or dashed). -orderedList :: Parser [DocH mod Identifier] -orderedList = (paren <|> dot) *> innerList orderedList +orderedList :: Parser (DocH mod Identifier) +orderedList = DocOrderedList <$> p where + p = (paren <|> dot) *> innerList p dot = (decimal :: Parser Int) <* "." paren = "(" *> decimal <* ")" @@ -265,19 +306,21 @@ innerList item = do (cs, items) <- more item let contents = docParagraph . parseString . dropNLs . unlines $ c : cs return $ case items of - Left p -> [contents <> p] + Left p -> [contents `docAppend` p] Right i -> contents : i -- | Parses definition lists. -definitionList :: Parser [(DocH mod Identifier, DocH mod Identifier)] -definitionList = do - label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n"::String))) <* "]" - c <- takeLine - (cs, items) <- more definitionList - let contents = parseString . dropNLs . unlines $ c : cs - return $ case items of - Left p -> [(label, contents <> p)] - Right i -> (label, contents) : i +definitionList :: Parser (DocH mod Identifier) +definitionList = DocDefList <$> p + where + p = do + label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n" :: String))) <* ("]" <* optional ":") + c <- takeLine + (cs, items) <- more p + let contents = parseString . dropNLs . unlines $ c : cs + return $ case items of + Left x -> [(label, contents `docAppend` x)] + Right i -> (label, contents) : i -- | Drops all trailing newlines. dropNLs :: String -> String @@ -291,12 +334,12 @@ more :: Monoid a => Parser a more item = innerParagraphs <|> moreListItems item <|> moreContent item <|> pure ([], Right mempty) --- | Use by 'innerList' and 'definitionList' to parse any nested paragraphs. +-- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs. innerParagraphs :: Parser ([String], Either (DocH mod Identifier) a) innerParagraphs = (,) [] . Left <$> ("\n" *> indentedParagraphs) --- | Attemps to fetch the next list if possibly. Used by 'innerList' and --- 'definitionList' to recursivly grab lists that aren't separated by a whole +-- | Attempts to fetch the next list if possibly. Used by 'innerList' and +-- 'definitionList' to recursively grab lists that aren't separated by a whole -- paragraph. moreListItems :: Parser a -> Parser ([String], Either (DocH mod Identifier) a) @@ -308,10 +351,10 @@ moreContent :: Monoid a => Parser a -> Parser ([String], Either (DocH mod Identifier) a) moreContent item = first . (:) <$> nonEmptyLine <*> more item --- | Runs the 'parseParas' parser on an indented paragraph. +-- | Parses an indented paragraph. -- The indentation is 4 spaces. indentedParagraphs :: Parser (DocH mod Identifier) -indentedParagraphs = parseParas . concat <$> dropFrontOfPara " " +indentedParagraphs = (concat <$> dropFrontOfPara " ") >>= parseParagraphs -- | Grab as many fully indented paragraphs as we can. dropFrontOfPara :: Parser BS.ByteString -> Parser [String] @@ -399,7 +442,7 @@ endOfLine = void "\n" <|> endOfInput -- | Property parser. -- --- >>> parseOnly property "prop> hello world" +-- >>> snd <$> parseOnly property "prop> hello world" -- Right (DocProperty "hello world") property :: Parser (DocH mod a) property = DocProperty . strip . decodeUtf8 <$> ("prop>" *> takeWhile1 (/= '\n')) @@ -442,11 +485,32 @@ codeblock = | isNewline && isSpace c = Just isNewline | otherwise = Just $ c == '\n' --- | Parses links that were specifically marked as such. hyperlink :: Parser (DocH mod a) hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8 <$> disallowNewline ("<" *> takeUntil ">") <|> autoUrl + <|> markdownLink + +markdownLink :: Parser (DocH mod a) +markdownLink = DocHyperlink <$> linkParser + +linkParser :: Parser Hyperlink +linkParser = flip Hyperlink <$> label <*> (whitespace *> url) + where + label :: Parser (Maybe String) + label = Just . strip . decode <$> ("[" *> takeUntil "]") + + whitespace :: Parser () + whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace) + + url :: Parser String + url = rejectWhitespace (decode <$> ("(" *> takeUntil ")")) + + rejectWhitespace :: MonadPlus m => m String -> m String + rejectWhitespace = mfilter (all (not . isSpace)) + + decode :: BS.ByteString -> String + decode = removeEscapes . decodeUtf8 -- | Looks for URL-like things to automatically hyperlink even if they -- weren't marked as links. @@ -456,32 +520,32 @@ autoUrl = mkLink <$> url url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace) mkLink :: BS.ByteString -> DocH mod a mkLink s = case unsnoc s of - Just (xs, x) | x `elem` (",.!?"::String) -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) <> DocString [x] + Just (xs, x) | x `elem` (",.!?" :: String) -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it -- deems to be valid in an identifier. Note that it simply blindly consumes -- characters and does no actual validation itself. parseValid :: Parser String -parseValid = do - vs' <- many' $ utf8String "⋆" <|> return <$> idChar - let vs = concat vs' - c <- peekChar - case c of - Just '`' -> return vs - Just '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> parseValid) - <|> return vs - _ -> fail "outofvalid" +parseValid = p some where idChar = satisfy (`elem` ("_.!#$%&*+/<=>?@\\|-~:^"::String)) <|> digit <|> letter_ascii + p p' = do + vs' <- p' $ utf8String "⋆" <|> return <$> idChar + let vs = concat vs' + c <- peekChar' + case c of + '`' -> return vs + '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> p many') <|> return vs + _ -> fail "outofvalid" -- | Parses UTF8 strings from ByteString streams. utf8String :: String -> Parser String utf8String x = decodeUtf8 <$> string (encodeUtf8 x) --- | Parses identifiers with help of 'parseValid'. Asks GHC for 'String' from the --- string it deems valid. +-- | Parses identifiers with help of 'parseValid'. Asks GHC for +-- 'String' from the string it deems valid. identifier :: Parser (DocH mod Identifier) identifier = do o <- idDelim diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs new file mode 100644 index 00000000..a421c58c --- /dev/null +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} +module Documentation.Haddock.Parser.Monad ( + module Documentation.Haddock.Parser.Monad +, Attoparsec.isDigit +, Attoparsec.isDigit_w8 +, Attoparsec.isAlpha_iso8859_15 +, Attoparsec.isAlpha_ascii +, Attoparsec.isSpace +, Attoparsec.isSpace_w8 +, Attoparsec.inClass +, Attoparsec.notInClass +, Attoparsec.isEndOfLine +, Attoparsec.isHorizontalSpace +, Attoparsec.choice +, Attoparsec.count +, Attoparsec.option +, Attoparsec.many' +, Attoparsec.many1 +, Attoparsec.many1' +, Attoparsec.manyTill +, Attoparsec.manyTill' +, Attoparsec.sepBy +, Attoparsec.sepBy' +, Attoparsec.sepBy1 +, Attoparsec.sepBy1' +, Attoparsec.skipMany +, Attoparsec.skipMany1 +, Attoparsec.eitherP +) where + +import Control.Applicative +import Control.Monad +import Data.String +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LB +import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec +import Control.Monad.Trans.State +import qualified Control.Monad.Trans.Class as Trans +import Data.Word +import Data.Bits +import Data.Tuple + +import Documentation.Haddock.Types (Version) + +data ParserState = ParserState { + parserStateSince :: Maybe Version +} deriving (Eq, Show) + +initialParserState :: ParserState +initialParserState = ParserState Nothing + +newtype Parser a = Parser (StateT ParserState Attoparsec.Parser a) + deriving (Functor, Applicative, Alternative, Monad, MonadPlus) + +instance (a ~ ByteString) => IsString (Parser a) where + fromString = lift . fromString + +parseOnly :: Parser a -> ByteString -> Either String (ParserState, a) +parseOnly (Parser p) = fmap swap . Attoparsec.parseOnly (runStateT p initialParserState) + +lift :: Attoparsec.Parser a -> Parser a +lift = Parser . Trans.lift + +setParserState :: ParserState -> Parser () +setParserState = Parser . put + +setSince :: Version -> Parser () +setSince since = Parser $ modify (\st -> st {parserStateSince = Just since}) + +char :: Char -> Parser Char +char = lift . Attoparsec.char + +char8 :: Char -> Parser Word8 +char8 = lift . Attoparsec.char8 + +anyChar :: Parser Char +anyChar = lift Attoparsec.anyChar + +notChar :: Char -> Parser Char +notChar = lift . Attoparsec.notChar + +satisfy :: (Char -> Bool) -> Parser Char +satisfy = lift . Attoparsec.satisfy + +peekChar :: Parser (Maybe Char) +peekChar = lift Attoparsec.peekChar + +peekChar' :: Parser Char +peekChar' = lift Attoparsec.peekChar' + +digit :: Parser Char +digit = lift Attoparsec.digit + +letter_iso8859_15 :: Parser Char +letter_iso8859_15 = lift Attoparsec.letter_iso8859_15 + +letter_ascii :: Parser Char +letter_ascii = lift Attoparsec.letter_ascii + +space :: Parser Char +space = lift Attoparsec.space + +string :: ByteString -> Parser ByteString +string = lift . Attoparsec.string + +stringCI :: ByteString -> Parser ByteString +stringCI = lift . Attoparsec.stringCI + +skipSpace :: Parser () +skipSpace = lift Attoparsec.skipSpace + +skipWhile :: (Char -> Bool) -> Parser () +skipWhile = lift . Attoparsec.skipWhile + +take :: Int -> Parser ByteString +take = lift . Attoparsec.take + +scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString +scan s = lift . Attoparsec.scan s + +takeWhile :: (Char -> Bool) -> Parser ByteString +takeWhile = lift . Attoparsec.takeWhile + +takeWhile1 :: (Char -> Bool) -> Parser ByteString +takeWhile1 = lift . Attoparsec.takeWhile1 + +takeTill :: (Char -> Bool) -> Parser ByteString +takeTill = lift . Attoparsec.takeTill + +takeByteString :: Parser ByteString +takeByteString = lift Attoparsec.takeByteString + +takeLazyByteString :: Parser LB.ByteString +takeLazyByteString = lift Attoparsec.takeLazyByteString + +endOfLine :: Parser () +endOfLine = lift Attoparsec.endOfLine + +decimal :: Integral a => Parser a +decimal = lift Attoparsec.decimal + +hexadecimal :: (Integral a, Bits a) => Parser a +hexadecimal = lift Attoparsec.hexadecimal + +endOfInput :: Parser () +endOfInput = lift Attoparsec.endOfInput + +atEnd :: Parser Bool +atEnd = lift Attoparsec.atEnd diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index ef2af140..d908ce18 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -14,6 +14,7 @@ module Documentation.Haddock.Parser.Util ( unsnoc , strip , takeUntil +, removeEscapes , makeLabeled , takeHorizontalSpace , skipHorizontalSpace @@ -21,7 +22,7 @@ module Documentation.Haddock.Parser.Util ( import Control.Applicative import Control.Monad (mfilter) -import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine) +import Documentation.Haddock.Parser.Monad import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile) @@ -49,14 +50,15 @@ makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of (uri, "") -> f uri Nothing (uri, label) -> f uri (Just $ dropWhile isSpace label) - where - -- As we don't parse these any further, we don't do any processing to the - -- string so we at least remove escape character here. Perhaps we should - -- actually be parsing the label at the very least? - removeEscapes "" = "" - removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs - removeEscapes ('\\':xs) = removeEscapes xs - removeEscapes (x:xs) = x : removeEscapes xs + +-- | Remove escapes from given string. +-- +-- Only do this if you do not process (read: parse) the input any further. +removeEscapes :: String -> String +removeEscapes "" = "" +removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs +removeEscapes ('\\':xs) = removeEscapes xs +removeEscapes (x:xs) = x : removeEscapes xs takeUntil :: ByteString -> Parser ByteString takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index b3118cc6..4ef89658 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable #-} -{-# LANGUAGE DeriveTraversable, StandaloneDeriving #-} +{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types @@ -18,24 +17,27 @@ module Documentation.Haddock.Types where import Data.Foldable import Data.Traversable -instance Foldable Header where - foldMap f (Header _ a) = f a +-- | With the advent of 'Version', we may want to start attaching more +-- meta-data to comments. We make a structure for this ahead of time +-- so we don't have to gut half the core each time we want to add such +-- info. +newtype Meta = Meta { _version :: Maybe Version } deriving (Eq, Show) -instance Traversable Header where - traverse f (Header l a) = Header l `fmap` f a +data MetaDoc mod id = + MetaDoc { _meta :: Meta + , _doc :: DocH mod id + } deriving (Eq, Show, Functor, Foldable, Traversable) +overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d +overDoc f d = d { _doc = f $ _doc d } -deriving instance Show a => Show (Header a) -deriving instance (Show a, Show b) => Show (DocH a b) -deriving instance Eq a => Eq (Header a) -deriving instance (Eq a, Eq b) => Eq (DocH a b) +type Version = [Int] data Hyperlink = Hyperlink { hyperlinkUrl :: String , hyperlinkLabel :: Maybe String } deriving (Eq, Show) - data Picture = Picture { pictureUri :: String , pictureTitle :: Maybe String @@ -44,7 +46,7 @@ data Picture = Picture data Header id = Header { headerLevel :: Int , headerTitle :: id - } deriving Functor + } deriving (Eq, Show, Functor, Foldable, Traversable) data Example = Example { exampleExpression :: String @@ -73,4 +75,4 @@ data DocH mod id | DocProperty String | DocExamples [Example] | DocHeader (Header (DocH mod id)) - deriving (Functor, Foldable, Traversable) + deriving (Eq, Show, Functor, Foldable, Traversable) diff --git a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs index a6ac49ee..10c701c7 100644 --- a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs +++ b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs @@ -1,10 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Documentation.Haddock.Parser.UtilSpec (main, spec) where -import Data.Attoparsec.ByteString.Char8 +import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util import Data.Either.Compat (isLeft) import Test.Hspec +import Control.Applicative main :: IO () main = hspec spec @@ -13,10 +14,10 @@ spec :: Spec spec = do describe "takeUntil" $ do it "takes everything until a specified byte sequence" $ do - parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" + snd <$> parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" it "requires the end sequence" $ do - parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft + snd <$> parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft it "takes escaped bytes unconditionally" $ do - parseOnly (takeUntil "end") "some\\endend" `shouldBe` Right "some\\end" + snd <$> parseOnly (takeUntil "end") "some\\endend" `shouldBe` Right "some\\end" diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 5181a3f3..44ec2988 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -1,16 +1,19 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances #-} -{-# LANGUAGE IncoherentInstances, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.ParserSpec (main, spec) where -import Data.Monoid import Data.String import qualified Documentation.Haddock.Parser as Parse import Documentation.Haddock.Types +import Documentation.Haddock.Doc (docAppend) import Test.Hspec import Test.QuickCheck +infixr 6 <> +(<>) :: Doc id -> Doc id -> Doc id +(<>) = docAppend + type Doc id = DocH () id instance IsString (Doc String) where @@ -19,12 +22,15 @@ instance IsString (Doc String) where instance IsString a => IsString (Maybe a) where fromString = Just . fromString -parseParas :: String -> Doc String -parseParas = Parse.toRegular . Parse.parseParas +parseParas :: String -> MetaDoc () String +parseParas = overDoc Parse.toRegular . Parse.parseParas parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString +hyperlink :: String -> Maybe String -> Doc String +hyperlink url = DocHyperlink . Hyperlink url + main :: IO () main = hspec spec @@ -79,10 +85,13 @@ spec = do " don't use apostrophe's in the wrong place's" `shouldParseTo` "don't use apostrophe's in the wrong place's" - context "when parsing URLs" $ do - let hyperlink :: String -> Maybe String -> Doc String - hyperlink url = DocHyperlink . Hyperlink url + it "doesn't parse empty identifiers" $ do + "``" `shouldParseTo` "``" + it "can parse infix identifiers" $ do + "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`" + + context "when parsing URLs" $ do it "parses a URL" $ do "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing @@ -111,6 +120,45 @@ spec = do it "doesn't allow for multi-line link tags" $ do "<ba\nz aar>" `shouldParseTo` "<ba\nz aar>" + context "when parsing markdown links" $ do + it "parses a simple link" $ do + "[some label](url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows whitespace between label and URL" $ do + "[some label] \t (url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows newlines in label" $ do + "[some\n\nlabel](url)" `shouldParseTo` + hyperlink "url" "some\n\nlabel" + + it "allows escaping in label" $ do + "[some\\] label](url)" `shouldParseTo` + hyperlink "url" "some] label" + + it "strips leading and trailing whitespace from label" $ do + "[ some label ](url)" `shouldParseTo` + hyperlink "url" "some label" + + it "rejects whitespace in URL" $ do + "[some label]( url)" `shouldParseTo` + "[some label]( url)" + + context "when URL is on a separate line" $ do + it "allows URL to be on a separate line" $ do + "[some label]\n(url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows leading whitespace" $ do + "[some label]\n \t (url)" `shouldParseTo` + hyperlink "url" "some label" + + it "rejects additional newlines" $ do + "[some label]\n\n(url)" `shouldParseTo` + "[some label]\n\n(url)" + + context "when autolinking URLs" $ do it "autolinks HTTP URLs" $ do "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing @@ -141,24 +189,22 @@ spec = do "foo https://example.com/example bar" `shouldParseTo` "foo " <> hyperlink "https://example.com/example" Nothing <> " bar" - context "when parsing pictures" $ do - let picture :: String -> Maybe String -> Doc String - picture uri = DocPic . Picture uri + context "when parsing images" $ do + let image :: String -> Maybe String -> Doc String + image uri = DocPic . Picture uri - it "parses a simple picture" $ do - "<<baz>>" `shouldParseTo` picture "baz" Nothing + it "accepts markdown syntax for images" $ do + "" `shouldParseTo` image "url" "label" - it "parses a picture with a title" $ do - "<<b a z>>" `shouldParseTo` picture "b" (Just "a z") + it "accepts Unicode" $ do + "" `shouldParseTo` image "url" "灼眼のシャナ" - it "parses a picture with unicode" $ do - "<<灼眼のシャナ>>" `shouldParseTo` picture "灼眼のシャナ" Nothing + it "supports deprecated picture syntax" $ do + "<<baz>>" `shouldParseTo` image "baz" Nothing - it "allows for escaping of the closing tags" $ do - "<<ba\\>>z>>" `shouldParseTo` picture "ba>>z" Nothing + it "supports title for deprecated picture syntax" $ do + "<<b a z>>" `shouldParseTo` image "b" "a z" - it "doesn't allow for multi-line picture tags" $ do - "<<ba\nz aar>>" `shouldParseTo` "<<ba\nz aar>>" context "when parsing anchors" $ do it "parses a single word anchor" $ do @@ -312,12 +358,39 @@ spec = do describe "parseParas" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation - shouldParseTo input ast = parseParas input `shouldBe` ast + shouldParseTo input ast = _doc (parseParas input) `shouldBe` ast it "is total" $ do property $ \xs -> (length . show . parseParas) xs `shouldSatisfy` (> 0) + context "when parsing @since" $ do + it "adds specified version to the result" $ do + parseParas "@since 0.5.0" `shouldBe` + MetaDoc { _meta = Meta { _version = Just [0,5,0] } + , _doc = DocEmpty } + + it "ignores trailing whitespace" $ do + parseParas "@since 0.5.0 \t " `shouldBe` + MetaDoc { _meta = Meta { _version = Just [0,5,0] } + , _doc = DocEmpty } + + it "does not allow trailing input" $ do + parseParas "@since 0.5.0 foo" `shouldBe` + MetaDoc { _meta = Meta { _version = Nothing } + , _doc = DocParagraph "@since 0.5.0 foo" } + + + context "when given multiple times" $ do + it "gives last occurrence precedence" $ do + (parseParas . unlines) [ + "@since 0.5.0" + , "@since 0.6.0" + , "@since 0.7.0" + ] `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,7,0] } + , _doc = DocEmpty } + + context "when parsing text paragraphs" $ do let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) @@ -345,6 +418,28 @@ spec = do it "turns it into a code block" $ do "@foo@" `shouldParseTo` DocCodeBlock "foo" + context "when a paragraph starts with a markdown link" $ do + it "correctly parses it as a text paragraph (not a definition list)" $ do + "[label](url)" `shouldParseTo` + DocParagraph (hyperlink "url" "label") + + it "can be followed by an other paragraph" $ do + "[label](url)\n\nfoobar" `shouldParseTo` + DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar" + + context "when paragraph contains additional text" $ do + it "accepts more text after the link" $ do + "[label](url) foo bar baz" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> " foo bar baz") + + it "accepts a newline right after the markdown link" $ do + "[label](url)\nfoo bar baz" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> " foo bar baz") + + it "can be followed by an other paragraph" $ do + "[label](url)foo\n\nbar" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar" + context "when parsing birdtracks" $ do it "parses them as a code block" $ do unlines [ @@ -584,7 +679,7 @@ spec = do it "can nest definition lists" $ do - "[a] foo\n\n [b] bar\n\n [c] baz\n qux" `shouldParseTo` + "[a]: foo\n\n [b]: bar\n\n [c]: baz\n qux" `shouldParseTo` DocDefList [ ("a", "foo" <> DocDefList [ ("b", "bar" <> DocDefList [("c", "baz\nqux")]) @@ -599,12 +694,27 @@ spec = do <> DocOrderedList [ DocParagraph "baz" ] it "definition lists can come back to top level with a different list" $ do - "[foo] foov\n\n [bar] barv\n\n1. baz" `shouldParseTo` + "[foo]: foov\n\n [bar]: barv\n\n1. baz" `shouldParseTo` DocDefList [ ("foo", "foov" <> DocDefList [ ("bar", "barv") ]) ] <> DocOrderedList [ DocParagraph "baz" ] + it "list order is preserved in presence of nesting + extra text" $ do + "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" + `shouldParseTo` + DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code" + , DocParagraph "Bar" + ] + <> DocParagraph (DocString "Some text") + + "1. Foo\n\n2. Bar\n\nSome text" + `shouldParseTo` + DocOrderedList [ DocParagraph "Foo" + , DocParagraph "Bar" + ] + <> DocParagraph (DocString "Some text") + context "when parsing properties" $ do it "can parse a single property" $ do "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" @@ -732,9 +842,9 @@ spec = do context "when parsing definition lists" $ do it "parses a simple list" $ do unlines [ - " [foo] one" - , " [bar] two" - , " [baz] three" + " [foo]: one" + , " [bar]: two" + , " [baz]: three" ] `shouldParseTo` DocDefList [ ("foo", "one") @@ -744,9 +854,9 @@ spec = do it "ignores empty lines between list items" $ do unlines [ - "[foo] one" + "[foo]: one" , "" - , "[bar] two" + , "[bar]: two" ] `shouldParseTo` DocDefList [ ("foo", "one") @@ -754,13 +864,13 @@ spec = do ] it "accepts an empty list item" $ do - "[foo]" `shouldParseTo` DocDefList [("foo", DocEmpty)] + "[foo]:" `shouldParseTo` DocDefList [("foo", DocEmpty)] it "accepts multi-line list items" $ do unlines [ - "[foo] point one" + "[foo]: point one" , " more one" - , "[bar] point two" + , "[bar]: point two" , "more two" ] `shouldParseTo` DocDefList [ @@ -769,21 +879,33 @@ spec = do ] it "accepts markup in list items" $ do - "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] + "[foo]: /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] it "accepts markup for the label" $ do - "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] + "[/foo/]: bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] it "requires empty lines between list and other paragraphs" $ do unlines [ "foo" , "" - , "[foo] bar" + , "[foo]: bar" , "" , "baz" ] `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" + it "dose not require the colon (deprecated - this will be removed in a future release)" $ do + unlines [ + " [foo] one" + , " [bar] two" + , " [baz] three" + ] + `shouldParseTo` DocDefList [ + ("foo", "one") + , ("bar", "two") + , ("baz", "three") + ] + context "when parsing consecutive paragraphs" $ do it "will not capture irrelevant consecutive lists" $ do unlines [ " * bullet" @@ -796,9 +918,9 @@ spec = do , " " , " 2. different bullet" , " " - , " [cat] kitten" + , " [cat]: kitten" , " " - , " [pineapple] fruit" + , " [pineapple]: fruit" ] `shouldParseTo` DocUnorderedList [ DocParagraph "bullet" , DocParagraph "different bullet"] diff --git a/haddock.cabal b/haddock.cabal index 01ab35d4..fbb4bfed 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.15.0 +version: 2.16.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -26,54 +26,28 @@ extra-source-files: doc/docbook-xml.mk doc/fptools.css doc/haddock.xml - haddock.spec - haskell.vim - src/haddock.sh + haddock-api/src/haddock.sh html-test/src/*.hs html-test/ref/*.html latex-test/src/Simple/*.hs latex-test/ref/Simple/*.tex latex-test/ref/Simple/*.sty -data-dir: resources -data-files: html/frames.html - html/haddock-util.js - html/Classic.theme/haskell_icon.gif - html/Classic.theme/minus.gif - html/Classic.theme/plus.gif - html/Classic.theme/xhaddock.css - html/Ocean.std-theme/hslogo-16.png - html/Ocean.std-theme/minus.gif - html/Ocean.std-theme/ocean.css - html/Ocean.std-theme/plus.gif - html/Ocean.std-theme/synopsis.png - latex/haddock.sty - flag in-ghc-tree description: Are we in a GHC tree? default: False manual: True --- Using this disables -O2, and hence allows to use --disable-optimization, --- which is about twice as fast. This should probably be the default, but we --- need some benchmarks first.. -flag dev - default: False - manual: True - executable haddock default-language: Haskell2010 main-is: Main.hs hs-source-dirs: driver - if flag(dev) - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs - else - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 build-depends: base >= 4.3 && < 4.9 if flag(in-ghc-tree) - hs-source-dirs: src, haddock-library/vendor/attoparsec-0.12.1.1, haddock-library/src + hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.12.1.1, haddock-library/src cpp-options: -DIN_GHC_TREE build-depends: filepath, @@ -83,11 +57,13 @@ executable haddock array, xhtml >= 3000.2 && < 3000.3, Cabal >= 1.10, - ghc == 7.9.*, - bytestring + ghc >= 7.9 && < 7.11, + bytestring, + transformers other-modules: Documentation.Haddock.Parser + Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc Data.Attoparsec @@ -134,93 +110,7 @@ executable haddock Haddock.GhcUtils Haddock.Convert else - build-depends: haddock, haddock-library - -library - default-language: Haskell2010 - - build-depends: - base >= 4.3 && < 4.9, - bytestring, - filepath, - directory, - containers, - deepseq, - array, - xhtml >= 3000.2 && < 3000.3, - Cabal >= 1.10, - ghc == 7.9.* - - if flag(in-ghc-tree) - cpp-options: -DIN_GHC_TREE - hs-source-dirs: src, haddock-library/vendor/attoparsec-0.12.1.1, haddock-library/src - - exposed-modules: - Documentation.Haddock.Parser - Documentation.Haddock.Types - Documentation.Haddock.Doc - - other-modules: - Data.Attoparsec - Data.Attoparsec.ByteString - Data.Attoparsec.ByteString.Buffer - Data.Attoparsec.ByteString.Char8 - Data.Attoparsec.ByteString.FastSet - Data.Attoparsec.ByteString.Internal - Data.Attoparsec.Combinator - Data.Attoparsec.Internal - Data.Attoparsec.Internal.Fhthagn - Data.Attoparsec.Internal.Types - Data.Attoparsec.Number - Documentation.Haddock.Utf8 - Documentation.Haddock.Parser.Util - - else - build-depends: ghc-paths, haddock-library - hs-source-dirs: src - - - if flag(dev) - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs - else - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 - - exposed-modules: - Documentation.Haddock - - other-modules: - Haddock - Haddock.Interface - Haddock.Interface.Rename - Haddock.Interface.Create - Haddock.Interface.AttachInstances - Haddock.Interface.LexParseRn - Haddock.Interface.ParseModuleHeader - Haddock.Parser - Haddock.Utils - Haddock.Backends.Xhtml - Haddock.Backends.Xhtml.Decl - Haddock.Backends.Xhtml.DocMarkup - Haddock.Backends.Xhtml.Layout - Haddock.Backends.Xhtml.Names - Haddock.Backends.Xhtml.Themes - Haddock.Backends.Xhtml.Types - Haddock.Backends.Xhtml.Utils - Haddock.Backends.LaTeX - Haddock.Backends.HaddockDB - Haddock.Backends.Hoogle - Haddock.ModuleTree - Haddock.Types - Haddock.Doc - Haddock.Version - Haddock.InterfaceFile - Haddock.Options - Haddock.GhcUtils - Haddock.Convert - Paths_haddock - - if flag(in-ghc-tree) - buildable: False + build-depends: haddock-api == 2.16.0 test-suite html-test type: exitcode-stdio-1.0 diff --git a/haddock.spec b/haddock.spec deleted file mode 100644 index dd640f8a..00000000 --- a/haddock.spec +++ /dev/null @@ -1,81 +0,0 @@ -# This is an RPM spec file that specifies how to package -# haddock for Red Hat Linux and, possibly, similar systems. -# It has been tested on Red Hat Linux 7.2 and SuSE Linux 9.1. -# -# If this file is part of a tarball, you can build RPMs directly from -# the tarball by using the following command: -# -# rpm -ta haddock-(VERSION).tar.gz -# -# The resulting package will be placed in the RPMS/(arch) subdirectory -# of your RPM build directory (usually /usr/src/redhat or ~/rpm), with -# the name haddock-(VERSION)-(RELEASE).noarch.rpm. A corresponding -# source RPM package will be in the SRPMS subdirectory. -# -# NOTE TO HADDOCK MAINTAINERS: When you release a new version of -# Haskell mode, update the version definition below to match the -# version label of your release tarball. - -%define name haddock -%define version 2.15.0 -%define release 1 - -Name: %{name} -Version: %{version} -Release: %{release} -License: BSD-like -Group: Development/Languages/Haskell -URL: http://haskell.org/haddock/ -Source: http://haskell.org/haddock/haddock-%{version}.tar.gz -Packager: Sven Panne <sven.panne@aedion.de> -BuildRoot: %{_tmppath}/%{name}-%{version}-build -Prefix: %{_prefix} -BuildRequires: ghc, docbook-dtd, docbook-xsl-stylesheets, libxslt, libxml2, fop, xmltex, dvips -Summary: A documentation tool for annotated Haskell source code - -%description -Haddock is a tool for automatically generating documentation from -annotated Haskell source code. It is primary intended for documenting -libraries, but it should be useful for any kind of Haskell code. - -Haddock lets you write documentation annotations next to the -definitions of functions and types in the source code, in a syntax -that is easy on the eye when writing the source code (no heavyweight -mark-up). The documentation generated by Haddock is fully hyperlinked --- click on a type name in a type signature to go straight to the -definition, and documentation, for that type. - -Haddock can generate documentation in multiple formats; currently HTML -is implemented, and there is partial support for generating DocBook. -The generated HTML uses stylesheets, so you need a fairly up-to-date -browser to view it properly (Mozilla, Konqueror, Opera, and IE 6 -should all be ok). - -%prep -%setup - -%build -runhaskell Setup.lhs configure --prefix=%{_prefix} --docdir=%{_datadir}/doc/packages/%{name} -runhaskell Setup.lhs build -cd doc -test -f configure || autoreconf -./configure -make html - -%install -runhaskell Setup.lhs copy --destdir=${RPM_BUILD_ROOT} - -%clean -rm -rf ${RPM_BUILD_ROOT} - -%files -%defattr(-,root,root) -%doc CHANGES -%doc LICENSE -%doc README -%doc TODO -%doc doc/haddock -%doc examples -%doc haskell.vim -%{prefix}/bin/haddock -%{prefix}/share/haddock-%{version} diff --git a/haskell.vim b/haskell.vim deleted file mode 100644 index cbc41be3..00000000 --- a/haskell.vim +++ /dev/null @@ -1,68 +0,0 @@ -" Attempt to add haddock highlighting for haskell comments -" It should be placed in ~/.vim/after/syntax/haskell.vim -" Brad Bowman <haddock.vim@bereft.net> - -syn match hsHdocChunk "$\i\+" contained -syn match hsHdocMod /"\(\i\|[.]\)\+"/ contained -syn match hsHdocLink "'\(\i\|[.#]\)\+'" contained -syn region hsHdocAnchor start="\\\@<!#" skip="\\#" end="\\\@<!#" contained oneline -" I think emphasis can span multiple lines -syn region hsHdocEm start="\\\@<!/" skip="\\/" end="\\\@!/" contained oneline -syn region hsHdocURL start="\\\@<!<" end="\\\@<!>" contained oneline -syn region hsHdocCode start="\\\@<!@" skip="\\@" end="\\\@<!@" contained oneline -syn region hsHdocBCodeBlock start="^@\(\s\|$\)" end="^@\s*$" contained -syn region hsHdocLCodeBlock start="\(^\s*--\s*\)\@<=@\s*$" end="\(^\s*--\s*\)\@<=@\s*$" contained -syn match hsHdocBHeading "^\s*\*\+" contained -syn match hsHdocLHeading "\(^\s*--\s*\)\@<=\*\+" contained -syn match hsHdocBTracks "^\s*>" contained -" match only the > using a look-behind -syn match hsHdocLTracks "\(^\s*--\s*\)\@<=>" contained - -" todo: numbered lists, mark haddock start separately -"syn match hsHdocStart "\([$^|]\|\*\+\)" contained - -syn cluster hsHdocSpecial - \ contains=hsHdocMod,hsHdocLink,hsHdocEm,hsHdocCode,hsHdocURL, - \ hsHdocAnchor,hsHdocChunk - -syn region hsHdocDef start="^\s*\(--\)\?\s*\[" end="\]" contained contains=hsHdocSpecial - -syn region hsHdocLines start="--\s*\([$\^|]\|\*\+\)" - \ skip="^\s*\(--.*\)$" - \ end="^\s*\(\$\|--\)\@!" - \ contains=@hsHdocSpecial,hsHdocLTracks,hsHdocLHeading,hsHdocLCodeBlock,hsHdocDef -syn region hsHdocBlock start="{-\s*\([$\^|]\|\*\+\)" end="-}" - \ contains=@hsHdocSpecial,hsHdocBTracks,hsHdocBHeading,hsHdocBCodeBlock,hsHdocDef - -syn sync minlines=20 - -if version >= 508 || !exists("did_haddock_syntax_inits") - if version < 508 - let did_haddock_syntax_inits = 1 - command -nargs=+ HiLink hi link <args> - else - command -nargs=+ HiLink hi def link <args> - endif - - HiLink hsHdocLines hsHdoc - HiLink hsHdocBlock hsHdoc - HiLink hsHdoc PreProc - HiLink hsHdocAnchor Special - HiLink hsHdocChunk Special - HiLink hsHdocMod Special - HiLink hsHdocLink Special - HiLink hsHdocEm Special - HiLink hsHdocURL Special - HiLink hsHdocCode Special - HiLink hsHdocLHeading Special - HiLink hsHdocBHeading Special - HiLink hsHdocLTracks Special - HiLink hsHdocBTracks Special - HiLink hsHdocBCodeBlock Special - HiLink hsHdocLCodeBlock Special - HiLink hsHdocSpecial Special - - delcommand HiLink -endif - -" Options for vi: sw=2 sts=2 nowrap ft=vim diff --git a/hcar.tex b/hcar.tex deleted file mode 100644 index e5ca8a20..00000000 --- a/hcar.tex +++ /dev/null @@ -1,65 +0,0 @@ -% Haddock-DH.tex -\begin{hcarentry}[updated]{Haddock} -\label{haddock} -\report{David Waern}%11/10 -\status{experimental, maintained} -\makeheader - -Haddock is a widely used documentation-generation tool for Haskell -library code. Haddock generates documentation by parsing and typechecking -Haskell source code directly and including documentation supplied by the -programmer in the form of specially-formatted comments in the source code -itself. Haddock has direct support in Cabal~\cref{cabal}, and is used to -generate the documentation for the hierarchical libraries that come with GHC, -Hugs, and nhc98 -(\url{http://www.haskell.org/ghc/docs/latest/html/libraries}) as well as -the documentation on Hackage. - -The latest release is version 2.8.1, released September 3 2010. - -\Separate -Recent changes: -\begin{itemize} -\item HTML backend completely rewritten to generate semantically rich XHTML - using the xhtml package. -\item New default CSS based on the color scheme chosen for the new Haskell - wiki, with a pull-out tab for the synopsis. -\item Theme engine based on CSS files. Themes can be switched from the - header menu. -\item Markup support for executable examples/unit-tests. -\item Addition of a LaTeX backend. -\item Additions and changes to the Haddock API. -\item Various smaller new features and bug fixes. -\end{itemize} - -\FuturePlans -\begin{itemize} -\item Although Haddock understands many GHC language extensions, we would like it to -understand all of them. Currently there are some constructs you cannot comment, -like GADTs and associated type synonyms. - -\item Error messages is an area with room for improvement. We would like Haddock -to include accurate line numbers in markup syntax errors. - -\item On the HTML rendering side we want to make more use of Javascript in order to make -the viewing experience better. The frames-mode could be improved this way, for -example. - -\item Finally, the long term plan is to split Haddock into one program that creates -data from sources, and separate backend programs that use that data via the -Haddock API. This will scale better, not requiring adding new backends to Haddock -for every tool that needs its own format. -\end{itemize} - -\FurtherReading -\begin{compactitem} -\item Haddock's homepage: -\url{http://www.haskell.org/haddock/} - -\item Haddock's developer Wiki and Trac: -\url{http://trac.haskell.org/haddock} - -\item Haddock's mailing list: -\url{haddock@@projects.haskell.org} -\end{compactitem} -\end{hcarentry} diff --git a/html-test/ref/Bold.html b/html-test/ref/Bold.html index d936a720..7151862d 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/Bold.html @@ -17,11 +17,11 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bold.html");}; ><div id="package-header" ><ul class="links" id="page-menu" ><li - ><a href="index.html" + ><a href="" >Contents</a ></li ><li - ><a href="doc-index.html" + ><a href="" >Index</a ></li ></ul @@ -46,9 +46,9 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bold.html");}; >Synopsis</p ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" ><li class="src short" - ><a href="#v:foo" + ><a href="" >foo</a - > :: t</li + > :: t</li ></ul ></div ><div id="interface" @@ -58,7 +58,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bold.html");}; ><p class="src" ><a name="v:foo" class="def" >foo</a - > :: t</p + > :: t</p ><div class="doc" ><p >Some <strong @@ -90,7 +90,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bold.html");}; ></div ><div id="footer" ><p - >Produced by <a href="http://www.haskell.org/haddock/" + >Produced by <a href="" >Haddock</a > version 2.15.0</p ></div diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html new file mode 100644 index 00000000..117286ce --- /dev/null +++ b/html-test/ref/Bug26.html @@ -0,0 +1,175 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug26</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug26.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe-Inferred</td + ></tr + ></table + ><p class="caption" + >Bug26</p + ></div + ><div id="description" + ><p class="caption" + >Description</p + ><div class="doc" + ><p + >This module tests the ‘@since …’ annotation.</p + ><p + ><em + >Since: 1.2.3</em + ></p + ></div + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="" + >f</a + > :: ()</li + ><li class="src short" + ><a href="" + >g</a + > :: ()</li + ><li class="src short" + ><span class="keyword" + >class</span + > <a href="" + >C</a + > a <span class="keyword" + >where</span + ><ul class="subs" + ><li + ><a href="" + >c_f</a + > :: a</li + ></ul + ></li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:f" class="def" + >f</a + > :: ()</p + ><div class="doc" + ><p + >Foo</p + ><p + ><em + >Since: 2.10.8</em + ></p + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:g" class="def" + >g</a + > :: ()</p + ><div class="doc" + ><p + >Bar</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >class</span + > <a name="t:C" class="def" + >C</a + > a <span class="keyword" + >where</span + ></p + ><div class="doc" + ><p + >Class</p + ><p + ><em + >Since: 1.0</em + ></p + ></div + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a name="v:c_f" class="def" + >c_f</a + > :: a</p + ><div class="doc" + ><p + ><em + >Since: 1.2.3</em + ></p + ></div + ></div + ><div class="subs instances" + ><p id="control.i:C" class="caption collapser" onclick="toggleSection('i:C')" + >Instances</p + ><div id="section.i:C" class="show" + ><table + ><tr + ><td class="src" + ><a href="" + >C</a + > ()</td + ><td class="doc" + ><p + >instance for ()</p + ><p + ><em + >Since: 0.7.8</em + ></p + ></td + ></tr + ></table + ></div + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.15.1</p + ></div + ></body + ></html +> diff --git a/html-test/ref/Bug298.html b/html-test/ref/Bug298.html index 03ed5eeb..040eccc4 100644 --- a/html-test/ref/Bug298.html +++ b/html-test/ref/Bug298.html @@ -48,19 +48,19 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug298.html");}; ><li class="src short" ><a href="" >(<^>)</a - > :: (a -> a) -> a -> a</li + > :: (a -> a) -> a -> a</li ><li class="src short" ><a href="" >(<^)</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><a href="" >(^>)</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><a href="" >(⋆^)</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><a href="" >f</a @@ -74,25 +74,25 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug298.html");}; ><p class="src" ><a name="v:-60--94--62-" class="def" >(<^>)</a - > :: (a -> a) -> a -> a</p + > :: (a -> a) -> a -> a</p ></div ><div class="top" ><p class="src" ><a name="v:-60--94-" class="def" >(<^)</a - > :: a -> a -> a</p + > :: a -> a -> a</p ></div ><div class="top" ><p class="src" ><a name="v:-94--62-" class="def" >(^>)</a - > :: a -> a -> a</p + > :: a -> a -> a</p ></div ><div class="top" ><p class="src" ><a name="v:-8902--94-" class="def" >(⋆^)</a - > :: a -> a -> a</p + > :: a -> a -> a</p ></div ><div class="top" ><p class="src" diff --git a/html-test/ref/Bug188.html b/html-test/ref/Bug310.html index 3e9f4eec..926d6cf2 100644 --- a/html-test/ref/Bug188.html +++ b/html-test/ref/Bug310.html @@ -3,13 +3,13 @@ ><head ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /><title - >Bug188</title + >Bug310</title ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" /><script src="haddock-util.js" type="text/javascript" ></script ><script type="text/javascript" >//<![CDATA[ -window.onload = function () {pageLoad();setSynopsis("mini_Bug188.html");}; +window.onload = function () {pageLoad();setSynopsis("mini_Bug310.html");}; //]]> </script ></head @@ -35,11 +35,25 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug188.html");}; ><th >Safe Haskell</th ><td - >Safe-Inferred</td + >None</td ></tr ></table ><p class="caption" - >Bug188</p + >Bug310</p + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><span class="keyword" + >type family</span + > a <a href="" + >+</a + > b :: <a href="" + >Nat</a + ></li + ></ul ></div ><div id="interface" ><h1 @@ -47,25 +61,19 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug188.html");}; ><div class="top" ><p class="src" ><span class="keyword" - >class</span - > <a name="t:A" class="def" - >A</a - > a <span class="keyword" - >where</span + >type family</span + > a <a name="t:-43-" class="def" + >+</a + > b :: <a href="" + >Nat</a + > <span class="fixity" + >infixl 6</span + ><span class="rightedge" + ></span ></p - ><div class="subs methods" - ><p class="caption" - >Methods</p - ><p class="src" - ><a name="v:f" class="def" - >f</a - >, <a name="v:g" class="def" - >g</a - >, <a name="v:h" class="def" - >h</a - >, <a name="v:i" class="def" - >i</a - > :: a -> ()</p + ><div class="doc" + ><p + >Addition of type-level naturals.</p ></div ></div ></div @@ -74,7 +82,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug188.html");}; ><p >Produced by <a href="" >Haddock</a - > version 2.15.0</p + > version 2.15.1</p ></div ></body ></html diff --git a/html-test/ref/Bug313.html b/html-test/ref/Bug313.html new file mode 100644 index 00000000..5fa34eff --- /dev/null +++ b/html-test/ref/Bug313.html @@ -0,0 +1,132 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug313</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug313.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe-Inferred</td + ></tr + ></table + ><p class="caption" + >Bug313</p + ></div + ><div id="description" + ><p class="caption" + >Description</p + ><div class="doc" + ><p + >The first list is incorrectly numbered as 1. 2. 1.; the second example + renders fine (1. 2. 3.).</p + ><p + >See <a href="" + >https://github.com/haskell/haddock/issues/313</a + ></p + ></div + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="" + >a</a + > :: a</li + ><li class="src short" + ><a href="" + >b</a + > :: a</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:a" class="def" + >a</a + > :: a</p + ><div class="doc" + ><p + >Some text.</p + ><ol + ><li + >Item 1</li + ><li + ><p + >Item 2</p + ><pre + >Some code</pre + ></li + ><li + >Item 3</li + ></ol + ><p + >Some more text.</p + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:b" class="def" + >b</a + > :: a</p + ><div class="doc" + ><p + >Some text.</p + ><ol + ><li + >Item 1</li + ><li + ><p + >Item 2</p + ><pre + >Some code</pre + ></li + ><li + >Item 3</li + ></ol + ><p + >Some more text.</p + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.15.0</p + ></div + ></body + ></html +> diff --git a/html-test/ref/Bug335.html b/html-test/ref/Bug335.html new file mode 100644 index 00000000..76c39951 --- /dev/null +++ b/html-test/ref/Bug335.html @@ -0,0 +1,125 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug335</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug335.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe-Inferred</td + ></tr + ></table + ><p class="caption" + >Bug335</p + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="" + >f</a + > :: ()</li + ><li class="src short" + ><a href="" + >g</a + > :: ()</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:f" class="def" + >f</a + > :: ()</p + ><div class="doc" + ><h3 id="control.ch:f0" class="caption collapser" onclick="toggleSection('ch:f0')" + >ExF:</h3 + ><div id="section.ch:f0" class="show" + ><p + >abc</p + ></div + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:g" class="def" + >g</a + > :: ()</p + ><div class="doc" + ><h3 id="control.ch:g0" class="caption collapser" onclick="toggleSection('ch:g0')" + >ExG:</h3 + ><div id="section.ch:g0" class="show" + ><pre class="screen" + ><code class="prompt" + >>>> </code + ><strong class="userinput" + ><code + >a +</code + ></strong + >b +</pre + ><pre class="screen" + ><code class="prompt" + >>>> </code + ><strong class="userinput" + ><code + >c +</code + ></strong + >d +</pre + ><h4 + >Under ex</h4 + ><p + >foo</p + ></div + ><h2 + >Out of Ex</h2 + ><p + >foo</p + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.15.1</p + ></div + ></body + ></html +> diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html index 3bb044c1..288ee9f5 100644 --- a/html-test/ref/Bug8.html +++ b/html-test/ref/Bug8.html @@ -86,7 +86,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");}; ><p class="src" ><a name="v:-45--45--62-" class="def" >(-->)</a - > :: t -> t1 -> <a href="Bug8.html#t:Typ" + > :: t -> t1 -> <a href="" >Typ</a > <span class="fixity" >infix 9</span @@ -98,9 +98,9 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");}; ><p class="src" ><a name="v:-45--45--45--62-" class="def" >(--->)</a - > :: [a] -> <a href="Bug8.html#t:Typ" + > :: [a] -> <a href="" >Typ</a - > -> <a href="Bug8.html#t:Typ" + > -> <a href="" >Typ</a > <span class="fixity" >infix 9</span @@ -112,19 +112,19 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");}; ><p class="src" ><a name="v:s" class="def" >s</a - > :: t</p + > :: t</p ></div ><div class="top" ><p class="src" ><a name="v:t" class="def" >t</a - > :: t</p + > :: t</p ></div ><div class="top" ><p class="src" ><a name="v:main" class="def" >main</a - > :: t</p + > :: t</p ></div ></div ></div diff --git a/html-test/ref/Extensions.html b/html-test/ref/Extensions.html index ba2af28f..b2acb26e 100644 --- a/html-test/ref/Extensions.html +++ b/html-test/ref/Extensions.html @@ -60,7 +60,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Extensions.html");}; ><li class="src short" ><a href="" >foobar</a - > :: t</li + > :: t</li ></ul ></div ><div id="interface" @@ -70,7 +70,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Extensions.html");}; ><p class="src" ><a name="v:foobar" class="def" >foobar</a - > :: t</p + > :: t</p ><div class="doc" ><p >Bar</p diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index d3fea6b7..5c1fe892 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -55,9 +55,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; ><table ><tr ><td class="src" - >:: <span class="keyword" - >forall</span - > a . <a href="" + >:: <a href="" >Ord</a > a</td ><td class="doc empty" @@ -154,6 +152,122 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; ></table ></div ></div + ><div class="top" + ><p class="src" + ><a name="v:h" class="def" + >h</a + ></p + ><div class="subs arguments" + ><p class="caption" + >Arguments</p + ><table + ><tr + ><td class="src" + >:: a</td + ><td class="doc" + ><p + >First argument</p + ></td + ></tr + ><tr + ><td class="src" + >-> b</td + ><td class="doc" + ><p + >Second argument</p + ></td + ></tr + ><tr + ><td class="src" + >-> c</td + ><td class="doc" + ><p + >Third argument</p + ></td + ></tr + ><tr + ><td class="src" + >-> d</td + ><td class="doc" + ><p + >Result</p + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:i" class="def" + >i</a + ></p + ><div class="subs arguments" + ><p class="caption" + >Arguments</p + ><table + ><tr + ><td class="src" + >:: <span class="keyword" + >forall</span + > (b :: <a href="" + >()</a + >). (d ~ <a href="" + >()</a + >)</td + ><td class="doc empty" + > </td + ></tr + ><tr + ><td class="src" + >=> a b c d</td + ><td class="doc" + ><p + >abcd</p + ></td + ></tr + ><tr + ><td class="src" + >-> ()</td + ><td class="doc" + ><p + >Result</p + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:j" class="def" + >j</a + ></p + ><div class="subs arguments" + ><p class="caption" + >Arguments</p + ><table + ><tr + ><td class="src" + >:: <span class="keyword" + >forall</span + > (a :: <a href="" + >()</a + >). proxy a</td + ><td class="doc" + ><p + >First argument</p + ></td + ></tr + ><tr + ><td class="src" + >-> b</td + ><td class="doc" + ><p + >Result</p + ></td + ></tr + ></table + ></div + ></div ></div ></div ><div id="footer" diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index 9bd826d6..3874af26 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -94,7 +94,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_ImplicitParams.html"); ><p class="src" ><a name="v:f" class="def" >f</a - > :: ((?x :: <a href="" + > :: ((?x :: <a href="" >X</a >) => a) -> a</p ></div diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index e3302d8f..2b0befba 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -48,31 +48,31 @@ window.onload = function () {pageLoad();setSynopsis("mini_Nesting.html");}; ><li class="src short" ><a href="" >d</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >e</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >f</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >g</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >h</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >i</a - > :: t</li + > :: t</li ><li class="src short" ><a href="" >j</a - > :: t</li + > :: t</li ></ul ></div ><div id="interface" @@ -82,7 +82,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Nesting.html");}; ><p class="src" ><a name="v:d" class="def" >d</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -114,7 +114,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Nesting.html");}; ><p class="src" ><a name="v:e" class="def" >e</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -135,7 +135,7 @@ the presence of this text pushes it out of nesting back to the top.</li ><p class="src" ><a name="v:f" class="def" >f</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -153,7 +153,7 @@ the presence of this text pushes it out of nesting back to the top.</li ><p class="src" ><a name="v:g" class="def" >g</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -171,7 +171,7 @@ the presence of this text pushes it out of nesting back to the top.</li ><p class="src" ><a name="v:h" class="def" >h</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -189,7 +189,7 @@ tracks</pre ><p class="src" ><a name="v:i" class="def" >i</a - > :: t</p + > :: t</p ><div class="doc" ><ul ><li @@ -239,7 +239,7 @@ More of the indented list.</p ><p class="src" ><a name="v:j" class="def" >j</a - > :: t</p + > :: t</p ><div class="doc" ><dl ><dt diff --git a/html-test/ref/NonGreedy.html b/html-test/ref/NonGreedy.html index ceede7cb..91deb281 100644 --- a/html-test/ref/NonGreedy.html +++ b/html-test/ref/NonGreedy.html @@ -48,7 +48,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_NonGreedy.html");}; ><li class="src short" ><a href="" >f</a - > :: a</li + > :: a</li ></ul ></div ><div id="interface" @@ -58,7 +58,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_NonGreedy.html");}; ><p class="src" ><a name="v:f" class="def" >f</a - > :: a</p + > :: a</p ><div class="doc" ><p ><a href="" diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html index b076206d..e9be655f 100644 --- a/html-test/ref/Operators.html +++ b/html-test/ref/Operators.html @@ -56,15 +56,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><li class="src short" ><a href="" >(+-)</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><a href="" >(*/)</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><a href="" >foo</a - > :: a -> a -> a</li + > :: a -> a -> a</li ><li class="src short" ><span class="keyword" >data</span @@ -153,11 +153,11 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><a href="" >(**>)</a >, <a href="" - >(**<)</a + >(<**)</a >, <a href="" >(>**)</a >, <a href="" - >(<**)</a + >(**<)</a > :: a -> a -> ()</li ></ul ></li @@ -178,7 +178,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><p class="src" ><a name="v:-43--45-" class="def" >(+-)</a - > :: a -> a -> a</p + > :: a -> a -> a</p ><div class="doc" ><p >Operator with no fixity</p @@ -188,7 +188,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><p class="src" ><a name="v:-42--47-" class="def" >(*/)</a - > :: a -> a -> a <span class="fixity" + > :: a -> a -> a <span class="fixity" >infixr 7</span ><span class="rightedge" ></span @@ -202,7 +202,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><p class="src" ><a name="v:foo" class="def" >foo</a - > :: a -> a -> a <span class="fixity" + > :: a -> a -> a <span class="fixity" >infixl 3</span ><span class="rightedge" ></span @@ -411,16 +411,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");}; ><p class="src" ><a name="v:-42--42--62-" class="def" >(**>)</a - >, <a name="v:-42--42--60-" class="def" - >(**<)</a - >, <a name="v:-62--42--42-" class="def" - >(>**)</a >, <a name="v:-60--42--42-" class="def" >(<**)</a + >, <a name="v:-62--42--42-" class="def" + >(>**)</a + >, <a name="v:-42--42--60-" class="def" + >(**<)</a > :: a -> a -> () <span class="fixity" >infixr 8 **>, >**</span ><span class="fixity" - >infixl 8 **<, <**</span + >infixl 8 <**, **<</span ><span class="rightedge" ></span ></p diff --git a/html-test/ref/TH2.html b/html-test/ref/TH2.html index 2cd886bb..61145958 100644 --- a/html-test/ref/TH2.html +++ b/html-test/ref/TH2.html @@ -48,7 +48,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TH2.html");}; ><p class="src" ><a name="v:f" class="def" >f</a - > :: t -> t</p + > :: t -> t</p ></div ></div ></div diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html index fcad8657..89491f01 100644 --- a/html-test/ref/Test.html +++ b/html-test/ref/Test.html @@ -487,7 +487,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><li ><a href="" >d</a - > :: <a href="" + > :: <a href="" >T</a > a b</li ><li @@ -657,7 +657,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><li class="src short" ><a href="" >withoutType</a - > :: t</li + > :: t</li ></ul ></div ><div id="interface" @@ -1535,7 +1535,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><p class="src" ><a name="v:d" class="def" >d</a - > :: <a href="" + > :: <a href="" >T</a > a b</p ><p class="src" @@ -2130,7 +2130,7 @@ is at the beginning of the line).</pre ><p class="src" ><a name="v:withoutType" class="def" >withoutType</a - > :: t</p + > :: t</p ><div class="doc" ><p >Comment on a definition without type signature</p diff --git a/html-test/ref/Ticket112.html b/html-test/ref/Ticket112.html index 9c3932cf..528787c7 100644 --- a/html-test/ref/Ticket112.html +++ b/html-test/ref/Ticket112.html @@ -48,7 +48,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket112.html");}; ><li class="src short" ><a href="" >f</a - > :: a</li + > :: a</li ></ul ></div ><div id="interface" @@ -58,7 +58,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket112.html");}; ><p class="src" ><a name="v:f" class="def" >f</a - > :: a</p + > :: a</p ><div class="doc" ><p >...given a raw <code diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index 1a53b8ec..2e80bf9f 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -120,7 +120,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeOperators.html");} ><p class="src" ><a name="v:biO" class="def" >biO</a - > :: (g <a href="" + > :: (g <a href="" >`O`</a > f) a</p ></div diff --git a/html-test/ref/mini_A.html b/html-test/ref/mini_A.html index cbe50e41..c3d36935 100644 --- a/html-test/ref/mini_A.html +++ b/html-test/ref/mini_A.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >A</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -45,7 +45,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >X</a - > </p + ></p ></div ><div class="top" ><p class="src" diff --git a/html-test/ref/mini_AdvanceTypes.html b/html-test/ref/mini_AdvanceTypes.html index 59d8dcb1..c4b0806a 100644 --- a/html-test/ref/mini_AdvanceTypes.html +++ b/html-test/ref/mini_AdvanceTypes.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Pattern</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_B.html b/html-test/ref/mini_B.html index 211a7deb..9b3ef381 100644 --- a/html-test/ref/mini_B.html +++ b/html-test/ref/mini_B.html @@ -37,7 +37,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >X</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_Bug1.html b/html-test/ref/mini_Bug1.html index adf81c73..bab3748c 100644 --- a/html-test/ref/mini_Bug1.html +++ b/html-test/ref/mini_Bug1.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >T</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_Bug6.html b/html-test/ref/mini_Bug6.html index 5c5c1119..e448e7a3 100644 --- a/html-test/ref/mini_Bug6.html +++ b/html-test/ref/mini_Bug6.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >A</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >B</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -41,7 +41,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >C</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -49,7 +49,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >D</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -57,7 +57,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >E</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_Bug7.html b/html-test/ref/mini_Bug7.html index 1bec82ee..2cb7ebe1 100644 --- a/html-test/ref/mini_Bug7.html +++ b/html-test/ref/mini_Bug7.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Foo</a - > </p + ></p ></div ><div class="top" ><p class="src" diff --git a/html-test/ref/mini_Bug8.html b/html-test/ref/mini_Bug8.html index 070dbcf8..ca6ec68a 100644 --- a/html-test/ref/mini_Bug8.html +++ b/html-test/ref/mini_Bug8.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Typ</a - > </p + ></p ></div ><div class="top" ><p class="src" diff --git a/html-test/ref/mini_BugDeprecated.html b/html-test/ref/mini_BugDeprecated.html index f0410137..9c8fc229 100644 --- a/html-test/ref/mini_BugDeprecated.html +++ b/html-test/ref/mini_BugDeprecated.html @@ -28,13 +28,13 @@ window.onload = function () {pageLoad();}; ><div class="top" ><p class="src" ><a href="" target="main" - >baz</a + >bar</a ></p ></div ><div class="top" ><p class="src" ><a href="" target="main" - >bar</a + >baz</a ></p ></div ><div class="top" @@ -46,13 +46,13 @@ window.onload = function () {pageLoad();}; ><div class="top" ><p class="src" ><a href="" target="main" - >three</a + >two</a ></p ></div ><div class="top" ><p class="src" ><a href="" target="main" - >two</a + >three</a ></p ></div ></div diff --git a/html-test/ref/mini_DeprecatedData.html b/html-test/ref/mini_DeprecatedData.html index 8ef20113..7f11afeb 100644 --- a/html-test/ref/mini_DeprecatedData.html +++ b/html-test/ref/mini_DeprecatedData.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Foo</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >One</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_DeprecatedNewtype.html b/html-test/ref/mini_DeprecatedNewtype.html index a913525f..84d41828 100644 --- a/html-test/ref/mini_DeprecatedNewtype.html +++ b/html-test/ref/mini_DeprecatedNewtype.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >SomeNewType</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >SomeOtherNewType</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_DeprecatedRecord.html b/html-test/ref/mini_DeprecatedRecord.html index 3d949d2d..54dc9722 100644 --- a/html-test/ref/mini_DeprecatedRecord.html +++ b/html-test/ref/mini_DeprecatedRecord.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Foo</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_DeprecatedTypeSynonym.html b/html-test/ref/mini_DeprecatedTypeSynonym.html index 5ade100d..c04c374f 100644 --- a/html-test/ref/mini_DeprecatedTypeSynonym.html +++ b/html-test/ref/mini_DeprecatedTypeSynonym.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >type</span > <a href="" target="main" >TypeSyn</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >type</span > <a href="" target="main" >OtherTypeSyn</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_HiddenInstances.html b/html-test/ref/mini_HiddenInstances.html index 0f1a2e04..01bab320 100644 --- a/html-test/ref/mini_HiddenInstances.html +++ b/html-test/ref/mini_HiddenInstances.html @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >VisibleData</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_HiddenInstancesB.html b/html-test/ref/mini_HiddenInstancesB.html index 3ce4f6a9..e02b42b1 100644 --- a/html-test/ref/mini_HiddenInstancesB.html +++ b/html-test/ref/mini_HiddenInstancesB.html @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Bar</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_QuasiExpr.html b/html-test/ref/mini_QuasiExpr.html index 7dd9b829..06797498 100644 --- a/html-test/ref/mini_QuasiExpr.html +++ b/html-test/ref/mini_QuasiExpr.html @@ -25,7 +25,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Expr</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -33,7 +33,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >BinOp</a - > </p + ></p ></div ><div class="top" ><p class="src" diff --git a/html-test/ref/mini_Test.html b/html-test/ref/mini_Test.html index 3a01ff1c..7453387c 100644 --- a/html-test/ref/mini_Test.html +++ b/html-test/ref/mini_Test.html @@ -69,7 +69,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >T6</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -135,7 +135,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >R</a - > </p + ></p ></div ><div class="top" ><p class="src" @@ -143,7 +143,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >R1</a - > </p + ></p ></div ><h1 >Class declarations</h1 diff --git a/html-test/ref/mini_Ticket253_2.html b/html-test/ref/mini_Ticket253_2.html index 603590a8..ea62c2ad 100644 --- a/html-test/ref/mini_Ticket253_2.html +++ b/html-test/ref/mini_Ticket253_2.html @@ -31,7 +31,7 @@ window.onload = function () {pageLoad();}; >data</span > <a href="" target="main" >Baz</a - > </p + ></p ></div ></div ></body diff --git a/html-test/ref/mini_TypeFamilies.html b/html-test/ref/mini_TypeFamilies.html index 0cf39c88..feb61abc 100644 --- a/html-test/ref/mini_TypeFamilies.html +++ b/html-test/ref/mini_TypeFamilies.html @@ -22,9 +22,49 @@ window.onload = function () {pageLoad();}; ><div class="top" ><p class="src" ><span class="keyword" + >data</span + > <a href="" target="main" + >X</a + ></p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a href="" target="main" + >Y</a + ></p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a href="" target="main" + >Z</a + ></p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >class</span + > <a href="" target="main" + >Test</a + > a</p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" >type family</span > <a href="" - >G</a + >Foo</a + > a :: k</p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data family</span + > <a href="" + >Bat</a > a :: *</p ></div ><div class="top" @@ -32,7 +72,7 @@ window.onload = function () {pageLoad();}; ><span class="keyword" >class</span > <a href="" target="main" - >A</a + >Assoc</a > a</p ></div ><div class="top" @@ -40,14 +80,24 @@ window.onload = function () {pageLoad();}; ><span class="keyword" >type family</span > <a href="" - >F</a - > a </p + >Bar</a + > b</p ></div ><div class="top" ><p class="src" - ><a href="" target="main" - >g</a - ></p + ><span class="keyword" + >type family</span + > a <a href="" + ><></a + > b :: k</p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >class</span + > a <a href="" target="main" + >><</a + > b</p ></div ></div ></body diff --git a/html-test/ref/mini_TypeOperators.html b/html-test/ref/mini_TypeOperators.html index 02bc918b..ce31643e 100644 --- a/html-test/ref/mini_TypeOperators.html +++ b/html-test/ref/mini_TypeOperators.html @@ -19,9 +19,7 @@ window.onload = function () {pageLoad();}; >TypeOperators</p ></div ><div id="interface" - ><h1 - >stuff</h1 - ><div class="top" + ><div class="top" ><p class="src" ><span class="keyword" >data</span @@ -55,10 +53,42 @@ window.onload = function () {pageLoad();}; ></div ><div class="top" ><p class="src" + ><span class="keyword" + >class</span + > a <a href="" target="main" + ><=></a + > b</p + ></div + ><div class="top" + ><p class="src" ><a href="" target="main" >biO</a ></p ></div + ><div class="top" + ><p class="src" + ><a href="" target="main" + >f</a + ></p + ></div + ><div class="top" + ><p class="src" + ><a href="" target="main" + >g</a + ></p + ></div + ><div class="top" + ><p class="src" + ><a href="" target="main" + >x</a + ></p + ></div + ><div class="top" + ><p class="src" + ><a href="" target="main" + >y</a + ></p + ></div ></div ></body ></html diff --git a/html-test/ref/ocean.css b/html-test/ref/ocean.css index 05597d79..de436324 100644 --- a/html-test/ref/ocean.css +++ b/html-test/ref/ocean.css @@ -49,14 +49,14 @@ a[href]:hover { text-decoration:underline; } For reasons, see: http://yui.yahooapis.com/3.1.1/build/cssfonts/fonts.css */ - + body { font:13px/1.4 sans-serif; *font-size:small; /* for IE */ *font:x-small; /* for IE in quirks mode */ } -h1 { font-size: 146.5%; /* 19pt */ } +h1 { font-size: 146.5%; /* 19pt */ } h2 { font-size: 131%; /* 17pt */ } h3 { font-size: 116%; /* 15pt */ } h4 { font-size: 100%; /* 13pt */ } @@ -98,7 +98,7 @@ pre, code, kbd, samp, tt, .src { /* @group Common */ -.caption, h1, h2, h3, h4, h5, h6 { +.caption, h1, h2, h3, h4, h5, h6 { font-weight: bold; color: rgb(78,98,114); margin: 0.8em 0 0.4em; @@ -122,7 +122,7 @@ ul.links { ul.links li { display: inline; - border-left: 1px solid #d5d5d5; + border-left: 1px solid #d5d5d5; white-space: nowrap; padding: 0; } @@ -378,6 +378,19 @@ div#style-menu-holder { margin: 0 -0.5em 0 0.5em; } +#interface span.fixity { + color: #919191; + border-left: 1px solid #919191; + padding: 0.2em 0.5em 0.2em 0.5em; + margin: 0 -1em 0 1em; +} + +#interface span.rightedge { + border-left: 1px solid #919191; + padding: 0.2em 0 0.2em 0; + margin: 0 0 0 1em; +} + #interface table { border-spacing: 2px; } #interface td { vertical-align: top; @@ -420,19 +433,18 @@ div#style-menu-holder { margin: 0; } -.subs ul { +/* Render short-style data instances */ +.inst ul { height: 100%; padding: 0.5em; margin: 0; } -.subs ul, -.subs ul li.src { +.inst, .inst li { list-style: none; margin-left: 1em; } - .top p.src { border-top: 1px solid #ccc; } @@ -482,7 +494,7 @@ div#style-menu-holder { } #mini > * { - font-size: 93%; /* 12pt */ + font-size: 93%; /* 12pt */ } #mini #module-list .caption, diff --git a/html-test/run.lhs b/html-test/run.lhs index a8664363..a80b265e 100755 --- a/html-test/run.lhs +++ b/html-test/run.lhs @@ -54,7 +54,7 @@ test = do let mods' = map (testDir </>) mods -- add haddock_datadir to environment for subprocesses - env <- Just . (:) ("haddock_datadir", dataDir) <$> getEnvironment + env <- Just . (:) ("haddock_datadir", Main.dataDir) <$> getEnvironment putStrLn "" putStrLn "Haddock version: " diff --git a/html-test/src/Bug188.hs b/html-test/src/Bug188.hs deleted file mode 100644 index 15089699..00000000 --- a/html-test/src/Bug188.hs +++ /dev/null @@ -1,7 +0,0 @@ --- Tests that the listed order of functions grouped under a single --- type signature is preserved as in-source. Before fixing #188, it --- seems to have preserved the first function but reversed the rest. -module Bug188 where - -class A a where - f, g, h, i :: a -> () diff --git a/html-test/src/Bug26.hs b/html-test/src/Bug26.hs new file mode 100644 index 00000000..b0483f03 --- /dev/null +++ b/html-test/src/Bug26.hs @@ -0,0 +1,29 @@ +-- | This module tests the ‘@since …’ annotation. +-- +-- @since 1.2.3 +module Bug26 where + +-- | Foo +-- +-- @since 2.10.7 +-- +-- @since 2.10.8 +f :: () +f = () + +-- | Bar +g :: () +g = () + +-- | Class +-- +-- @since 1.0 +class C a where + -- | @since 1.2.3 + c_f :: a + +-- | instance for () +-- +-- @since 0.7.8 +instance C () where + c_f = () diff --git a/html-test/src/Bug310.hs b/html-test/src/Bug310.hs new file mode 100644 index 00000000..d2492dc0 --- /dev/null +++ b/html-test/src/Bug310.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitNamespaces #-} +module Bug310 ( type (+) ) where + +import GHC.TypeLits diff --git a/html-test/src/Bug313.hs b/html-test/src/Bug313.hs new file mode 100644 index 00000000..90d4d3b6 --- /dev/null +++ b/html-test/src/Bug313.hs @@ -0,0 +1,37 @@ +-- | The first list is incorrectly numbered as 1. 2. 1.; the second example +-- renders fine (1. 2. 3.). +-- +-- See https://github.com/haskell/haddock/issues/313 +module Bug313 where + +{- | +Some text. + +1. Item 1 + +2. Item 2 + + > Some code + +3. Item 3 + +Some more text. +-} +a :: a +a = undefined + +{- | +Some text. + +1. Item 1 + +2. Item 2 + + > Some code + +3. Item 3 + +-} +-- | Some more text. +b :: a +b = undefined diff --git a/html-test/src/Bug335.hs b/html-test/src/Bug335.hs new file mode 100644 index 00000000..c1821dd0 --- /dev/null +++ b/html-test/src/Bug335.hs @@ -0,0 +1,26 @@ +-- Tests for collapsable headers +module Bug335 where + +{-| +=== __ExF:__ +abc +-} +f :: () +f = () + +{-| +=== __ExG:__ +>>> a +b + +>>> c +d + +==== Under ex +foo + +== Out of Ex +foo +-} +g :: () +g = () diff --git a/html-test/src/FunArgs.hs b/html-test/src/FunArgs.hs index cfde185d..24e1ccff 100644 --- a/html-test/src/FunArgs.hs +++ b/html-test/src/FunArgs.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE RankNTypes, DataKinds, TypeFamilies #-} module FunArgs where f :: forall a. Ord a @@ -15,3 +15,24 @@ g :: a -- ^ First argument -> c -- ^ Third argument -> d -- ^ Result g = undefined + + +h :: forall a b c + . a -- ^ First argument + -> b -- ^ Second argument + -> c -- ^ Third argument + -> forall d. d -- ^ Result +h = undefined + + +i :: forall a (b :: ()) d. (d ~ '()) + => forall c + . a b c d -- ^ abcd + -> () -- ^ Result +i = undefined + + +j :: forall proxy (a :: ()) b + . proxy a -- ^ First argument + -> b -- ^ Result +j = undefined diff --git a/make-sdist.sh b/make-sdist.sh index 27c0ea6f..914bf909 100644 --- a/make-sdist.sh +++ b/make-sdist.sh @@ -13,7 +13,7 @@ cd .. tar cvzf haddock-*.tar.gz haddock-*/ # Steps for doing a release: -# * Update version number in .cabal, doc/haddock.xml, haddock.spec +# * Update version number in .cabal, doc/haddock.xml # * Update CHANGES # * Source: # - do the above |
