diff options
114 files changed, 12803 insertions, 6230 deletions
diff --git a/.travis.yml b/.travis.yml index 35ee528d..2417dea9 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,8 +1,11 @@ +# NOTE: manually changes were made to an otherwise autogenerated script. This is to +# query GHC CI artifacts instead of going via Herbert's PPA +# # This Travis job script has been generated by a script via # -# runghc make_travis_yml_2.hs 'haddock.cabal' +# make_travis_yml_2.hs 'haddock.cabal' # -# For more information, see https://github.com/haskell-CI/haskell-ci +# For more information, see https://github.com/hvr/multi-ghc-travis # language: c sudo: false @@ -28,66 +31,74 @@ before_cache: matrix: include: - - compiler: "ghc-8.6.1" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1], sources: [hvr-ghc]}} + - os: linux + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head], sources: [hvr-ghc]}} + env: + - GHC_ZIP='https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/download?job=validate-x86_64-linux-deb8' before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} - - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - - echo $HCNUMVER + # Manually install GHC validate artifact + - travis_retry curl -L $GHC_ZIP --output artifact.zip + - unzip artifact.zip + - tar xpf ghc.tar.xz --strip-components 1 + - ./configure + - sudo make V=1 install + + # Set up some vars + - HC=ghc + - HCPKG=${HC/ghc/ghc-pkg} + - PATH=/usr/local/bin:/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - PKGNAME='haddock' install: - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - HADDOCK=${HADDOCK-true} - - UNCONSTRAINED=${UNCONSTRAINED-true} - - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} - - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - touch cabal.project.local - - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- haddock | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then - (cd "." && autoreconf -i); - fi - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "."/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=--enable-benchmarks + - TEST=--enable-tests + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - rm -f cabal.project.freeze + # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage + - | + sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config + for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed 's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /" ${HOME}/.cabal/config; done -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. -script: - - cat cabal.project || true - - cat cabal.project.local || true - # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + echo 'repository head.hackage' >> ${HOME}/.cabal/config + echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config + echo ' secure: True' >> ${HOME}/.cabal/config + echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config + echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config + echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config + echo ' key-threshold: 3' >> ${HOME}/.cabal.config - # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi + grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - # cabal check - - cabal check + cabal new-update head.hackage -v + - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 --allow-newer --constraint 'setup.Cabal installed' all + - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 --allow-newer --constraint 'setup.Cabal installed' all - # Build documentation - - cabal new-haddock -w ${HC} all +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. +script: + - if [ -f configure.ac ]; then autoreconf -i; fi + - rm -rf dist/ + - cabal new-sdist # test that a source-distribution can be generated + - cd dist-newstyle/sdist/ + - SRCTAR=(${PKGNAME}-*.tar.gz) + - SRC_BASENAME="${SRCTAR/%.tar.gz}" + - tar -xvf "./$SRC_BASENAME.tar.gz" + - cd "$SRC_BASENAME/" +## from here on, CWD is inside the extracted source-tarball + - rm -fv cabal.project.local + # this builds all libraries and executables (without tests/benchmarks) + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --allow-newer --constraint 'setup.Cabal installed' all + # this builds all libraries and executables (including tests/benchmarks) + # - rm -rf ./dist-newstyle - # Build without installed constraints for packages in global-db - - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + # build & run tests + - cabal new-build -w ${HC} ${TEST} ${BENCH} --allow-newer --constraint 'setup.Cabal installed' all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} --allow-newer --constraint 'setup.Cabal installed' all; fi -# REGENDATA ["haddock.cabal"] # EOF @@ -1,9 +1,28 @@ -## Changes in TBA +## Changes in TBA * "Linuwial" is the new default theme (#721, #782, #949) * Fix style switcher (enabled by `--built-in-themes`) (#949) + * Support inline markup in markdown-style links (#875) + + * The hyperlinker backend has been re-engineered to use HIE files + and display type annotations on expressions (#977) + + * The hyperlinker backend lexer is now more incremental, faster, and + more memory efficient (#977) + + * Add an "Instances" menu item to the HTML backend for controlling + settings related to expanding/collapsing instances (#1007) + + * Improved identifier links including value/type namespaces, and + hyperlinking of parenthesized/backticked identifiers + + * Substantial bugfixes for converting `TyThing` back into source + declarations (#1003, #1005, #1022, #1020) + + * `--show-interface` now outputs to stdout (instead of stderr) + ## Changes in version 2.22.0 * Make `--package-version` optional for `--hoogle` (#899) @@ -5,8 +5,8 @@ # This file is part of the GHC build system. # # To understand how the build system works and how to modify it, see -# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture -# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying # # ----------------------------------------------------------------------------- @@ -1,4 +1,4 @@ -# Haddock, a Haskell Documentation Tool [](https://travis-ci.org/haskell/haddock) +# Haddock, a Haskell Documentation Tool [](https://travis-ci.org/haskell/haddock) ## About haddock @@ -57,9 +57,9 @@ and then proceed using your favourite build tool. #### Using [`cabal new-build`](http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html) ```bash -cabal new-build -w ghc-8.6.1 +cabal new-build -w ghc-head # build & run the test suite -cabal new-test -w ghc-8.6.1 all +cabal new-test -w ghc-head all ``` #### Using Cabal sandboxes diff --git a/doc/cheatsheet/haddocks.md b/doc/cheatsheet/haddocks.md index a3464584..5ee285b3 100644 --- a/doc/cheatsheet/haddocks.md +++ b/doc/cheatsheet/haddocks.md @@ -85,7 +85,7 @@ definitions with "[thing]" -- \[ -- f(n) = \Sum_{i=1}^{n} i -- \] - \\ when \(n > 0\) + -- when \(n > 0\) ``` # Headings in Documentation @@ -5,8 +5,8 @@ # This file is part of the GHC build system. # # To understand how the build system works and how to modify it, see -# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture -# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying # # ----------------------------------------------------------------------------- diff --git a/doc/invoking.rst b/doc/invoking.rst index ebf9792f..12a127f0 100644 --- a/doc/invoking.rst +++ b/doc/invoking.rst @@ -27,8 +27,8 @@ considered a bug in the new versions. If you ever get failed parsing message, please report it. You must also specify an option for the output format. Currently only -the :option:`--html` option for HTML and the :option:`--hoogle` option for -outputting Hoogle data are functional. +the :option:`--html` option for HTML, the :option:`--hoogle` option for +outputting Hoogle data, and the :option:`--latex` option are functional. The packaging tool `Cabal <http://www.haskell.org/ghc/docs/latest/html/Cabal/index.html>`__ @@ -124,6 +124,12 @@ The following options are available: Some JavaScript utilities used to implement some of the dynamic features like collapsible sections. +.. option:: --mathjax + + Specify a custom URL for a mathjax-compatible JS script. By default, + this is set to `MathJax + <https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML>`_. + .. option:: --latex Generate documentation in LaTeX format. Several files will be @@ -159,6 +165,35 @@ The following options are available: Generate an index file for the `Hoogle <http://hackage.haskell.org/package/hoogle>`_ search engine. + One text file will be generated into the current directory (or the + specified directory if the :option:`-o` is given). Note that + the :option:`--package-name` is required. + + Since the output is intended to be parsed by Hoogle, some conventions + need to be upheld: + + * Every entity should span exactly one line. :: + + newtype ReaderT r (m :: * -> *) a :: * -> (* -> *) -> * -> * + + The one exception to this rule is classes. The body of a class + is split up with one class member per line, an opening brace on + the line of the header, and a closing brace on a new line after + the class. :: + + class Foo a where { + foo :: a -> a -> Baz a; + type family Baz a; + type Baz a = [(a, a)]; + } + + * Entites that are exported only indirectly (for instance data + constructors visible via a ``ReaderT(..)`` export) have their names + wrapped in square brackets. :: + + [ReaderT] :: (r -> m a) -> ReaderT r m a + [runReaderT] :: ReaderT r m a -> r -> m a + .. option:: --hyperlinked-source @@ -341,6 +376,14 @@ The following options are available: The title should be a plain string (no markup please!). +.. option:: --package-name=<name> + + Specify the name of the package being documented. + +.. option:: --package-version=<version> + + Specify the version of the package being documented. + .. option:: -q <mode> --qual=<mode> @@ -368,6 +411,19 @@ The following options are available: - relative: x, B.y, C.z +.. option:: --since-qual=<mode> + + Specify how ``@since`` annotations are qualified. + + mode should be one of + + - ``always`` (default): always qualify ``@since`` annotations with + a package name and version + + - ``only-external``: only qualify ``@since`` annotations with a + package name and version when they do not come from the current + package + .. option:: -? --help @@ -378,6 +434,21 @@ The following options are available: Output version information and exit. +.. option:: --ghc-version + + Output the version of GHC which Haddock expects to find at :option:-B + and exit. + +.. option:: --print-ghc-path + + Output the path to the GHC (which Haddock computes based on :option:-B) + and exit. + +.. option:: --print-ghc-libdir + + Output the path to the GHC ``lib`` directory (which Haddock computes + based on :option:-B) and exit. + .. option:: -v --verbose @@ -415,6 +486,16 @@ The following options are available: Causes Haddock to behave as if module module has the ``hide`` attribute. (:ref:`module-attrs`). +.. option:: --show <module> + + Causes Haddock to behave as if module module does not have the ``hide`` + attribute. (:ref:`module-attrs`). + +.. option:: --show-all + + Causes Haddock to behave as if no modules have the ``hide`` attribute. + (:ref:`module-attrs`). + .. option:: --show-extensions <module> Causes Haddock to behave as if module module has the @@ -430,10 +511,21 @@ The following options are available: Turn off all warnings. +.. option:: --interface-version + + Prints out the version of the binary Haddock interface files that + this version of Haddock generates. + .. option:: --compatible-interface-versions Prints out space-separated versions of binary Haddock interface - files that this version is compatible with. + files that this version of Haddock is compatible with. + +.. option:: --bypass-interface-version-check + + **DANGEROUS** Causes Haddock to ignore the interface versions of + binary Haddock interface files. This can make Haddock crash during + deserialization of interface files. .. option:: --no-tmp-comp-dir diff --git a/doc/markup.rst b/doc/markup.rst index 4e00f708..56238855 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -8,6 +8,8 @@ will just generate documentation that contains the type signatures, data type declarations, and class declarations exported by each of the modules being processed. +.. _top-level-declaration + Documenting a Top-Level Declaration ----------------------------------- @@ -47,6 +49,8 @@ the following: - A ``class`` declaration, +- An ``instance`` declaration, + - A ``data family`` or ``type family`` declaration, or - A ``data instance`` or ``type instance`` declaration. @@ -106,6 +110,8 @@ signatures, by using either the ``-- |`` or ``-- ^`` annotations: :: -- | This is the documentation for the 'g' method g :: Int -> a +Associated type and data families can also be annotated in this way. + Constructors and Record Fields ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -166,6 +172,32 @@ would join up documentation of each field and render the result. The reason for this seemingly weird behaviour is the fact that ``someField`` is actually the same (partial) function. +Deriving clauses +~~~~~~~~~~~~~~~~ + +Most instances are top-level, so can be documented as in +:ref:`top-level-declaration`. The exception to this is instance that are +come from a ``deriving`` clause on a datatype declaration. These can +the documented like this: :: + + data D a = L a | M + deriving ( Eq -- ^ @since 4.5 + , Ord -- ^ default 'Ord' instance + ) + +This also scales to the various GHC extensions for deriving: :: + + newtype T a = T a + deriving Show -- ^ derivation of 'Show' + deriving stock ( Eq -- ^ stock derivation of 'Eq' + , Foldable -- ^ stock derivation of 'Foldable' + ) + deriving newtype Ord -- ^ newtype derivation of 'Ord' + deriving anyclass Read -- ^ unsafe derivation of 'Read' + deriving ( Eq1 -- ^ deriving 'Eq1' via 'Identity' + , Ord1 -- ^ deriving 'Ord1' via 'Identity' + ) via Identity + Function Arguments ~~~~~~~~~~~~~~~~~~ @@ -175,8 +207,8 @@ Individual arguments to a function may be documented like this: :: -> Float -- ^ The 'Float' argument -> IO () -- ^ The return value -Pattern synonyms and GADT-style data constructors also support this -style of documentation. +Pattern synonyms, GADT-style data constructors, and class methods also +support this style of documentation. .. _module-description: @@ -881,6 +913,16 @@ If ``M.T`` is not otherwise in scope, then Haddock will simply emit a link pointing to the entity ``T`` exported from module ``M`` (without checking to see whether either ``M`` or ``M.T`` exist). +Since values and types live in different namespaces in Haskell, it is +possible for a reference such as ``'X'`` to be ambiguous. In such a case, +Haddock defaults to pointing to the type. The ambiguity can be overcome by explicitly specifying a namespace, by way of a ``v`` (for value) or ``t`` +(for type) immediately before the link: :: + + -- | An implicit reference to 'X', the type constructor + -- An explicit reference to v'X', the data constructor + -- An explicit reference to t'X', the type constructor + data X = X + To make life easier for documentation writers, a quoted identifier is only interpreted as such if the quotes surround a lexically valid Haskell identifier. This means, for example, that it normally isn't @@ -890,8 +932,9 @@ necessary to escape the single quote when used as an apostrophe: :: Nothing special is needed to hyperlink identifiers which contain apostrophes themselves: to hyperlink ``foo'`` one would simply type -``'foo''``. To hyperlink identifiers written in infix form, simply put -them in quotes as always: ``'`elem`'``. +``'foo''``. Hyperlinking operators works in exactly the same way. :: + + -- | A prefix operator @'(++)'@ and an infix identifier @'`elem`'@. Emphasis, Bold and Monospaced Text ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index b4193456..a58b092a 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -44,9 +44,9 @@ library -- this package typically supports only single major versions build-depends: base ^>= 4.12.0 , Cabal ^>= 2.4.0 - , ghc ^>= 8.6 + , ghc ^>= 8.7 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.7.0 + , haddock-library ^>= 1.8.0 , xhtml ^>= 3000.2.2 -- Versions for the dependencies below are transitively pinned by @@ -59,6 +59,7 @@ library , directory , filepath , ghc-boot + , ghc-boot-th , transformers hs-source-dirs: src @@ -97,7 +98,6 @@ library Haddock.Backends.HaddockDB Haddock.Backends.Hoogle Haddock.Backends.Hyperlinker - Haddock.Backends.Hyperlinker.Ast Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Renderer Haddock.Backends.Hyperlinker.Types @@ -130,7 +130,6 @@ test-suite spec Haddock Haddock.Backends.Hoogle Haddock.Backends.Hyperlinker - Haddock.Backends.Hyperlinker.Ast Haddock.Backends.Hyperlinker.Renderer Haddock.Backends.Hyperlinker.Utils Haddock.Backends.LaTeX @@ -169,9 +168,9 @@ test-suite spec Haddock.Backends.Hyperlinker.Types build-depends: Cabal ^>= 2.4 - , ghc ^>= 8.6 + , ghc ^>= 8.7 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.7.0 + , haddock-library ^>= 1.8.0 , xhtml ^>= 3000.2.2 , hspec >= 2.4.4 && < 2.7 , QuickCheck >= 2.11 && < 2.13 @@ -187,6 +186,7 @@ test-suite spec , directory , filepath , ghc-boot + , ghc-boot-th , transformers build-tool-depends: diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css index e83dc5ec..0146eedd 100644 --- a/haddock-api/resources/html/solarized.css +++ b/haddock-api/resources/html/solarized.css @@ -53,3 +53,45 @@ a:link, a:visited { a:hover, a.hover-highlight { background-color: #eee8d5; } + +span.annot{ + position:relative; + color:#000; + text-decoration:none + } + +span.annot:hover{z-index:25; background-color:#ff0} + +span.annot span.annottext{ + display: none; + border-radius: 5px 5px; + + -moz-border-radius: 5px; + -webkit-border-radius: 5px; + + box-shadow: 5px 5px 5px rgba(0, 0, 0, 0.1); + -webkit-box-shadow: 5px 5px rgba(0, 0, 0, 0.1); + -moz-box-shadow: 5px 5px rgba(0, 0, 0, 0.1); + + position: absolute; + left: 1em; top: 2em; + z-index: 99; + margin-left: 5; + background: #FFFFAA; + border: 2px solid #FFAD33; + padding: 0.8em 1em; +} + +span.annot:hover span.annottext{ + display:block; +} + +/* This bridges the gap so you can mouse into the tooltip without it disappearing */ +span.annot span.annottext:before{ + content: ""; + position: absolute; + left: -1em; top: -1em; + background: #FFFFFF00; + z-index:-1; + padding: 2em 2em; +} diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 4ebdbfb4..412d8391 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -39,8 +39,10 @@ import Haddock.Version import Haddock.InterfaceFile import Haddock.Options import Haddock.Utils +import Haddock.GhcUtils (modifySessionDynFlags, setOutputDir) import Control.Monad hiding (forM_) +import Data.Bifunctor (second) import Data.Foldable (forM_, foldl') import Data.Traversable (for) import Data.List (isPrefixOf) @@ -66,6 +68,8 @@ import qualified GHC.Paths as GhcPaths import Paths_haddock_api (getDataDir) import System.Directory (doesDirectoryExist) #endif +import System.Directory (getTemporaryDirectory) +import System.FilePath ((</>)) import Text.ParserCombinators.ReadP (readP_to_S) import GHC hiding (verbosity) @@ -161,16 +165,30 @@ haddockWithGhc ghc args = handleTopExceptions $ do Just "YES" -> return $ Flag_OptGhc "-dynamic-too" : flags _ -> return flags + -- bypass the interface version check + let noChecks = Flag_BypassInterfaceVersonCheck `elem` flags + + -- Create a temporary directory and redirect GHC output there (unless user + -- requested otherwise). + -- + -- Output dir needs to be set before calling 'depanal' since 'depanal' uses it + -- to compute output file names that are stored in the 'DynFlags' of the + -- resulting 'ModSummary's. + let withDir | Flag_NoTmpCompDir `elem` flags = id + | otherwise = withTempOutputDir + unless (Flag_NoWarnings `elem` flags) $ do hypSrcWarnings flags forM_ (warnings args) $ \warning -> do hPutStrLn stderr warning + when noChecks $ + hPutStrLn stderr noCheckWarning - ghc flags' $ do + ghc flags' $ withDir $ do dflags <- getDynFlags forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do - mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] + mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] noChecks forM_ mIfaceFile $ \(_, ifaceFile) -> do logOutput dflags (defaultUserStyle dflags) (renderJson (jsonInterfaceFile ifaceFile)) @@ -192,17 +210,30 @@ haddockWithGhc ghc args = handleTopExceptions $ do throwE "No input file(s)." -- Get packages supplied with --read-interface. - packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags) + packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags) noChecks -- Render even though there are no input files (usually contents/index). liftIO $ renderStep dflags flags sinceQual qual packages [] +-- | Run the GHC action using a temporary output directory +withTempOutputDir :: Ghc a -> Ghc a +withTempOutputDir action = do + tmp <- liftIO getTemporaryDirectory + x <- liftIO getProcessID + let dir = tmp </> ".haddock-" ++ show x + modifySessionDynFlags (setOutputDir dir) + withTempDir dir action + -- | Create warnings about potential misuse of -optghc warnings :: [String] -> [String] warnings = map format . filter (isPrefixOf "-optghc") where format arg = concat ["Warning: `", arg, "' means `-o ", drop 2 arg, "', did you mean `-", arg, "'?"] +-- | Create a warning about bypassing the interface version check +noCheckWarning :: String +noCheckWarning = "Warning: `--bypass-interface-version-check' can cause " ++ + "Haddock to crash when reading Haddock interface files." withGhc :: [Flag] -> Ghc a -> IO a withGhc flags action = do @@ -212,15 +243,17 @@ withGhc flags action = do let handleSrcErrors action' = flip handleSourceError action' $ \err -> do printException err liftIO exitFailure + needHieFiles = Flag_HyperlinkedSource `elem` flags - withGhc' libDir (ghcFlags flags) (\_ -> handleSrcErrors action) + withGhc' libDir needHieFiles (ghcFlags flags) (\_ -> handleSrcErrors action) readPackagesAndProcessModules :: [Flag] -> [String] -> Ghc ([(DocPaths, InterfaceFile)], [Interface], LinkEnv) readPackagesAndProcessModules flags files = do -- Get packages supplied with --read-interface. - packages <- readInterfaceFiles nameCacheFromGhc (readIfaceArgs flags) + let noChecks = Flag_BypassInterfaceVersonCheck `elem` flags + packages <- readInterfaceFiles nameCacheFromGhc (readIfaceArgs flags) noChecks -- Create the interfaces -- this is the core part of Haddock. let ifaceFiles = map snd packages @@ -411,13 +444,14 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do readInterfaceFiles :: MonadIO m => NameCacheAccessor m -> [(DocPaths, FilePath)] + -> Bool -> m [(DocPaths, InterfaceFile)] -readInterfaceFiles name_cache_accessor pairs = do +readInterfaceFiles name_cache_accessor pairs bypass_version_check = do catMaybes `liftM` mapM ({-# SCC readInterfaceFile #-} tryReadIface) pairs where -- try to read an interface, warn if we can't tryReadIface (paths, file) = - readInterfaceFile name_cache_accessor file >>= \case + readInterfaceFile name_cache_accessor file bypass_version_check >>= \case Left err -> liftIO $ do putStrLn ("Warning: Cannot read " ++ file ++ ":") putStrLn (" " ++ err) @@ -433,14 +467,10 @@ 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 - dynflags <- getSessionDynFlags - dynflags' <- parseGhcFlags (gopt_set dynflags Opt_Haddock) { - hscTarget = HscNothing, - ghcMode = CompManager, - ghcLink = NoLink - } +withGhc' :: String -> Bool -> [String] -> (DynFlags -> Ghc a) -> IO a +withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do + dynflags' <- parseGhcFlags =<< getSessionDynFlags + -- We disable pattern match warnings because than can be very -- expensive to check let dynflags'' = unsetPatternMatchWarnings $ @@ -468,11 +498,19 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do parseGhcFlags dynflags = do -- TODO: handle warnings? - let flags' = filterRtsFlags flags - (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags') + let extra_opts | needHieFiles = [Opt_WriteHie, Opt_Haddock] + | otherwise = [Opt_Haddock] + dynflags' = (foldl' gopt_set dynflags extra_opts) + { hscTarget = HscNothing + , ghcMode = CompManager + , ghcLink = NoLink + } + flags' = filterRtsFlags flags + + (dynflags'', rest, _) <- parseDynamicFlags dynflags' (map noLoc flags') if not (null rest) then throwE ("Couldn't parse GHC options: " ++ unwords flags') - else return dynflags' + else return dynflags'' unsetPatternMatchWarnings :: DynFlags -> DynFlags unsetPatternMatchWarnings dflags = @@ -622,7 +660,7 @@ getPrologue dflags flags = h <- openFile filename ReadMode hSetEncoding h utf8 str <- hGetContents h -- semi-closes the handle - return . Just $! parseParas dflags Nothing str + return . Just $! second (fmap rdrName) $ parseParas dflags Nothing str _ -> throwE "multiple -p/--prologue options" diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 7e2ce2f2..149f4815 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -17,14 +17,14 @@ module Haddock.Backends.Hoogle ( ppHoogle ) where -import BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..)) +import BasicTypes ( OverlapFlag(..), OverlapMode(..), SourceText(..) + , PromotionFlag(..) ) import InstEnv (ClsInst(..)) import Documentation.Haddock.Markup import Haddock.GhcUtils import Haddock.Types hiding (Version) import Haddock.Utils hiding (out) -import HsBinds (emptyLHsBinds) import GHC import Outputable import NameSet @@ -36,7 +36,6 @@ import Data.Version import System.Directory import System.FilePath -import System.IO prefix :: [String] prefix = ["-- Hoogle documentation, generated by Haddock" @@ -56,10 +55,7 @@ ppHoogle dflags package version synopsis prologue ifaces odir = do | not (null (versionBranch version)) ] ++ concat [ppModule dflags' i | i <- ifaces, OptHide `notElem` ifaceOptions i] createDirectoryIfMissing True odir - h <- openFile (odir </> filename) WriteMode - hSetEncoding h utf8 - hPutStr h (unlines contents) - hClose h + writeUtf8File (odir </> filename) (unlines contents) ppModule :: DynFlags -> Interface -> [String] ppModule dflags iface = @@ -80,6 +76,7 @@ dropHsDocTy = f f (HsQualTy x a e) = HsQualTy x a (g e) f (HsBangTy x a b) = HsBangTy x a (g b) f (HsAppTy x a b) = HsAppTy x (g a) (g b) + f (HsAppKindTy x a b) = HsAppKindTy x (g a) (g b) f (HsFunTy x a b) = HsFunTy x (g a) (g b) f (HsListTy x a) = HsListTy x (g a) f (HsTupleTy x a b) = HsTupleTy x a (map g b) @@ -338,7 +335,7 @@ markupTag dflags = Markup { markupString = str, markupAppend = (++), markupIdentifier = box (TagInline "a") . str . out dflags, - markupIdentifierUnchecked = box (TagInline "a") . str . out dflags . snd, + markupIdentifierUnchecked = box (TagInline "a") . str . showWrapped (out dflags . snd), markupModule = box (TagInline "a") . str, markupWarning = box (TagInline "i"), markupEmphasis = box (TagInline "i"), @@ -351,7 +348,7 @@ markupTag dflags = Markup { markupOrderedList = box (TagL 'o'), markupDefList = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b), markupCodeBlock = box TagPre, - markupHyperlink = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel), + markupHyperlink = \(Hyperlink url mLabel) -> box (TagInline "a") (fromMaybe (str url) mLabel), markupAName = const $ str "", markupProperty = box TagPre . str, markupExample = box TagPre . str . unlines . map exampleToString, diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 248a8a54..5ef7d9bb 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Haddock.Backends.Hyperlinker ( ppHyperlinkedSource , module Haddock.Backends.Hyperlinker.Types @@ -6,16 +7,26 @@ module Haddock.Backends.Hyperlinker import Haddock.Types +import Haddock.Utils (writeUtf8File) import Haddock.Backends.Hyperlinker.Renderer +import Haddock.Backends.Hyperlinker.Parser import Haddock.Backends.Hyperlinker.Types import Haddock.Backends.Hyperlinker.Utils - -import Text.XHtml hiding ((</>)) +import Haddock.Backends.Xhtml.Utils ( renderToString ) import Data.Maybe import System.Directory import System.FilePath +import HieTypes ( HieFile(..), HieASTs(..) ) +import HieBin ( readHieFile ) +import Data.Map as M +import FastString ( mkFastString ) +import Module ( Module, moduleName ) +import NameCache ( initNameCache ) +import UniqSupply ( mkSplitUniqSupply ) +import SysTools.Info ( getCompilerInfo' ) + -- | Generate hyperlinked source for given interfaces. -- @@ -26,10 +37,10 @@ ppHyperlinkedSource :: FilePath -- ^ Output directory -> FilePath -- ^ Resource directory -> Maybe FilePath -- ^ Custom CSS file path -> Bool -- ^ Flag indicating whether to pretty-print HTML - -> SrcMap -- ^ Paths to sources + -> M.Map Module SrcPath -- ^ Paths to sources -> [Interface] -- ^ Interfaces for which we create source -> IO () -ppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do +ppHyperlinkedSource outdir libdir mstyle pretty srcs' ifaces = do createDirectoryIfMissing True srcdir let cssFile = fromMaybe (defaultCssFile libdir) mstyle copyFile cssFile $ srcdir </> srcCssFile @@ -38,17 +49,39 @@ ppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces where srcdir = outdir </> hypSrcDir + srcs = (srcs', M.mapKeys moduleName srcs') -- | Generate hyperlinked source for particular interface. -ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface - -> IO () -ppHyperlinkedModuleSource srcdir pretty srcs iface = - case ifaceTokenizedSrc iface of - Just tokens -> writeFile path . html . render' $ tokens - Nothing -> return () +ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMaps -> Interface -> IO () +ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of + Just hfp -> do + -- Parse the GHC-produced HIE file + u <- mkSplitUniqSupply 'a' + HieFile { hie_hs_file = file + , hie_asts = HieASTs asts + , hie_types = types + , hie_hs_src = rawSrc + } <- fmap fst (readHieFile (initNameCache u []) hfp) + comp <- getCompilerInfo' df + + -- Get the AST and tokens corresponding to the source file we want + let mast | M.size asts == 1 = snd <$> M.lookupMin asts + | otherwise = M.lookup (mkFastString file) asts + tokens = parse comp df file rawSrc + + -- Produce and write out the hyperlinked sources + case mast of + Just ast -> + let fullAst = recoverFullIfaceTypes df types ast + in writeUtf8File path . renderToString pretty . render' fullAst $ tokens + Nothing + | M.size asts == 0 -> return () + | otherwise -> error $ unwords [ "couldn't find ast for" + , file, show (M.keys asts) ] + Nothing -> return () where + df = ifaceDynFlags iface render' = render (Just srcCssFile) (Just highlightScript) srcs - html = if pretty then renderHtml else showHtml path = srcdir </> hypSrcModuleFile (ifaceMod iface) -- | Name of CSS file in output directory. @@ -62,3 +95,4 @@ highlightScript = "highlight.js" -- | Path to default CSS file. defaultCssFile :: FilePath -> FilePath defaultCssFile libdir = libdir </> "html" </> "solarized.css" + diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs deleted file mode 100644 index 0ecf7109..00000000 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ /dev/null @@ -1,219 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeApplications #-} - -module Haddock.Backends.Hyperlinker.Ast (enrich) where - - -import qualified Haddock.Syb as Syb -import Haddock.Backends.Hyperlinker.Types - -import qualified GHC -import qualified SrcLoc -import qualified Outputable as GHC - -import Control.Applicative -import Control.Monad (guard) -import Data.Data -import qualified Data.Map.Strict as Map -import Data.Maybe - -import Prelude hiding (span) - -everythingInRenamedSource :: (Alternative f, Data x) - => (forall a. Data a => a -> f r) -> x -> f r -everythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f - --- | Add more detailed information to token stream using GHC API. -enrich :: GHC.RenamedSource -> [Token] -> [RichToken] -enrich src = - map $ \token -> RichToken - { rtkToken = token - , rtkDetails = enrichToken token detailsMap - } - where - detailsMap = - mkDetailsMap (concatMap ($ src) - [ variables - , types - , decls - , binds - , imports - ]) - -type LTokenDetails = [(GHC.SrcSpan, TokenDetails)] - --- | A map containing association between source locations and "details" of --- this location. --- -type DetailsMap = Map.Map Position (Span, TokenDetails) - -mkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap -mkDetailsMap xs = - Map.fromListWith select_details [ (start, (span, token_details)) - | (ghc_span, token_details) <- xs - , GHC.RealSrcSpan span <- [ghc_span] - , let start = SrcLoc.realSrcSpanStart span - ] - where - -- favour token details which appear earlier in the list - select_details _new old = old - -lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails -lookupBySpan span details = do - let pos = SrcLoc.realSrcSpanStart span - (_, (tok_span, tok_details)) <- Map.lookupLE pos details - guard (tok_span `SrcLoc.containsSpan` span) - return tok_details - -enrichToken :: Token -> DetailsMap -> Maybe TokenDetails -enrichToken (Token typ _ spn) dm - | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm -enrichToken _ _ = Nothing - --- | Obtain details map for variables ("normally" used identifiers). -variables :: GHC.RenamedSource -> LTokenDetails -variables = - everythingInRenamedSource (var `Syb.combine` rec) - where - var term = case cast term of - (Just ((GHC.L sspan (GHC.HsVar _ name)) :: GHC.LHsExpr GHC.GhcRn)) -> - pure (sspan, RtkVar (GHC.unLoc name)) - (Just (GHC.L _ (GHC.RecordCon _ (GHC.L sspan name) _))) -> - pure (sspan, RtkVar name) - _ -> empty - rec term = case cast term of - Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.GhcRn) _) -> - pure (sspan, RtkVar name) - _ -> empty - --- | Obtain details map for types. -types :: GHC.RenamedSource -> LTokenDetails -types = everythingInRenamedSource ty - where - ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)] - ty term = case cast term of - (Just ((GHC.L sspan (GHC.HsTyVar _ _ name)) :: GHC.LHsType GHC.GhcRn)) -> - pure (sspan, RtkType (GHC.unLoc name)) - (Just ((GHC.L sspan (GHC.HsOpTy _ l name r)) :: GHC.LHsType GHC.GhcRn)) -> - (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r) - _ -> empty - --- | Obtain details map for identifier bindings. --- --- That includes both identifiers bound by pattern matching or declared using --- ordinary assignment (in top-level declarations, let-expressions and where --- clauses). - -binds :: GHC.RenamedSource -> LTokenDetails -binds = everythingInRenamedSource - (fun `Syb.combine` pat `Syb.combine` tvar) - where - fun term = case cast term of - (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn)) -> - pure (sspan, RtkBind name) - (Just (GHC.PatSynBind _ (GHC.PSB _ (GHC.L sspan name) args _ _))) -> - pure (sspan, RtkBind name) ++ everythingInRenamedSource patsyn_binds args - _ -> empty - patsyn_binds term = case cast term of - (Just (GHC.L sspan (name :: GHC.Name))) -> pure (sspan, RtkVar name) - _ -> empty - pat term = case cast term of - (Just ((GHC.L sspan (GHC.VarPat _ name)) :: GHC.LPat GHC.GhcRn)) -> - pure (sspan, RtkBind (GHC.unLoc name)) - (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) -> - [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs - (Just (GHC.L _ (GHC.AsPat _ (GHC.L sspan name) _))) -> - pure (sspan, RtkBind name) - _ -> empty - rec term = case cast term of - (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.GhcRn) _)) -> - pure (sspan, RtkVar name) - _ -> empty - tvar term = case cast term of - (Just ((GHC.L sspan (GHC.UserTyVar _ name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) -> - pure (sspan, RtkBind (GHC.unLoc name)) - (Just (GHC.L _ (GHC.KindedTyVar _ (GHC.L sspan name) _))) -> - pure (sspan, RtkBind name) - _ -> empty - --- | Obtain details map for top-level declarations. -decls :: GHC.RenamedSource -> LTokenDetails -decls (group, _, _, _) = concatMap ($ group) - [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds - , everythingInRenamedSource fun . GHC.hs_valds - , everythingInRenamedSource fix . GHC.hs_fixds - , everythingInRenamedSource (con `Syb.combine` ins) - ] - where - typ (GHC.L _ t) = case t of - GHC.DataDecl { tcdLName = name } -> pure . decl $ name - GHC.SynDecl _ name _ _ _ -> pure . decl $ name - GHC.FamDecl _ fam -> pure . decl $ GHC.fdLName fam - GHC.ClassDecl{..} -> - [decl tcdLName] - ++ concatMap sig tcdSigs - ++ concatMap tyfam tcdATs - GHC.XTyClDecl {} -> GHC.panic "haddock:decls" - fun term = case cast term of - (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn)) - | GHC.isExternalName name -> pure (sspan, RtkDecl name) - (Just (GHC.PatSynBind _ (GHC.PSB _ (GHC.L sspan name) _ _ _))) - | GHC.isExternalName name -> pure (sspan, RtkDecl name) - _ -> empty - con term = case cast term of - (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) -> - map decl (GHC.getConNames cdcl) - ++ everythingInRenamedSource fld cdcl - Nothing -> empty - ins term = case cast term of - (Just ((GHC.DataFamInstD _ (GHC.DataFamInstDecl eqn)) - :: GHC.InstDecl GHC.GhcRn)) - -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn - (Just (GHC.TyFamInstD _ (GHC.TyFamInstDecl eqn))) -> - pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn - _ -> empty - fld term = case cast term of - Just (field :: GHC.ConDeclField GHC.GhcRn) - -> map (decl . fmap GHC.extFieldOcc) $ GHC.cd_fld_names field - Nothing -> empty - fix term = case cast term of - Just ((GHC.FixitySig _ names _) :: GHC.FixitySig GHC.GhcRn) - -> map (\(GHC.L sspan x) -> (sspan, RtkVar x)) names - Just ((GHC.XFixitySig {}) :: GHC.FixitySig GHC.GhcRn) - -> GHC.panic "haddock:decls" - Nothing -> empty - tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName] - tyfam (GHC.L _ (GHC.XFamilyDecl {})) = GHC.panic "haddock:dels" - sig (GHC.L _ (GHC.TypeSig _ names _)) = map decl names - sig (GHC.L _ (GHC.PatSynSig _ names _)) = map decl names - sig (GHC.L _ (GHC.ClassOpSig _ _ names _)) = map decl names - sig _ = [] - decl (GHC.L sspan name) = (sspan, RtkDecl name) - tyref (GHC.L sspan name) = (sspan, RtkType name) - --- | Obtain details map for import declarations. --- --- This map also includes type and variable details for items in export and --- import lists. -imports :: GHC.RenamedSource -> LTokenDetails -imports src@(_, imps, _, _) = - everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps - where - ie term = case cast term of - (Just ((GHC.IEVar _ v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v - (Just (GHC.IEThingAbs _ t)) -> pure $ typ $ GHC.ieLWrappedName t - (Just (GHC.IEThingAll _ t)) -> pure $ typ $ GHC.ieLWrappedName t - (Just (GHC.IEThingWith _ t _ vs _fls)) -> - [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs - (Just (GHC.IEModuleContents _ m)) -> pure $ modu m - _ -> empty - typ (GHC.L sspan name) = (sspan, RtkType name) - var (GHC.L sspan name) = (sspan, RtkVar name) - modu (GHC.L sspan name) = (sspan, RtkModule name) - imp idecl - | not . GHC.ideclImplicit $ idecl = Just (modu (GHC.ideclName idecl)) - | otherwise = Nothing diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index acb2c892..1d5576cc 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -1,213 +1,212 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Haddock.Backends.Hyperlinker.Parser (parse) where -import Data.Either ( isRight, isLeft ) -import Data.List ( foldl', isPrefixOf, isSuffixOf ) -import Data.Maybe ( maybeToList ) -import Data.Char ( isSpace ) -import qualified Text.Read as R +import Control.Applicative ( Alternative(..) ) +import Data.List ( isPrefixOf, isSuffixOf ) -import GHC ( DynFlags, addSourceToTokens ) -import SrcLoc +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC + +import GHC.LanguageExtensions.Type + +import BasicTypes ( IntegralLit(..) ) +import DynFlags +import qualified EnumSet as E +import ErrUtils ( emptyMessages ) import FastString ( mkFastString ) -import StringBuffer ( stringToStringBuffer ) -import Lexer ( Token(..) ) -import qualified Lexer as L +import Lexer ( P(..), ParseResult(..), PState(..), Token(..) + , mkPStatePure, lexer, mkParserFlags' ) +import Outputable ( showSDoc, panic ) +import SrcLoc +import StringBuffer ( StringBuffer, atEnd ) import Haddock.Backends.Hyperlinker.Types as T - +import Haddock.GhcUtils -- | Turn source code string into a stream of more descriptive tokens. -- --- Result should retain original file layout (including comments, whitespace, --- etc.), i.e. the following "law" should hold: --- --- prop> concat . map tkValue . parse = id --- --- (In reality, this only holds for input not containing '\r', '\t', '\f', '\v', --- characters, since GHC transforms those into ' ' and '\n') -parse :: DynFlags -> FilePath -> String -> [T.Token] -parse dflags fp = ghcToks . processCPP dflags fp . filterCRLF +-- Result should retain original file layout (including comments, +-- whitespace, and CPP). +parse + :: CompilerInfo -- ^ Underlying CC compiler (whatever expanded CPP) + -> DynFlags -- ^ Flags for this module + -> FilePath -- ^ Path to the source of this module + -> BS.ByteString -- ^ Raw UTF-8 encoded source of this module + -> [T.Token] +parse comp dflags fpath bs = case unP (go False []) initState of + POk _ toks -> reverse toks + PFailed _ ss errMsg -> panic $ "Hyperlinker parse error at " ++ show ss ++ + ": " ++ showSDoc dflags errMsg where - -- Remove CRLFs from source - filterCRLF :: String -> String - filterCRLF ('\r':'\n':cs) = '\n' : filterCRLF cs - filterCRLF (c:cs) = c : filterCRLF cs - filterCRLF [] = [] --- | Parse the source into tokens using the GHC lexer. + initState = mkPStatePure pflags buf start + buf = stringBufferFromByteString bs + start = mkRealSrcLoc (mkFastString fpath) 1 1 + needPragHack' = needPragHack comp dflags + pflags = mkParserFlags' (warningFlags dflags) + (extensionFlags dflags) + (thisPackage dflags) + (safeImportsOn dflags) + False -- lex Haddocks as comment tokens + True -- produce comment tokens + False -- produce position pragmas tokens + + go :: Bool -- ^ are we currently in a pragma? + -> [T.Token] -- ^ tokens accumulated so far (in reverse) + -> P [T.Token] + go inPrag toks = do + (b, _) <- getInput + if not (atEnd b) + then do + (newToks, inPrag') <- parseCppLine <|> parsePlainTok inPrag <|> unknownLine + go inPrag' (newToks ++ toks) + else + pure toks + + -- | Like 'Lexer.lexer', but slower, with a better API, and filtering out empty tokens + wrappedLexer :: P (RealLocated Lexer.Token) + wrappedLexer = Lexer.lexer False andThen + where andThen (L (RealSrcSpan s) t) + | srcSpanStartLine s /= srcSpanEndLine s || + srcSpanStartCol s /= srcSpanEndCol s + = pure (L s t) + andThen (L (RealSrcSpan s) ITeof) = pure (L s ITeof) + andThen _ = wrappedLexer + + -- | Try to parse a CPP line (can fail) + parseCppLine :: P ([T.Token], Bool) + parseCppLine = do + (b, l) <- getInput + case tryCppLine l b of + Just (cppBStr, l', b') + -> let cppTok = T.Token { tkType = TkCpp + , tkValue = cppBStr + , tkSpan = mkRealSrcSpan l l' } + in setInput (b', l') *> pure ([cppTok], False) + _ -> empty + + -- | Try to parse a regular old token (can fail) + parsePlainTok :: Bool -> P ([T.Token], Bool) -- return list is only ever 0-2 elements + parsePlainTok inPrag = do + (bInit, lInit) <- getInput + L sp tok <- Lexer.lexer False return + (bEnd, _) <- getInput + case sp of + UnhelpfulSpan _ -> pure ([], False) -- pretend the token never existed + RealSrcSpan rsp -> do + let typ = if inPrag then TkPragma else classify tok + RealSrcLoc lStart = srcSpanStart sp -- safe since @sp@ is real + (spaceBStr, bStart) = spanPosition lInit lStart bInit + inPragDef = inPragma inPrag tok + + (bEnd', inPrag') <- case tok of + + -- Update internal line + file position if this is a LINE pragma + ITline_prag _ -> tryOrElse (bEnd, inPragDef) $ do + L _ (ITinteger (IL { il_value = line })) <- wrappedLexer + L _ (ITstring _ file) <- wrappedLexer + L spF ITclose_prag <- wrappedLexer + + let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF) + (bEnd'', _) <- getInput + setInput (bEnd'', newLoc) + + pure (bEnd'', False) + + -- Update internal column position if this is a COLUMN pragma + ITcolumn_prag _ -> tryOrElse (bEnd, inPragDef) $ do + L _ (ITinteger (IL { il_value = col })) <- wrappedLexer + L spF ITclose_prag <- wrappedLexer + + let newLoc = mkRealSrcLoc (srcSpanFile spF) (srcSpanEndLine spF) (fromIntegral col) + (bEnd'', _) <- getInput + setInput (bEnd'', newLoc) + + pure (bEnd'', False) + + -- See 'needPragHack' + ITclose_prag{} + | needPragHack' + , '\n' `BSC.elem` spaceBStr + -> getInput >>= \(b,p) -> setInput (b,advanceSrcLoc p '\n') >> pure (bEnd, False) + + _ -> pure (bEnd, inPragDef) + + let tokBStr = splitStringBuffer bStart bEnd' + plainTok = T.Token { tkType = typ + , tkValue = tokBStr + , tkSpan = rsp } + spaceTok = T.Token { tkType = TkSpace + , tkValue = spaceBStr + , tkSpan = mkRealSrcSpan lInit lStart } + + pure (plainTok : [ spaceTok | not (BS.null spaceBStr) ], inPrag') + + -- | Parse whatever remains of the line as an unknown token (can't fail) + unknownLine :: P ([T.Token], Bool) + unknownLine = do + (b, l) <- getInput + let (unkBStr, l', b') = spanLine l b + unkTok = T.Token { tkType = TkUnknown + , tkValue = unkBStr + , tkSpan = mkRealSrcSpan l l' } + setInput (b', l') + pure ([unkTok], False) + + +-- | This is really, really, /really/ gross. Problem: consider a Haskell +-- file that looks like: -- --- * CPP lines are removed and reinserted as line-comments --- * top-level file pragmas are parsed as block comments (see the --- 'ITblockComment' case of 'classify' for more details) +-- @ +-- {-# LANGUAGE CPP #-} +-- module SomeMod where -- -processCPP :: DynFlags -- ^ GHC's flags - -> FilePath -- ^ source file name (for position information) - -> String -- ^ source file contents - -> [(Located L.Token, String)] -processCPP dflags fpath s = addSrc . go start . splitCPP $ s - where - start = mkRealSrcLoc (mkFastString fpath) 1 1 - addSrc = addSourceToTokens start (stringToStringBuffer s) - - -- Transform a list of Haskell/CPP lines into a list of tokens - go :: RealSrcLoc -> [Either String String] -> [Located L.Token] - go _ [] = [] - go pos ls = - let (hLinesRight, ls') = span isRight ls - (cppLinesLeft, rest) = span isLeft ls' - - hSrc = concat [ hLine | Right hLine <- hLinesRight ] - cppSrc = concat [ cppLine | Left cppLine <- cppLinesLeft ] - - in case L.lexTokenStream (stringToStringBuffer hSrc) pos dflags of - - -- Stuff that fails to lex gets turned into comments - L.PFailed _ _ss _msg -> - let (src_pos, failed) = mkToken ITunknown pos hSrc - (new_pos, cpp) = mkToken ITlineComment src_pos cppSrc - in failed : cpp : go new_pos rest - - -- Successfully lexed - L.POk ss toks -> - let (new_pos, cpp) = mkToken ITlineComment (L.loc ss) cppSrc - in toks ++ [cpp] ++ go new_pos rest - - -- Manually make a token from a 'String', advancing the cursor position - mkToken tok start' str = - let end = foldl' advanceSrcLoc start' str - in (end, L (RealSrcSpan $ mkRealSrcSpan start' end) (tok str)) - - --- | Split apart the initial file into Haskell source lines ('Left' entries) and --- CPP lines ('Right' entries). +-- #define SIX 6 +-- +-- {-# INLINE foo +-- #-} +-- foo = 1 +-- @ -- --- All characters in the input are present in the output: +-- Clang's CPP replaces the @#define SIX 6@ line with an empty line (as it +-- should), but get confused about @#-}@. I'm guessing it /starts/ by +-- parsing that as a pre-processor directive and, when it fails to, it just +-- leaves the line alone. HOWEVER, it still adds an extra newline. =.= -- --- prop> concat . map (either id id) . splitCPP = id -splitCPP :: String -> [Either String String] -splitCPP "" = [] -splitCPP s | isCPPline s = Left l : splitCPP rest - | otherwise = Right l : splitCPP rest +-- This function makes sure that the Hyperlinker backend also adds that +-- extra newline (or else our spans won't line up with GHC's anymore). +needPragHack :: CompilerInfo -> DynFlags -> Bool +needPragHack comp dflags = isCcClang && E.member Cpp (extensionFlags dflags) where - ~(l, rest) = spanToNewline 0 s + isCcClang = case comp of + GCC -> False + Clang -> True + AppleClang -> True + AppleClang51 -> True + UnknownCC -> False +-- | Get the input +getInput :: P (StringBuffer, RealSrcLoc) +getInput = P $ \p @ PState { buffer = buf, loc = srcLoc } -> POk p (buf, srcLoc) --- | Heuristic to decide if a line is going to be a CPP line. This should be a --- cheap operation since it is going to be run on every line being processed. --- --- Right now it just checks if the first non-whitespace character in the first --- five characters of the line is a '#': --- --- >>> isCPPline "#define FOO 1" --- True --- --- >>> isCPPline "\t\t #ifdef GHC" --- True --- --- >>> isCPPline " #endif" --- False --- -isCPPline :: String -> Bool -isCPPline = isPrefixOf "#" . dropWhile (`elem` " \t") . take 5 +-- | Set the input +setInput :: (StringBuffer, RealSrcLoc) -> P () +setInput (buf, srcLoc) = P $ \p -> POk (p { buffer = buf, loc = srcLoc }) () --- | Split a "line" off the front of a string, hopefully without cutting tokens --- in half. I say "hopefully" because knowing what a token is requires lexing, --- yet lexing depends on this function. --- --- All characters in the input are present in the output: --- --- prop> curry (++) . spanToNewLine 0 = id -spanToNewline :: Int -- ^ open '{-' - -> String -- ^ input - -> (String, String) - --- Base case and space characters -spanToNewline _ "" = ("", "") -spanToNewline n ('\n':str) | n <= 0 = ("\n", str) -spanToNewline n ('\n':str) | n <= 0 = ("\n", str) -spanToNewline n ('\\':'\n':str) = - let (str', rest) = spanToNewline n str - in ('\\':'\n':str', rest) - --- Block comments -spanToNewline n ('{':'-':str) = - let (str', rest) = spanToNewline (n+1) str - in ('{':'-':str', rest) -spanToNewline n ('-':'}':str) = - let (str', rest) = spanToNewline (n-1) str - in ('-':'}':str', rest) - --- When not in a block comment, try to lex a Haskell token -spanToNewline 0 str@(c:_) | ((lexed, str') : _) <- R.lex str, not (isSpace c) = - if all (== '-') lexed && length lexed >= 2 - -- A Haskell line comment - then case span (/= '\n') str' of - (str'', '\n':rest) -> (lexed ++ str'' ++ "\n", rest) - (_, _) -> (str, "") - - -- An actual Haskell token - else let (str'', rest) = spanToNewline 0 str' - in (lexed ++ str'', rest) - --- In all other cases, advance one character at a time -spanToNewline n (c:str) = - let (str', rest) = spanToNewline n str - in (c:str', rest) - - --- | Turn a list of GHC's 'L.Token' (and their source 'String') into a list of --- Haddock's 'T.Token'. -ghcToks :: [(Located L.Token, String)] -> [T.Token] -ghcToks = reverse . (\(_,ts,_) -> ts) . foldl' go (start, [], False) - where - start = mkRealSrcLoc (mkFastString "lexing") 1 1 - - go :: (RealSrcLoc, [T.Token], Bool) - -- ^ current position, tokens accumulated, currently in pragma (or not) - - -> (Located L.Token, String) - -- ^ next token, its content - - -> (RealSrcLoc, [T.Token], Bool) - -- ^ new position, new tokens accumulated, currently in pragma (or not) - - go (pos, toks, in_prag) (L l tok, raw) = - ( next_pos - , classifiedTok ++ maybeToList white ++ toks - , inPragma in_prag tok - ) - where - (next_pos, white) = mkWhitespace pos l - - classifiedTok = [ Token (classify' tok) raw rss - | RealSrcSpan rss <- [l] - , not (null raw) - ] - - classify' | in_prag = const TkPragma - | otherwise = classify - - --- | Find the correct amount of whitespace between tokens. -mkWhitespace :: RealSrcLoc -> SrcSpan -> (RealSrcLoc, Maybe T.Token) -mkWhitespace prev spn = - case spn of - UnhelpfulSpan _ -> (prev,Nothing) - RealSrcSpan s | null wsstring -> (end, Nothing) - | otherwise -> (end, Just (Token TkSpace wsstring wsspan)) - where - start = realSrcSpanStart s - end = realSrcSpanEnd s - wsspan = mkRealSrcSpan prev start - nls = srcLocLine start - srcLocLine prev - spaces = if nls == 0 then srcLocCol start - srcLocCol prev - else srcLocCol start - 1 - wsstring = replicate nls '\n' ++ replicate spaces ' ' +-- | Orphan instance that adds backtracking to 'P' +instance Alternative P where + empty = P $ \_ -> PFailed (const emptyMessages) noSrcSpan "Alterative.empty" + P x <|> P y = P $ \s -> case x s of { p@POk{} -> p + ; _ -> y s } +-- | Try a parser. If it fails, backtrack and return the pure value. +tryOrElse :: a -> P a -> P a +tryOrElse x p = p <|> pure x -- | Classify given tokens as appropriate Haskell token type. -classify :: L.Token -> TokenType +classify :: Lexer.Token -> TokenType classify tok = case tok of ITas -> TkKeyword @@ -378,15 +377,11 @@ classify tok = ITLarrowtail {} -> TkGlyph ITRarrowtail {} -> TkGlyph + ITcomment_line_prag -> TkUnknown ITunknown {} -> TkUnknown ITeof -> TkUnknown - -- Line comments are only supposed to start with '--'. Starting with '#' - -- means that this was probably a CPP. - ITlineComment s - | isCPPline s -> TkCpp - | otherwise -> TkComment - + ITlineComment {} -> TkComment ITdocCommentNext {} -> TkComment ITdocCommentPrev {} -> TkComment ITdocCommentNamed {} -> TkComment @@ -403,9 +398,9 @@ classify tok = | otherwise -> TkComment -- | Classify given tokens as beginning pragmas (or not). -inPragma :: Bool -- ^ currently in pragma - -> L.Token -- ^ current token - -> Bool -- ^ new information about whether we are in a pragma +inPragma :: Bool -- ^ currently in pragma + -> Lexer.Token -- ^ current token + -> Bool -- ^ new information about whether we are in a pragma inPragma _ ITclose_prag = False inPragma True _ = True inPragma False tok = diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index d7ea70a6..a4dcb77b 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -1,4 +1,8 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} module Haddock.Backends.Hyperlinker.Renderer (render) where @@ -6,15 +10,19 @@ module Haddock.Backends.Hyperlinker.Renderer (render) where import Haddock.Backends.Hyperlinker.Types import Haddock.Backends.Hyperlinker.Utils -import qualified GHC -import qualified Name as GHC -import qualified Unique as GHC +import qualified Data.ByteString as BS + +import HieTypes +import Module ( ModuleName, moduleNameString ) +import Name ( getOccString, isInternalName, Name, nameModule, nameUnique ) +import SrcLoc +import Unique ( getKey ) +import Encoding ( utf8DecodeByteString ) import System.FilePath.Posix ((</>)) -import Data.List -import Data.Maybe import qualified Data.Map as Map +import qualified Data.Set as Set import Text.XHtml (Html, HtmlAttr, (!)) import qualified Text.XHtml as Html @@ -22,22 +30,24 @@ import qualified Text.XHtml as Html type StyleClass = String +-- | Produce the HTML corresponding to a hyperlinked Haskell source +render + :: Maybe FilePath -- ^ path to the CSS file + -> Maybe FilePath -- ^ path to the JS file + -> SrcMaps -- ^ Paths to sources + -> HieAST PrintedType -- ^ ASTs from @.hie@ files + -> [Token] -- ^ tokens to render + -> Html +render mcss mjs srcs ast tokens = header mcss mjs <> body srcs ast tokens -render :: Maybe FilePath -> Maybe FilePath -> SrcMap -> [RichToken] - -> Html -render mcss mjs srcs tokens = header mcss mjs <> body srcs tokens - -body :: SrcMap -> [RichToken] -> Html -body srcs tokens = Html.body . Html.pre $ hypsrc +body :: SrcMaps -> HieAST PrintedType -> [Token] -> Html +body srcs ast tokens = Html.body . Html.pre $ hypsrc where - hypsrc = mconcat . map (richToken srcs) $ tokens - + hypsrc = renderWithAst srcs ast tokens header :: Maybe FilePath -> Maybe FilePath -> Html -header mcss mjs - | isNothing mcss && isNothing mjs = Html.noHtml -header mcss mjs = - Html.header $ css mcss <> js mjs +header Nothing Nothing = Html.noHtml +header mcss mjs = Html.header $ css mcss <> js mjs where css Nothing = Html.noHtml css (Just cssFile) = Html.thelink Html.noHtml ! @@ -51,25 +61,132 @@ header mcss mjs = , Html.src scriptFile ] + +splitTokens :: HieAST PrintedType -> [Token] -> ([Token],[Token],[Token]) +splitTokens ast toks = (before,during,after) + where + (before,rest) = span leftOf toks + (during,after) = span inAst rest + leftOf t = realSrcSpanEnd (tkSpan t) <= realSrcSpanStart nodeSp + inAst t = nodeSp `containsSpan` tkSpan t + nodeSp = nodeSpan ast + +-- | Turn a list of tokens into hyperlinked sources, threading in relevant link +-- information from the 'HieAST'. +renderWithAst :: SrcMaps -> HieAST PrintedType -> [Token] -> Html +renderWithAst srcs Node{..} toks = anchored $ case toks of + + [tok] | nodeSpan == tkSpan tok -> richToken srcs nodeInfo tok + + -- NB: the GHC lexer lexes backquoted identifiers and parenthesized operators + -- as multiple tokens. + -- + -- * @a `elem` b@ turns into @[a, `, elem, `, b]@ (excluding space tokens) + -- * @(+) 1 2@ turns into @[(, +, ), 1, 2]@ (excluding space tokens) + -- + -- However, the HIE ast considers @`elem`@ and @(+)@ to be single nodes. In + -- order to make sure these get hyperlinked properly, we intercept these + -- special sequences of tokens and merge them into just one identifier or + -- operator token. + [BacktickTok s1, tok @ Token{ tkType = TkIdentifier }, BacktickTok s2] + | realSrcSpanStart s1 == realSrcSpanStart nodeSpan + , realSrcSpanEnd s2 == realSrcSpanEnd nodeSpan + -> richToken srcs nodeInfo + (Token{ tkValue = "`" <> tkValue tok <> "`" + , tkType = TkOperator + , tkSpan = nodeSpan }) + [OpenParenTok s1, tok @ Token{ tkType = TkOperator }, CloseParenTok s2] + | realSrcSpanStart s1 == realSrcSpanStart nodeSpan + , realSrcSpanEnd s2 == realSrcSpanEnd nodeSpan + -> richToken srcs nodeInfo + (Token{ tkValue = "(" <> tkValue tok <> ")" + , tkType = TkOperator + , tkSpan = nodeSpan }) + + _ -> go nodeChildren toks + where + go _ [] = mempty + go [] xs = foldMap renderToken xs + go (cur:rest) xs = + foldMap renderToken before <> renderWithAst srcs cur during <> go rest after + where + (before,during,after) = splitTokens cur xs + anchored c = Map.foldrWithKey anchorOne c (nodeIdentifiers nodeInfo) + anchorOne n dets c = externalAnchor n d $ internalAnchor n d c + where d = identInfo dets + +renderToken :: Token -> Html +renderToken Token{..} + | BS.null tkValue = mempty + | tkType == TkSpace = renderSpace (srcSpanStartLine tkSpan) tkValue' + | otherwise = tokenSpan ! [ multiclass style ] + where + tkValue' = filterCRLF $ utf8DecodeByteString tkValue + style = tokenStyle tkType + tokenSpan = Html.thespan (Html.toHtml tkValue') + + -- | Given information about the source position of definitions, render a token -richToken :: SrcMap -> RichToken -> Html -richToken srcs (RichToken Token{..} details) - | tkType == TkSpace = renderSpace (GHC.srcSpanStartLine tkSpan) tkValue - | otherwise = linked content +richToken :: SrcMaps -> NodeInfo PrintedType -> Token -> Html +richToken srcs details Token{..} + | tkType == TkSpace = renderSpace (srcSpanStartLine tkSpan) tkValue' + | otherwise = annotate details $ linked content where + tkValue' = filterCRLF $ utf8DecodeByteString tkValue content = tokenSpan ! [ multiclass style ] - tokenSpan = Html.thespan (Html.toHtml tkValue) - style = tokenStyle tkType ++ maybe [] richTokenStyle details + tokenSpan = Html.thespan (Html.toHtml tkValue') + style = tokenStyle tkType ++ concatMap (richTokenStyle (null (nodeType details))) contexts + + contexts = concatMap (Set.elems . identInfo) . Map.elems . nodeIdentifiers $ details + + -- pick an arbitary identifier to hyperlink with + identDet = Map.lookupMin . nodeIdentifiers $ details -- If we have name information, we can make links - linked = case details of - Just d -> externalAnchor d . internalAnchor d . hyperlink srcs d + linked = case identDet of + Just (n,_) -> hyperlink srcs n Nothing -> id -richTokenStyle :: TokenDetails -> [StyleClass] -richTokenStyle (RtkVar _) = ["hs-var"] -richTokenStyle (RtkType _) = ["hs-type"] -richTokenStyle _ = [] +-- | Remove CRLFs from source +filterCRLF :: String -> String +filterCRLF ('\r':'\n':cs) = '\n' : filterCRLF cs +filterCRLF (c:cs) = c : filterCRLF cs +filterCRLF [] = [] + +annotate :: NodeInfo PrintedType -> Html -> Html +annotate ni content = + Html.thespan (annot <> content) ! [ Html.theclass "annot" ] + where + annot + | not (null annotation) = + Html.thespan (Html.toHtml annotation) ! [ Html.theclass "annottext" ] + | otherwise = mempty + annotation = typ ++ identTyps + typ = unlines (nodeType ni) + typedIdents = [ (n,t) | (n, identType -> Just t) <- Map.toList $ nodeIdentifiers ni ] + identTyps + | length typedIdents > 1 || null (nodeType ni) + = concatMap (\(n,t) -> printName n ++ " :: " ++ t ++ "\n") typedIdents + | otherwise = "" + + printName :: Either ModuleName Name -> String + printName = either moduleNameString getOccString + +richTokenStyle + :: Bool -- ^ are we lacking a type annotation? + -> ContextInfo -- ^ in what context did this token show up? + -> [StyleClass] +richTokenStyle True Use = ["hs-type"] +richTokenStyle False Use = ["hs-var"] +richTokenStyle _ RecField{} = ["hs-var"] +richTokenStyle _ PatternBind{} = ["hs-var"] +richTokenStyle _ MatchBind{} = ["hs-var"] +richTokenStyle _ TyVarBind{} = ["hs-type"] +richTokenStyle _ ValBind{} = ["hs-var"] +richTokenStyle _ TyDecl = ["hs-type"] +richTokenStyle _ ClassTyDecl{} = ["hs-type"] +richTokenStyle _ Decl{} = ["hs-var"] +richTokenStyle _ IEThing{} = [] -- could be either a value or type tokenStyle :: TokenType -> [StyleClass] tokenStyle TkIdentifier = ["hs-identifier"] @@ -87,61 +204,70 @@ tokenStyle TkPragma = ["hs-pragma"] tokenStyle TkUnknown = [] multiclass :: [StyleClass] -> HtmlAttr -multiclass = Html.theclass . intercalate " " +multiclass = Html.theclass . unwords + +externalAnchor :: Identifier -> Set.Set ContextInfo -> Html -> Html +externalAnchor (Right name) contexts content + | not (isInternalName name) + , any isBinding contexts + = Html.thespan content ! [ Html.identifier $ externalAnchorIdent name ] +externalAnchor _ _ content = content -externalAnchor :: TokenDetails -> Html -> Html -externalAnchor (RtkDecl name) content = - Html.anchor content ! [ Html.name $ externalAnchorIdent name ] -externalAnchor _ content = content +isBinding :: ContextInfo -> Bool +isBinding (ValBind RegularBind _ _) = True +isBinding PatternBind{} = True +isBinding Decl{} = True +isBinding (RecField RecFieldDecl _) = True +isBinding TyVarBind{} = True +isBinding ClassTyDecl{} = True +isBinding _ = False -internalAnchor :: TokenDetails -> Html -> Html -internalAnchor (RtkBind name) content = - Html.anchor content ! [ Html.name $ internalAnchorIdent name ] -internalAnchor _ content = content +internalAnchor :: Identifier -> Set.Set ContextInfo -> Html -> Html +internalAnchor (Right name) contexts content + | isInternalName name + , any isBinding contexts + = Html.thespan content ! [ Html.identifier $ internalAnchorIdent name ] +internalAnchor _ _ content = content -externalAnchorIdent :: GHC.Name -> String +externalAnchorIdent :: Name -> String externalAnchorIdent = hypSrcNameUrl -internalAnchorIdent :: GHC.Name -> String -internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique - -hyperlink :: SrcMap -> TokenDetails -> Html -> Html -hyperlink srcs details = case rtkName details of - Left name -> - if GHC.isInternalName name - then internalHyperlink name - else externalNameHyperlink srcs name - Right name -> externalModHyperlink srcs name - -internalHyperlink :: GHC.Name -> Html -> Html -internalHyperlink name content = - Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ] - -externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html -externalNameHyperlink srcs name content = case Map.lookup mdl srcs of - Just SrcLocal -> Html.anchor content ! - [ Html.href $ hypSrcModuleNameUrl mdl name ] - Just (SrcExternal path) -> Html.anchor content ! - [ Html.href $ path </> hypSrcModuleNameUrl mdl name ] - Nothing -> content +internalAnchorIdent :: Name -> String +internalAnchorIdent = ("local-" ++) . show . getKey . nameUnique + +-- | Generate the HTML hyperlink for an identifier +hyperlink :: SrcMaps -> Identifier -> Html -> Html +hyperlink (srcs, srcs') ident = case ident of + Right name | isInternalName name -> internalHyperlink name + | otherwise -> externalNameHyperlink name + Left name -> externalModHyperlink name + where - mdl = GHC.nameModule name + internalHyperlink name content = + Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ] + + externalNameHyperlink name content = case Map.lookup mdl srcs of + Just SrcLocal -> Html.anchor content ! + [ Html.href $ hypSrcModuleNameUrl mdl name ] + Just (SrcExternal path) -> Html.anchor content ! + [ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing (".." </> path) ] + Nothing -> content + where + mdl = nameModule name -externalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html -externalModHyperlink srcs name content = - let srcs' = Map.mapKeys GHC.moduleName srcs in - case Map.lookup name srcs' of - Just SrcLocal -> Html.anchor content ! - [ Html.href $ hypSrcModuleUrl' name ] - Just (SrcExternal path) -> Html.anchor content ! - [ Html.href $ path </> hypSrcModuleUrl' name ] - Nothing -> content + externalModHyperlink moduleName content = + case Map.lookup moduleName srcs' of + Just SrcLocal -> Html.anchor content ! + [ Html.href $ hypSrcModuleUrl' moduleName ] + Just (SrcExternal path) -> Html.anchor content ! + [ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing (".." </> path) ] + Nothing -> content renderSpace :: Int -> String -> Html -renderSpace _ [] = Html.noHtml -renderSpace line ('\n':rest) = mconcat - [ Html.thespan . Html.toHtml $ "\n" +renderSpace !_ "" = Html.noHtml +renderSpace !line ('\n':rest) = mconcat + [ Html.thespan (Html.toHtml '\n') , lineAnchor (line + 1) , renderSpace (line + 1) rest ] @@ -151,4 +277,4 @@ renderSpace line space = lineAnchor :: Int -> Html -lineAnchor line = Html.anchor Html.noHtml ! [ Html.name $ hypSrcLineUrl line ] +lineAnchor line = Html.thespan Html.noHtml ! [ Html.identifier $ hypSrcLineUrl line ] diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs index e377471e..50916937 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs @@ -1,17 +1,24 @@ +{-# LANGUAGE PatternSynonyms, OverloadedStrings #-} module Haddock.Backends.Hyperlinker.Types where - import qualified GHC +import Data.ByteString ( ByteString ) + import Data.Map (Map) data Token = Token { tkType :: TokenType - , tkValue :: String + , tkValue :: ByteString -- ^ UTF-8 encoded , tkSpan :: {-# UNPACK #-} !Span } deriving (Show) +pattern BacktickTok, OpenParenTok, CloseParenTok :: Span -> Token +pattern BacktickTok sp = Token TkSpecial "`" sp +pattern OpenParenTok sp = Token TkSpecial "(" sp +pattern CloseParenTok sp = Token TkSpecial ")" sp + type Position = GHC.RealSrcLoc type Span = GHC.RealSrcSpan @@ -31,29 +38,6 @@ data TokenType | TkUnknown deriving (Show, Eq) - -data RichToken = RichToken - { rtkToken :: Token - , rtkDetails :: Maybe TokenDetails - } - -data TokenDetails - = RtkVar GHC.Name - | RtkType GHC.Name - | RtkBind GHC.Name - | RtkDecl GHC.Name - | RtkModule GHC.ModuleName - deriving (Eq) - - -rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName -rtkName (RtkVar name) = Left name -rtkName (RtkType name) = Left name -rtkName (RtkBind name) = Left name -rtkName (RtkDecl name) = Left name -rtkName (RtkModule name) = Right name - - -- | Path for making cross-package hyperlinks in generated sources. -- -- Used in 'SrcMap' to determine whether module originates in current package @@ -63,5 +47,5 @@ data SrcPath | SrcLocal -- | Mapping from modules to cross-package source paths. -type SrcMap = Map GHC.Module SrcPath +type SrcMaps = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs index 9de4a03d..4e8b88d2 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Haddock.Backends.Hyperlinker.Utils ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile' , hypSrcModuleUrl, hypSrcModuleUrl' @@ -6,21 +7,35 @@ module Haddock.Backends.Hyperlinker.Utils , hypSrcModuleNameUrl, hypSrcModuleLineUrl , hypSrcModuleUrlFormat , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat - ) where + , spliceURL, spliceURL' + -- * HIE file processing + , PrintedType + , recoverFullIfaceTypes + ) where +import Haddock.Utils import Haddock.Backends.Xhtml.Utils import GHC -import FastString -import System.FilePath.Posix ((</>)) +import HieTypes ( HieAST(..), HieType(..), HieArgs(..), TypeIndex, HieTypeFlat ) +import IfaceType +import Name ( getOccFS, getOccString ) +import Outputable ( showSDoc ) +import Var ( VarBndr(..) ) + +import System.FilePath.Posix ((</>), (<.>)) +import qualified Data.Array as A + +{-# INLINE hypSrcDir #-} hypSrcDir :: FilePath hypSrcDir = "src" +{-# INLINE hypSrcModuleFile #-} hypSrcModuleFile :: Module -> FilePath -hypSrcModuleFile = hypSrcModuleFile' . moduleName +hypSrcModuleFile m = moduleNameString (moduleName m) <.> "html" hypSrcModuleFile' :: ModuleName -> FilePath hypSrcModuleFile' mdl = spliceURL' @@ -32,20 +47,19 @@ hypSrcModuleUrl = hypSrcModuleFile hypSrcModuleUrl' :: ModuleName -> String hypSrcModuleUrl' = hypSrcModuleFile' +{-# INLINE hypSrcNameUrl #-} hypSrcNameUrl :: Name -> String -hypSrcNameUrl name = spliceURL - Nothing Nothing (Just name) Nothing nameFormat +hypSrcNameUrl = escapeStr . getOccString +{-# INLINE hypSrcLineUrl #-} hypSrcLineUrl :: Int -> String -hypSrcLineUrl line = spliceURL - Nothing Nothing Nothing (Just spn) lineFormat - where - loc = mkSrcLoc nilFS line 1 - spn = mkSrcSpan loc loc +hypSrcLineUrl line = "line-" ++ show line +{-# INLINE hypSrcModuleNameUrl #-} hypSrcModuleNameUrl :: Module -> Name -> String hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name +{-# INLINE hypSrcModuleLineUrl #-} hypSrcModuleLineUrl :: Module -> Int -> String hypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ "#" ++ hypSrcLineUrl line @@ -66,3 +80,65 @@ nameFormat = "%{NAME}" lineFormat :: String lineFormat = "line-%{LINE}" + + +-- * HIE file procesddsing + +-- This belongs in GHC's HieUtils... + +-- | Pretty-printed type, ready to be turned into HTML by @xhtml@ +type PrintedType = String + +-- | Expand the flattened HIE AST into one where the types printed out and +-- ready for end-users to look at. +-- +-- Using just primitives found in GHC's HIE utilities, we could write this as +-- follows: +-- +-- > 'recoverFullIfaceTypes' dflags hieTypes hieAst +-- > = 'fmap' (\ti -> 'showSDoc' df . +-- > 'pprIfaceType' $ +-- > 'recoverFullType' ti hieTypes) +-- > hieAst +-- +-- However, this is very inefficient (both in time and space) because the +-- mutliple calls to 'recoverFullType' don't share intermediate results. This +-- function fixes that. +recoverFullIfaceTypes + :: DynFlags + -> A.Array TypeIndex HieTypeFlat -- ^ flat types + -> HieAST TypeIndex -- ^ flattened AST + -> HieAST PrintedType -- ^ full AST +recoverFullIfaceTypes df flattened ast = fmap (printed A.!) ast + where + + -- Splitting this out into its own array is also important: we don't want + -- to pretty print the same type many times + printed :: A.Array TypeIndex PrintedType + printed = fmap (showSDoc df . pprIfaceType) unflattened + + -- The recursion in 'unflattened' is crucial - it's what gives us sharing + -- between the IfaceType's produced + unflattened :: A.Array TypeIndex IfaceType + unflattened = fmap (\flatTy -> go (fmap (unflattened A.!) flatTy)) flattened + + -- Unfold an 'HieType' whose subterms have already been unfolded + go :: HieType IfaceType -> IfaceType + go (HTyVarTy n) = IfaceTyVar (getOccFS n) + go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b) + go (HLitTy l) = IfaceLitTy l + go (HForAllTy ((n,k),af) t) = let b = (getOccFS n, k) + in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t + go (HFunTy a b) = IfaceFunTy a b + go (HQualTy con b) = IfaceDFunTy con b + go (HCastTy a) = a + go HCoercionTy = IfaceTyVar "<coercion type>" + go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) + + -- This isn't fully faithful - we can't produce the 'Inferred' case + hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs + hieToIfaceArgs (HieArgs args) = go' args + where + go' [] = IA_Nil + go' ((True ,x):xs) = IA_Arg x Required $ go' xs + go' ((False,x):xs) = IA_Arg x Specified $ go' xs diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index a84e7e45..119bbc01 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- -- | -- Module : Haddock.Backends.LaTeX @@ -22,6 +24,7 @@ import Haddock.GhcUtils import Pretty hiding (Doc, quote) import qualified Pretty +import BasicTypes ( PromotionFlag(..) ) import GHC import OccName import Name ( nameOccName ) @@ -135,7 +138,7 @@ ppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do filename = odir </> (fromMaybe "haddock" packageStr <.> "tex") - writeFile filename (show tex) + writeUtf8File filename (show tex) ppLaTeXModule :: String -> FilePath -> Interface -> IO () @@ -168,7 +171,7 @@ ppLaTeXModule _title odir iface = do body = processExports exports -- - writeFile (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex) + writeUtf8File (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex) -- | Prints out an entry in a module export list. exportListItem :: ExportItem DocNameI -> LaTeX @@ -342,7 +345,7 @@ ppFamDecl doc instances decl unicode = ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n , feqn_rhs = rhs , feqn_pats = ts } }) - = hsep [ ppAppNameTypes n (map unLoc ts) unicode + = hsep [ ppAppNameTypeArgs n ts unicode , equals , ppType unicode (unLoc rhs) ] @@ -908,6 +911,11 @@ ppAppDocNameTyVarBndrs unicode n vs = ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX ppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode) +ppAppNameTypeArgs :: DocName -> [LHsTypeArg DocNameI] -> Bool -> LaTeX +ppAppNameTypeArgs n args@(HsValArg _:HsValArg _:_) unicode + = ppTypeApp n args ppDocName (ppLHsTypeArg unicode) +ppAppNameTypeArgs n args unicode + = ppDocName n <+> hsep (map (ppLHsTypeArg unicode) args) -- | Print an application of a DocName and a list of Names ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX @@ -926,7 +934,6 @@ ppTypeApp n (t1:t2:rest) ppDN ppT ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts) - ------------------------------------------------------------------------------- -- * Contexts ------------------------------------------------------------------------------- @@ -956,7 +963,7 @@ ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX pp_hs_context [] _ = empty -pp_hs_context [p] unicode = ppType unicode p +pp_hs_context [p] unicode = ppCtxType unicode p pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt) @@ -977,7 +984,7 @@ tupleParens _ = parenList sumParens :: [LaTeX] -> LaTeX -sumParens = ubxparens . hsep . punctuate (text " | ") +sumParens = ubxparens . hsep . punctuate (text " |") ------------------------------------------------------------------------------- @@ -991,11 +998,17 @@ ppLType unicode y = ppType unicode (unLoc y) ppLParendType unicode y = ppParendType unicode (unLoc y) ppLFunLhType unicode y = ppFunLhType unicode (unLoc y) - -ppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX +ppType, ppParendType, ppFunLhType, ppCtxType :: Bool -> HsType DocNameI -> LaTeX ppType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode ppFunLhType unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode +ppCtxType unicode ty = ppr_mono_ty (reparenTypePrec PREC_CTX ty) unicode + +ppLHsTypeArg :: Bool -> LHsTypeArg DocNameI -> LaTeX +ppLHsTypeArg unicode (HsValArg ty) = ppLParendType unicode ty +ppLHsTypeArg unicode (HsTypeArg ki) = atSign unicode <> + ppLParendType unicode ki +ppLHsTypeArg _ (HsArgPar _) = text "" ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name @@ -1034,27 +1047,30 @@ ppr_mono_ty (HsFunTy _ ty1 ty2) u ppr_mono_ty (HsBangTy _ b ty) u = ppBang b <> ppLParendType u ty ppr_mono_ty (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name -ppr_mono_ty (HsTyVar _ Promoted (L _ name)) _ = char '\'' <> ppDocName name +ppr_mono_ty (HsTyVar _ IsPromoted (L _ name)) _ = char '\'' <> ppDocName name ppr_mono_ty (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys) ppr_mono_ty (HsSumTy _ tys) u = sumParens (map (ppLType u) tys) -ppr_mono_ty (HsKindSig _ ty kind) u = parens (ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind) +ppr_mono_ty (HsKindSig _ ty kind) u = ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind ppr_mono_ty (HsListTy _ ty) u = brackets (ppr_mono_lty ty u) -ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty ty u) +ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u ppr_mono_ty (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy" ppr_mono_ty (HsRecTy {}) _ = text "{..}" ppr_mono_ty (XHsType (NHsCoreTy {})) _ = error "ppr_mono_ty HsCoreTy" -ppr_mono_ty (HsExplicitListTy _ Promoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys +ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys ppr_mono_ty (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode = hsep [ppr_mono_lty fun_ty unicode, ppr_mono_lty arg_ty unicode] +ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode + = hsep [ppr_mono_lty fun_ty unicode, atSign unicode <> ppr_mono_lty arg_ki unicode] + ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode = ppr_mono_lty ty1 unicode <+> ppr_op <+> ppr_mono_lty ty2 unicode where - ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op - occName = nameOccName . getName . unLoc $ op + ppr_op | isSymOcc (getOccName op) = ppLDocName op + | otherwise = char '`' <> ppLDocName op <> char '`' ppr_mono_ty (HsParTy _ ty) unicode = parens (ppr_mono_lty ty unicode) @@ -1063,7 +1079,7 @@ ppr_mono_ty (HsParTy _ ty) unicode ppr_mono_ty (HsDocTy _ ty _) unicode = ppr_mono_lty ty unicode -ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = text "\\_" +ppr_mono_ty (HsWildCardTy _) _ = text "\\_" ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode) @@ -1083,16 +1099,13 @@ ppr_tylit (HsStrTy _ s) _ = text (show s) ppBinder :: OccName -> LaTeX ppBinder n - | isInfixName n = parens $ ppOccName n - | otherwise = ppOccName n + | isSymOcc n = parens $ ppOccName n + | otherwise = ppOccName n ppBinderInfix :: OccName -> LaTeX ppBinderInfix n - | isInfixName n = ppOccName n - | otherwise = cat [ char '`', ppOccName n, char '`' ] - -isInfixName :: OccName -> Bool -isInfixName n = isVarSym n || isConSym n + | isSymOcc n = ppOccName n + | otherwise = cat [ char '`', ppOccName n, char '`' ] ppSymName :: Name -> LaTeX ppSymName name @@ -1100,22 +1113,21 @@ ppSymName name | otherwise = ppName name -ppVerbOccName :: OccName -> LaTeX -ppVerbOccName = text . latexFilter . occNameString +ppVerbOccName :: Wrap OccName -> LaTeX +ppVerbOccName = text . latexFilter . showWrapped occNameString ppIPName :: HsIPName -> LaTeX -ppIPName ip = text $ unpackFS $ hsIPNameFS ip +ppIPName = text . ('?':) . unpackFS . hsIPNameFS ppOccName :: OccName -> LaTeX ppOccName = text . occNameString - -ppVerbDocName :: DocName -> LaTeX -ppVerbDocName = ppVerbOccName . nameOccName . getName +ppVerbDocName :: Wrap DocName -> LaTeX +ppVerbDocName = text . latexFilter . showWrapped (occNameString . nameOccName . getName) -ppVerbRdrName :: RdrName -> LaTeX -ppVerbRdrName = ppVerbOccName . rdrNameOcc +ppVerbRdrName :: Wrap RdrName -> LaTeX +ppVerbRdrName = text . latexFilter . showWrapped (occNameString . rdrNameOcc) ppDocName :: DocName -> LaTeX @@ -1176,7 +1188,7 @@ parLatexMarkup ppId = Markup { markupString = \s v -> text (fixString v s), markupAppend = \l r v -> l v <> r v, markupIdentifier = markupId ppId, - markupIdentifierUnchecked = markupId (ppVerbOccName . snd), + markupIdentifierUnchecked = markupId (ppVerbOccName . fmap snd), markupModule = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl), markupWarning = \p v -> emph (p v), markupEmphasis = \p v -> emph (p v), @@ -1189,7 +1201,7 @@ parLatexMarkup ppId = Markup { markupOrderedList = \p v -> enumeratedList (map ($v) p) $$ text "", markupDefList = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l), markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "", - markupHyperlink = \l _ -> markupLink l, + markupHyperlink = \(Hyperlink u l) p -> markupLink u (fmap ($p) l), markupAName = \_ _ -> empty, markupProperty = \p _ -> quote $ verb $ text p, markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e, @@ -1209,8 +1221,8 @@ parLatexMarkup ppId = Markup { fixString Verb s = s fixString Mono s = latexMonoFilter s - markupLink (Hyperlink url mLabel) = case mLabel of - Just label -> text "\\href" <> braces (text url) <> braces (text label) + markupLink url mLabel = case mLabel of + Just label -> text "\\href" <> braces (text url) <> braces label Nothing -> text "\\url" <> braces (text url) -- Is there a better way of doing this? Just a space is an aribtrary choice. @@ -1233,11 +1245,11 @@ parLatexMarkup ppId = Markup { where theid = ppId_ id -latexMarkup :: DocMarkup DocName (StringContext -> LaTeX) +latexMarkup :: DocMarkup (Wrap DocName) (StringContext -> LaTeX) latexMarkup = parLatexMarkup ppVerbDocName -rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX) +rdrLatexMarkup :: DocMarkup (Wrap RdrName) (StringContext -> LaTeX) rdrLatexMarkup = parLatexMarkup ppVerbRdrName @@ -1322,12 +1334,13 @@ quote :: LaTeX -> LaTeX quote doc = text "\\begin{quote}" $$ doc $$ text "\\end{quote}" -dcolon, arrow, darrow, forallSymbol, starSymbol :: Bool -> LaTeX +dcolon, arrow, darrow, forallSymbol, starSymbol, atSign :: Bool -> LaTeX dcolon unicode = text (if unicode then "∷" else "::") arrow unicode = text (if unicode then "→" else "->") darrow unicode = text (if unicode then "⇒" else "=>") forallSymbol unicode = text (if unicode then "∀" else "forall") starSymbol unicode = text (if unicode then "★" else "*") +atSign unicode = text (if unicode then "@" else "@") dot :: LaTeX dot = char '.' @@ -1342,7 +1355,7 @@ ubxParenList = ubxparens . hsep . punctuate comma ubxparens :: LaTeX -> LaTeX -ubxparens h = text "(#" <> h <> text "#)" +ubxparens h = text "(#" <+> h <+> text "#)" nl :: LaTeX diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 46d94b37..9add4cae 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -39,7 +39,7 @@ import Haddock.GhcUtils import Control.Monad ( when, unless ) import qualified Data.ByteString.Builder as Builder import Data.Char ( toUpper, isSpace ) -import Data.List ( sortBy, isPrefixOf, intercalate, intersperse ) +import Data.List ( sortBy, isPrefixOf, intersperse ) import Data.Maybe import System.Directory import System.FilePath hiding ( (</>) ) @@ -293,7 +293,7 @@ ppHtmlContents dflags odir doctitle _maybe_package ppModuleTree pkg qual tree ] createDirectoryIfMissing True odir - writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html) + writeUtf8File (joinPath [odir, contentsHtmlFile]) (renderToString debug html) ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html @@ -388,7 +388,7 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = d | Just item_html <- processExport True links_info unicode pkg qual item = [ Object [ "display_html" .= String (showHtmlFragment item_html) - , "name" .= String (intercalate " " (map nameString names)) + , "name" .= String (unwords (map getOccString names)) , "module" .= String (moduleString mdl) , "link" .= String (fromMaybe "" (listToMaybe (map (nameLink mdl) names))) ] @@ -397,18 +397,15 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = d where names = exportName item ++ exportSubs item - exportSubs :: ExportItem name -> [IdP name] + exportSubs :: ExportItem DocNameI -> [IdP DocNameI] exportSubs ExportDecl { expItemSubDocs } = map fst expItemSubDocs exportSubs _ = [] - exportName :: ExportItem name -> [IdP name] + exportName :: ExportItem DocNameI -> [IdP DocNameI] exportName ExportDecl { expItemDecl } = getMainDeclBinder (unLoc expItemDecl) exportName ExportNoDecl { expItemName } = [expItemName] exportName _ = [] - nameString :: NamedThing name => name -> String - nameString = occNameString . nameOccName . getName - nameLink :: NamedThing name => Module -> name -> String nameLink mdl = moduleNameUrl' (moduleName mdl) . nameOccName . getName @@ -436,9 +433,9 @@ ppHtmlIndex odir doctitle _maybe_package themes mapM_ (do_sub_index index) initialChars -- Let's add a single large index as well for those who don't know exactly what they're looking for: let mergedhtml = indexPage False Nothing index - writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml) + writeUtf8File (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml) - writeFile (joinPath [odir, indexHtmlFile]) (renderToString debug html) + writeUtf8File (joinPath [odir, indexHtmlFile]) (renderToString debug html) where indexPage showLetters ch items = @@ -479,7 +476,7 @@ ppHtmlIndex odir doctitle _maybe_package themes do_sub_index this_ix c = unless (null index_part) $ - writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) + writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) where html = indexPage True (Just c) index_part index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c] @@ -573,7 +570,7 @@ ppHtmlModule odir doctitle themes ] createDirectoryIfMissing True odir - writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html) + writeUtf8File (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html) signatureDocURL :: String signatureDocURL = "https://wiki.haskell.org/Module_signature" diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index bc6e2c2b..f2cab635 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -1,6 +1,8 @@ {-# LANGUAGE TransformListComp #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- -- | -- Module : Haddock.Backends.Html.Decl @@ -32,6 +34,7 @@ import qualified Data.Map as Map import Data.Maybe import Text.XHtml hiding ( name, title, p, quote ) +import BasicTypes (PromotionFlag(..), isPromoted) import GHC hiding (LexicalFixity(..)) import GHC.Exts import Name @@ -297,7 +300,7 @@ ppFamDecl summary associated links instances fixities loc doc decl splice unicod ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n , feqn_rhs = rhs , feqn_pats = ts } }) - = ( ppAppNameTypes n (map unLoc ts) unicode qual + = ( ppAppNameTypeArgs n ts unicode qual <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs) , Nothing , [] @@ -400,6 +403,11 @@ ppAppNameTypes :: DocName -> [HsType DocNameI] -> Unicode -> Qualification -> Ht ppAppNameTypes n ts unicode qual = ppTypeApp n ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts) +ppAppNameTypeArgs :: DocName -> [LHsTypeArg DocNameI] -> Unicode -> Qualification -> Html +ppAppNameTypeArgs n args@(HsValArg _:HsValArg _:_) u q + = ppTypeApp n args (\p -> ppDocName q p True) (ppLHsTypeArg u q HideEmptyContexts) +ppAppNameTypeArgs n args u q + = (ppDocName q Prefix True n) <+> hsep (map (ppLHsTypeArg u q HideEmptyContexts) args) -- | General printing of type applications ppTypeApp :: DocName -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html @@ -412,7 +420,6 @@ ppTypeApp n (t1:t2:rest) ppDN ppT ppTypeApp n ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT ts) - ------------------------------------------------------------------------------- -- * Contexts ------------------------------------------------------------------------------- @@ -678,7 +685,7 @@ instanceId origin no orphan ihd = concat $ [ "o:" | orphan ] ++ [ qual origin , ":" ++ getOccString origin - , ":" ++ (occNameString . getOccName . ihdClsName) ihd + , ":" ++ getOccString (ihdClsName ihd) , ":" ++ show no ] where @@ -1083,6 +1090,11 @@ ppType unicode qual emptyCtxts ty = ppr_mono_ty (reparenTypePrec PREC_TOP ppParendType unicode qual emptyCtxts ty = ppr_mono_ty (reparenTypePrec PREC_CON ty) unicode qual emptyCtxts ppFunLhType unicode qual emptyCtxts ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode qual emptyCtxts +ppLHsTypeArg :: Unicode -> Qualification -> HideEmptyContexts -> LHsTypeArg DocNameI -> Html +ppLHsTypeArg unicode qual emptyCtxts (HsValArg ty) = ppLParendType unicode qual emptyCtxts ty +ppLHsTypeArg unicode qual emptyCtxts (HsTypeArg ki) = atSign unicode <> + ppLParendType unicode qual emptyCtxts ki +ppLHsTypeArg _ _ _ (HsArgPar _) = toHtml "" ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html ppHsTyVarBndr _ qual (UserTyVar _ (L _ name)) = ppDocName qual Raw False name @@ -1143,8 +1155,9 @@ ppr_mono_ty (HsTyVar _ _ (L _ name)) True _ _ ppr_mono_ty (HsBangTy _ b ty) u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty -ppr_mono_ty (HsTyVar _ _ (L _ name)) _ q _ = - ppDocName q Prefix True name +ppr_mono_ty (HsTyVar _ prom (L _ name)) _ q _ + | isPromoted prom = promoQuote (ppDocName q Prefix True name) + | otherwise = ppDocName q Prefix True name ppr_mono_ty (HsStarTy _ isUni) u _ _ = toHtml (if u || isUni then "★" else "*") ppr_mono_ty (HsFunTy _ ty1 ty2) u q e = @@ -1156,7 +1169,7 @@ ppr_mono_ty (HsTupleTy _ con tys) u q _ = ppr_mono_ty (HsSumTy _ tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys) ppr_mono_ty (HsKindSig _ ty kind) u q e = - parens (ppr_mono_lty ty u q e <+> dcolon u <+> ppLKind u q kind) + ppr_mono_lty ty u q e <+> dcolon u <+> ppLKind u q kind ppr_mono_ty (HsListTy _ ty) u q _ = brackets (ppr_mono_lty ty u q HideEmptyContexts) ppr_mono_ty (HsIParamTy _ (L _ n) ty) u q _ = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u q HideEmptyContexts @@ -1166,7 +1179,7 @@ ppr_mono_ty (HsRecTy {}) _ _ _ = toHtml "{..}" -- placeholder in the signature, which is followed by the field -- declarations. ppr_mono_ty (XHsType (NHsCoreTy {})) _ _ _ = error "ppr_mono_ty HsCoreTy" -ppr_mono_ty (HsExplicitListTy _ Promoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys ppr_mono_ty (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys @@ -1174,6 +1187,10 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode qual _ = hsep [ ppr_mono_lty fun_ty unicode qual HideEmptyContexts , ppr_mono_lty arg_ty unicode qual HideEmptyContexts ] +ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode qual _ + = hsep [ppr_mono_lty fun_ty unicode qual HideEmptyContexts + , atSign unicode <> ppr_mono_lty arg_ki unicode qual HideEmptyContexts] + ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode qual _ = ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts where @@ -1191,10 +1208,9 @@ ppr_mono_ty (HsParTy _ ty) unicode qual emptyCtxts ppr_mono_ty (HsDocTy _ ty _) unicode qual emptyCtxts = ppr_mono_lty ty unicode qual emptyCtxts -ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_' +ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_' ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n ppr_tylit :: HsTyLit -> Html ppr_tylit (HsNumTy _ n) = toHtml (show n) ppr_tylit (HsStrTy _ s) = toHtml (show s) - diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index 38aa7b7e..1901cf05 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -62,8 +62,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup { markupHyperlink = \(Hyperlink url mLabel) -> if insertAnchors then anchor ! [href url] - << fromMaybe url mLabel - else toHtml $ fromMaybe url mLabel, + << fromMaybe (toHtml url) mLabel + else fromMaybe (toHtml url) mLabel, markupAName = \aname -> if insertAnchors then namedAnchor aname << "" @@ -171,12 +171,12 @@ flatten x = [x] -- extract/append the underlying 'Doc' and convert it to 'Html'. For -- 'CollapsingHeader', we attach extra info to the generated 'Html' -- that allows us to expand/collapse the content. -hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (ModuleName, OccName) id -> Html +hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (Wrap (ModuleName, OccName)) id -> Html hackMarkup fmt' currPkg h' = let (html, ms) = hackMarkup' fmt' h' in html +++ renderMeta fmt' currPkg (metaConcat ms) where - hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id + hackMarkup' :: DocMarkup id Html -> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta]) hackMarkup' fmt h = case h of UntouchedDoc d -> (markup fmt $ _doc d, [_meta d]) @@ -206,7 +206,7 @@ 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 first. -markupHacked :: DocMarkup id Html +markupHacked :: DocMarkup (Wrap id) Html -> Maybe Package -- this package -> Maybe String -> MDoc id @@ -220,7 +220,7 @@ docToHtml :: Maybe String -- ^ Name of the thing this doc is for. See -> Maybe Package -- ^ Current package -> Qualification -> MDoc DocName -> Html docToHtml n pkg qual = markupHacked fmt pkg n . cleanup - where fmt = parHtmlMarkup qual True (ppDocName qual Raw) + where fmt = parHtmlMarkup qual True (ppWrappedDocName qual Raw) -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element -- in links. This is used to generate the Contents box elements. @@ -228,16 +228,16 @@ docToHtmlNoAnchors :: Maybe String -- ^ See 'toHack' -> Maybe Package -- ^ Current package -> Qualification -> MDoc DocName -> Html docToHtmlNoAnchors n pkg qual = markupHacked fmt pkg n . cleanup - where fmt = parHtmlMarkup qual False (ppDocName qual Raw) + where fmt = parHtmlMarkup qual False (ppWrappedDocName qual Raw) origDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html origDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup - where fmt = parHtmlMarkup qual True (const $ ppName Raw) + where fmt = parHtmlMarkup qual True (const (ppWrappedName Raw)) rdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html rdrDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup - where fmt = parHtmlMarkup qual True (const ppRdrName) + where fmt = parHtmlMarkup qual True (const (ppRdrName . unwrap)) docElement :: (Html -> Html) -> Html -> Html @@ -273,7 +273,7 @@ cleanup = overDoc (markup fmtUnParagraphLists) unParagraph (DocParagraph d) = d unParagraph doc = doc - fmtUnParagraphLists :: DocMarkup a (Doc a) + fmtUnParagraphLists :: DocMarkup (Wrap a) (Doc a) fmtUnParagraphLists = idMarkup { markupUnorderedList = DocUnorderedList . map unParagraph, markupOrderedList = DocOrderedList . map unParagraph diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index 574045e0..6a047747 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs @@ -13,7 +13,8 @@ module Haddock.Backends.Xhtml.Names ( ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink, ppBinder, ppBinderInfix, ppBinder', - ppModule, ppModuleRef, ppIPName, linkId, Notation(..) + ppModule, ppModuleRef, ppIPName, linkId, Notation(..), + ppWrappedDocName, ppWrappedName, ) where @@ -24,7 +25,7 @@ import Haddock.Utils import Text.XHtml hiding ( name, p, quote ) import qualified Data.Map as M -import qualified Data.List as List +import Data.List ( stripPrefix ) import GHC hiding (LexicalFixity(..)) import Name @@ -49,9 +50,11 @@ ppIPName :: HsIPName -> Html ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS -ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html -ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName - +ppUncheckedLink :: Qualification -> Wrap (ModuleName, OccName) -> Html +ppUncheckedLink _ x = linkIdOcc' mdl (Just occ) << occHtml + where + (mdl, occ) = unwrap x + occHtml = toHtml (showWrapped (occNameString . snd) x) -- TODO: apply ppQualifyName -- The Bool indicates if it is to be rendered in infix notation ppLDocName :: Qualification -> Notation -> Located DocName -> Html @@ -68,6 +71,19 @@ ppDocName qual notation insertAnchors docName = ppQualifyName qual notation name (nameModule name) | otherwise -> ppName notation name + +ppWrappedDocName :: Qualification -> Notation -> Bool -> Wrap DocName -> Html +ppWrappedDocName qual notation insertAnchors docName = case docName of + Unadorned n -> ppDocName qual notation insertAnchors n + Parenthesized n -> ppDocName qual Prefix insertAnchors n + Backticked n -> ppDocName qual Infix insertAnchors n + +ppWrappedName :: Notation -> Wrap Name -> Html +ppWrappedName notation docName = case docName of + Unadorned n -> ppName notation n + Parenthesized n -> ppName Prefix n + Backticked n -> ppName Infix n + -- | Render a name depending on the selected qualification mode ppQualifyName :: Qualification -> Notation -> Name -> Module -> Html ppQualifyName qual notation name mdl = @@ -79,7 +95,7 @@ ppQualifyName qual notation name mdl = then ppName notation name else ppFullQualName notation mdl name RelativeQual localmdl -> - case List.stripPrefix (moduleString localmdl) (moduleString mdl) of + case stripPrefix (moduleString localmdl) (moduleString mdl) of -- local, A.x -> x Just [] -> ppName notation name -- sub-module, A.B.x -> B.x diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index 7fbaec6d..c3acb6df 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -22,6 +22,7 @@ module Haddock.Backends.Xhtml.Utils ( braces, brackets, pabrackets, parens, parenList, ubxParenList, ubxSumList, arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote, + atSign, hsep, vcat, @@ -183,15 +184,15 @@ ubxSumList = ubxparens . hsep . punctuate (toHtml " | ") ubxparens :: Html -> Html -ubxparens h = toHtml "(#" +++ h +++ toHtml "#)" +ubxparens h = toHtml "(#" <+> h <+> toHtml "#)" -dcolon, arrow, darrow, forallSymbol :: Bool -> Html +dcolon, arrow, darrow, forallSymbol, atSign :: Bool -> Html dcolon unicode = toHtml (if unicode then "∷" else "::") arrow unicode = toHtml (if unicode then "→" else "->") darrow unicode = toHtml (if unicode then "⇒" else "=>") forallSymbol unicode = if unicode then toHtml "∀" else keyword "forall" - +atSign unicode = toHtml (if unicode then "@" else "@") dot :: Html dot = toHtml "." diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 7735ed0d..d22efc9a 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -12,12 +12,16 @@ -- Conversion between TyThing and HsDecl. This functionality may be moved into -- GHC at some point. ----------------------------------------------------------------------------- -module Haddock.Convert where --- Some other functions turned out to be useful for converting --- instance heads, which aren't TyThings, so just export everything. +module Haddock.Convert ( + tyThingToLHsDecl, + synifyInstHead, + synifyFamInst, + PrintRuntimeReps(..), +) where import Bag ( emptyBag ) -import BasicTypes ( TupleSort(..), SourceText(..), LexicalFixity(..) ) +import BasicTypes ( TupleSort(..), SourceText(..), LexicalFixity(..) + , PromotionFlag(..), DefMethSpec(..) ) import Class import CoAxiom import ConLike @@ -36,9 +40,10 @@ import TyCon import Type import TyCoRep import TysPrim ( alphaTyVars ) -import TysWiredIn ( listTyConName, liftedTypeKindTyConName, unitTy ) -import PrelNames ( hasKey, eqTyConKey, eqTyConName, ipClassKey - , tYPETyConKey, liftedRepDataConKey ) +import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName + , unitTy, promotedNilDataCon, promotedConsDataCon ) +import PrelNames ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey + , liftedRepDataConKey ) import Unique ( getUnique ) import Util ( chkAppend, compareLength, dropList, filterByList, filterOut , splitAtList ) @@ -47,12 +52,22 @@ import VarSet import Haddock.Types import Haddock.Interface.Specialize +import Haddock.GhcUtils ( orderedFVs, defaultRuntimeRepVars ) +import Data.Maybe ( catMaybes, maybeToList ) +-- | Whether or not to default 'RuntimeRep' variables to 'LiftedRep'. Check +-- out Note [Defaulting RuntimeRep variables] in IfaceType.hs for the +-- motivation. +data PrintRuntimeReps = ShowRuntimeRep | HideRuntimeRep deriving Show + -- the main function here! yay! -tyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl GhcRn)) -tyThingToLHsDecl t = case t of +tyThingToLHsDecl + :: PrintRuntimeReps + -> TyThing + -> Either ErrMsg ([ErrMsg], (HsDecl GhcRn)) +tyThingToLHsDecl prr 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 @@ -61,40 +76,60 @@ tyThingToLHsDecl t = 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 -> allOK $ SigD noExt (synifyIdSig ImplicitizeForAll i) + AnId i -> allOK $ SigD noExt (synifyIdSig prr 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 -> Either ErrMsg (LFamilyDecl a) - extractFamilyDecl (FamDecl _ d) = return $ noLoc d + -> let extractFamilyDecl :: TyClDecl a -> Either ErrMsg (FamilyDecl a) + extractFamilyDecl (FamDecl _ d) = return d extractFamilyDecl _ = Left "tyThingToLHsDecl: impossible associated tycon" - atTyClDecls = [synifyTyCon Nothing at_tc | ATI at_tc _ <- classATItems cl] - atFamDecls = map extractFamilyDecl (rights atTyClDecls) - tyClErrors = lefts atTyClDecls - famDeclErrors = lefts atFamDecls - in withErrs (tyClErrors ++ famDeclErrors) . TyClD noExt $ ClassDecl + extractFamDefDecl :: FamilyDecl GhcRn -> Type -> TyFamDefltEqn GhcRn + extractFamDefDecl fd rhs = FamEqn + { feqn_ext = noExt + , feqn_tycon = fdLName fd + , feqn_bndrs = Nothing + -- TODO: this must change eventually + , feqn_pats = fdTyVars fd + , feqn_fixity = fdFixity fd + , feqn_rhs = synifyType WithinType [] rhs } + + extractAtItem + :: ClassATItem + -> Either ErrMsg (LFamilyDecl GhcRn, Maybe (LTyFamDefltEqn GhcRn)) + extractAtItem (ATI at_tc def) = do + tyDecl <- synifyTyCon prr Nothing at_tc + famDecl <- extractFamilyDecl tyDecl + let defEqnTy = fmap (noLoc . extractFamDefDecl famDecl . fst) def + pure (noLoc famDecl, defEqnTy) + + atTyClDecls = map extractAtItem (classATItems cl) + (atFamDecls, atDefFamDecls) = unzip (rights atTyClDecls) + vs = tyConVisibleTyVars (classTyCon cl) + + in withErrs (lefts atTyClDecls) . TyClD noExt $ ClassDecl { tcdCtxt = synifyCtx (classSCTheta cl) , tcdLName = synifyName cl - , tcdTyVars = synifyTyVars (tyConVisibleTyVars (classTyCon cl)) - , tcdFixity = Prefix + , tcdTyVars = synifyTyVars vs + , tcdFixity = synifyFixity cl , tcdFDs = map (\ (l,r) -> noLoc (map (noLoc . getName) l, map (noLoc . getName) r) ) $ snd $ classTvsFds cl , tcdSigs = noLoc (MinimalSig noExt NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) : - map (noLoc . synifyTcIdSig DeleteTopLevelQuantification) - (classMethods cl) + [ noLoc tcdSig + | clsOp <- classOpItems cl + , tcdSig <- synifyTcIdSig vs clsOp ] , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature -- class associated-types are a subset of TyCon: - , tcdATs = rights atFamDecls - , tcdATDefs = [] --ignore associated type defaults + , tcdATs = atFamDecls + , tcdATDefs = catMaybes atDefFamDecls , tcdDocs = [] --we don't have any docs at this point , tcdCExt = placeHolderNamesTc } | otherwise - -> synifyTyCon Nothing tc >>= allOK . TyClD noExt + -> synifyTyCon prr Nothing tc >>= allOK . TyClD noExt -- type-constructors (e.g. Maybe) are complicated, put the definition -- later in the file (also it's used for class associated-types too.) @@ -102,7 +137,7 @@ tyThingToLHsDecl t = case t of -- a data-constructor alone just gets rendered as a function: AConLike (RealDataCon dc) -> allOK $ SigD noExt (TypeSig noExt [synifyName dc] - (synifySigWcType ImplicitizeForAll (dataConUserType dc))) + (synifySigWcType ImplicitizeForAll [] (dataConUserType dc))) AConLike (PatSynCon ps) -> allOK . SigD noExt $ PatSynSig noExt [synifyName ps] (synifyPatSynSigType ps) @@ -114,16 +149,17 @@ synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn GhcRn synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) = let name = synifyName tc args_types_only = filterOutInvisibleTypes tc args - typats = map (synifyType WithinType) args_types_only + typats = map (synifyType WithinType []) args_types_only annot_typats = zipWith3 annotHsType (mkIsPolyTvs fam_tvs) args_types_only typats - hs_rhs = synifyType WithinType rhs - in HsIB { hsib_ext = HsIBRn { hsib_vars = map tyVarName tkvs - , hsib_closed = True } + hs_rhs = synifyType WithinType [] rhs + in HsIB { hsib_ext = map tyVarName tkvs , hsib_body = FamEqn { feqn_ext = noExt , feqn_tycon = name - , feqn_pats = annot_typats - , feqn_fixity = Prefix + , feqn_bndrs = Nothing + -- TODO: this must change eventually + , feqn_pats = map HsValArg annot_typats + , feqn_fixity = synifyFixity name , feqn_rhs = hs_rhs } } where fam_tvs = tyConVisibleTyVars tc @@ -138,42 +174,51 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc , getUnique ax' == getUnique ax -- without the getUniques, type error - = synifyTyCon (Just ax) tc >>= return . TyClD noExt + = synifyTyCon ShowRuntimeRep (Just ax) tc >>= return . TyClD noExt | otherwise = Left "synifyAxiom: closed/open family confusion" --- | Turn type constructors into type class declarations -synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl GhcRn) -synifyTyCon _coax tc +-- | Turn type constructors into data declarations, type families, or type synonyms +synifyTyCon + :: PrintRuntimeReps + -> Maybe (CoAxiom br) -- ^ RHS of type synonym + -> TyCon -- ^ type constructor to convert + -> Either ErrMsg (TyClDecl GhcRn) +synifyTyCon prr _coax 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 noExt (noLoc (getName fakeTyVar)) - (synifyKindSig realKind) - in HsQTvs { hsq_ext = + , tcdTyVars = HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = [] -- No kind polymorphism , hsq_dependent = emptyNameSet } - , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc))) - alphaTyVars --a, b, c... which are unfortunately all kind * + , hsq_explicit = zipWith mk_hs_tv + tyVarKinds + alphaTyVars --a, b, c... which are unfortunately all kind * } - , tcdFixity = Prefix + , tcdFixity = synifyFixity tc , tcdDataDefn = HsDataDefn { dd_ext = noExt , dd_ND = DataType -- arbitrary lie, they are neither -- algebraic data nor newtype: , dd_ctxt = noLoc [] , dd_cType = Nothing - , dd_kindSig = Just (synifyKindSig (tyConKind tc)) + , dd_kindSig = synifyDataTyConReturnKind tc -- we have their kind accurately: , dd_cons = [] -- No constructors , dd_derivs = noLoc [] } , tcdDExt = DataDeclRn False placeHolderNamesTc } + where + -- tyConTyVars doesn't work on fun/prim, but we can make them up: + mk_hs_tv realKind fakeTyVar + | isLiftedTypeKind realKind = noLoc $ UserTyVar noExt (noLoc (getName fakeTyVar)) + | otherwise = noLoc $ KindedTyVar noExt (noLoc (getName fakeTyVar)) (synifyKindSig realKind) + + conKind = defaultType prr (tyConKind tc) + tyVarKinds = fst . splitFunTys . snd . splitPiTysInvisible $ conKind -synifyTyCon _coax tc +synifyTyCon _prr _coax tc | Just flav <- famTyConFlav_maybe tc = case flav of -- Type families @@ -197,7 +242,7 @@ synifyTyCon _coax tc , fdInfo = i , fdLName = synifyName tc , fdTyVars = synifyTyVars (tyConVisibleTyVars tc) - , fdFixity = Prefix + , fdFixity = synifyFixity tc , fdResultSig = synifyFamilyResultSig resultVar (tyConResKind tc) , fdInjectivityAnn = @@ -205,13 +250,13 @@ synifyTyCon _coax tc (tyConInjectivityInfo tc) } -synifyTyCon coax tc +synifyTyCon _prr coax tc | Just ty <- synTyConRhs_maybe tc = return $ SynDecl { tcdSExt = emptyNameSet , tcdLName = synifyName tc , tcdTyVars = synifyTyVars (tyConVisibleTyVars tc) - , tcdFixity = Prefix - , tcdRhs = synifyType WithinType ty } + , tcdFixity = synifyFixity tc + , tcdRhs = synifyType WithinType [] ty } | otherwise = -- (closed) newtype and data let @@ -239,7 +284,7 @@ synifyTyCon coax tc -- That seems like an acceptable compromise (they'll just be documented -- in prefix position), since, otherwise, the logic (at best) gets much more -- complicated. (would use dataConIsInfix.) - use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc) + use_gadt_syntax = isGadtSyntaxTyCon tc consRaw = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc) cons = rights consRaw -- "deriving" doesn't affect the signature, no need to specify any. @@ -253,31 +298,31 @@ synifyTyCon coax tc , dd_derivs = alg_deriv } in case lefts consRaw of [] -> return $ - DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdFixity = Prefix + DataDecl { tcdLName = name, tcdTyVars = tyvars + , tcdFixity = synifyFixity name , tcdDataDefn = defn , tcdDExt = DataDeclRn False placeHolderNamesTc } dataConErrs -> Left $ unlines dataConErrs --- In this module, every TyCon being considered has come from an interface +-- | In this module, every TyCon being considered has come from an interface -- file. This means that when considering a data type constructor such as: -- --- data Foo (w :: *) (m :: * -> *) (a :: *) +-- > data Foo (w :: *) (m :: * -> *) (a :: *) -- -- Then its tyConKind will be (* -> (* -> *) -> * -> *). But beware! We are -- also rendering the type variables of Foo, so if we synify the tyConKind of -- Foo in full, we will end up displaying this in Haddock: -- --- data Foo (w :: *) (m :: * -> *) (a :: *) --- :: * -> (* -> *) -> * -> * +-- > data Foo (w :: *) (m :: * -> *) (a :: *) +-- > :: * -> (* -> *) -> * -> * -- --- Which is entirely wrong (#548). We only want to display the *return* kind, +-- Which is entirely wrong (#548). We only want to display the /return/ kind, -- which this function obtains. synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind GhcRn) synifyDataTyConReturnKind tc - = case splitFunTys (dropForAlls (tyConKind tc)) of - (_, ret_kind) - | isLiftedTypeKind ret_kind -> Nothing -- Don't bother displaying :: * - | otherwise -> Just (synifyKindSig ret_kind) + | isLiftedTypeKind ret_kind = Nothing -- Don't bother displaying :: * + | otherwise = Just (synifyKindSig ret_kind) + where ret_kind = tyConResKind tc synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity -> Maybe (LInjectivityAnn GhcRn) @@ -288,8 +333,9 @@ synifyInjectivityAnn (Just lhs) tvs (Injective inj) = in Just $ noLoc $ InjectivityAnn (noLoc lhs) rhs synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GhcRn -synifyFamilyResultSig Nothing kind = - noLoc $ KindSig noExt (synifyKindSig kind) +synifyFamilyResultSig Nothing kind + | isLiftedTypeKind kind = noLoc $ NoSig noExt + | otherwise = noLoc $ KindSig noExt (synifyKindSig kind) synifyFamilyResultSig (Just name) kind = noLoc $ TyVarSig noExt (noLoc $ KindedTyVar noExt (noLoc name) (synifyKindSig kind)) @@ -307,14 +353,16 @@ synifyDataCon use_gadt_syntax dc = use_named_field_syntax = not (null field_tys) name = synifyName dc -- con_qvars means a different thing depending on gadt-syntax - (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc + (_univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc + user_tvs = dataConUserTyVars dc -- Used for GADT data constructors -- skip any EqTheta, use 'orig'inal syntax - ctx = synifyCtx theta + ctx | null theta = Nothing + | otherwise = Just $ synifyCtx theta linear_tys = zipWith (\ty bang -> - let tySyn = synifyType WithinType ty + let tySyn = synifyType WithinType [] ty in case bang of (HsSrcBang _ NoSrcUnpack NoSrcStrict) -> tySyn bang' -> noLoc $ HsBangTy noExt bang' tySyn) @@ -338,33 +386,55 @@ synifyDataCon use_gadt_syntax dc = then return $ noLoc $ ConDeclGADT { con_g_ext = noExt , con_names = [name] - , con_forall = noLoc True - , con_qvars = synifyTyVars (univ_tvs ++ ex_tvs) - , con_mb_cxt = Just ctx - , con_args = hat - , con_res_ty = synifyType WithinType res_ty - , con_doc = Nothing } + , con_forall = noLoc $ not $ null user_tvs + , con_qvars = synifyTyVars user_tvs + , con_mb_cxt = ctx + , con_args = hat + , con_res_ty = synifyType WithinType [] res_ty + , con_doc = Nothing } else return $ noLoc $ ConDeclH98 { con_ext = noExt , con_name = name - , con_forall = noLoc True + , con_forall = noLoc False , con_ex_tvs = map synifyTyVar ex_tvs - , con_mb_cxt = Just ctx + , con_mb_cxt = ctx , con_args = hat , con_doc = Nothing } synifyName :: NamedThing n => n -> Located Name synifyName n = L (srcLocSpan (getSrcLoc n)) (getName n) - -synifyIdSig :: SynifyTypeState -> Id -> Sig GhcRn -synifyIdSig s i = TypeSig noExt [synifyName i] (synifySigWcType s (varType i)) - -synifyTcIdSig :: SynifyTypeState -> Id -> Sig GhcRn -synifyTcIdSig s i = ClassOpSig noExt False [synifyName i] (synifySigType s (varType i)) +-- | Guess the fixity of a something with a name. This isn't quite right, since +-- a user can always declare an infix name in prefix form or a prefix name in +-- infix form. Unfortunately, that is not something we can usually reconstruct. +synifyFixity :: NamedThing n => n -> LexicalFixity +synifyFixity n | isSymOcc (getOccName n) = Infix + | otherwise = Prefix + +synifyIdSig + :: PrintRuntimeReps -- ^ are we printing tyvars of kind 'RuntimeRep'? + -> SynifyTypeState -- ^ what to do with a 'forall' + -> [TyVar] -- ^ free variables in the type to convert + -> Id -- ^ the 'Id' from which to get the type signature + -> Sig GhcRn +synifyIdSig prr s vs i = TypeSig noExt [synifyName i] (synifySigWcType s vs t) + where + t = defaultType prr (varType i) + +-- | Turn a 'ClassOpItem' into a list of signatures. The list returned is going +-- to contain the synified 'ClassOpSig' as well (when appropriate) a default +-- 'ClassOpSig'. +synifyTcIdSig :: [TyVar] -> ClassOpItem -> [Sig GhcRn] +synifyTcIdSig vs (i, dm) = + [ ClassOpSig noExt False [synifyName i] (mainSig (varType i)) ] ++ + [ ClassOpSig noExt True [noLoc dn] (defSig dt) + | Just (dn, GenericDM dt) <- [dm] ] + where + mainSig t = synifySigType DeleteTopLevelQuantification vs t + defSig t = synifySigType ImplicitizeForAll vs t synifyCtx :: [PredType] -> LHsContext GhcRn -synifyCtx = noLoc . map (synifyType WithinType) +synifyCtx = noLoc . map (synifyType WithinType []) synifyTyVars :: [TyVar] -> LHsQTyVars GhcRn @@ -373,13 +443,20 @@ synifyTyVars ktvs = HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = [] , hsq_explicit = map synifyTyVar ktvs } synifyTyVar :: TyVar -> LHsTyVarBndr GhcRn -synifyTyVar tv - | isLiftedTypeKind kind = noLoc (UserTyVar noExt (noLoc name)) - | otherwise = noLoc (KindedTyVar noExt (noLoc name) (synifyKindSig kind)) +synifyTyVar = synifyTyVar' emptyVarSet + +-- | Like 'synifyTyVar', but accepts a set of variables for which to omit kind +-- signatures (even if they don't have the lifted type kind). +synifyTyVar' :: VarSet -> TyVar -> LHsTyVarBndr GhcRn +synifyTyVar' no_kinds tv + | isLiftedTypeKind kind || tv `elemVarSet` no_kinds + = noLoc (UserTyVar noExt (noLoc name)) + | otherwise = noLoc (KindedTyVar noExt (noLoc name) (synifyKindSig kind)) where kind = tyVarKind tv name = getName tv + -- | Annotate (with HsKingSig) a type if the first parameter is True -- and if the type contains a free variable. -- This is used to synify type patterns for poly-kinded tyvars in @@ -391,7 +468,7 @@ annotHsType _ _ hs_ty@(L _ (HsKindSig {})) = hs_ty annotHsType True ty hs_ty | not $ isEmptyVarSet $ filterVarSet isTyVar $ tyCoVarsOfType ty = let ki = typeKind ty - hs_ki = synifyType WithinType ki + hs_ki = synifyType WithinType [] ki in noLoc (HsKindSig noExt hs_ty hs_ki) annotHsType _ _ hs_ty = hs_ty @@ -414,7 +491,8 @@ data SynifyTypeState -- quite understand what's going on. | ImplicitizeForAll -- ^ beginning of a function definition, in which, to make it look - -- less ugly, those rank-1 foralls are made implicit. + -- less ugly, those rank-1 foralls (without kind annotations) are made + -- implicit. | DeleteTopLevelQuantification -- ^ because in class methods the context is added to the type -- (e.g. adding @forall a. Num a =>@ to @(+) :: a -> a -> a@) @@ -423,22 +501,33 @@ data SynifyTypeState -- the defining class gets to quantify all its functions for free! -synifySigType :: SynifyTypeState -> Type -> LHsSigType GhcRn +synifySigType :: SynifyTypeState -> [TyVar] -> Type -> LHsSigType GhcRn -- The empty binders is a bit suspicious; -- what if the type has free variables? -synifySigType s ty = mkEmptyImplicitBndrs (synifyType s ty) +synifySigType s vs ty = mkEmptyImplicitBndrs (synifyType s vs ty) -synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType GhcRn +synifySigWcType :: SynifyTypeState -> [TyVar] -> Type -> LHsSigWcType GhcRn -- Ditto (see synifySigType) -synifySigWcType s ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs (synifyType s ty)) +synifySigWcType s vs ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs (synifyType s vs ty)) synifyPatSynSigType :: PatSyn -> LHsSigType GhcRn -- Ditto (see synifySigType) synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps) -synifyType :: SynifyTypeState -> Type -> LHsType GhcRn -synifyType _ (TyVarTy tv) = noLoc $ HsTyVar noExt NotPromoted $ noLoc (getName tv) -synifyType _ (TyConApp tc tys) +-- | Depending on the first argument, try to default all type variables of kind +-- 'RuntimeRep' to 'LiftedType'. +defaultType :: PrintRuntimeReps -> Type -> Type +defaultType ShowRuntimeRep = id +defaultType HideRuntimeRep = defaultRuntimeRepVars + +-- | Convert a core type into an 'HsType'. +synifyType + :: SynifyTypeState -- ^ what to do with a 'forall' + -> [TyVar] -- ^ free variables in the type to convert + -> Type -- ^ the type to convert + -> LHsType GhcRn +synifyType _ _ (TyVarTy tv) = noLoc $ HsTyVar noExt NotPromoted $ noLoc (getName tv) +synifyType _ vs (TyConApp tc tys) = maybe_sig res_ty where res_ty :: LHsType GhcRn @@ -456,39 +545,55 @@ synifyType _ (TyConApp tc tys) BoxedTuple -> HsBoxedTuple ConstraintTuple -> HsConstraintTuple UnboxedTuple -> HsUnboxedTuple) - (map (synifyType WithinType) vis_tys) + (map (synifyType WithinType vs) vis_tys) + | isUnboxedSumTyCon tc = noLoc $ HsSumTy noExt (map (synifyType WithinType vs) vis_tys) + | Just dc <- isPromotedDataCon_maybe tc + , isTupleDataCon dc + , dataConSourceArity dc == length vis_tys + = noLoc $ HsExplicitTupleTy noExt (map (synifyType WithinType vs) vis_tys) -- ditto for lists - | getName tc == listTyConName, [ty] <- tys = - noLoc $ HsListTy noExt (synifyType WithinType ty) + | getName tc == listTyConName, [ty] <- vis_tys = + noLoc $ HsListTy noExt (synifyType WithinType vs ty) + | tc == promotedNilDataCon, [] <- vis_tys + = noLoc $ HsExplicitListTy noExt IsPromoted [] + | tc == promotedConsDataCon + , [ty1, ty2] <- vis_tys + = let hTy = synifyType WithinType vs ty1 + in case synifyType WithinType vs ty2 of + tTy | L _ (HsExplicitListTy _ IsPromoted tTy') <- stripKindSig tTy + -> noLoc $ HsExplicitListTy noExt IsPromoted (hTy : tTy') + | otherwise + -> noLoc $ HsOpTy noExt hTy (noLoc $ getName tc) tTy -- ditto for implicit parameter tycons | tc `hasKey` ipClassKey , [name, ty] <- tys , Just x <- isStrLitTy name - = noLoc $ HsIParamTy noExt (noLoc $ HsIPName x) (synifyType WithinType ty) + = noLoc $ HsIParamTy noExt (noLoc $ HsIPName x) (synifyType WithinType vs ty) -- and equalities | tc `hasKey` eqTyConKey , [ty1, ty2] <- tys = noLoc $ HsOpTy noExt - (synifyType WithinType ty1) + (synifyType WithinType vs ty1) (noLoc eqTyConName) - (synifyType WithinType ty2) + (synifyType WithinType vs ty2) -- and infix type operators | isSymOcc (nameOccName (getName tc)) , ty1:ty2:tys_rest <- vis_tys = mk_app_tys (HsOpTy noExt - (synifyType WithinType ty1) + (synifyType WithinType vs ty1) (noLoc $ getName tc) - (synifyType WithinType ty2)) + (synifyType WithinType vs ty2)) tys_rest -- Most TyCons: | otherwise - = mk_app_tys (HsTyVar noExt NotPromoted $ noLoc (getName tc)) + = mk_app_tys (HsTyVar noExt prom $ noLoc (getName tc)) vis_tys where + prom = if isPromotedDataCon tc then IsPromoted else NotPromoted mk_app_tys ty_app ty_args = foldl (\t1 t2 -> noLoc $ HsAppTy noExt t1 t2) (noLoc ty_app) - (map (synifyType WithinType) $ + (map (synifyType WithinType vs) $ filterOut isCoercionTy ty_args) vis_tys = filterOutInvisibleTypes tc tys @@ -499,7 +604,7 @@ synifyType _ (TyConApp tc tys) maybe_sig ty' | needs_kind_sig = let full_kind = typeKind (mkTyConApp tc tys) - full_kind' = synifyType WithinType full_kind + full_kind' = synifyType WithinType vs full_kind in noLoc $ HsKindSig noExt ty' full_kind' | otherwise = ty' @@ -517,76 +622,174 @@ synifyType _ (TyConApp tc tys) in not (subVarSet result_vars dropped_vars) -synifyType s (AppTy t1 (CoercionTy {})) = synifyType s t1 -synifyType _ (AppTy t1 t2) = let - s1 = synifyType WithinType t1 - s2 = synifyType WithinType t2 +synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1 +synifyType _ vs (AppTy t1 t2) = let + s1 = synifyType WithinType vs t1 + s2 = synifyType WithinType vs t2 in noLoc $ HsAppTy noExt s1 s2 -synifyType _ (FunTy t1 t2) = let - s1 = synifyType WithinType t1 - s2 = synifyType WithinType t2 - in noLoc $ HsFunTy noExt s1 s2 -synifyType s forallty@(ForAllTy _tv _ty) = - let (tvs, ctx, tau) = tcSplitSigmaTyPreserveSynonyms forallty +synifyType s vs funty@(FunTy t1 t2) + | isPredTy t1 = synifyForAllType s vs funty + | otherwise = let s1 = synifyType WithinType vs t1 + s2 = synifyType WithinType vs t2 + in noLoc $ HsFunTy noExt s1 s2 +synifyType s vs forallty@(ForAllTy _tv _ty) = synifyForAllType s vs forallty + +synifyType _ _ (LitTy t) = noLoc $ HsTyLit noExt $ synifyTyLit t +synifyType s vs (CastTy t _) = synifyType s vs t +synifyType _ _ (CoercionTy {}) = error "synifyType:Coercion" + +-- | Process a 'Type' which starts with a forall or a constraint into +-- an 'HsType' +synifyForAllType + :: SynifyTypeState -- ^ what to do with the 'forall' + -> [TyVar] -- ^ free variables in the type to convert + -> Type -- ^ the forall type to convert + -> LHsType GhcRn +synifyForAllType s vs ty = + let (tvs, ctx, tau) = tcSplitSigmaTyPreserveSynonyms ty sPhi = HsQualTy { hst_ctxt = synifyCtx ctx - , hst_xqual = noExt - , hst_body = synifyType WithinType tau } + , hst_xqual = noExt + , hst_body = synifyType WithinType (tvs' ++ vs) tau } + + sTy = HsForAllTy { hst_bndrs = sTvs + , hst_xforall = noExt + , hst_body = noLoc sPhi } + + sTvs = map synifyTyVar tvs + + -- Figure out what the type variable order would be inferred in the + -- absence of an explicit forall + tvs' = orderedFVs (mkVarSet vs) (ctx ++ [tau]) + in case s of - DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau - WithinType -> noLoc $ HsForAllTy { hst_bndrs = map synifyTyVar tvs - , hst_xforall = noExt - , hst_body = noLoc sPhi } - ImplicitizeForAll -> noLoc sPhi + DeleteTopLevelQuantification -> synifyType ImplicitizeForAll (tvs' ++ vs) tau + + -- Put a forall in if there are any type variables + WithinType + | not (null tvs) -> noLoc sTy + | otherwise -> noLoc sPhi + + ImplicitizeForAll -> implicitForAll [] vs tvs ctx (synifyType WithinType) tau + + +-- | Put a forall in if there are any type variables which require +-- explicit kind annotations or if the inferred type variable order +-- would be different. +implicitForAll + :: [TyCon] -- ^ type constructors that determine their args kinds + -> [TyVar] -- ^ free variables in the type to convert + -> [TyVar] -- ^ type variable binders in the forall + -> ThetaType -- ^ constraints right after the forall + -> ([TyVar] -> Type -> LHsType GhcRn) -- ^ how to convert the inner type + -> Type -- ^ inner type + -> LHsType GhcRn +implicitForAll tycons vs tvs ctx synInner tau + | any (isHsKindedTyVar . unLoc) sTvs = noLoc sTy + | tvs' /= tvs = noLoc sTy + | otherwise = noLoc sPhi + where + sRho = synInner (tvs' ++ vs) tau + sPhi | null ctx = unLoc sRho + | otherwise + = HsQualTy { hst_ctxt = synifyCtx ctx + , hst_xqual = noExt + , hst_body = synInner (tvs' ++ vs) tau } + sTy = HsForAllTy { hst_bndrs = sTvs + , hst_xforall = noExt + , hst_body = noLoc sPhi } + + no_kinds_needed = noKindTyVars tycons tau + sTvs = map (synifyTyVar' no_kinds_needed) tvs + + -- Figure out what the type variable order would be inferred in the + -- absence of an explicit forall + tvs' = orderedFVs (mkVarSet vs) (ctx ++ [tau]) + -synifyType _ (LitTy t) = noLoc $ HsTyLit noExt $ synifyTyLit t -synifyType s (CastTy t _) = synifyType s t -synifyType _ (CoercionTy {}) = error "synifyType:Coercion" + +-- | Find the set of type variables whose kind signatures can be properly +-- inferred just from their uses in the type signature. This means the type +-- variable to has at least one fully applied use @f x1 x2 ... xn@ where: +-- +-- * @f@ has a function kind where the arguments have the same kinds +-- as @x1 x2 ... xn@. +-- +-- * @f@ has a function kind whose final return has lifted type kind +-- +noKindTyVars + :: [TyCon] -- ^ type constructors that determine their args kinds + -> Type -- ^ type to inspect + -> VarSet -- ^ set of variables whose kinds can be inferred from uses in the type +noKindTyVars _ (TyVarTy var) + | isLiftedTypeKind (tyVarKind var) = unitVarSet var +noKindTyVars ts ty + | (f, xs) <- splitAppTys ty + , not (null xs) + = let args = map (noKindTyVars ts) xs + func = case f of + TyVarTy var | (xsKinds, outKind) <- splitFunTys (tyVarKind var) + , xsKinds `eqTypes` map typeKind xs + , isLiftedTypeKind outKind + -> unitVarSet var + TyConApp t ks | t `elem` ts + , all noFreeVarsOfType ks + -> mkVarSet [ v | TyVarTy v <- xs ] + _ -> noKindTyVars ts f + in unionVarSets (func : args) +noKindTyVars ts (ForAllTy _ t) = noKindTyVars ts t +noKindTyVars ts (FunTy t1 t2) = noKindTyVars ts t1 `unionVarSet` noKindTyVars ts t2 +noKindTyVars ts (CastTy t _) = noKindTyVars ts t +noKindTyVars _ _ = emptyVarSet synifyPatSynType :: PatSyn -> LHsType GhcRn -synifyPatSynType ps = let - (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps - req_theta' | null req_theta && not (null prov_theta && null ex_tvs) = [unitTy] - -- HACK: a HsQualTy with theta = [unitTy] will be printed as "() =>", - -- i.e., an explicit empty context, which is what we need. This is not - -- possible by taking theta = [], as that will print no context at all - | otherwise = req_theta - sForAll [] s = s - sForAll tvs s = HsForAllTy { hst_bndrs = map synifyTyVar tvs - , hst_xforall = noExt - , hst_body = noLoc s } - sQual theta s = HsQualTy { hst_ctxt = synifyCtx theta - , hst_xqual = noExt - , hst_body = noLoc s } - sTau = unLoc $ synifyType WithinType $ mkFunTys arg_tys res_ty - in noLoc $ sForAll univ_tvs $ sQual req_theta' $ sForAll ex_tvs $ sQual prov_theta sTau +synifyPatSynType ps = + let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps + ts = maybeToList (tyConAppTyCon_maybe res_ty) + + -- HACK: a HsQualTy with theta = [unitTy] will be printed as "() =>", + -- i.e., an explicit empty context, which is what we need. This is not + -- possible by taking theta = [], as that will print no context at all + req_theta' | null req_theta + , not (null prov_theta && null ex_tvs) + = [unitTy] + | otherwise = req_theta + + in implicitForAll ts [] (univ_tvs ++ ex_tvs) req_theta' + (\vs -> implicitForAll ts vs [] prov_theta (synifyType WithinType)) + (mkFunTys arg_tys res_ty) synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s synifyKindSig :: Kind -> LHsKind GhcRn -synifyKindSig k = synifyType WithinType k +synifyKindSig k = synifyType WithinType [] k + +stripKindSig :: LHsType GhcRn -> LHsType GhcRn +stripKindSig (L _ (HsKindSig _ t _)) = t +stripKindSig t = t synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead GhcRn -synifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead +synifyInstHead (vs, preds, cls, types) = specializeInstHead $ InstHead { ihdClsName = getName cls , ihdTypes = map unLoc annot_ts , ihdInstType = ClassInst - { clsiCtx = map (unLoc . synifyType WithinType) preds + { clsiCtx = map (unLoc . synifyType WithinType []) preds , clsiTyVars = synifyTyVars (tyConVisibleTyVars cls_tycon) , clsiSigs = map synifyClsIdSig $ classMethods cls , clsiAssocTys = do - (Right (FamDecl _ fam)) <- map (synifyTyCon Nothing) $ classATs cls + (Right (FamDecl _ fam)) <- map (synifyTyCon HideRuntimeRep Nothing) + (classATs cls) pure $ mkPseudoFamilyDecl fam } } where cls_tycon = classTyCon cls ts = filterOutInvisibleTypes cls_tycon types - ts' = map (synifyType WithinType) ts + ts' = map (synifyType WithinType vs) ts annot_ts = zipWith3 annotHsType is_poly_tvs ts ts' is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars cls_tycon) - synifyClsIdSig = synifyIdSig DeleteTopLevelQuantification + synifyClsIdSig = synifyIdSig ShowRuntimeRep DeleteTopLevelQuantification vs -- Convert a family instance, this could be a type family or data family synifyFamInst :: FamInst -> Bool -> Either ErrMsg (InstHead GhcRn) @@ -600,9 +803,9 @@ synifyFamInst fi opaque = do where ityp SynFamilyInst | opaque = return $ TypeInst Nothing ityp SynFamilyInst = - return . TypeInst . Just . unLoc $ synifyType WithinType fam_rhs + return . TypeInst . Just . unLoc $ synifyType WithinType [] fam_rhs ityp (DataFamilyInst c) = - DataInst <$> synifyTyCon (Just $ famInstAxiom fi) c + DataInst <$> synifyTyCon HideRuntimeRep (Just $ famInstAxiom fi) c fam_tc = famInstTyCon fi fam_flavor = fi_flavor fi fam_lhs = fi_tys fi @@ -622,7 +825,7 @@ synifyFamInst fi opaque = do = fam_lhs ts = filterOutInvisibleTypes fam_tc eta_expanded_lhs - synifyTypes = map (synifyType WithinType) + synifyTypes = map (synifyType WithinType []) ts' = synifyTypes ts annot_ts = zipWith3 annotHsType is_poly_tvs ts ts' is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars fam_tc) @@ -652,8 +855,8 @@ tcSplitSigmaTyPreserveSynonyms ty = tcSplitForAllTysPreserveSynonyms :: Type -> ([TyVar], Type) tcSplitForAllTysPreserveSynonyms ty = split ty ty [] where - split _ (ForAllTy (TvBndr tv _) ty') tvs = split ty' ty' (tv:tvs) - split orig_ty _ tvs = (reverse tvs, orig_ty) + split _ (ForAllTy (Bndr tv _) ty') tvs = split ty' ty' (tv:tvs) + split orig_ty _ tvs = (reverse tvs, orig_ty) -- | See Note [Invariant: Never expand type synonyms] tcSplitPhiTyPreserveSynonyms :: Type -> (ThetaType, Type) diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index e7d80969..29a52faf 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE BangPatterns, FlexibleInstances, ViewPatterns #-} +{-# LANGUAGE BangPatterns, StandaloneDeriving, FlexibleInstances, ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -18,20 +19,34 @@ module Haddock.GhcUtils where import Control.Arrow +import Data.Char ( isSpace ) + import Haddock.Types( DocNameI ) import Exception -import Outputable +import FV +import Outputable ( Outputable, panic, showPpr ) import Name import NameSet -import Lexeme import Module import HscTypes import GHC import Class import DynFlags +import SrcLoc ( advanceSrcLoc ) +import Var ( VarBndr(..), TyVarBinder, tyVarKind, updateTyVarKind, + isInvisibleArgFlag ) +import VarSet ( VarSet, emptyVarSet ) +import VarEnv ( TyVarEnv, extendVarEnv, elemVarEnv, emptyVarEnv ) +import TyCoRep ( Type(..), isRuntimeRepVar ) +import TysWiredIn( liftedRepDataConTyCon ) + +import StringBuffer ( StringBuffer ) +import qualified StringBuffer as S -import HsTypes (HsType(..)) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BS moduleString :: Module -> String @@ -40,15 +55,8 @@ moduleString = moduleNameString . moduleName isNameSym :: Name -> Bool isNameSym = isSymOcc . nameOccName - -isVarSym :: OccName -> Bool -isVarSym = isLexVarSym . occNameFS - -isConSym :: OccName -> Bool -isConSym = isLexConSym . occNameFS - - -getMainDeclBinder :: HsDecl name -> [IdP name] +getMainDeclBinder :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) => + HsDecl p -> [IdP p] getMainDeclBinder (TyClD _ d) = [tcdName d] getMainDeclBinder (ValD _ d) = case collectHsBindBinders d of @@ -141,12 +149,6 @@ isValD :: HsDecl a -> Bool isValD (ValD _ _) = True isValD _ = False - -declATs :: HsDecl a -> [IdP a] -declATs (TyClD _ d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d -declATs _ = [] - - pretty :: Outputable a => DynFlags -> a -> String pretty = showPpr @@ -237,6 +239,8 @@ getGADTConTypeG (XConDecl {}) = panic "getGADTConTypeG" data Precedence = PREC_TOP -- ^ precedence of 'type' production in GHC's parser + | PREC_SIG -- ^ explicit type signature + | PREC_CTX -- ^ Used for single contexts, eg. ctx => type -- (as opposed to (ctx1, ctx2) => type) @@ -263,12 +267,13 @@ reparenTypePrec = go go _ (HsBangTy x b ty) = HsBangTy x b (reparenLType ty) go _ (HsTupleTy x con tys) = HsTupleTy x con (map reparenLType tys) go _ (HsSumTy x tys) = HsSumTy x (map reparenLType tys) - go _ (HsKindSig x ty kind) = HsKindSig x (reparenLType ty) (reparenLType kind) go _ (HsListTy x ty) = HsListTy x (reparenLType ty) go _ (HsRecTy x flds) = HsRecTy x (map (fmap reparenConDeclField) flds) go p (HsDocTy x ty d) = HsDocTy x (goL p ty) d go _ (HsExplicitListTy x p tys) = HsExplicitListTy x p (map reparenLType tys) go _ (HsExplicitTupleTy x tys) = HsExplicitTupleTy x (map reparenLType tys) + go p (HsKindSig x ty kind) + = paren p PREC_SIG $ HsKindSig x (goL PREC_SIG ty) (goL PREC_SIG kind) go p (HsIParamTy x n ty) = paren p PREC_CTX $ HsIParamTy x n (reparenLType ty) go p (HsForAllTy x tvs ty) @@ -279,6 +284,8 @@ reparenTypePrec = go = paren p PREC_FUN $ HsFunTy x (goL PREC_FUN ty1) (goL PREC_TOP ty2) go p (HsAppTy x fun_ty arg_ty) = paren p PREC_CON $ HsAppTy x (goL PREC_FUN fun_ty) (goL PREC_CON arg_ty) + go p (HsAppKindTy x fun_ty arg_ki) + = paren p PREC_CON $ HsAppKindTy x (goL PREC_FUN fun_ty) (goL PREC_CON arg_ki) go p (HsOpTy x ty1 op ty2) = paren p PREC_FUN $ HsOpTy x (goL PREC_OP ty1) op (goL PREC_OP ty2) go p (HsParTy _ t) = unLoc $ goL p t -- pretend the paren doesn't exist - it will be added back if needed @@ -426,13 +433,230 @@ minimalDef n = do ------------------------------------------------------------------------------- -setObjectDir, setHiDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags +setObjectDir, setHiDir, setHieDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags setObjectDir f d = d{ objectDir = Just f} setHiDir f d = d{ hiDir = Just f} +setHieDir f d = d{ hieDir = Just f} setStubDir f d = d{ stubDir = Just f , includePaths = addGlobalInclude (includePaths d) [f] } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file -- \#included from the .hc file when compiling with -fvia-C. -setOutputDir f = setObjectDir f . setHiDir f . setStubDir f +setOutputDir f = setObjectDir f . setHiDir f . setHieDir f . setStubDir f + + +------------------------------------------------------------------------------- +-- * 'StringBuffer' and 'ByteString' +------------------------------------------------------------------------------- +-- We get away with a bunch of these functions because 'StringBuffer' and +-- 'ByteString' have almost exactly the same structure. + +-- | Convert a UTF-8 encoded 'ByteString' into a 'StringBuffer. This really +-- relies on the internals of both 'ByteString' and 'StringBuffer'. +-- +-- /O(n)/ (but optimized into a @memcpy@ by @bytestring@ under the hood) +stringBufferFromByteString :: ByteString -> StringBuffer +stringBufferFromByteString bs = + let BS.PS fp off len = bs <> BS.pack [0,0,0] + in S.StringBuffer { S.buf = fp, S.len = len - 3, S.cur = off } + +-- | Take the first @n@ /bytes/ of the 'StringBuffer' and put them in a +-- 'ByteString'. +-- +-- /O(1)/ +takeStringBuffer :: Int -> StringBuffer -> ByteString +takeStringBuffer !n !(S.StringBuffer fp _ cur) = BS.PS fp cur n + +-- | Return the prefix of the first 'StringBuffer' that /isn't/ in the second +-- 'StringBuffer'. **The behavior is undefined if the 'StringBuffers' use +-- separate buffers.** +-- +-- /O(1)/ +splitStringBuffer :: StringBuffer -> StringBuffer -> ByteString +splitStringBuffer buf1 buf2 = takeStringBuffer n buf1 + where n = S.byteDiff buf1 buf2 + +-- | Split the 'StringBuffer' at the next newline (or the end of the buffer). +-- Also: initial position is passed in and the updated position is returned. +-- +-- /O(n)/ (but /O(1)/ space) +spanLine :: RealSrcLoc -> StringBuffer -> (ByteString, RealSrcLoc, StringBuffer) +spanLine !loc !buf = go loc buf + where + + go !l !b + | not (S.atEnd b) + = case S.nextChar b of + ('\n', b') -> (splitStringBuffer buf b', advanceSrcLoc l '\n', b') + (c, b') -> go (advanceSrcLoc l c) b' + | otherwise + = (splitStringBuffer buf b, advanceSrcLoc l '\n', b) +-- | Given a start position and a buffer with that start position, split the +-- buffer at an end position. +-- +-- /O(n)/ (but /O(1)/ space) +spanPosition :: RealSrcLoc -- ^ start of buffeer + -> RealSrcLoc -- ^ position until which to take + -> StringBuffer -- ^ buffer from which to take + -> (ByteString, StringBuffer) +spanPosition !start !end !buf = go start buf + where + + go !l !b + | l < end + , not (S.atEnd b) + , (c, b') <- S.nextChar b + = go (advanceSrcLoc l c) b' + | otherwise + = (splitStringBuffer buf b, b) + +-- | Try to parse a line of CPP from the from of the buffer. A \"line\" of CPP +-- consists of +-- +-- * at most 10 whitespace characters, including at least one newline +-- * a @#@ character +-- * keep parsing lines until you find a line not ending in @\\@. +-- +-- This is chock full of heuristics about what a line of CPP is. +-- +-- /O(n)/ (but /O(1)/ space) +tryCppLine :: RealSrcLoc -> StringBuffer -> Maybe (ByteString, RealSrcLoc, StringBuffer) +tryCppLine !loc !buf = spanSpace (S.prevChar buf '\n' == '\n') loc buf + where + + -- Keep consuming space characters until we hit either a @#@ or something + -- else. If we hit a @#@, start parsing CPP + spanSpace !seenNl !l !b + | S.atEnd b + = Nothing + | otherwise + = case S.nextChar b of + ('#' , b') | not (S.atEnd b') + , ('-', b'') <- S.nextChar b' + , ('}', _) <- S.nextChar b'' + -> Nothing -- Edge case exception for @#-}@ + | seenNl + -> Just (spanCppLine (advanceSrcLoc l '#') b') -- parse CPP + | otherwise + -> Nothing -- We didn't see a newline, so this can't be CPP! + + (c , b') | isSpace c -> spanSpace (seenNl || c == '\n') + (advanceSrcLoc l c) b' + | otherwise -> Nothing + + -- Consume a CPP line to its "end" (basically the first line that ends not + -- with a @\@ character) + spanCppLine !l !b + | S.atEnd b + = (splitStringBuffer buf b, l, b) + | otherwise + = case S.nextChar b of + ('\\', b') | not (S.atEnd b') + , ('\n', b'') <- S.nextChar b' + -> spanCppLine (advanceSrcLoc (advanceSrcLoc l '\\') '\n') b'' + + ('\n', b') -> (splitStringBuffer buf b', advanceSrcLoc l '\n', b') + + (c , b') -> spanCppLine (advanceSrcLoc l c) b' + +------------------------------------------------------------------------------- +-- * Free variables of a 'Type' +------------------------------------------------------------------------------- + +-- | Get free type variables in a 'Type' in their order of appearance. +-- See [Ordering of implicit variables]. +orderedFVs + :: VarSet -- ^ free variables to ignore + -> [Type] -- ^ types to traverse (in order) looking for free variables + -> [TyVar] -- ^ free type variables, in the order they appear in +orderedFVs vs tys = + reverse . fst $ tyCoFVsOfTypes' tys (const True) vs ([], emptyVarSet) + + +-- See the "Free variables of types and coercions" section in 'TyCoRep', or +-- check out Note [Free variables of types]. The functions in this section +-- don't output type variables in the order they first appear in in the 'Type'. +-- +-- For example, 'tyCoVarsOfTypeList' reports an incorrect order for the type +-- of 'const :: a -> b -> a': +-- +-- >>> import Name +-- >>> import TyCoRep +-- >>> import TysPrim +-- >>> import Var +-- >>> a = TyVarTy alphaTyVar +-- >>> b = TyVarTy betaTyVar +-- >>> constTy = mkFunTys [a, b] a +-- >>> map (getOccString . tyVarName) (tyCoVarsOfTypeList constTy) +-- ["b","a"] +-- +-- However, we want to reuse the very optimized traversal machinery there, so +-- so we make our own `tyCoFVsOfType'`, `tyCoFVsBndr'`, and `tyCoVarsOfTypes'`. +-- All these do differently is traverse in a different order and ignore +-- coercion variables. + +-- | Just like 'tyCoFVsOfType', but traverses type variables in reverse order +-- of appearance. +tyCoFVsOfType' :: Type -> FV +tyCoFVsOfType' (TyVarTy v) a b c = (FV.unitFV v `unionFV` tyCoFVsOfType' (tyVarKind v)) a b c +tyCoFVsOfType' (TyConApp _ tys) a b c = tyCoFVsOfTypes' tys a b c +tyCoFVsOfType' (LitTy {}) a b c = emptyFV a b c +tyCoFVsOfType' (AppTy fun arg) a b c = (tyCoFVsOfType' arg `unionFV` tyCoFVsOfType' fun) a b c +tyCoFVsOfType' (FunTy arg res) a b c = (tyCoFVsOfType' res `unionFV` tyCoFVsOfType' arg) a b c +tyCoFVsOfType' (ForAllTy bndr ty) a b c = tyCoFVsBndr' bndr (tyCoFVsOfType' ty) a b c +tyCoFVsOfType' (CastTy ty _) a b c = (tyCoFVsOfType' ty) a b c +tyCoFVsOfType' (CoercionTy _ ) a b c = emptyFV a b c + +-- | Just like 'tyCoFVsOfTypes', but traverses type variables in reverse order +-- of appearance. +tyCoFVsOfTypes' :: [Type] -> FV +tyCoFVsOfTypes' (ty:tys) fv_cand in_scope acc = (tyCoFVsOfTypes' tys `unionFV` tyCoFVsOfType' ty) fv_cand in_scope acc +tyCoFVsOfTypes' [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc + +-- | Just like 'tyCoFVsBndr', but traverses type variables in reverse order of +-- appearance. +tyCoFVsBndr' :: TyVarBinder -> FV -> FV +tyCoFVsBndr' (Bndr tv _) fvs = FV.delFV tv fvs `unionFV` tyCoFVsOfType' (tyVarKind tv) + + +------------------------------------------------------------------------------- +-- * Defaulting RuntimeRep variables +------------------------------------------------------------------------------- + +-- | Traverses the type, defaulting type variables of kind 'RuntimeRep' to +-- 'LiftedType'. See 'defaultRuntimeRepVars' in IfaceType.hs the original such +-- function working over `IfaceType`'s. +defaultRuntimeRepVars :: Type -> Type +defaultRuntimeRepVars = go emptyVarEnv + where + go :: TyVarEnv () -> Type -> Type + go subs (ForAllTy (Bndr var flg) ty) + | isRuntimeRepVar var + , isInvisibleArgFlag flg + = let subs' = extendVarEnv subs var () + in go subs' ty + | otherwise + = ForAllTy (Bndr (updateTyVarKind (go subs) var) flg) + (go subs ty) + + go subs (TyVarTy tv) + | tv `elemVarEnv` subs + = TyConApp liftedRepDataConTyCon [] + | otherwise + = TyVarTy (updateTyVarKind (go subs) tv) + + go subs (TyConApp tc tc_args) + = TyConApp tc (map (go subs) tc_args) + + go subs (FunTy arg res) + = FunTy (go subs arg) (go subs res) + + go subs (AppTy t u) + = AppTy (go subs t) (go subs u) + + go subs (CastTy x co) + = CastTy (go subs x) co + + go _ ty@(LitTy {}) = ty + go _ ty@(CoercionTy {}) = ty diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 3d54970b..e7d30fc7 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -43,22 +43,19 @@ import Haddock.Types import Haddock.Utils import Control.Monad +import Control.Exception (evaluate) import Data.List import qualified Data.Map as Map import qualified Data.Set as Set import Distribution.Verbosity -import System.Directory -import System.FilePath import Text.Printf import Module (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) import Digraph import DynFlags hiding (verbosity) -import Exception import GHC hiding (verbosity) import HscTypes import FastString (unpackFS) -import MonadUtils (liftIO) import TcRnTypes (tcg_rdr_env) import Name (nameIsFromExternalPackage, nameOccName) import OccName (isTcOcc) @@ -92,7 +89,7 @@ processModules verbosity modules flags extIfaces = do out verbosity verbose "Creating interfaces..." let instIfaceMap = Map.fromList [ (instMod iface, iface) | ext <- extIfaces , iface <- ifInstalledIfaces ext ] - (interfaces, ms) <- createIfaces0 verbosity modules flags instIfaceMap + (interfaces, ms) <- createIfaces verbosity modules flags instIfaceMap let exportedNames = Set.unions $ map (Set.fromList . ifaceExports) $ @@ -125,39 +122,15 @@ processModules verbosity modules flags extIfaces = do -------------------------------------------------------------------------------- -createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc ([Interface], ModuleSet) -createIfaces0 verbosity modules flags instIfaceMap = - -- Output dir needs to be set before calling depanal since depanal uses it to - -- compute output file names that are stored in the DynFlags of the - -- resulting ModSummaries. - (if useTempDir then withTempOutputDir else id) $ do - modGraph <- depAnalysis - createIfaces verbosity flags instIfaceMap modGraph +createIfaces :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc ([Interface], ModuleSet) +createIfaces verbosity modules flags instIfaceMap = do + -- Ask GHC to tell us what the module graph is + targets <- mapM (\filePath -> guessTarget filePath Nothing) modules + setTargets targets + modGraph <- depanal [] False - where - useTempDir :: Bool - useTempDir = Flag_NoTmpCompDir `notElem` flags - - - withTempOutputDir :: Ghc a -> Ghc a - withTempOutputDir action = do - tmp <- liftIO getTemporaryDirectory - x <- liftIO getProcessID - let dir = tmp </> ".haddock-" ++ show x - modifySessionDynFlags (setOutputDir dir) - withTempDir dir action - - - depAnalysis :: Ghc ModuleGraph - depAnalysis = do - targets <- mapM (\f -> guessTarget f Nothing) modules - setTargets targets - depanal [] False - - -createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc ([Interface], ModuleSet) -createIfaces verbosity flags instIfaceMap mods = do - let sortedMods = flattenSCCs $ topSortModuleGraph False mods Nothing + -- Visit modules in that order + let sortedMods = flattenSCCs $ topSortModuleGraph False modGraph Nothing out verbosity normal "Haddock coverage:" (ifaces, _, !ms) <- foldM f ([], Map.empty, emptyModuleSet) sortedMods return (reverse ifaces, ms) @@ -271,12 +244,3 @@ buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces) keep_old env n = Map.insertWith (\_ old -> old) n mdl env keep_new env n = Map.insert n mdl env - --------------------------------------------------------------------------------- --- * Utils --------------------------------------------------------------------------------- - - -withTempDir :: (ExceptionMonad m) => FilePath -> m a -> m a -withTempDir dir = gbracket_ (liftIO $ createDirectory dir) - (liftIO $ removeDirectoryRecursive dir) diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 2d72d117..dd6c70a5 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, BangPatterns #-} +{-# LANGUAGE MagicHash, BangPatterns #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -19,6 +19,7 @@ import Haddock.Types import Haddock.Convert import Haddock.GhcUtils +import Control.Applicative ((<|>)) import Control.Arrow hiding ((<+>)) import Data.List import Data.Ord (comparing) @@ -31,7 +32,6 @@ import DynFlags import CoreSyn (isOrphan) import ErrUtils import FamInstEnv -import FastString import GHC import InstEnv import Module ( ModuleSet, moduleSetElts ) @@ -39,13 +39,11 @@ import MonadUtils (liftIO) import Name import NameEnv import Outputable (text, sep, (<+>)) -import PrelNames import SrcLoc import TyCon import TyCoRep -import TysPrim( funTyCon ) +import TysPrim( funTyConName ) import Var hiding (varName) -#define FSLIT(x) (mkFastString# (x#)) type ExportedNames = Set.Set Name type Modules = Set.Set Module @@ -63,16 +61,24 @@ attachInstances expInfo ifaces instIfaceMap mods = do ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ] attach index iface = do - newItems <- mapM (attachToExportItem index expInfo iface ifaceMap instIfaceMap) + + let getInstDoc = findInstDoc iface ifaceMap instIfaceMap + getFixity = findFixity iface ifaceMap instIfaceMap + + newItems <- mapM (attachToExportItem index expInfo getInstDoc getFixity) (ifaceExportItems iface) - let orphanInstances = attachOrphanInstances expInfo iface ifaceMap instIfaceMap (ifaceInstances iface) + let orphanInstances = attachOrphanInstances expInfo getInstDoc (ifaceInstances iface) return $ iface { ifaceExportItems = newItems , ifaceOrphanInstances = orphanInstances } -attachOrphanInstances :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> [ClsInst] -> [DocInstance GhcRn] -attachOrphanInstances expInfo iface ifaceMap instIfaceMap cls_instances = - [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, (L (getSrcSpan n) n), Nothing) +attachOrphanInstances + :: ExportInfo + -> (Name -> Maybe (MDoc Name)) -- ^ how to lookup the doc of an instance + -> [ClsInst] -- ^ a list of orphan instances + -> [DocInstance GhcRn] +attachOrphanInstances expInfo getInstDoc cls_instances = + [ (synifyInstHead i, getInstDoc n, (L (getSrcSpan n) n), Nothing) | let is = [ (instanceSig i, getName i) | i <- cls_instances, isOrphan (is_orphan i) ] , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is , not $ isInstanceHidden expInfo cls tys @@ -80,40 +86,40 @@ attachOrphanInstances expInfo iface ifaceMap instIfaceMap cls_instances = attachToExportItem - :: NameEnv ([ClsInst], [FamInst]) + :: NameEnv ([ClsInst], [FamInst]) -- ^ all instances (that we know of) -> ExportInfo - -> Interface - -> IfaceMap - -> InstIfaceMap + -> (Name -> Maybe (MDoc Name)) -- ^ how to lookup the doc of an instance + -> (Name -> Maybe Fixity) -- ^ how to lookup a fixity -> ExportItem GhcRn -> Ghc (ExportItem GhcRn) -attachToExportItem index expInfo iface ifaceMap instIfaceMap export = +attachToExportItem index expInfo getInstDoc getFixity export = case attachFixities export of e@ExportDecl { expItemDecl = L eSpan (TyClD _ d) } -> do insts <- let mb_instances = lookupNameEnv index (tcdName d) cls_instances = maybeToList mb_instances >>= fst fam_instances = maybeToList mb_instances >>= snd - fam_insts = [ ( synifyFamInst i opaque - , doc - , spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d)) + fam_insts = [ ( synFamInst + , getInstDoc n + , spanNameE n synFamInst (L eSpan (tcdName d)) , nameModule_maybe n ) | i <- sortBy (comparing instFam) fam_instances , let n = getName i - , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap , not $ isNameHidden expInfo (fi_fam i) , not $ any (isTypeHidden expInfo) (fi_tys i) , let opaque = isTypeHidden expInfo (fi_rhs i) + , let synFamInst = synifyFamInst i opaque ] - cls_insts = [ ( synifyInstHead i - , instLookup instDocMap n iface ifaceMap instIfaceMap - , spanName n (synifyInstHead i) (L eSpan (tcdName d)) + cls_insts = [ ( synClsInst + , getInstDoc n + , spanName n synClsInst (L eSpan (tcdName d)) , nameModule_maybe n ) | let is = [ (instanceSig i, getName i) | i <- cls_instances ] , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is , not $ isInstanceHidden expInfo cls tys + , let synClsInst = synifyInstHead i ] -- fam_insts but with failing type fams filtered out cleanFamInsts = [ (fi, n, L l r, m) | (Right fi, n, L l (Right r), m) <- fam_insts ] @@ -133,7 +139,7 @@ attachToExportItem index expInfo iface ifaceMap instIfaceMap export = nubByName fst $ expItemFixities e ++ [ (n',f) | n <- getMainDeclBinder d , n' <- n : (map fst subDocs ++ patsyn_names) - , Just f <- [instLookup instFixMap n' iface ifaceMap instIfaceMap] + , f <- maybeToList (getFixity n') ] } where patsyn_names = concatMap (getMainDeclBinder . fst) patsyns @@ -152,16 +158,20 @@ attachToExportItem index expInfo iface ifaceMap instIfaceMap export = let L l r = spanName s ok linst in L l (Right r) +-- | Lookup the doc associated with a certain instance +findInstDoc :: Interface -> IfaceMap -> InstIfaceMap -> Name -> Maybe (MDoc Name) +findInstDoc iface ifaceMap instIfaceMap = \name -> + (Map.lookup name . ifaceDocMap $ iface) <|> + (Map.lookup name . ifaceDocMap =<< Map.lookup (nameModule name) ifaceMap) <|> + (Map.lookup name . instDocMap =<< Map.lookup (nameModule name) instIfaceMap) + +-- | Lookup the fixity associated with a certain name +findFixity :: Interface -> IfaceMap -> InstIfaceMap -> Name -> Maybe Fixity +findFixity iface ifaceMap instIfaceMap = \name -> + (Map.lookup name . ifaceFixMap $ iface) <|> + (Map.lookup name . ifaceFixMap =<< Map.lookup (nameModule name) ifaceMap) <|> + (Map.lookup name . instFixMap =<< Map.lookup (nameModule name) instIfaceMap) -instLookup :: (InstalledInterface -> Map.Map Name a) -> Name - -> Interface -> IfaceMap -> InstIfaceMap -> Maybe a -instLookup f name iface ifaceMap instIfaceMap = - case Map.lookup name (f $ toInstalledIface iface) of - res@(Just _) -> res - Nothing -> do - let ifaceMaps = Map.union (fmap toInstalledIface ifaceMap) instIfaceMap - iface' <- Map.lookup (nameModule name) ifaceMaps - Map.lookup name (f iface') -------------------------------------------------------------------------------- -- Collecting and sorting instances @@ -211,13 +221,6 @@ instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } = (map argCount ts, n, map simplify ts, argCount t, simplify t) -funTyConName :: Name -funTyConName = mkWiredInName gHC_PRIM - (mkOccNameFS tcName FSLIT("(->)")) - funTyConKey - (ATyCon funTyCon) -- Relevant TyCon - BuiltInSyntax - -------------------------------------------------------------------------------- -- Filtering hidden instances -------------------------------------------------------------------------------- diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 146c3cc8..d89efb5a 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -20,27 +20,21 @@ module Haddock.Interface.Create (createInterface) where import Documentation.Haddock.Doc (metaDocAppend) -import Documentation.Haddock.Utf8 as Utf8 import Haddock.Types import Haddock.Options import Haddock.GhcUtils import Haddock.Utils import Haddock.Convert import Haddock.Interface.LexParseRn -import Haddock.Backends.Hyperlinker.Types -import Haddock.Backends.Hyperlinker.Ast as Hyperlinker -import Haddock.Backends.Hyperlinker.Parser as Hyperlinker import Data.Bifunctor import Data.Bitraversable -import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) import Data.List import Data.Maybe import Data.Ord import Control.Applicative -import Control.Exception (evaluate) import Control.Monad import Data.Traversable @@ -59,9 +53,8 @@ import Bag import RdrName import TcRnTypes import FastString ( unpackFS, fastStringToByteString) -import BasicTypes ( StringLiteral(..), SourceText(..) ) +import BasicTypes ( StringLiteral(..), SourceText(..), PromotionFlag(..) ) import qualified Outputable as O -import HsDecls ( getConArgs ) -- | Use a 'TypecheckedModule' to produce an 'Interface'. @@ -117,7 +110,7 @@ createInterface tm flags modMap instIfaceMap = do let declsWithDocs = topDecls group_ - exports0 = fmap (reverse . map (first unLoc)) mayExports + exports0 = fmap (map (first unLoc)) mayExports exports | OptIgnoreExports `elem` opts = Nothing | otherwise = exports0 @@ -170,8 +163,6 @@ createInterface tm flags modMap instIfaceMap = do modWarn <- liftErrMsg (moduleWarning dflags gre warnings) - tokenizedSrc <- mkMaybeTokenizedSrc dflags flags tm - return $! Interface { ifaceMod = mdl , ifaceIsSig = is_sig @@ -197,7 +188,8 @@ createInterface tm flags modMap instIfaceMap = do , ifaceRnOrphanInstances = [] -- Filled in `renameInterface` , ifaceHaddockCoverage = coverage , ifaceWarningMap = warningMap - , ifaceTokenizedSrc = tokenizedSrc + , ifaceHieFile = Just $ ml_hie_file $ ms_location ms + , ifaceDynFlags = dflags } @@ -899,7 +891,7 @@ hiDecl dflags t = do Nothing -> do liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty dflags t] return Nothing - Just x -> case tyThingToLHsDecl x of + Just x -> case tyThingToLHsDecl ShowRuntimeRep x of Left m -> liftErrMsg (tell [bugWarn m]) >> return Nothing Right (m, t') -> liftErrMsg (tell $ map bugWarn m) >> return (Just $ noLoc t') @@ -1077,8 +1069,8 @@ extractDecl declMap name decl TyClD _ d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) in if isDataConName name - then SigD noExt <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d)) - else SigD noExt <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) + then SigD noExt <$> extractPatternSyn name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) + else SigD noExt <$> extractRecSel name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) TyClD _ FamDecl {} | isValName name , Just (famInst:_) <- M.lookup name declMap @@ -1113,10 +1105,11 @@ extractDecl declMap name decl in case matches of [d0] -> extractDecl declMap name (noLoc . InstD noExt $ DataFamInstD noExt d0) _ -> error "internal: extractDecl (ClsInstD)" - _ -> error "internal: extractDecl" - + _ -> O.pprPanic "extractDecl" $ + O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":" + O.$$ O.nest 4 (O.ppr decl) -extractPatternSyn :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn +extractPatternSyn :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn extractPatternSyn nm t tvs cons = case filter matches cons of [] -> error "extractPatternSyn: constructor pattern not found" @@ -1144,9 +1137,13 @@ extractPatternSyn nm t tvs cons = data_ty con | ConDeclGADT{} <- con = con_res_ty con - | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn + mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsTypeArg ki) = HsAppKindTy noExt f ki + mkAppTyArg f (HsArgPar _) = HsParTy noExt f -extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] +extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn extractRecSel _ _ _ [] = error "extractRecSel: selector not found" @@ -1162,7 +1159,11 @@ extractRecSel nm t tvs (L _ con : rest) = data_ty -- ResTyGADT _ ty <- con_res con = ty | ConDeclGADT{} <- con = con_res_ty con - | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn + mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsTypeArg ki) = HsAppKindTy noExt f ki + mkAppTyArg f (HsArgPar _) = HsParTy noExt f -- | Keep export items with docs. pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn] @@ -1192,34 +1193,6 @@ seqList :: [a] -> () seqList [] = () seqList (x : xs) = x `seq` seqList xs -mkMaybeTokenizedSrc :: DynFlags -> [Flag] -> TypecheckedModule - -> ErrMsgGhc (Maybe [RichToken]) -mkMaybeTokenizedSrc dflags flags tm - | Flag_HyperlinkedSource `elem` flags = case renamedSource tm of - Just src -> do - tokens <- liftGhcToErrMsgGhc (liftIO (mkTokenizedSrc dflags summary src)) - return $ Just tokens - Nothing -> do - liftErrMsg . tell . pure $ concat - [ "Warning: Cannot hyperlink module \"" - , moduleNameString . ms_mod_name $ summary - , "\" because renamed source is not available" - ] - return Nothing - | otherwise = return Nothing - where - summary = pm_mod_summary . tm_parsed_module $ tm - -mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken] -mkTokenizedSrc dflags ms src = do - -- make sure to read the whole file at once otherwise - -- we run out of file descriptors (see #495) - rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate - let tokens = Hyperlinker.parse dflags filepath (Utf8.decodeUtf8 rawSrc) - return $ Hyperlinker.enrich src tokens - where - filepath = msHsFilePath ms - -- | Find a stand-alone documentation comment by its name. findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString) findNamedDoc name = search diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs index 636d3e19..a9834fa0 100644 --- a/haddock-api/src/Haddock/Interface/Json.hs +++ b/haddock-api/src/Haddock/Interface/Json.hs @@ -62,7 +62,10 @@ jsonMDoc MetaDoc{..} = ] jsonDoc :: Doc Name -> JsonDoc -jsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc)) +jsonDoc doc = jsonString (show (bimap showModName showName doc)) + where + showModName = showWrapped (moduleNameString . fst) + showName = showWrapped nameStableString jsonModule :: Module -> JsonDoc jsonModule = JSString . moduleStableString diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index b6913012..0b40ed3c 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -19,9 +19,9 @@ module Haddock.Interface.LexParseRn , processModuleHeader ) where -import Avail import Control.Arrow import Control.Monad +import Data.Functor (($>)) import Data.List import Data.Ord import Documentation.Haddock.Doc (metaDocConcat) @@ -34,8 +34,8 @@ import Haddock.Types import Name import Outputable ( showPpr, showSDoc ) import RdrName +import RdrHsSyn (setRdrNameSpace) import EnumSet -import RnEnv (dataTcOccs) processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (MDoc Name)) @@ -89,24 +89,38 @@ processModuleHeader dflags pkgName gre safety mayStr = do -- fallbacks in case we can't locate the identifiers. -- -- See the comments in the source for implementation commentary. -rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name) +rename :: DynFlags -> GlobalRdrEnv -> Doc NsRdrName -> ErrMsgM (Doc Name) rename dflags gre = rn where rn d = case d of DocAppend a b -> DocAppend <$> rn a <*> rn b DocParagraph doc -> DocParagraph <$> rn doc - DocIdentifier x -> do + DocIdentifier i -> do + let NsRdrName ns x = unwrap i + occ = rdrNameOcc x + isValueName = isDataOcc occ || isVarOcc occ + + let valueNsChoices | isValueName = [x] + | otherwise = [] -- is this ever possible? + typeNsChoices | isValueName = [setRdrNameSpace x tcName] + | otherwise = [x] + -- Generate the choices for the possible kind of thing this - -- is. - let choices = dataTcOccs x + -- is. We narrow down the possibilities with the namespace (if + -- there is one). + let choices = case ns of + Value -> valueNsChoices + Type -> typeNsChoices + None -> valueNsChoices ++ typeNsChoices -- Lookup any GlobalRdrElts that match the choices. case concatMap (\c -> lookupGRE_RdrName c gre) choices of -- We found no names in the env so we start guessing. [] -> case choices of - -- This shouldn't happen as 'dataTcOccs' always returns at least its input. - [] -> pure (DocMonospaced (DocString (showPpr dflags x))) + -- The only way this can happen is if a value namespace was + -- specified on something that cannot be a value. + [] -> invalidValue dflags i -- There was nothing in the environment so we need to -- pick some default from what's available to us. We @@ -116,14 +130,14 @@ rename dflags gre = rn -- type constructor names (such as in #253). So now we -- only get type constructor links if they are actually -- in scope. - a:_ -> outOfScope dflags a + a:_ -> outOfScope dflags ns (i $> a) -- There is only one name in the environment that matches so -- use it. - [a] -> pure (DocIdentifier (gre_name a)) + [a] -> pure (DocIdentifier (i $> gre_name a)) -- There are multiple names available. - gres -> ambiguous dflags x gres + gres -> ambiguous dflags i gres DocWarning doc -> DocWarning <$> rn doc DocEmphasis doc -> DocEmphasis <$> rn doc @@ -135,7 +149,7 @@ rename dflags gre = rn DocCodeBlock doc -> DocCodeBlock <$> rn doc DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x) DocModule str -> pure (DocModule str) - DocHyperlink l -> pure (DocHyperlink l) + DocHyperlink (Hyperlink u l) -> DocHyperlink . Hyperlink u <$> traverse rn l DocPic str -> pure (DocPic str) DocMathInline str -> pure (DocMathInline str) DocMathDisplay str -> pure (DocMathDisplay str) @@ -155,19 +169,25 @@ rename dflags gre = rn -- users shouldn't rely on this doing the right thing. See tickets -- #253 and #375 on the confusion this causes depending on which -- default we pick in 'rename'. -outOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a) -outOfScope dflags x = - case x of - Unqual occ -> warnAndMonospace occ - Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ)) - Orig _ occ -> warnAndMonospace occ - Exact name -> warnAndMonospace name -- Shouldn't happen since x is out of scope +outOfScope :: DynFlags -> Namespace -> Wrap RdrName -> ErrMsgM (Doc a) +outOfScope dflags ns x = + case unwrap x of + Unqual occ -> warnAndMonospace (x $> occ) + Qual mdl occ -> pure (DocIdentifierUnchecked (x $> (mdl, occ))) + Orig _ occ -> warnAndMonospace (x $> occ) + Exact name -> warnAndMonospace (x $> name) -- Shouldn't happen since x is out of scope where + prefix = case ns of + Value -> "the value " + Type -> "the type " + None -> "" + warnAndMonospace a = do - tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++ + let a' = showWrapped (showPpr dflags) a + tell ["Warning: " ++ prefix ++ "'" ++ a' ++ "' is out of scope.\n" ++ " If you qualify the identifier, haddock can try to link it anyway."] - pure (monospaced a) - monospaced a = DocMonospaced (DocString (showPpr dflags a)) + pure (monospaced a') + monospaced = DocMonospaced . DocString -- | Handle ambiguous identifiers. -- @@ -175,26 +195,39 @@ outOfScope dflags x = -- -- Emits a warning if the 'GlobalRdrElts's don't belong to the same type or class. ambiguous :: DynFlags - -> RdrName + -> Wrap NsRdrName -> [GlobalRdrElt] -- ^ More than one @gre@s sharing the same `RdrName` above. -> ErrMsgM (Doc Name) ambiguous dflags x gres = do - let noChildren = map availName (gresToAvailInfo gres) - dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren - msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++ - concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++ + let dflt = maximumBy (comparing (gre_lcl &&& isTyConName . gre_name)) gres + msg = "Warning: " ++ showNsRdrName dflags x ++ " is ambiguous. It is defined\n" ++ + concatMap (\n -> " * " ++ defnLoc n ++ "\n") gres ++ " You may be able to disambiguate the identifier by qualifying it or\n" ++ - " by hiding some imports.\n" ++ - " Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt + " by specifying the type/value namespace explicitly.\n" ++ + " Defaulting to the one defined " ++ defnLoc dflt -- TODO: Once we have a syntax for namespace qualification (#667) we may also -- want to emit a warning when an identifier is a data constructor for a type -- of the same name, but not the only constructor. -- For example, for @data D = C | D@, someone may want to reference the @D@ -- constructor. - when (length noChildren > 1) $ tell [msg] - pure (DocIdentifier dflt) + when (length (gresToAvailInfo gres) > 1) $ tell [msg] + pure (DocIdentifier (x $> gre_name dflt)) + where + defnLoc = showSDoc dflags . pprNameDefnLoc . gre_name + +-- | Handle value-namespaced names that cannot be for values. +-- +-- Emits a warning that the value-namespace is invalid on a non-value identifier. +invalidValue :: DynFlags -> Wrap NsRdrName -> ErrMsgM (Doc a) +invalidValue dflags x = do + tell ["Warning: " ++ showNsRdrName dflags x ++ " cannot be value, yet it is\n" ++ + " namespaced as such. Did you mean to specify a type namespace\n" ++ + " instead?"] + pure (DocMonospaced (DocString (showNsRdrName dflags x))) + +-- | Printable representation of a wrapped and namespaced name +showNsRdrName :: DynFlags -> Wrap NsRdrName -> String +showNsRdrName dflags = (\p i -> p ++ "'" ++ i ++ "'") <$> prefix <*> ident where - isLocalName (nameSrcLoc -> RealSrcLoc {}) = True - isLocalName _ = False - x_str = '\'' : showPpr dflags x ++ "'" - defnLoc = showSDoc dflags . pprNameDefnLoc + ident = showWrapped (showPpr dflags . rdrName) + prefix = renderNs . namespace . unwrap diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs index 050901b6..802ea773 100644 --- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs +++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs @@ -16,7 +16,6 @@ import Data.Char import DynFlags import Haddock.Parser import Haddock.Types -import RdrName -- ----------------------------------------------------------------------------- -- Parsing module headers @@ -24,7 +23,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 -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName) +parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo NsRdrName, MDoc NsRdrName) parseModuleHeader dflags pkgName str0 = let getKey :: String -> String -> (Maybe String,String) diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 1c976410..88238f04 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} ---------------------------------------------------------------------------- -- | -- Module : Haddock.Interface.Rename @@ -23,15 +24,15 @@ import GHC hiding (NoLink) import Name import Outputable ( panic ) import RdrName (RdrName(Exact)) -import PrelNames (eqTyCon_RDR) +import TysWiredIn (eqTyCon_RDR) import Control.Applicative +import Control.Arrow ( first ) import Control.Monad hiding (mapM) import Data.List import qualified Data.Map as Map hiding ( Map ) import Prelude hiding (mapM) - renameInterface :: DynFlags -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface renameInterface dflags renamingEnv warnings iface = @@ -92,56 +93,53 @@ renameInterface dflags renamingEnv warnings iface = -------------------------------------------------------------------------------- -- Monad for renaming --- --- The monad does two things for us: it passes around the environment for --- renaming, and it returns a list of names which couldn't be found in --- the environment. -------------------------------------------------------------------------------- +-- | The monad does two things for us: it passes around the environment for +-- renaming, and it returns a list of names which couldn't be found in +-- the environment. newtype RnM a = - RnM { unRn :: (Name -> (Bool, DocName)) -- name lookup function - -> (a,[Name]) + RnM { unRn :: (Name -> (Bool, DocName)) + -- Name lookup function. The 'Bool' indicates that if the name + -- was \"found\" in the environment. + + -> (a, [Name] -> [Name]) + -- Value returned, as well as a difference list of the names not + -- found } instance Monad RnM where - (>>=) = thenRn - return = pure + m >>= k = RnM $ \lkp -> let (a, out1) = unRn m lkp + (b, out2) = unRn (k a) lkp + in (b, out1 . out2) instance Functor RnM where - fmap f x = do a <- x; return (f a) + fmap f (RnM lkp) = RnM (first f . lkp) instance Applicative RnM where - pure = returnRn - (<*>) = ap - -returnRn :: a -> RnM a -returnRn a = RnM (const (a,[])) -thenRn :: RnM a -> (a -> RnM b) -> RnM b -m `thenRn` k = RnM (\lkp -> case unRn m lkp of - (a,out1) -> case unRn (k a) lkp of - (b,out2) -> (b,out1++out2)) - -getLookupRn :: RnM (Name -> (Bool, DocName)) -getLookupRn = RnM (\lkp -> (lkp,[])) - -outRn :: Name -> RnM () -outRn name = RnM (const ((),[name])) + pure a = RnM (const (a, id)) + mf <*> mx = RnM $ \lkp -> let (f, out1) = unRn mf lkp + (x, out2) = unRn mx lkp + in (f x, out1 . out2) +-- | Look up a 'Name' in the renaming environment. lookupRn :: Name -> RnM DocName -lookupRn name = do - lkp <- getLookupRn +lookupRn name = RnM $ \lkp -> case lkp name of - (False,maps_to) -> do outRn name; return maps_to - (True, maps_to) -> return maps_to - - -runRnFM :: LinkEnv -> RnM a -> (a,[Name]) -runRnFM env rn = unRn rn lkp + (False,maps_to) -> (maps_to, (name :)) + (True, maps_to) -> (maps_to, id) + +-- | Run the renamer action using lookup in a 'LinkEnv' as the lookup function. +-- Returns the renamed value along with a list of `Name`'s that could not be +-- renamed because they weren't in the environment. +runRnFM :: LinkEnv -> RnM a -> (a, [Name]) +runRnFM env rn = let (x, dlist) = unRn rn lkp in (x, dlist []) where - lkp n = case Map.lookup n env of - Nothing -> (False, Undocumented n) - Just mdl -> (True, Documented n mdl) + lkp n | isTyVarName n = (True, Undocumented n) + | otherwise = case Map.lookup n env of + Nothing -> (False, Undocumented n) + Just mdl -> (True, Documented n mdl) -------------------------------------------------------------------------------- @@ -175,8 +173,8 @@ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString renameLDocHsSyn = return -renameDoc :: Traversable t => t Name -> RnM (t DocName) -renameDoc = traverse rename +renameDoc :: Traversable t => t (Wrap Name) -> RnM (t (Wrap DocName)) +renameDoc = traverse (traverse rename) renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName) renameFnArgsDoc = mapM renameDoc @@ -185,6 +183,13 @@ renameFnArgsDoc = mapM renameDoc renameLType :: LHsType GhcRn -> RnM (LHsType DocNameI) renameLType = mapM renameType +renameLTypeArg :: LHsTypeArg GhcRn -> RnM (LHsTypeArg DocNameI) +renameLTypeArg (HsValArg ty) = do { ty' <- renameLType ty + ; return $ HsValArg ty' } +renameLTypeArg (HsTypeArg ki) = do { ki' <- renameLKind ki + ; return $ HsTypeArg ki' } +renameLTypeArg (HsArgPar sp) = return $ HsArgPar sp + renameLSigType :: LHsSigType GhcRn -> RnM (LHsSigType DocNameI) renameLSigType = renameImplicit renameLType @@ -240,6 +245,11 @@ renameType t = case t of b' <- renameLType b return (HsAppTy NoExt a' b') + HsAppKindTy _ a b -> do + a' <- renameLType a + b' <- renameLKind b + return (HsAppKindTy NoExt a' b') + HsFunTy _ a b -> do a' <- renameLType a b' <- renameLType b @@ -276,7 +286,7 @@ renameType t = case t of HsExplicitListTy i a b -> HsExplicitListTy i a <$> mapM renameLType b HsExplicitTupleTy a b -> HsExplicitTupleTy a <$> mapM renameLType b HsSpliceTy _ s -> renameHsSpliceTy s - HsWildCardTy a -> HsWildCardTy <$> renameWildCardInfo a + HsWildCardTy a -> pure (HsWildCardTy a) -- | Rename splices, but _only_ those that turn out to be for types. -- I think this is actually safe for our possible inputs: @@ -311,9 +321,6 @@ renameLContext (L loc context) = do context' <- mapM renameLType context return (L loc context') -renameWildCardInfo :: HsWildCardInfo -> RnM HsWildCardInfo -renameWildCardInfo (AnonWildCard (L l name)) = return (AnonWildCard (L l name)) - renameInstHead :: InstHead GhcRn -> RnM (InstHead DocNameI) renameInstHead InstHead {..} = do cname <- rename ihdClsName @@ -600,13 +607,16 @@ renameTyFamInstEqn eqn rename_ty_fam_eqn :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn) -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (LHsType DocNameI)) - rename_ty_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats - , feqn_fixity = fixity, feqn_rhs = rhs }) + rename_ty_fam_eqn (FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs + , feqn_pats = pats, feqn_fixity = fixity + , feqn_rhs = rhs }) = do { tc' <- renameL tc - ; pats' <- mapM renameLType pats + ; bndrs' <- traverse (mapM renameLTyVarBndr) bndrs + ; pats' <- mapM renameLTypeArg pats ; rhs' <- renameLType rhs ; return (FamEqn { feqn_ext = noExt , feqn_tycon = tc' + , feqn_bndrs = bndrs' , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = rhs' }) } @@ -620,6 +630,7 @@ renameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs ; rhs' <- renameLType rhs ; return (L loc (FamEqn { feqn_ext = noExt , feqn_tycon = tc' + , feqn_bndrs = Nothing -- this is always Nothing , feqn_pats = tvs' , feqn_fixity = fixity , feqn_rhs = rhs' })) } @@ -633,13 +644,16 @@ renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn }) rename_data_fam_eqn :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn) -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (HsDataDefn DocNameI)) - rename_data_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats - , feqn_fixity = fixity, feqn_rhs = defn }) + rename_data_fam_eqn (FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs + , feqn_pats = pats, feqn_fixity = fixity + , feqn_rhs = defn }) = do { tc' <- renameL tc - ; pats' <- mapM renameLType pats + ; bndrs' <- traverse (mapM renameLTyVarBndr) bndrs + ; pats' <- mapM renameLTypeArg pats ; defn' <- renameDataDefn defn ; return (FamEqn { feqn_ext = noExt , feqn_tycon = tc' + , feqn_bndrs = bndrs' , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = defn' }) } diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 30931c26..6fd528af 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -15,6 +15,8 @@ import Haddock.Types import GHC import Name import FastString +import TysPrim ( funTyConName ) +import TysWiredIn ( listTyConName ) import Control.Monad import Control.Monad.Trans.State @@ -47,14 +49,13 @@ specialize specs = go spec_map0 -- one by one, we should avoid infinite loops. spec_map0 = foldr (\(n,t) acc -> Map.insert n (go acc t) acc) mempty specs +{-# SPECIALIZE specialize :: [(Name, HsType GhcRn)] -> HsType GhcRn -> HsType GhcRn #-} -- | Instantiate given binders with corresponding types. -- -- Again, it is just a convenience function around 'specialize'. Note that -- length of type list should be the same as the number of binders. -specializeTyVarBndrs :: Data a - => LHsQTyVars GhcRn -> [HsType GhcRn] - -> a -> a +specializeTyVarBndrs :: LHsQTyVars GhcRn -> [HsType GhcRn] -> HsType GhcRn -> HsType GhcRn specializeTyVarBndrs bndrs typs = specialize $ zip bndrs' typs where @@ -64,11 +65,12 @@ specializeTyVarBndrs bndrs typs = bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs" + specializePseudoFamilyDecl :: LHsQTyVars GhcRn -> [HsType GhcRn] -> PseudoFamilyDecl GhcRn -> PseudoFamilyDecl GhcRn specializePseudoFamilyDecl bndrs typs decl = - decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)} + decl {pfdTyVars = map (fmap (specializeTyVarBndrs bndrs typs)) (pfdTyVars decl)} specializeSig :: LHsQTyVars GhcRn -> [HsType GhcRn] -> Sig GhcRn @@ -110,10 +112,7 @@ sugar = sugarOperators . sugarTuples . sugarLists sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p) sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp) - | isBuiltInSyntax name' && strName == "[]" = HsListTy NoExt ltyp - where - name' = getName name - strName = occNameString . nameOccName $ name' + | getName name == listTyConName = HsListTy NoExt ltyp sugarLists typ = typ @@ -127,7 +126,7 @@ sugarTuples typ = | isBuiltInSyntax name' && suitable = HsTupleTy NoExt HsBoxedTuple apps where name' = getName name - strName = occNameString . nameOccName $ name' + strName = getOccString name suitable = case parseTupleArity strName of Just arity -> arity == length apps Nothing -> False @@ -137,7 +136,7 @@ sugarTuples typ = sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p) sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb) | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb - | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy NoExt la lb + | funTyConName == name' = HsFunTy NoExt la lb where name' = getName name sugarOperators typ = typ @@ -182,7 +181,7 @@ parseTupleArity _ = Nothing type NameRep = FastString getNameRep :: NamedThing name => name -> NameRep -getNameRep = occNameFS . getOccName +getNameRep = getOccFS nameRepString :: NameRep -> String nameRepString = unpackFS @@ -256,6 +255,7 @@ renameType (HsQualTy x lctxt lt) = renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name renameType t@(HsStarTy _ _) = pure t renameType (HsAppTy x lf la) = HsAppTy x <$> renameLType lf <*> renameLType la +renameType (HsAppKindTy x lt lk) = HsAppKindTy x <$> renameLType lt <*> renameLKind lk renameType (HsFunTy x la lr) = HsFunTy x <$> renameLType la <*> renameLType lr renameType (HsListTy x lt) = HsListTy x <$> renameLType lt renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt @@ -281,6 +281,8 @@ renameType (HsWildCardTy wc) = pure (HsWildCardTy wc) renameLType :: LHsType GhcRn -> Rename (IdP GhcRn) (LHsType GhcRn) renameLType = located renameType +renameLKind :: LHsKind GhcRn -> Rename (IdP GhcRn) (LHsKind GhcRn) +renameLKind = renameLType renameLTypes :: [LHsType GhcRn] -> Rename (IdP GhcRn) [LHsType GhcRn] renameLTypes = mapM renameLType diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index ce6ecc78..7645b1bb 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -82,8 +82,8 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if (__GLASGOW_HASKELL__ >= 805) && (__GLASGOW_HASKELL__ < 807) -binaryInterfaceVersion = 33 +#if (__GLASGOW_HASKELL__ >= 807) && (__GLASGOW_HASKELL__ < 809) +binaryInterfaceVersion = 35 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] @@ -190,8 +190,9 @@ readInterfaceFile :: forall m. MonadIO m => NameCacheAccessor m -> FilePath + -> Bool -- ^ Disable version check. Can cause runtime crash. -> m (Either String InterfaceFile) -readInterfaceFile (get_name_cache, set_name_cache) filename = do +readInterfaceFile (get_name_cache, set_name_cache) filename bypass_checks = do bh0 <- liftIO $ readBinMem filename magic <- liftIO $ get bh0 @@ -200,7 +201,8 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do case () of _ | magic /= binaryInterfaceMagic -> return . Left $ "Magic number mismatch: couldn't load interface file: " ++ filename - | version `notElem` binaryInterfaceVersionCompatibility -> return . Left $ + | not bypass_checks + , (version `notElem` binaryInterfaceVersionCompatibility) -> return . Left $ "Interface file is of wrong version: " ++ filename | otherwise -> with_name_cache $ \update_nc -> do @@ -432,7 +434,7 @@ instance Binary Example where result <- get bh return (Example expression result) -instance Binary Hyperlink where +instance Binary a => Binary (Hyperlink a) where put_ bh (Hyperlink url label) = do put_ bh url put_ bh label @@ -699,3 +701,28 @@ instance Binary DocName where name <- get bh return (Undocumented name) _ -> error "get DocName: Bad h" + +instance Binary n => Binary (Wrap n) where + put_ bh (Unadorned n) = do + putByte bh 0 + put_ bh n + put_ bh (Parenthesized n) = do + putByte bh 1 + put_ bh n + put_ bh (Backticked n) = do + putByte bh 2 + put_ bh n + + get bh = do + h <- getByte bh + case h of + 0 -> do + name <- get bh + return (Unadorned name) + 1 -> do + name <- get bh + return (Parenthesized name) + 2 -> do + name <- get bh + return (Backticked name) + _ -> error "get Wrap: Bad h" diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index bdc98406..e314bbd0 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -84,6 +84,7 @@ data Flag | Flag_Version | Flag_CompatibleInterfaceVersions | Flag_InterfaceVersion + | Flag_BypassInterfaceVersonCheck | Flag_UseContents String | Flag_GenContents | Flag_UseIndex String @@ -175,6 +176,8 @@ options backwardsCompat = "output compatible interface file versions and exit", Option [] ["interface-version"] (NoArg Flag_InterfaceVersion) "output interface file version and exit", + Option [] ["bypass-interface-version-check"] (NoArg Flag_BypassInterfaceVersonCheck) + "bypass the interface file version check (dangerous)", Option ['v'] ["verbosity"] (ReqArg Flag_Verbosity "VERBOSITY") "set verbosity level", Option [] ["use-contents"] (ReqArg Flag_UseContents "URL") @@ -186,7 +189,7 @@ options backwardsCompat = Option [] ["gen-index"] (NoArg Flag_GenIndex) "generate an HTML index from specified\ninterfaces", Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports) - "behave as if all modules have the\nignore-exports atribute", + "behave as if all modules have the\nignore-exports attribute", Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") "behave as if MODULE has the hide attribute", Option [] ["show"] (ReqArg Flag_ShowModule "MODULE") diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs index 58500f1b..6d5dc103 100644 --- a/haddock-api/src/Haddock/Parser.hs +++ b/haddock-api/src/Haddock/Parser.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving - , FlexibleInstances, UndecidableInstances - , IncoherentInstances #-} -{-# LANGUAGE LambdaCase #-} -- | -- Module : Haddock.Parser -- Copyright : (c) Mateusz Kowalczyk 2013, @@ -19,26 +14,33 @@ module Haddock.Parser ( parseParas ) where import qualified Documentation.Haddock.Parser as P -import DynFlags (DynFlags) -import FastString (mkFastString) import Documentation.Haddock.Types -import Lexer (mkPState, unP, ParseResult(POk)) -import Parser (parseIdentifier) -import RdrName (RdrName) -import SrcLoc (mkRealSrcLoc, unLoc) -import StringBuffer (stringToStringBuffer) +import Haddock.Types -parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName +import DynFlags ( DynFlags ) +import FastString ( fsLit ) +import Lexer ( mkPState, unP, ParseResult(POk) ) +import Parser ( parseIdentifier ) +import SrcLoc ( mkRealSrcLoc, GenLocated(..) ) +import StringBuffer ( stringToStringBuffer ) + + +parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod (Wrap NsRdrName) parseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p -parseString :: DynFlags -> String -> DocH mod RdrName +parseString :: DynFlags -> String -> DocH mod (Wrap NsRdrName) parseString d = P.overIdentifier (parseIdent d) . P.parseString -parseIdent :: DynFlags -> String -> Maybe RdrName -parseIdent dflags str0 = - let buffer = stringToStringBuffer str0 - realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0 +parseIdent :: DynFlags -> Namespace -> String -> Maybe (Wrap NsRdrName) +parseIdent dflags ns str0 = + let buffer = stringToStringBuffer str1 + realSrcLc = mkRealSrcLoc (fsLit "<unknown file>") 0 0 pstate = mkPState dflags buffer realSrcLc + (wrap,str1) = case str0 of + '(' : s@(c : _) | c /= ',', c /= ')' -- rule out tuple names + -> (Parenthesized, init s) + '`' : s@(_ : _) -> (Backticked, init s) + _ -> (Unadorned, str0) in case unP parseIdentifier pstate of - POk _ name -> Just (unLoc name) + POk _ (L _ name) -> Just (wrap (NsRdrName ns name)) _ -> Nothing diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 6da45a3b..cd4ac1a1 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types] +{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -28,23 +30,19 @@ module Haddock.Types ( import Control.Exception import Control.Arrow hiding ((<+>)) import Control.DeepSeq +import Control.Monad (ap) import Control.Monad.IO.Class (MonadIO(..)) -import Data.Typeable +import Data.Typeable (Typeable) import Data.Map (Map) import Data.Data (Data) -import qualified Data.Map as Map import Documentation.Haddock.Types -import BasicTypes (Fixity(..)) +import BasicTypes (Fixity(..), PromotionFlag(..)) -import GHC hiding (NoLink) +import GHC import DynFlags (Language) import qualified GHC.LanguageExtensions as LangExt import OccName -import Outputable -import Control.Applicative (Applicative(..)) -import Control.Monad (ap) - -import Haddock.Backends.Hyperlinker.Types +import Outputable hiding ((<>)) ----------------------------------------------------------------------------- -- * Convenient synonyms @@ -143,7 +141,8 @@ data Interface = Interface -- | Tokenized source code of module (avaliable if Haddock is invoked with -- source generation flag). - , ifaceTokenizedSrc :: !(Maybe [RichToken]) + , ifaceHieFile :: !(Maybe FilePath) + , ifaceDynFlags :: !DynFlags } type WarningMap = Map Name (Doc Name) @@ -274,7 +273,7 @@ type DocForDecl name = (Documentation name, FnArgsDoc name) noDocForDecl :: DocForDecl name -noDocForDecl = (Documentation Nothing Nothing, Map.empty) +noDocForDecl = (Documentation Nothing Nothing, mempty) ----------------------------------------------------------------------------- @@ -285,6 +284,12 @@ noDocForDecl = (Documentation Nothing Nothing, Map.empty) -- | Type of environment used to cross-reference identifiers in the syntax. type LinkEnv = Map Name Module +-- | An 'RdrName' tagged with some type/value namespace information. +data NsRdrName = NsRdrName + { namespace :: !Namespace + , rdrName :: !RdrName + } + -- | Extends 'Name' with cross-reference information. data DocName = Documented Name Module @@ -329,6 +334,26 @@ instance SetName DocName where setName name' (Documented _ mdl) = Documented name' mdl setName name' (Undocumented _) = Undocumented name' +-- | Adds extra "wrapper" information to a name. +-- +-- This is to work around the fact that most name types in GHC ('Name', 'RdrName', +-- 'OccName', ...) don't include backticks or parens. +data Wrap n + = Unadorned { unwrap :: n } -- ^ don't do anything to the name + | Parenthesized { unwrap :: n } -- ^ add parentheses around the name + | Backticked { unwrap :: n } -- ^ add backticks around the name + deriving (Show, Functor, Foldable, Traversable) + +-- | Useful for debugging +instance Outputable n => Outputable (Wrap n) where + ppr (Unadorned n) = ppr n + ppr (Parenthesized n) = hcat [ char '(', ppr n, char ')' ] + ppr (Backticked n) = hcat [ char '`', ppr n, char '`' ] + +showWrapped :: (a -> String) -> Wrap a -> String +showWrapped f (Unadorned n) = f n +showWrapped f (Parenthesized n) = "(" ++ f n ++ ")" +showWrapped f (Backticked n) = "`" ++ f n ++ "`" ----------------------------------------------------------------------------- @@ -424,10 +449,10 @@ instance NamedThing name => NamedThing (InstOrigin name) where type LDoc id = Located (Doc id) -type Doc id = DocH (ModuleName, OccName) id -type MDoc id = MetaDoc (ModuleName, OccName) id +type Doc id = DocH (Wrap (ModuleName, OccName)) (Wrap id) +type MDoc id = MetaDoc (Wrap (ModuleName, OccName)) (Wrap id) -type DocMarkup id a = DocMarkupH (ModuleName, OccName) id a +type DocMarkup id a = DocMarkupH (Wrap (ModuleName, OccName)) id a instance (NFData a, NFData mod) => NFData (DocH mod a) where @@ -467,7 +492,7 @@ instance NFData ModuleName where rnf x = seq x () instance NFData id => NFData (Header id) where rnf (Header a b) = a `deepseq` b `deepseq` () -instance NFData Hyperlink where +instance NFData id => NFData (Hyperlink id) where rnf (Hyperlink a b) = a `deepseq` b `deepseq` () instance NFData Picture where @@ -674,6 +699,7 @@ type instance XQualTy DocNameI = NoExt type instance XTyVar DocNameI = NoExt type instance XStarTy DocNameI = NoExt type instance XAppTy DocNameI = NoExt +type instance XAppKindTy DocNameI = NoExt type instance XFunTy DocNameI = NoExt type instance XListTy DocNameI = NoExt type instance XTupleTy DocNameI = NoExt @@ -689,7 +715,7 @@ type instance XRecTy DocNameI = NoExt type instance XExplicitListTy DocNameI = NoExt type instance XExplicitTupleTy DocNameI = NoExt type instance XTyLit DocNameI = NoExt -type instance XWildCardTy DocNameI = HsWildCardInfo +type instance XWildCardTy DocNameI = NoExt type instance XXType DocNameI = NewHsTypeX type instance XUserTyVar DocNameI = NoExt @@ -742,3 +768,19 @@ type instance XHsWC DocNameI _ = NoExt type instance XHsQTvs DocNameI = NoExt type instance XConDeclField DocNameI = NoExt +type instance XXPat DocNameI = Located (Pat DocNameI) + +type instance SrcSpanLess (LPat DocNameI) = Pat DocNameI +instance HasSrcSpan (LPat DocNameI) where + -- NB: The following chooses the behaviour of the outer location + -- wrapper replacing the inner ones. + composeSrcSpan (L sp p) = if sp == noSrcSpan + then p + else XPat (L sp (stripSrcSpanPat p)) + -- NB: The following only returns the top-level location, if any. + decomposeSrcSpan (XPat (L sp p)) = L sp (stripSrcSpanPat p) + decomposeSrcSpan p = L noSrcSpan p + +stripSrcSpanPat :: LPat DocNameI -> Pat DocNameI +stripSrcSpanPat (XPat (L _ p)) = stripSrcSpanPat p +stripSrcSpanPat p = p diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index c2cdddf7..dda42cea 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -33,6 +33,7 @@ module Haddock.Utils ( -- * Miscellaneous utilities getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr, + writeUtf8File, withTempDir, -- * HTML cross reference mapping html_xrefs_ref, html_xrefs_ref', @@ -60,9 +61,10 @@ import Documentation.Haddock.Doc (emptyMetaDoc) import Haddock.Types import Haddock.GhcUtils +import BasicTypes ( PromotionFlag(..) ) +import Exception (ExceptionMonad) import GHC import Name -import HsTypes (extFieldOcc) import Outputable ( panic ) import Control.Monad ( liftM ) @@ -75,7 +77,8 @@ import Data.List ( isSuffixOf ) import Data.Maybe ( mapMaybe ) import System.Environment ( getProgName ) import System.Exit -import System.IO ( hPutStr, stderr ) +import System.Directory ( createDirectory, removeDirectoryRecursive ) +import System.IO ( hPutStr, hSetEncoding, IOMode(..), stderr, utf8, withFile ) import System.IO.Unsafe ( unsafePerformIO ) import qualified System.FilePath.Posix as HtmlPath import Distribution.Verbosity @@ -395,6 +398,19 @@ isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') isDigitChar c = c >= '0' && c <= '9' isAlphaNumChar c = isAlphaChar c || isDigitChar c +-- | Utility to write output to UTF-8 encoded files. +-- +-- The problem with 'writeFile' is that it picks up its 'TextEncoding' from +-- 'getLocaleEncoding', and on some platforms (like Windows) this default +-- encoding isn't enough for the characters we want to write. +writeUtf8File :: FilePath -> String -> IO () +writeUtf8File filepath contents = withFile filepath WriteMode $ \h -> do + hSetEncoding h utf8 + hPutStr h contents + +withTempDir :: (ExceptionMonad m) => FilePath -> m a -> m a +withTempDir dir = gbracket_ (liftIO $ createDirectory dir) + (liftIO $ removeDirectoryRecursive dir) ----------------------------------------------------------------------------- -- * HTML cross references diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index 4639253c..ff18cb40 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -1,22 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where - import Test.Hspec import Test.QuickCheck -import qualified GHC +import GHC ( runGhc, getSessionDynFlags ) +import DynFlags ( CompilerInfo, DynFlags ) +import SysTools.Info ( getCompilerInfo' ) import Control.Monad.IO.Class +import Data.String ( fromString ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS + import Haddock (getGhcDirs) import Haddock.Backends.Hyperlinker.Parser import Haddock.Backends.Hyperlinker.Types -withDynFlags :: (GHC.DynFlags -> IO ()) -> IO () +withDynFlags :: ((DynFlags, CompilerInfo) -> IO ()) -> IO () withDynFlags cont = do libDir <- fmap snd (getGhcDirs []) - GHC.runGhc (Just libDir) $ do - dflags <- GHC.getSessionDynFlags - liftIO $ cont dflags + runGhc (Just libDir) $ do + dflags <- getSessionDynFlags + cinfo <- liftIO $ getCompilerInfo' dflags + liftIO $ cont (dflags, cinfo) main :: IO () @@ -53,51 +60,60 @@ instance Arbitrary NoGhcRewrite where parseSpec :: Spec parseSpec = around withDynFlags $ do - it "is total" $ \dflags -> - property $ \src -> length (parse dflags "" src) `shouldSatisfy` (>= 0) + it "is total" $ \(dflags, cinfo) -> + property $ \src -> length (parse cinfo dflags "" (fromString src)) `shouldSatisfy` (>= 0) - it "retains file layout" $ \dflags -> - property $ \(NoGhcRewrite src) -> concatMap tkValue (parse dflags "" src) == src + it "retains file layout" $ \(dflags, cinfo) -> + property $ \(NoGhcRewrite src) -> + let orig = fromString src + lexed = BS.concat (map tkValue (parse cinfo dflags "" orig)) + in lexed == orig context "when parsing single-line comments" $ do - it "should ignore content until the end of line" $ \dflags -> + it "should ignore content until the end of line" $ \(dflags, cinfo) -> shouldParseTo "-- some very simple comment\nidentifier" [TkComment, TkSpace, TkIdentifier] + cinfo dflags - it "should allow endline escaping" $ \dflags -> + it "should allow endline escaping" $ \(dflags, cinfo) -> shouldParseTo "#define first line\\\nsecond line\\\nand another one" [TkCpp] + cinfo dflags context "when parsing multi-line comments" $ do - it "should support nested comments" $ \dflags -> + it "should support nested comments" $ \(dflags, cinfo) -> shouldParseTo "{- comment {- nested -} still comment -} {- next comment -}" [TkComment, TkSpace, TkComment] + cinfo dflags - it "should distinguish compiler pragma" $ \dflags -> + it "should distinguish compiler pragma" $ \(dflags, cinfo) -> shouldParseTo "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" [TkComment, TkPragma, TkComment] + cinfo dflags - it "should recognize preprocessor directives" $ \dflags -> do + it "should recognize preprocessor directives" $ \(dflags, cinfo) -> do shouldParseTo "\n#define foo bar" - [TkSpace, TkCpp] + [TkCpp] + cinfo dflags shouldParseTo "x # y" [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] + cinfo dflags - it "should distinguish basic language constructs" $ \dflags -> do + it "should distinguish basic language constructs" $ \(dflags, cinfo) -> do shouldParseTo "(* 2) <$> (\"abc\", foo)" @@ -105,6 +121,7 @@ parseSpec = around withDynFlags $ do , TkSpace, TkOperator, TkSpace , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial ] + cinfo dflags shouldParseTo @@ -114,6 +131,7 @@ parseSpec = around withDynFlags $ do , TkIdentifier, TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier ] + cinfo dflags shouldParseTo @@ -124,9 +142,10 @@ parseSpec = around withDynFlags $ do , TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier ] + cinfo dflags - it "should parse do-notation syntax" $ \dflags -> do + it "should parse do-notation syntax" $ \(dflags, cinfo) -> do shouldParseTo "do { foo <- getLine; putStrLn foo }" [ TkKeyword, TkSpace, TkSpecial, TkSpace @@ -134,10 +153,11 @@ parseSpec = around withDynFlags $ do , TkIdentifier, TkSpecial, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial ] + cinfo dflags shouldParseTo - (unlines + (fromString $ unlines [ "do" , " foo <- getLine" , " putStrLn foo" @@ -146,7 +166,10 @@ parseSpec = around withDynFlags $ do , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace ] + cinfo dflags where - shouldParseTo :: String -> [TokenType] -> GHC.DynFlags -> Expectation - shouldParseTo str tokens dflags = map tkType (parse dflags "" str) `shouldBe` tokens + shouldParseTo :: ByteString -> [TokenType] -> CompilerInfo -> DynFlags -> Expectation + shouldParseTo str tokens cinfo dflags = [ tkType tok + | tok <- parse cinfo dflags "" str + , not (BS.null (tkValue tok)) ] `shouldBe` tokens diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index 0175b6af..265579ca 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -1,3 +1,10 @@ +## Changes in version 1.8.0 + + * Support inline markup in markdown-style links (#875) + + * Remove now unused `Documentation.Haddock.Utf8` module. + This module was anyways copied from the `utf8-string` package. + ## Changes in version 1.7.0 * Make `Documentation.Haddock.Parser.Monad` an internal module diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs index a4e4321f..72ea8525 100644 --- a/haddock-library/fixtures/Fixtures.hs +++ b/haddock-library/fixtures/Fixtures.hs @@ -146,8 +146,8 @@ instance (ToExpr mod, ToExpr id) => ToExpr (DocH mod id) deriving instance Generic (Header id) instance ToExpr id => ToExpr (Header id) -deriving instance Generic Hyperlink -instance ToExpr Hyperlink +deriving instance Generic (Hyperlink id) +instance ToExpr id => ToExpr (Hyperlink id) deriving instance Generic Picture instance ToExpr Picture diff --git a/haddock-library/fixtures/examples/link.parsed b/haddock-library/fixtures/examples/link.parsed index 0e85338c..781dee87 100644 --- a/haddock-library/fixtures/examples/link.parsed +++ b/haddock-library/fixtures/examples/link.parsed @@ -1,5 +1,5 @@ DocParagraph (DocHyperlink Hyperlink - {hyperlinkLabel = Just "link", + {hyperlinkLabel = Just (DocString "link"), hyperlinkUrl = "http://example.com"}) diff --git a/haddock-library/fixtures/examples/linkInline.parsed b/haddock-library/fixtures/examples/linkInline.parsed index 43470d7b..fe771598 100644 --- a/haddock-library/fixtures/examples/linkInline.parsed +++ b/haddock-library/fixtures/examples/linkInline.parsed @@ -3,4 +3,5 @@ DocParagraph (DocString "Bla ") (DocHyperlink Hyperlink - {hyperlinkLabel = Just "link", hyperlinkUrl = "http://example.com"})) + {hyperlinkLabel = Just (DocString "link"), + hyperlinkUrl = "http://example.com"})) diff --git a/haddock-library/fixtures/examples/linkInlineMarkup.input b/haddock-library/fixtures/examples/linkInlineMarkup.input new file mode 100644 index 00000000..e2f4e405 --- /dev/null +++ b/haddock-library/fixtures/examples/linkInlineMarkup.input @@ -0,0 +1 @@ +Bla [link /emphasized/](http://example.com) diff --git a/haddock-library/fixtures/examples/linkInlineMarkup.parsed b/haddock-library/fixtures/examples/linkInlineMarkup.parsed new file mode 100644 index 00000000..39adab64 --- /dev/null +++ b/haddock-library/fixtures/examples/linkInlineMarkup.parsed @@ -0,0 +1,8 @@ +DocParagraph + (DocAppend + (DocString "Bla ") + (DocHyperlink + Hyperlink + {hyperlinkLabel = Just (DocAppend (DocString "link ") + (DocEmphasis (DocString "emphasized"))), + hyperlinkUrl = "http://example.com"})) diff --git a/haddock-library/fixtures/examples/urlLabel.parsed b/haddock-library/fixtures/examples/urlLabel.parsed index d7e3a76c..58d2a81a 100644 --- a/haddock-library/fixtures/examples/urlLabel.parsed +++ b/haddock-library/fixtures/examples/urlLabel.parsed @@ -1,5 +1,5 @@ DocParagraph (DocHyperlink Hyperlink - {hyperlinkLabel = Just "some link", + {hyperlinkLabel = Just (DocString "some link"), hyperlinkUrl = "http://example.com/"}) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 32ffc110..5c744082 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,33 +1,42 @@ -cabal-version: 2.0 +cabal-version: 2.2 name: haddock-library -version: 1.7.0 +version: 1.8.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 - without pulling in the GHC dependency. Please note that the - API is likely to change so specify upper bounds in your - project. For interacting with Haddock + libraries. These modules expose some + functionality of it without pulling in the GHC + dependency. Please note that the API is likely + to change so be sure to specify upper bounds in + your projects. For interacting with Haddock itself, see the [haddock package](https://hackage.haskell.org/package/haddock). -license: BSD3 + +license: BSD-2-Clause license-files: LICENSE maintainer: Alec Theriault <alec.theriault@gmail.com>, Alex Biehl <alexbiehl@gmail.com>, 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 category: Documentation -build-type: Simple extra-source-files: CHANGES.md -library - default-language: Haskell2010 +common lib-defaults + default-language: Haskell2010 build-depends: - base >= 4.5 && < 4.13 - , bytestring >= 0.9.2.1 && < 0.11 - , containers >= 0.4.2.1 && < 0.7 - , transformers >= 0.3.0 && < 0.6 - , text >= 1.2.3.0 && < 1.3 - , parsec >= 3.1.13.0 && < 3.2 + , base >= 4.5 && < 4.14 + , bytestring ^>= 0.9.2.1 || ^>= 0.10.0.0 + , containers ^>= 0.4.2.1 || ^>= 0.5.0.0 || ^>= 0.6.0.1 + , transformers ^>= 0.3.0.0 || ^>= 0.4.1.0 || ^>= 0.5.0.0 + , text ^>= 1.2.3.0 + , parsec ^>= 3.1.13.0 + + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + +library + import: lib-defaults hs-source-dirs: src @@ -36,73 +45,68 @@ library Documentation.Haddock.Markup Documentation.Haddock.Parser Documentation.Haddock.Types - Documentation.Haddock.Utf8 other-modules: Documentation.Haddock.Parser.Util Documentation.Haddock.Parser.Monad - - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances - + Documentation.Haddock.Parser.Identifier test-suite spec + import: lib-defaults type: exitcode-stdio-1.0 - default-language: Haskell2010 main-is: Spec.hs hs-source-dirs: test - , src - ghc-options: -Wall + src cpp-options: -DTEST other-modules: Documentation.Haddock.Doc + Documentation.Haddock.Markup Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad Documentation.Haddock.Parser.Util Documentation.Haddock.Parser.UtilSpec Documentation.Haddock.ParserSpec Documentation.Haddock.Types - Documentation.Haddock.Utf8 - Documentation.Haddock.Utf8Spec + Documentation.Haddock.Parser.Identifier build-depends: - base >= 4.5 && < 4.13 - , base-compat >= 0.9.3 && < 0.11 - , bytestring >= 0.9.2.1 && < 0.11 - , containers >= 0.4.2.1 && < 0.7 - , transformers >= 0.3.0 && < 0.6 - , hspec >= 2.4.4 && < 2.7 - , QuickCheck >= 2.11 && < 2.13 - , text >= 1.2.3.0 && < 1.3 - , parsec >= 3.1.13.0 && < 3.2 - , deepseq >= 1.3 && < 1.5 + , base-compat ^>= 0.9.3 || ^>= 0.10.0 + , QuickCheck ^>= 2.11 || ^>= 2.12 + , deepseq ^>= 1.3.0.0 || ^>= 1.4.0.0 + + -- NB: build-depends & build-tool-depends have independent + -- install-plans, so it's best to limit to a single major + -- version of `hspec` & `hspec-discover` to ensure + -- intercompatibility + build-depends: + , hspec >= 2.4.4 && < 2.7 build-tool-depends: - hspec-discover:hspec-discover >= 2.4.4 && < 2.6 + , hspec-discover:hspec-discover >= 2.4.4 && < 2.7 test-suite fixtures type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Fixtures.hs - ghc-options: -Wall -O0 + ghc-options: -Wall hs-source-dirs: fixtures build-depends: - base >= 4.5 && < 4.13 + -- intra-package dependency + , haddock-library + -- constraints inherited via lib:haddock-library component + , base + + -- extra dependencies , base-compat >= 0.9.3 && < 0.11 , directory ^>= 1.3.0.2 , filepath ^>= 1.4.1.2 , optparse-applicative ^>= 0.14.0.0 , tree-diff ^>= 0.0.0.1 - -- Depend on the library. - build-depends: - haddock-library - source-repository head type: git subdir: haddock-library diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index da8edcd4..365041ee 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -2,35 +2,38 @@ module Documentation.Haddock.Markup ( markup , idMarkup + , plainMarkup ) where import Documentation.Haddock.Types +import Data.Maybe ( fromMaybe ) + markup :: DocMarkupH mod id a -> DocH mod id -> a -markup m DocEmpty = markupEmpty m -markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) -markup m (DocString s) = markupString m s -markup m (DocParagraph d) = markupParagraph m (markup m d) -markup m (DocIdentifier x) = markupIdentifier m x -markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x -markup m (DocModule mod0) = markupModule m mod0 -markup m (DocWarning d) = markupWarning m (markup m d) -markup m (DocEmphasis d) = markupEmphasis m (markup m d) -markup m (DocBold d) = markupBold m (markup m d) -markup m (DocMonospaced d) = markupMonospaced m (markup m d) -markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) -markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) -markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) -markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) -markup m (DocHyperlink l) = markupHyperlink m l -markup m (DocAName ref) = markupAName m ref -markup m (DocPic img) = markupPic m img -markup m (DocMathInline mathjax) = markupMathInline m mathjax -markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax -markup m (DocProperty p) = markupProperty m p -markup m (DocExamples e) = markupExample m e -markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t)) -markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) +markup m DocEmpty = markupEmpty m +markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) +markup m (DocString s) = markupString m s +markup m (DocParagraph d) = markupParagraph m (markup m d) +markup m (DocIdentifier x) = markupIdentifier m x +markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x +markup m (DocModule mod0) = markupModule m mod0 +markup m (DocWarning d) = markupWarning m (markup m d) +markup m (DocEmphasis d) = markupEmphasis m (markup m d) +markup m (DocBold d) = markupBold m (markup m d) +markup m (DocMonospaced d) = markupMonospaced m (markup m d) +markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) +markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) +markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) +markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) +markup m (DocHyperlink (Hyperlink u l)) = markupHyperlink m (Hyperlink u (fmap (markup m) l)) +markup m (DocAName ref) = markupAName m ref +markup m (DocPic img) = markupPic m img +markup m (DocMathInline mathjax) = markupMathInline m mathjax +markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax +markup m (DocProperty p) = markupProperty m p +markup m (DocExamples e) = markupExample m e +markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t)) +markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a) markupPair m (a,b) = (markup m a, markup m b) @@ -63,3 +66,34 @@ idMarkup = Markup { markupHeader = DocHeader, markupTable = DocTable } + +-- | Map a 'DocH' into a best estimate of an alternate string. The idea is to +-- strip away any formatting while preserving as much of the actual text as +-- possible. +plainMarkup :: (mod -> String) -> (id -> String) -> DocMarkupH mod id String +plainMarkup plainMod plainIdent = Markup { + markupEmpty = "", + markupString = id, + markupParagraph = id, + markupAppend = (++), + markupIdentifier = plainIdent, + markupIdentifierUnchecked = plainMod, + markupModule = id, + markupWarning = id, + markupEmphasis = id, + markupBold = id, + markupMonospaced = id, + markupUnorderedList = const "", + markupOrderedList = const "", + markupDefList = const "", + markupCodeBlock = id, + markupHyperlink = \(Hyperlink url lbl) -> fromMaybe url lbl, + markupAName = id, + markupPic = \(Picture uri title) -> fromMaybe uri title, + markupMathInline = id, + markupMathDisplay = id, + markupProperty = id, + markupExample = const "", + markupHeader = \(Header _ title) -> title, + markupTable = const "" + } diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index d79da40b..36c8bb5b 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -27,14 +27,16 @@ module Documentation.Haddock.Parser ( import Control.Applicative import Control.Arrow (first) import Control.Monad -import Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace) -import Data.List (intercalate, unfoldr, elemIndex, notElem) +import Data.Char (chr, isUpper, isAlpha, isSpace) +import Data.List (intercalate, unfoldr, elemIndex) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set import Documentation.Haddock.Doc +import Documentation.Haddock.Markup ( markup, plainMarkup ) import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util +import Documentation.Haddock.Parser.Identifier import Documentation.Haddock.Types import Prelude hiding (takeWhile) import qualified Prelude as P @@ -45,53 +47,26 @@ import Text.Parsec (try) import qualified Data.Text as T import Data.Text (Text) -#if MIN_VERSION_base(4,9,0) -import Text.Read.Lex (isSymbolChar) -#else -import Data.Char (GeneralCategory (..), - generalCategory) -#endif -- $setup -- >>> :set -XOverloadedStrings -#if !MIN_VERSION_base(4,9,0) --- inlined from base-4.10.0.0 -isSymbolChar :: Char -> Bool -isSymbolChar c = not (isPuncChar c) && case generalCategory c of - MathSymbol -> True - CurrencySymbol -> True - ModifierSymbol -> True - OtherSymbol -> True - DashPunctuation -> True - OtherPunctuation -> c `notElem` ("'\"" :: String) - ConnectorPunctuation -> c /= '_' - _ -> False - where - -- | The @special@ character class as defined in the Haskell Report. - isPuncChar :: Char -> Bool - isPuncChar = (`elem` (",;()[]{}`" :: String)) -#endif - --- | Identifier string surrounded with opening and closing quotes/backticks. -type Identifier = (Char, String, Char) - -- | Drops the quotes/backticks around all identifiers, as if they -- were valid but still 'String's. toRegular :: DocH mod Identifier -> DocH mod String -toRegular = fmap (\(_, x, _) -> x) +toRegular = fmap (\(Identifier _ _ x _) -> x) -- | Maps over 'DocIdentifier's over 'String' with potentially failing -- conversion using user-supplied function. If the conversion fails, -- the identifier is deemed to not be valid and is treated as a -- regular string. -overIdentifier :: (String -> Maybe a) +overIdentifier :: (Namespace -> String -> Maybe a) -> DocH mod Identifier -> DocH mod a overIdentifier f d = g d where - g (DocIdentifier (o, x, e)) = case f x of - Nothing -> DocString $ o : x ++ [e] + g (DocIdentifier (Identifier ns o x e)) = case f ns x of + Nothing -> DocString $ renderNs ns ++ [o] ++ x ++ [e] Just x' -> DocIdentifier x' g DocEmpty = DocEmpty g (DocAppend x x') = DocAppend (g x) (g x') @@ -107,7 +82,7 @@ overIdentifier f d = g d g (DocOrderedList x) = DocOrderedList $ fmap g x g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x g (DocCodeBlock x) = DocCodeBlock $ g x - g (DocHyperlink x) = DocHyperlink x + g (DocHyperlink (Hyperlink u x)) = DocHyperlink (Hyperlink u (fmap g x)) g (DocPic x) = DocPic x g (DocMathInline x) = DocMathInline x g (DocMathDisplay x) = DocMathDisplay x @@ -301,13 +276,20 @@ mathInline = DocMathInline . T.unpack -- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]" -- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathDisplay :: Parser (DocH mod a) -mathDisplay = DocMathDisplay . T.unpack +mathDisplay = DocMathDisplay . T.unpack <$> ("\\[" *> takeUntil "\\]") -markdownImage :: Parser (DocH mod a) -markdownImage = fromHyperlink <$> ("!" *> linkParser) +-- | Markdown image parser. As per the commonmark reference recommendation, the +-- description text for an image converted to its a plain string representation. +-- +-- >>> parseString "" +-- DocPic (Picture "www.site.com" (Just "some emphasis in a description")) +markdownImage :: Parser (DocH mod Identifier) +markdownImage = DocPic . fromHyperlink <$> ("!" *> linkParser) where - fromHyperlink (Hyperlink url label) = DocPic (Picture url label) + fromHyperlink (Hyperlink u l) = Picture u (fmap (markup stringMarkup) l) + stringMarkup = plainMarkup (const "") renderIdent + renderIdent (Identifier ns l c r) = renderNs ns <> [l] <> c <> [r] -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) @@ -360,32 +342,34 @@ table = do parseFirstRow :: Parser Text parseFirstRow = do skipHorizontalSpace - -- upper-left corner is + - c <- Parsec.char '+' - cs <- some (Parsec.char '-' <|> Parsec.char '+') + cs <- takeWhile (\c -> c == '-' || c == '+') - -- upper right corner is + too - guard (last cs == '+') + -- upper-left and upper-right corners are `+` + guard (T.length cs >= 2 && + T.head cs == '+' && + T.last cs == '+') -- trailing space skipHorizontalSpace _ <- Parsec.newline - return (T.cons c $ T.pack cs) + return cs parseRestRows :: Int -> Parser Text parseRestRows l = do skipHorizontalSpace + bs <- scan predicate l - c <- Parsec.char '|' <|> Parsec.char '+' - bs <- scan predicate (l - 2) - c2 <- Parsec.char '|' <|> Parsec.char '+' + -- Left and right edges are `|` or `+` + guard (T.length bs >= 2 && + (T.head bs == '|' || T.head bs == '+') && + (T.last bs == '|' || T.last bs == '+')) -- trailing space skipHorizontalSpace _ <- Parsec.newline - return (T.cons c (T.snoc bs c2)) + return bs where predicate n c | n <= 0 = Nothing @@ -662,7 +646,7 @@ nonSpace xs -- Doesn't discard the trailing newline. takeNonEmptyLine :: Parser Text takeNonEmptyLine = do - l <- takeWhile1 (Parsec.noneOf "\n") >>= nonSpace + l <- takeWhile1 (/= '\n') >>= nonSpace _ <- "\n" pure (l <> "\n") @@ -732,7 +716,7 @@ nonEmptyLine :: Parser Text nonEmptyLine = try (mfilter (T.any (not . isSpace)) takeLine) takeLine :: Parser Text -takeLine = try (takeWhile (Parsec.noneOf "\n") <* endOfLine) +takeLine = try (takeWhile (/= '\n') <* endOfLine) endOfLine :: Parser () endOfLine = void "\n" <|> Parsec.eof @@ -742,7 +726,7 @@ endOfLine = void "\n" <|> Parsec.eof -- >>> snd <$> parseOnly property "prop> hello world" -- Right (DocProperty "hello world") property :: Parser (DocH mod a) -property = DocProperty . T.unpack . T.strip <$> ("prop>" *> takeWhile1 (Parsec.noneOf "\n")) +property = DocProperty . T.unpack . T.strip <$> ("prop>" *> takeWhile1 (/= '\n')) -- | -- Paragraph level codeblock. Anything between the two delimiting \@ is parsed @@ -782,22 +766,22 @@ codeblock = | isNewline && isSpace c = Just isNewline | otherwise = Just $ c == '\n' -hyperlink :: Parser (DocH mod a) +hyperlink :: Parser (DocH mod Identifier) hyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ] angleBracketLink :: Parser (DocH mod a) angleBracketLink = - DocHyperlink . makeLabeled Hyperlink + DocHyperlink . makeLabeled (\s -> Hyperlink s . fmap DocString) <$> disallowNewline ("<" *> takeUntil ">") -markdownLink :: Parser (DocH mod a) +markdownLink :: Parser (DocH mod Identifier) markdownLink = DocHyperlink <$> linkParser -linkParser :: Parser Hyperlink +linkParser :: Parser (Hyperlink (DocH mod Identifier)) linkParser = flip Hyperlink <$> label <*> (whitespace *> url) where - label :: Parser (Maybe String) - label = Just . decode . T.strip <$> ("[" *> takeUntil "]") + label :: Parser (Maybe (DocH mod Identifier)) + label = Just . parseParagraph . T.strip <$> ("[" *> takeUntil "]") whitespace :: Parser () whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace) @@ -816,41 +800,17 @@ linkParser = flip Hyperlink <$> label <*> (whitespace *> url) autoUrl :: Parser (DocH mod a) autoUrl = mkLink <$> url where - url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (Parsec.satisfy (not . isSpace)) + url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (not . isSpace) mkLink :: Text -> DocH mod a mkLink s = case T.unsnoc s of Just (xs,x) | x `elem` (",.!?" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x] _ -> DocHyperlink (mkHyperlink s) - mkHyperlink :: Text -> Hyperlink + mkHyperlink :: Text -> Hyperlink (DocH mod a) mkHyperlink lnk = Hyperlink (T.unpack lnk) 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 = p some - where - idChar = Parsec.satisfy (\c -> isAlphaNum c || isSymbolChar c || c == '_') - - p p' = do - vs <- p' idChar - c <- peekChar' - case c of - '`' -> return vs - '\'' -> choice' [ (\x -> vs ++ "'" ++ x) <$> ("'" *> p many), return vs ] - _ -> fail "outofvalid" - --- | Parses identifiers with help of 'parseValid'. Asks GHC for --- 'String' from the string it deems valid. +-- | Parses identifiers with help of 'parseValid'. identifier :: Parser (DocH mod Identifier) -identifier = do - o <- idDelim - vid <- parseValid - e <- idDelim - return $ DocIdentifier (o, vid, e) - where - idDelim = Parsec.satisfy (\c -> c == '\'' || c == '`') +identifier = DocIdentifier <$> parseValid diff --git a/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs b/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs new file mode 100644 index 00000000..7bc98b62 --- /dev/null +++ b/haddock-library/src/Documentation/Haddock/Parser/Identifier.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Documentation.Haddock.Parser.Identifier +-- Copyright : (c) Alec Theriault 2019, +-- License : BSD-like +-- +-- Maintainer : haddock@projects.haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Functionality for parsing identifiers and operators + +module Documentation.Haddock.Parser.Identifier ( + Identifier(..), + parseValid, +) where + +import Documentation.Haddock.Types ( Namespace(..) ) +import Documentation.Haddock.Parser.Monad +import qualified Text.Parsec as Parsec +import Text.Parsec.Pos ( updatePosChar ) +import Text.Parsec ( State(..) + , getParserState, setParserState ) + +import Data.Text (Text) +import qualified Data.Text as T + +import Data.Char (isAlpha, isAlphaNum) +import Control.Monad (guard) +import Data.Functor (($>)) +#if MIN_VERSION_base(4,9,0) +import Text.Read.Lex (isSymbolChar) +#else +import Data.Char (GeneralCategory (..), + generalCategory) +#endif + +import Data.Maybe + +-- | Identifier string surrounded with namespace, opening, and closing quotes/backticks. +data Identifier = Identifier !Namespace !Char String !Char + deriving (Show, Eq) + +parseValid :: Parser Identifier +parseValid = do + s@State{ stateInput = inp, statePos = pos } <- getParserState + + case takeIdentifier inp of + Nothing -> Parsec.parserFail "parseValid: Failed to match a valid identifier" + Just (ns, op, ident, cl, inp') -> + let posOp = updatePosChar pos op + posIdent = T.foldl updatePosChar posOp ident + posCl = updatePosChar posIdent cl + s' = s{ stateInput = inp', statePos = posCl } + in setParserState s' $> Identifier ns op (T.unpack ident) cl + + +#if !MIN_VERSION_base(4,9,0) +-- inlined from base-4.10.0.0 +isSymbolChar :: Char -> Bool +isSymbolChar c = not (isPuncChar c) && case generalCategory c of + MathSymbol -> True + CurrencySymbol -> True + ModifierSymbol -> True + OtherSymbol -> True + DashPunctuation -> True + OtherPunctuation -> c `notElem` "'\"" + ConnectorPunctuation -> c /= '_' + _ -> False + where + -- | The @special@ character class as defined in the Haskell Report. + isPuncChar :: Char -> Bool + isPuncChar = (`elem` (",;()[]{}`" :: String)) +#endif + +-- | Try to parse a delimited identifier off the front of the given input. +-- +-- This tries to match as many valid Haskell identifiers/operators as possible, +-- to the point of sometimes accepting invalid things (ex: keywords). Some +-- considerations: +-- +-- - operators and identifiers can have module qualifications +-- - operators can be wrapped in parens (for prefix) +-- - identifiers can be wrapped in backticks (for infix) +-- - delimiters are backticks or regular ticks +-- - since regular ticks are also valid in identifiers, we opt for the +-- longest successful parse +-- +-- This function should make /O(1)/ allocations +takeIdentifier :: Text -> Maybe (Namespace, Char, Text, Char, Text) +takeIdentifier input = listToMaybe $ do + + -- Optional namespace + let (ns, input') = case T.uncons input of + Just ('v', i) -> (Value, i) + Just ('t', i) -> (Type, i) + _ -> (None, input) + + -- Opening tick + (op, input'') <- maybeToList (T.uncons input') + guard (op == '\'' || op == '`') + + -- Identifier/operator + (ident, input''') <- wrapped input'' + + -- Closing tick + (cl, input'''') <- maybeToList (T.uncons input''') + guard (cl == '\'' || cl == '`') + + pure (ns, op, ident, cl, input'''') + + where + + -- | Parse out a wrapped, possibly qualified, operator or identifier + wrapped t = do + (c, t' ) <- maybeToList (T.uncons t) + -- Tuples + case c of + '(' | Just (c', _) <- T.uncons t' + , c' == ',' || c' == ')' + -> do let (commas, t'') = T.span (== ',') t' + (')', t''') <- maybeToList (T.uncons t'') + pure (T.take (T.length commas + 2) t, t''') + + -- Parenthesized + '(' -> do (n, t'' ) <- general False 0 [] t' + (')', t''') <- maybeToList (T.uncons t'') + pure (T.take (n + 2) t, t''') + + -- Backticked + '`' -> do (n, t'' ) <- general False 0 [] t' + ('`', t''') <- maybeToList (T.uncons t'') + pure (T.take (n + 2) t, t''') + + -- Unadorned + _ -> do (n, t'' ) <- general False 0 [] t + pure (T.take n t, t'') + + -- | Parse out a possibly qualified operator or identifier + general :: Bool -- ^ refuse inputs starting with operators + -> Int -- ^ total characters \"consumed\" so far + -> [(Int, Text)] -- ^ accumulated results + -> Text -- ^ current input + -> [(Int, Text)] -- ^ total characters parsed & what remains + general !identOnly !i acc t + -- Starts with an identifier (either just an identifier, or a module qual) + | Just (n, rest) <- identLike t + = if T.null rest + then acc + else case T.head rest of + '`' -> (n + i, rest) : acc + ')' -> (n + i, rest) : acc + '.' -> general False (n + i + 1) acc (T.tail rest) + '\'' -> let (m, rest') = quotes rest + in general True (n + m + 1 + i) ((n + m + i, rest') : acc) (T.tail rest') + _ -> acc + + -- An operator + | Just (n, rest) <- optr t + , not identOnly + = (n + i, rest) : acc + + -- Anything else + | otherwise + = acc + + -- | Parse an identifier off the front of the input + identLike t + | T.null t = Nothing + | isAlpha (T.head t) || '_' == T.head t + = let !(idt, rest) = T.span (\c -> isAlphaNum c || c == '_') t + !(octos, rest') = T.span (== '#') rest + in Just (T.length idt + T.length octos, rest') + | otherwise = Nothing + + -- | Parse all but the last quote off the front of the input + -- PRECONDITION: T.head t == '\'' + quotes :: Text -> (Int, Text) + quotes t = let !n = T.length (T.takeWhile (== '\'') t) - 1 + in (n, T.drop n t) + + -- | Parse an operator off the front of the input + optr t = let !(op, rest) = T.span isSymbolChar t + in if T.null op then Nothing else Just (T.length op, rest) diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs index a5664aa8..fa46f536 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -4,15 +4,32 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} +-- | +-- Module : Documentation.Haddock.Parser.Monad +-- Copyright : (c) Alec Theriault 2018-2019, +-- License : BSD-like +-- +-- Maintainer : haddock@projects.haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Defines the Parsec monad over which all parsing is done and also provides +-- more efficient versions of the usual parsec combinator functions (but +-- specialized to 'Text'). module Documentation.Haddock.Parser.Monad where import qualified Text.Parsec.Char as Parsec import qualified Text.Parsec as Parsec +import Text.Parsec.Pos ( updatePosChar ) +import Text.Parsec ( State(..) + , getParserState, setParserState ) import qualified Data.Text as T import Data.Text ( Text ) +import Control.Monad ( mfilter ) +import Data.Functor ( ($>) ) import Data.String ( IsString(..) ) import Data.Bits ( Bits(..) ) import Data.Char ( ord ) @@ -20,7 +37,11 @@ import Data.List ( foldl' ) import Control.Applicative as App import Documentation.Haddock.Types ( Version ) +import Prelude hiding (takeWhile) +-- | The only bit of information we really care about truding along with us +-- through parsing is the version attached to a @\@since@ annotation - if +-- the doc even contained one. newtype ParserState = ParserState { parserStateSince :: Maybe Version } deriving (Eq, Show) @@ -29,7 +50,7 @@ initialParserState :: ParserState initialParserState = ParserState Nothing setSince :: Version -> Parser () -setSince since = Parsec.modifyState (\st -> st {parserStateSince = Just since}) +setSince since = Parsec.modifyState (\st -> st{ parserStateSince = Just since }) type Parser = Parsec.Parsec Text ParserState @@ -44,38 +65,74 @@ parseOnly p t = case Parsec.runParser p' initialParserState "<haddock>" t of -- | Always succeeds, but returns 'Nothing' if at the end of input. Does not -- consume input. +-- +-- Equivalent to @Parsec.optionMaybe . Parsec.lookAhead $ Parsec.anyChar@, but +-- more efficient. peekChar :: Parser (Maybe Char) -peekChar = Parsec.optionMaybe . Parsec.try . Parsec.lookAhead $ Parsec.anyChar +peekChar = headOpt . stateInput <$> getParserState + where headOpt t | T.null t = Nothing + | otherwise = Just (T.head t) +{-# INLINE peekChar #-} -- | Fails if at the end of input. Does not consume input. +-- +-- Equivalent to @Parsec.lookAhead Parsec.anyChar@, but more efficient. peekChar' :: Parser Char -peekChar' = Parsec.lookAhead Parsec.anyChar +peekChar' = headFail . stateInput =<< getParserState + where headFail t | T.null t = Parsec.parserFail "peekChar': reached EOF" + | otherwise = App.pure (T.head t) +{-# INLINE peekChar' #-} -- | Parses the given string. Returns the parsed string. +-- +-- Equivalent to @Parsec.string (T.unpack t) $> t@, but more efficient. string :: Text -> Parser Text -string t = Parsec.string (T.unpack t) *> App.pure t +string t = do + s@State{ stateInput = inp, statePos = pos } <- getParserState + case T.stripPrefix t inp of + Nothing -> Parsec.parserFail "string: Failed to match the input string" + Just inp' -> + let pos' = T.foldl updatePosChar pos t + s' = s{ stateInput = inp', statePos = pos' } + in setParserState s' $> t + +-- | Keep matching characters as long as the predicate function holds (and +-- return them). +-- +-- Equivalent to @fmap T.pack . Parsec.many@, but more efficient. +takeWhile :: (Char -> Bool) -> Parser Text +takeWhile f = do + s@State{ stateInput = inp, statePos = pos } <- getParserState + let (t, inp') = T.span f inp + pos' = T.foldl updatePosChar pos t + s' = s{ stateInput = inp', statePos = pos' } + setParserState s' $> t + +-- | Like 'takeWhile', but fails if no characters matched. +-- +-- Equivalent to @fmap T.pack . Parsec.many1@, but more efficient. +takeWhile1 :: (Char -> Bool) -> Parser Text +takeWhile1 = mfilter (not . T.null) . takeWhile -- | Scan the input text, accumulating characters as long as the scanning -- function returns true. scan :: (s -> Char -> Maybe s) -- ^ scan function -> s -- ^ initial state -> Parser Text -scan f = fmap T.pack . go - where go s1 = do { cOpt <- peekChar - ; case cOpt >>= f s1 of - Nothing -> pure "" - Just s2 -> (:) <$> Parsec.anyChar <*> go s2 - } - --- | Apply a parser for a character zero or more times and collect the result in --- a string. -takeWhile :: Parser Char -> Parser Text -takeWhile = fmap T.pack . Parsec.many - --- | Apply a parser for a character one or more times and collect the result in --- a string. -takeWhile1 :: Parser Char -> Parser Text -takeWhile1 = fmap T.pack . Parsec.many1 +scan f st = do + s@State{ stateInput = inp, statePos = pos } <- getParserState + go inp st pos 0 $ \inp' pos' n -> + let s' = s{ Parsec.stateInput = inp', Parsec.statePos = pos' } + in setParserState s' $> T.take n inp + where + go inp s !pos !n cont + = case T.uncons inp of + Nothing -> cont inp pos n -- ran out of input + Just (c, inp') -> + case f s c of + Nothing -> cont inp pos n -- scan function failed + Just s' -> go inp' s' (updatePosChar pos c) (n+1) cont + -- | Parse a decimal number. decimal :: Integral a => Parser a diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index ffa91b09..98570c22 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -40,7 +40,7 @@ skipHorizontalSpace = Parsec.skipMany (Parsec.oneOf horizontalSpace) -- | Take leading horizontal space takeHorizontalSpace :: Parser Text -takeHorizontalSpace = takeWhile (Parsec.oneOf horizontalSpace) +takeHorizontalSpace = takeWhile (`elem` horizontalSpace) makeLabeled :: (String -> Maybe String -> a) -> Text -> a makeLabeled f input = case T.break isSpace $ removeEscapes $ T.strip input of diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index b5dea3d4..ba2f873c 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -65,10 +65,10 @@ overDocF f d = (\x -> d { _doc = x }) <$> f (_doc d) type Version = [Int] type Package = String -data Hyperlink = Hyperlink +data Hyperlink id = Hyperlink { hyperlinkUrl :: String - , hyperlinkLabel :: Maybe String - } deriving (Eq, Show) + , hyperlinkLabel :: Maybe id + } deriving (Eq, Show, Functor, Foldable, Traversable) data Picture = Picture { pictureUri :: String @@ -118,7 +118,7 @@ data DocH mod id | DocOrderedList [DocH mod id] | DocDefList [(DocH mod id, DocH mod id)] | DocCodeBlock (DocH mod id) - | DocHyperlink Hyperlink + | DocHyperlink (Hyperlink (DocH mod id)) | DocPic Picture | DocMathInline String | DocMathDisplay String @@ -147,7 +147,7 @@ instance Bifunctor DocH where bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs) bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs) bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc) - bimap _ _ (DocHyperlink hyperlink) = DocHyperlink hyperlink + bimap f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink (Hyperlink url (fmap (bimap f g) lbl)) bimap _ _ (DocPic picture) = DocPic picture bimap _ _ (DocMathInline s) = DocMathInline s bimap _ _ (DocMathDisplay s) = DocMathDisplay s @@ -192,7 +192,7 @@ instance Bitraversable DocH where bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc - bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink) + bitraverse f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink <$> (Hyperlink url <$> traverse (bitraverse f g) lbl) bitraverse _ _ (DocPic picture) = pure (DocPic picture) bitraverse _ _ (DocMathInline s) = pure (DocMathInline s) bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s) @@ -203,6 +203,16 @@ instance Bitraversable DocH where bitraverse f g (DocTable (Table header body)) = (\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body #endif +-- | The namespace qualification for an identifier. +data Namespace = Value | Type | None deriving (Eq, Ord, Enum, Show) + +-- | Render the a namespace into the same format it was initially parsed. +renderNs :: Namespace -> String +renderNs Value = "v" +renderNs Type = "t" +renderNs None = "" + + -- | 'DocMarkupH' is a set of instructions for marking up documentation. -- In fact, it's really just a mapping from 'Doc' to some other -- type [a], where [a] is usually the type of the output (HTML, say). @@ -227,7 +237,7 @@ data DocMarkupH mod id a = Markup , markupOrderedList :: [a] -> a , markupDefList :: [(a,a)] -> a , markupCodeBlock :: a -> a - , markupHyperlink :: Hyperlink -> a + , markupHyperlink :: Hyperlink a -> a , markupAName :: String -> a , markupPic :: Picture -> a , markupMathInline :: String -> a diff --git a/haddock-library/src/Documentation/Haddock/Utf8.hs b/haddock-library/src/Documentation/Haddock/Utf8.hs deleted file mode 100644 index 3f75e53b..00000000 --- a/haddock-library/src/Documentation/Haddock/Utf8.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Documentation.Haddock.Utf8 (encodeUtf8, decodeUtf8) where -import Data.Bits ((.|.), (.&.), shiftL, shiftR) -import qualified Data.ByteString as BS -import Data.Char (chr, ord) -import Data.Word (Word8) - --- | Helper that encodes and packs a 'String' into a 'BS.ByteString' -encodeUtf8 :: String -> BS.ByteString -encodeUtf8 = BS.pack . encode - --- | Helper that unpacks and decodes a 'BS.ByteString' into a 'String' -decodeUtf8 :: BS.ByteString -> String -decodeUtf8 = decode . BS.unpack - --- Copy/pasted functions from Codec.Binary.UTF8.String for encoding/decoding --- | Character to use when 'encode' or 'decode' fail for a byte. -replacementCharacter :: Char -replacementCharacter = '\xfffd' - --- | Encode a Haskell String to a list of Word8 values, in UTF8 format. -encode :: String -> [Word8] -encode = concatMap (map fromIntegral . go . ord) - where - go oc - | oc <= 0x7f = [oc] - - | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6) - , 0x80 + oc .&. 0x3f - ] - - | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12) - , 0x80 + ((oc `shiftR` 6) .&. 0x3f) - , 0x80 + oc .&. 0x3f - ] - | otherwise = [ 0xf0 + (oc `shiftR` 18) - , 0x80 + ((oc `shiftR` 12) .&. 0x3f) - , 0x80 + ((oc `shiftR` 6) .&. 0x3f) - , 0x80 + oc .&. 0x3f - ] - --- | Decode a UTF8 string packed into a list of Word8 values, directly to String -decode :: [Word8] -> String -decode [ ] = "" -decode (c:cs) - | c < 0x80 = chr (fromEnum c) : decode cs - | c < 0xc0 = replacementCharacter : decode cs - | c < 0xe0 = multi1 - | c < 0xf0 = multi_byte 2 0xf 0x800 - | c < 0xf8 = multi_byte 3 0x7 0x10000 - | c < 0xfc = multi_byte 4 0x3 0x200000 - | c < 0xfe = multi_byte 5 0x1 0x4000000 - | otherwise = replacementCharacter : decode cs - where - multi1 = case cs of - c1 : ds | c1 .&. 0xc0 == 0x80 -> - let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|. fromEnum (c1 .&. 0x3f) - in if d >= 0x000080 then toEnum d : decode ds - else replacementCharacter : decode ds - _ -> replacementCharacter : decode cs - - multi_byte :: Int -> Word8 -> Int -> String - multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) - where - aux 0 rs acc - | overlong <= acc && acc <= 0x10ffff && - (acc < 0xd800 || 0xdfff < acc) && - (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs - | otherwise = replacementCharacter : decode rs - - aux n (r:rs) acc - | r .&. 0xc0 == 0x80 = aux (n-1) rs - $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) - - aux _ rs _ = replacementCharacter : decode rs diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 0449c917..bc40a0a2 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -37,7 +37,7 @@ parseParas = overDoc Parse.toRegular . Parse.parseParas Nothing parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString -hyperlink :: String -> Maybe String -> Doc String +hyperlink :: String -> Maybe (Doc String) -> Doc String hyperlink url = DocHyperlink . Hyperlink url main :: IO () @@ -112,7 +112,7 @@ spec = do "``" `shouldParseTo` "``" it "can parse an identifier in infix notation enclosed within backticks" $ do - "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`" + "``infix``" `shouldParseTo` DocIdentifier "`infix`" it "can parse identifiers containing a single quote" $ do "'don't'" `shouldParseTo` DocIdentifier "don't" @@ -132,6 +132,19 @@ spec = do it "can parse an identifier that starts with an underscore" $ do "'_x'" `shouldParseTo` DocIdentifier "_x" + it "can parse value-namespaced identifiers" $ do + "v'foo'" `shouldParseTo` DocIdentifier "foo" + + it "can parse type-namespaced identifiers" $ do + "t'foo'" `shouldParseTo` DocIdentifier "foo" + + it "can parse parenthesized operators and backticked identifiers" $ do + "'(<|>)'" `shouldParseTo` DocIdentifier "(<|>)" + "'`elem`'" `shouldParseTo` DocIdentifier "`elem`" + + it "can properly figure out the end of identifiers" $ do + "'DbModule'/'DbUnitId'" `shouldParseTo` DocIdentifier "DbModule" <> "/" <> DocIdentifier "DbUnitId" + context "when parsing operators" $ do it "can parse an operator enclosed within single quotes" $ do "'.='" `shouldParseTo` DocIdentifier ".=" @@ -202,6 +215,10 @@ spec = do "[some label]( url)" `shouldParseTo` "[some label]( url)" + it "allows inline markup in the label" $ do + "[something /emphasized/](url)" `shouldParseTo` + hyperlink "url" (Just ("something " <> DocEmphasis "emphasized")) + context "when URL is on a separate line" $ do it "allows URL to be on a separate line" $ do "[some label]\n(url)" `shouldParseTo` diff --git a/haddock-library/test/Documentation/Haddock/Utf8Spec.hs b/haddock-library/test/Documentation/Haddock/Utf8Spec.hs deleted file mode 100644 index 47e12704..00000000 --- a/haddock-library/test/Documentation/Haddock/Utf8Spec.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Documentation.Haddock.Utf8Spec (main, spec) where - -import Test.Hspec -import Test.QuickCheck -import Documentation.Haddock.Utf8 - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "decodeUtf8" $ do - it "is inverse to encodeUtf8" $ do - property $ \xs -> (decodeUtf8 . encodeUtf8) xs `shouldBe` xs diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal index 48314600..23b5953c 100644 --- a/haddock-test/haddock-test.cabal +++ b/haddock-test/haddock-test.cabal @@ -16,7 +16,7 @@ library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - build-depends: base >= 4.3 && < 4.13, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb + build-depends: base >= 4.3 && < 4.13, bytestring, directory, process, filepath, Cabal, xml, xhtml exposed-modules: Test.Haddock diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index 942c0587..25c64cfe 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -34,12 +34,12 @@ data CheckResult runAndCheck :: Config c -> IO () runAndCheck cfg = do - runHaddock cfg - checkFiles cfg + crashed <- runHaddock cfg + checkFiles cfg crashed -checkFiles :: Config c -> IO () -checkFiles cfg@(Config { .. }) = do +checkFiles :: Config c -> Bool -> IO () +checkFiles cfg@(Config { .. }) somethingCrashed = do putStrLn "Testing output files..." files <- ignore <$> getDirectoryTree (cfgOutDir cfg) @@ -54,13 +54,14 @@ checkFiles cfg@(Config { .. }) = do Error msg -> putStrLn ("ERROR (" ++ msg ++ ")") >> return Nothing Accepted -> putStrLn "ACCEPTED" >> return Nothing - if null failed - then do - putStrLn "All tests passed!" - exitSuccess - else do - maybeDiff cfg failed - exitFailure + if (null failed && not somethingCrashed) + then do + putStrLn "All tests passed!" + exitSuccess + else do + unless (null failed) $ maybeDiff cfg failed + when somethingCrashed $ putStrLn "Some tests crashed." + exitFailure where ignore = filter (not . dcfgCheckIgnore cfgDirConfig) @@ -72,12 +73,14 @@ maybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) files = do forM_ files $ diffFile cfg diff -runHaddock :: Config c -> IO () +-- | Runs Haddock on all of the test packages, and returns whether 'True' if +-- any of them caused Haddock to crash. +runHaddock :: Config c -> IO Bool runHaddock cfg@(Config { .. }) = do createEmptyDirectory $ cfgOutDir cfg putStrLn "Generating documentation..." - forM_ cfgPackages $ \tpkg -> do + successes <- forM cfgPackages $ \tpkg -> do haddockStdOut <- openFile cfgHaddockStdOut WriteMode let pc = processConfig { pcArgs = concat @@ -87,9 +90,20 @@ runHaddock cfg@(Config { .. }) = do ] , pcEnv = Just $ cfgEnv , pcStdOut = Just $ haddockStdOut + , pcStdErr = Just $ haddockStdOut } - handle <- runProcess' cfgHaddockPath pc - waitForSuccess "Failed to run Haddock on specified test files" handle + + let msg = "Failed to run Haddock on test package '" ++ tpkgName tpkg ++ "'" + succeeded <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc + unless succeeded $ removeDirectoryRecursive (outDir cfgDirConfig tpkg) + + pure succeeded + + let somethingFailed = any not successes + when somethingFailed $ + putStrLn ("Haddock output is at '" ++ cfgHaddockStdOut ++ "'. " ++ + "This file can be set with `--haddock-stdout`.") + pure somethingFailed checkFile :: Config c -> FilePath -> IO CheckResult diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 51032a3a..51394eff 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -196,6 +196,7 @@ loadConfig ccfg dcfg flags files = do cfgHaddockArgs <- liftM concat . sequence $ [ pure ["--no-warnings"] + , pure ["--bypass-interface-version-check"] , pure ["--odir=" ++ dcfgOutDir dcfg] , pure ["--optghc=-w"] , pure ["--optghc=-hide-all-packages"] @@ -223,13 +224,13 @@ printVersions env haddockPath = do { pcEnv = Just env , pcArgs = ["--version"] } - waitForSuccess "Failed to run `haddock --version`" handleHaddock + void $ waitForSuccess "Failed to run `haddock --version`" stderr handleHaddock handleGhc <- runProcess' haddockPath $ processConfig { pcEnv = Just env , pcArgs = ["--ghc-version"] } - waitForSuccess "Failed to run `haddock --ghc-version`" handleGhc + void $ waitForSuccess "Failed to run `haddock --ghc-version`" stderr handleGhc baseDependencies :: FilePath -> IO [String] @@ -240,7 +241,7 @@ baseDependencies ghcPath = do unsetEnv "GHC_PACKAGE_PATH" (comp, _, cfg) <- configure normal (Just ghcPath) Nothing - defaultProgramConfiguration + defaultProgramDb #if MIN_VERSION_Cabal(1,23,0) pkgIndex <- getInstalledPackages normal comp [GlobalPackageDB] cfg #else @@ -300,7 +301,7 @@ defaultDiffTool :: IO (Maybe FilePath) defaultDiffTool = liftM listToMaybe . filterM isAvailable $ ["colordiff", "diff"] where - isAvailable = liftM isJust . findProgramLocation silent + isAvailable = liftM isJust . findExecutable defaultStdOut :: FilePath diff --git a/haddock-test/src/Test/Haddock/Process.hs b/haddock-test/src/Test/Haddock/Process.hs index 52bf9533..a6cab9ac 100644 --- a/haddock-test/src/Test/Haddock/Process.hs +++ b/haddock-test/src/Test/Haddock/Process.hs @@ -40,10 +40,10 @@ runProcess' :: FilePath -> ProcessConfig -> IO ProcessHandle runProcess' path (ProcessConfig { .. }) = runProcess path pcArgs pcWorkDir pcEnv pcStdIn pcStdOut pcStdErr - -waitForSuccess :: String -> ProcessHandle -> IO () -waitForSuccess msg handle = do - result <- waitForProcess handle - unless (result == ExitSuccess) $ do - hPutStrLn stderr $ msg - exitFailure +-- | Wait for a process to finish running. If it ends up failing, print out the +-- error message. +waitForSuccess :: String -> Handle -> ProcessHandle -> IO Bool +waitForSuccess msg out handle = do + succeeded <- fmap (== ExitSuccess) $ waitForProcess handle + unless succeeded $ hPutStrLn out msg + pure succeeded diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs index 8bfc973f..6c19dbca 100644 --- a/haddock-test/src/Test/Haddock/Xhtml.hs +++ b/haddock-test/src/Test/Haddock/Xhtml.hs @@ -1,17 +1,17 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Haddock.Xhtml ( Xml(..) , parseXml, dumpXml - , stripLinks, stripLinksWhen, stripAnchorsWhen, stripFooter + , stripLinks, stripLinksWhen, stripAnchorsWhen, stripIdsWhen, stripFooter ) where - -import Data.Generics.Aliases -import Data.Generics.Schemes - +import Data.Data ( Data(..), Typeable, eqT, (:~:)(..) ) import Text.XML.Light import Text.XHtml (Html, HtmlAttr, (!)) import qualified Text.XHtml as Xhtml @@ -26,6 +26,12 @@ deriving instance Eq Element deriving instance Eq Content deriving instance Eq CData +-- | Similar to @everywhere (mkT f) x@ from SYB. +gmapEverywhere :: forall a b. (Data a, Typeable b) => (b -> b) -> a -> a +gmapEverywhere f x = gmapT (gmapEverywhere f) $ case eqT @a @b of + Nothing -> x + Just Refl -> f x + parseXml :: String -> Maybe Xml parseXml = fmap Xml . parseXMLDoc @@ -56,14 +62,22 @@ stripAnchorsWhen p = | qName key == "name" && p val = attr { attrVal = "" } | otherwise = attr +stripIdsWhen :: (String -> Bool) -> Xml -> Xml +stripIdsWhen p = + processAnchors unname + where + unname attr@(Attr { attrKey = key, attrVal = val }) + | qName key == "id" && p val = attr { attrVal = "" } + | otherwise = attr + processAnchors :: (Attr -> Attr) -> Xml -> Xml -processAnchors f = Xml . everywhere (mkT f) . xmlElement +processAnchors f = Xml . gmapEverywhere f . xmlElement stripFooter :: Xml -> Xml stripFooter = - Xml . everywhere (mkT defoot) . xmlElement + Xml . gmapEverywhere defoot . xmlElement where defoot el | isFooter el = el { elContent = [] } diff --git a/haddock.cabal b/haddock.cabal index 0f99d16b..91a5ea3d 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -64,7 +64,8 @@ executable haddock -- haddock typically only supports a single GHC major version build-depends: - base ^>= 4.12.0 + -- FIXME: drop 4.12.0.0 once GHC HEAD updates to 4.13.0.0 + base ^>= 4.12.0.0 || ^>= 4.13.0.0 if flag(in-ghc-tree) hs-source-dirs: haddock-api/src, haddock-library/src @@ -78,7 +79,8 @@ executable haddock xhtml >= 3000.2 && < 3000.3, Cabal >= 1.10, ghc-boot, - ghc == 8.6.*, + ghc-boot-th, + ghc == 8.7.*, bytestring, parsec, text, @@ -87,9 +89,9 @@ executable haddock other-modules: Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad + Documentation.Haddock.Parser.Identifier Documentation.Haddock.Types Documentation.Haddock.Doc - Documentation.Haddock.Utf8 Documentation.Haddock.Parser.Util Documentation.Haddock.Markup @@ -119,7 +121,6 @@ executable haddock Haddock.Backends.HaddockDB Haddock.Backends.Hoogle Haddock.Backends.Hyperlinker - Haddock.Backends.Hyperlinker.Ast Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Renderer Haddock.Backends.Hyperlinker.Types diff --git a/hoogle-test/ref/Bug873/test.txt b/hoogle-test/ref/Bug873/test.txt index 19100212..68873317 100644 --- a/hoogle-test/ref/Bug873/test.txt +++ b/hoogle-test/ref/Bug873/test.txt @@ -18,9 +18,10 @@ module Bug873 -- It is also useful in higher-order situations, such as <tt><a>map</a> -- (<a>$</a> 0) xs</tt>, or <tt><a>zipWith</a> (<a>$</a>) fs xs</tt>. -- --- Note that <tt>($)</tt> is levity-polymorphic in its result type, so --- that foo $ True where foo :: Bool -> Int# is well-typed -($) :: () => (a -> b) -> a -> b +-- Note that <tt>(<a>$</a>)</tt> is levity-polymorphic in its result +-- type, so that <tt>foo <a>$</a> True</tt> where <tt>foo :: Bool -> +-- Int#</tt> is well-typed. +($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b infixr 0 $ ($$) :: (a -> b) -> a -> b infixr 0 $$ diff --git a/html-test/Main.hs b/html-test/Main.hs index d65a5087..26eefe4a 100755 --- a/html-test/Main.hs +++ b/html-test/Main.hs @@ -45,7 +45,7 @@ stripIfRequired mdl = -- | List of modules in which we don't 'stripLinks' preserveLinksModules :: [String] -preserveLinksModules = ["Bug253"] +preserveLinksModules = ["Bug253.html", "NamespacedIdentifiers.html"] ingoredTests :: [FilePath] ingoredTests = diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html index 9179e252..630df356 100644 --- a/html-test/ref/Bug1004.html +++ b/html-test/ref/Bug1004.html @@ -116,8 +116,12 @@ >Type</a >)</span ></td - ><td class="doc empty" - ></td + ><td class="doc" + ><p + ><em + >Since: base-4.9.0.0</em + ></p + ></td ></tr ><tr ><td colspan="2" @@ -150,7 +154,9 @@ ><p class="src" ><a href="#" >from1</a - > :: <a href="#" title="Bug1004" + > :: <span class="keyword" + >forall</span + > (a :: k0). <a href="#" title="Bug1004" >Product</a > f g a -> <a href="#" title="GHC.Generics" >Rep1</a @@ -162,7 +168,9 @@ ><p class="src" ><a href="#" >to1</a - > :: <a href="#" title="GHC.Generics" + > :: <span class="keyword" + >forall</span + > (a :: k0). <a href="#" title="GHC.Generics" >Rep1</a > (<a href="#" title="Bug1004" >Product</a @@ -511,6 +519,16 @@ ></p ><p class="src" ><a href="#" + >foldMap'</a + > :: <a href="#" title="Data.Monoid" + >Monoid</a + > m => (a -> m) -> <a href="#" title="Bug1004" + >Product</a + > f g a -> m <a href="#" class="selflink" + >#</a + ></p + ><p class="src" + ><a href="#" >foldr</a > :: (a -> b -> b) -> b -> <a href="#" title="Bug1004" >Product</a @@ -1380,7 +1398,7 @@ >forall</span > d. <a href="#" title="Data.Data" >Data</a - > d => c (t d)) -> <a href="#" title="GHC.Maybe" + > d => c (t d)) -> <a href="#" title="Data.Maybe" >Maybe</a > (c (<a href="#" title="Bug1004" >Product</a @@ -1398,7 +1416,7 @@ >Data</a > d, <a href="#" title="Data.Data" >Data</a - > e) => c (t d e)) -> <a href="#" title="GHC.Maybe" + > e) => c (t d e)) -> <a href="#" title="Data.Maybe" >Maybe</a > (c (<a href="#" title="Bug1004" >Product</a @@ -1434,7 +1452,9 @@ ><p class="src" ><a href="#" >gmapQr</a - > :: (r' -> r -> r) -> r -> (<span class="keyword" + > :: <span class="keyword" + >forall</span + > r r'. (r' -> r -> r) -> r -> (<span class="keyword" >forall</span > d. <a href="#" title="Data.Data" >Data</a @@ -1810,8 +1830,12 @@ >Product</a > f g a)</span ></td - ><td class="doc empty" - ></td + ><td class="doc" + ><p + ><em + >Since: base-4.9.0.0</em + ></p + ></td ></tr ><tr ><td colspan="2" @@ -1886,12 +1910,8 @@ >Type</a >)</span ></td - ><td class="doc" - ><p - ><em - >Since: base-4.9.0.0</em - ></p - ></td + ><td class="doc empty" + ></td ></tr ><tr ><td colspan="2" @@ -1913,33 +1933,33 @@ >Type</a >) = <a href="#" title="GHC.Generics" >D1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaData</a - > "Product" "Data.Functor.Product" "base" <a href="#" title="Data.Bool" + > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >C1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaCons</a - > "Pair" <a href="#" title="GHC.Generics" + > "Pair" '<a href="#" title="GHC.Generics" >PrefixI</a - > <a href="#" title="Data.Bool" + > '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Nothing</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="GHC.TypeLits" >Symbol</a - >) <a href="#" title="GHC.Generics" + >) '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec1</a @@ -1947,19 +1967,19 @@ >:*:</a > <a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Nothing</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="GHC.TypeLits" >Symbol</a - >) <a href="#" title="GHC.Generics" + >) '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec1</a @@ -1980,12 +2000,8 @@ >Product</a > f g a)</span ></td - ><td class="doc" - ><p - ><em - >Since: base-4.9.0.0</em - ></p - ></td + ><td class="doc empty" + ></td ></tr ><tr ><td colspan="2" @@ -2005,33 +2021,33 @@ >Product</a > f g a) = <a href="#" title="GHC.Generics" >D1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaData</a - > "Product" "Data.Functor.Product" "base" <a href="#" title="Data.Bool" + > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >C1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaCons</a - > "Pair" <a href="#" title="GHC.Generics" + > "Pair" '<a href="#" title="GHC.Generics" >PrefixI</a - > <a href="#" title="Data.Bool" + > '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Nothing</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="GHC.TypeLits" >Symbol</a - >) <a href="#" title="GHC.Generics" + >) '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec0</a @@ -2039,19 +2055,19 @@ >:*:</a > <a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Nothing</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="GHC.TypeLits" >Symbol</a - >) <a href="#" title="GHC.Generics" + >) '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec0</a diff --git a/html-test/ref/Bug1033.html b/html-test/ref/Bug1033.html index 32a9f6d3..d01cef79 100644 --- a/html-test/ref/Bug1033.html +++ b/html-test/ref/Bug1033.html @@ -187,17 +187,17 @@ >Foo</a > = <a href="#" title="GHC.Generics" >D1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaData</a - > "Foo" "Bug1033" "main" <a href="#" title="Data.Bool" + > "Foo" "Bug1033" "main" '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >C1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaCons</a - > "Foo" <a href="#" title="GHC.Generics" + > "Foo" '<a href="#" title="GHC.Generics" >PrefixI</a - > <a href="#" title="Data.Bool" + > '<a href="#" title="Data.Bool" >False</a >) (<a href="#" title="GHC.Generics" >U1</a diff --git a/html-test/ref/Bug1035.html b/html-test/ref/Bug1035.html new file mode 100644 index 00000000..f9b04581 --- /dev/null +++ b/html-test/ref/Bug1035.html @@ -0,0 +1,146 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >Bug1035</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Bug1035</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >Foo</a + > = <a href="#" + >Bar</a + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >Bar</a + > = <a href="#" + >Foo</a + ></li + ><li class="src short" + ><a href="#" + >foo</a + > :: ()</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Foo" class="def" + >Foo</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:Bar" class="def" + >Bar</a + ></td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Bar" class="def" + >Bar</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:Foo" class="def" + >Foo</a + ></td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><a id="v:foo" class="def" + >foo</a + > :: () <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A link to <code + ><a href="#" title="Bug1035" + >Bar</a + ></code + ></p + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/Bug253.html b/html-test/ref/Bug253.html index 315ffb79..b4581e91 100644 --- a/html-test/ref/Bug253.html +++ b/html-test/ref/Bug253.html @@ -4,9 +4,9 @@ /><meta name="viewport" content="width=device-width, initial-scale=1" /><title >Bug253</title - ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" - /><link rel="stylesheet" type="text/css" href="#" - /><link rel="stylesheet" type="text/css" href="#" + ><link href="linuwial.css" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="quick-jump.css" + /><link rel="stylesheet" type="text/css" href="https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" /><script src="haddock-bundle.min.js" async="async" type="text/javascript" ></script ><script type="text/x-mathjax-config" @@ -20,11 +20,11 @@ ></span ><ul class="links" id="page-menu" ><li - ><a href="#" + ><a href="index.html" >Contents</a ></li ><li - ><a href="#" + ><a href="doc-index.html" >Index</a ></li ></ul @@ -64,7 +64,7 @@ >Synopsis</summary ><ul class="details-toggle" data-details-id="syn" ><li class="src short" - ><a href="#" + ><a href="#v:foo" >foo</a > :: ()</li ></ul @@ -77,7 +77,7 @@ ><p class="src" ><a id="v:foo" class="def" >foo</a - > :: () <a href="#" class="selflink" + > :: () <a href="#v:foo" class="selflink" >#</a ></p ><div class="doc" @@ -85,7 +85,7 @@ >This link should generate <code >#v</code > anchor: <code - ><a href="#" title="DoesNotExist" + ><a href="DoesNotExist.html#v:fakeFakeFake" title="DoesNotExist" >fakeFakeFake</a ></code ></p diff --git a/html-test/ref/Bug548.html b/html-test/ref/Bug548.html index c8c30c23..b2a1da0b 100644 --- a/html-test/ref/Bug548.html +++ b/html-test/ref/Bug548.html @@ -114,8 +114,12 @@ >Type</a >)</span ></td - ><td class="doc empty" - ></td + ><td class="doc" + ><p + ><em + >Since: base-4.7.0.0</em + ></p + ></td ></tr ><tr ><td colspan="2" @@ -148,7 +152,9 @@ ><p class="src" ><a href="#" >from1</a - > :: <a href="#" title="Bug548" + > :: <span class="keyword" + >forall</span + > (a0 :: k). <a href="#" title="Bug548" >WrappedArrow</a > a b a0 -> <a href="#" title="GHC.Generics" >Rep1</a @@ -160,7 +166,9 @@ ><p class="src" ><a href="#" >to1</a - > :: <a href="#" title="GHC.Generics" + > :: <span class="keyword" + >forall</span + > (a0 :: k). <a href="#" title="GHC.Generics" >Rep1</a > (<a href="#" title="Bug548" >WrappedArrow</a @@ -410,8 +418,12 @@ >WrappedArrow</a > a b c)</span ></td - ><td class="doc empty" - ></td + ><td class="doc" + ><p + ><em + >Since: base-4.7.0.0</em + ></p + ></td ></tr ><tr ><td colspan="2" @@ -488,12 +500,8 @@ >Type</a >)</span ></td - ><td class="doc" - ><p - ><em - >Since: base-4.7.0.0</em - ></p - ></td + ><td class="doc empty" + ></td ></tr ><tr ><td colspan="2" @@ -517,29 +525,29 @@ >Type</a >) = <a href="#" title="GHC.Generics" >D1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaData</a - > "WrappedArrow" "Control.Applicative" "base" <a href="#" title="Data.Bool" + > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool" >True</a >) (<a href="#" title="GHC.Generics" >C1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaCons</a - > "WrapArrow" <a href="#" title="GHC.Generics" + > "WrapArrow" '<a href="#" title="GHC.Generics" >PrefixI</a - > <a href="#" title="Data.Bool" + > '<a href="#" title="Data.Bool" >True</a >) (<a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Just</a - > "unwrapArrow") <a href="#" title="GHC.Generics" + > "unwrapArrow") '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec1</a @@ -560,12 +568,8 @@ >WrappedArrow</a > a b c)</span ></td - ><td class="doc" - ><p - ><em - >Since: base-4.7.0.0</em - ></p - ></td + ><td class="doc empty" + ></td ></tr ><tr ><td colspan="2" @@ -585,29 +589,29 @@ >WrappedArrow</a > a b c) = <a href="#" title="GHC.Generics" >D1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaData</a - > "WrappedArrow" "Control.Applicative" "base" <a href="#" title="Data.Bool" + > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool" >True</a >) (<a href="#" title="GHC.Generics" >C1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaCons</a - > "WrapArrow" <a href="#" title="GHC.Generics" + > "WrapArrow" '<a href="#" title="GHC.Generics" >PrefixI</a - > <a href="#" title="Data.Bool" + > '<a href="#" title="Data.Bool" >True</a >) (<a href="#" title="GHC.Generics" >S1</a - > (<a href="#" title="GHC.Generics" + > ('<a href="#" title="GHC.Generics" >MetaSel</a - > (<a href="#" title="GHC.Maybe" + > ('<a href="#" title="Data.Maybe" >Just</a - > "unwrapArrow") <a href="#" title="GHC.Generics" + > "unwrapArrow") '<a href="#" title="GHC.Generics" >NoSourceUnpackedness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >NoSourceStrictness</a - > <a href="#" title="GHC.Generics" + > '<a href="#" title="GHC.Generics" >DecidedLazy</a >) (<a href="#" title="GHC.Generics" >Rec0</a diff --git a/html-test/ref/Bug865.html b/html-test/ref/Bug865.html new file mode 100644 index 00000000..16b1714e --- /dev/null +++ b/html-test/ref/Bug865.html @@ -0,0 +1,88 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >Bug865</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Bug865</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><a href="#" + >link</a + > :: ()</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a id="v:link" class="def" + >link</a + > :: () <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >An emphasized link <a href="#" + >yes <em + >this</em + > is emphasized while this is + <code + >monospaced</code + ></a + >. And here is an image:</p + ><p + ><img src="https://www.haskell.org/static/img/haskell-logo.svg" title="emphasis stripped" + /></p + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/Bug923.html b/html-test/ref/Bug923.html new file mode 100644 index 00000000..387b7192 --- /dev/null +++ b/html-test/ref/Bug923.html @@ -0,0 +1,200 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >Bug923</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Bug923</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >T</a + > :: (* -> (*, *)) -> * <span class="keyword" + >where</span + ><ul class="subs" + ><li + ><a href="#" + >T</a + > :: a -> <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a)</li + ></ul + ></li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:T" class="def" + >T</a + > :: (* -> (*, *)) -> * <span class="keyword" + >where</span + > <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A promoted tuple type</p + ></div + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:T" class="def" + >T</a + > :: a -> <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a)</td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ><div class="subs instances" + ><h4 class="instances details-toggle-control details-toggle" data-details-id="i:T" + >Instances</h4 + ><details id="i:T" open="open" + ><summary class="hide-when-js-enabled" + >Instances details</summary + ><table + ><tr + ><td class="src clearfix" + ><span class="inst-left" + ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:T:Eq:1" + ></span + > <a href="#" title="Data.Eq" + >Eq</a + > a => <a href="#" title="Data.Eq" + >Eq</a + > (<a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a :: <a href="#" title="Data.Kind" + >Type</a + > -> (<a href="#" title="Data.Kind" + >Type</a + >, <a href="#" title="Data.Kind" + >Type</a + >)))</span + > <a href="#" class="selflink" + >#</a + ></td + ><td class="doc" + ><p + >A promoted tuple type in an instance</p + ></td + ></tr + ><tr + ><td colspan="2" + ><details id="i:id:T:Eq:1" + ><summary class="hide-when-js-enabled" + >Instance details</summary + ><p + >Defined in <a href="#" + >Bug923</a + ></p + > <div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a href="#" + >(==)</a + > :: <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a) -> <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a) -> <a href="#" title="Data.Bool" + >Bool</a + > <a href="#" class="selflink" + >#</a + ></p + ><p class="src" + ><a href="#" + >(/=)</a + > :: <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a) -> <a href="#" title="Bug923" + >T</a + > ('<a href="#" title="GHC.Tuple" + >(,)</a + > a) -> <a href="#" title="Data.Bool" + >Bool</a + > <a href="#" class="selflink" + >#</a + ></p + ></div + ></details + ></td + ></tr + ></table + ></details + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/ConstructorPatternExport.html b/html-test/ref/ConstructorPatternExport.html index 32f6737c..3296ac93 100644 --- a/html-test/ref/ConstructorPatternExport.html +++ b/html-test/ref/ConstructorPatternExport.html @@ -103,7 +103,7 @@ >MyGADTCons</a > :: a -> <a href="#" title="Data.Int" >Int</a - > -> MyGADT (<a href="#" title="GHC.Maybe" + > -> MyGADT (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.String" >String</a diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index b40aa97c..0b87c47b 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -224,7 +224,7 @@ ><td class="src" >:: <span class="keyword" >forall</span - > a (b :: ()) d. d ~ <a href="#" title="GHC.Tuple" + > a (b :: ()) d. d ~ '<a href="#" title="GHC.Tuple" >()</a ></td ><td class="doc empty" diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html index 438375f0..29f299f2 100644 --- a/html-test/ref/Hash.html +++ b/html-test/ref/Hash.html @@ -121,7 +121,7 @@ >Hash</a > key => key -> <a href="#" title="System.IO" >IO</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > val)</li ><li class="src short" @@ -229,7 +229,7 @@ >Hash</a > key => key -> <a href="#" title="System.IO" >IO</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > val) <a href="#" class="selflink" >#</a @@ -238,13 +238,13 @@ ><p >Looks up a key in the hash table, returns <code ><code - ><a href="#" title="GHC.Maybe" + ><a href="#" title="Data.Maybe" >Just</a ></code > val</code > if the key was found, or <code - ><a href="#" title="GHC.Maybe" + ><a href="#" title="Data.Maybe" >Nothing</a ></code > otherwise.</p diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html new file mode 100644 index 00000000..a9e6fb21 --- /dev/null +++ b/html-test/ref/Identifiers.html @@ -0,0 +1,286 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >Identifiers</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Identifiers</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >Id</a + > = <a href="#" + >Id</a + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > a <a href="#" + >:*</a + > b = a <a href="#" + >:*</a + > b</li + ><li class="src short" + ><a href="#" + >foo</a + > :: ()</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Id" class="def" + >Id</a + > <a href="#" class="selflink" + >#</a + ></p + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:Id" class="def" + >Id</a + ></td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > a <a id="t::-42-" class="def" + >:*</a + > b <a href="#" class="selflink" + >#</a + ></p + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + >a <a id="v::-42-" class="def" + >:*</a + > b</td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><a id="v:foo" class="def" + >foo</a + > :: () <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><ul + ><li + ><p + >Unadorned:</p + ><ul + ><li + >Unqualified: <code + ><a href="#" title="GHC.List" + >++</a + ></code + >, <code + ><a href="#" title="Data.Foldable" + >elem</a + ></code + ></li + ><li + >Qualified: <code + ><a href="#" title="GHC.List" + >++</a + ></code + >, <code + ><a href="#" title="Data.Lis" + >elem</a + ></code + ></li + ><li + >Namespaced: <code + ><a href="#" title="GHC.List" + >++</a + ></code + >, <code + >++</code + >, <code + ><a href="#" title="Data.Foldable" + >elem</a + ></code + >, <code + >elem</code + >, <code + ><a href="#" title="Identifiers" + >Id</a + ></code + >, <code + ><a href="#" title="Identifiers" + >Id</a + ></code + >, <code + ><a href="#" title="Identifiers" + >:*</a + ></code + >, <code + ><a href="#" title="Identifiers" + >:*</a + ></code + ></li + ></ul + ></li + ><li + ><p + >Parenthesized:</p + ><ul + ><li + >Unqualified: <code + ><code + ><a href="#" title="GHC.List" + >(++)</a + ></code + > [1,2,3] [4,5,6]</code + ></li + ><li + >Qualified: <code + ><code + ><a href="#" title="GHC.List" + >(++)</a + ></code + > [1,2,3] [4,5,6]</code + ></li + ><li + >Namespaced: <code + ><a href="#" title="GHC.List" + >(++)</a + ></code + >, <code + >++</code + >, <code + ><a href="#" title="Identifiers" + >(:*)</a + ></code + >, <code + ><a href="#" title="Identifiers" + >(:*)</a + ></code + ></li + ></ul + ></li + ><li + ><p + >Backticked:</p + ><ul + ><li + >Unqualified: <code + >1 <code + ><a href="#" title="Data.Foldable" + >`elem`</a + ></code + > [-3..3]</code + ></li + ><li + >Qualified: <code + >1 <code + ><a href="#" title="Data.Foldable" + >`elem`</a + ></code + > [-3..3]</code + ></li + ><li + >Namespaced: <code + ><a href="#" title="Data.Foldable" + >`elem`</a + ></code + >, <code + >`elem`</code + >, <code + ><a href="#" title="Identifiers" + >`Id`</a + ></code + >, <code + ><a href="#" title="Identifiers" + >`Id`</a + ></code + ></li + ></ul + ></li + ><li + ><p + >Edge cases:</p + ><ul + ><li + >Tuples: <code + >()</code + >, <code + >(,,,)</code + ></li + ></ul + ></li + ></ul + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index 308b97ce..7faa9588 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -242,7 +242,7 @@ ></span > <a href="#" title="Instances" >Foo</a - > <a href="#" title="GHC.Maybe" + > <a href="#" title="Data.Maybe" >Maybe</a ></span > <a href="#" class="selflink" @@ -266,11 +266,11 @@ ><p class="src" ><a href="#" >foo</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Int" >Int</a - > -> a -> <a href="#" title="GHC.Maybe" + > -> a -> <a href="#" title="Data.Maybe" >Maybe</a > a <a href="#" class="selflink" >#</a @@ -278,15 +278,15 @@ ><p class="src" ><a href="#" >foo'</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > a) -> <a href="#" title="Data.Int" >Int</a - > -> <a href="#" title="GHC.Maybe" + > -> <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Int" >Int</a @@ -706,7 +706,7 @@ ></span > <a href="#" title="Instances" >Bar</a - > <a href="#" title="GHC.Maybe" + > <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a @@ -732,11 +732,11 @@ ><p class="src" ><a href="#" >bar</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - > -> <a href="#" title="GHC.Maybe" + > -> <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a @@ -748,17 +748,17 @@ ><p class="src" ><a href="#" >bar'</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - >) -> <a href="#" title="GHC.Maybe" + >) -> <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > b)) <a href="#" class="selflink" >#</a @@ -766,17 +766,17 @@ ><p class="src" ><a href="#" >bar0</a - > :: (<a href="#" title="GHC.Maybe" + > :: (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - >, <a href="#" title="GHC.Maybe" + >, <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - >) -> (<a href="#" title="GHC.Maybe" + >) -> (<a href="#" title="Data.Maybe" >Maybe</a - > b, <a href="#" title="GHC.Maybe" + > b, <a href="#" title="Data.Maybe" >Maybe</a > c) <a href="#" class="selflink" >#</a @@ -784,17 +784,17 @@ ><p class="src" ><a href="#" >bar1</a - > :: (<a href="#" title="GHC.Maybe" + > :: (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - >, <a href="#" title="GHC.Maybe" + >, <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a - >) -> (<a href="#" title="GHC.Maybe" + >) -> (<a href="#" title="Data.Maybe" >Maybe</a - > b, <a href="#" title="GHC.Maybe" + > b, <a href="#" title="Data.Maybe" >Maybe</a > c) <a href="#" class="selflink" >#</a @@ -810,7 +810,7 @@ ></span > <a href="#" title="Instances" >Bar</a - > <a href="#" title="GHC.Maybe" + > <a href="#" title="Data.Maybe" >Maybe</a > [a]</span > <a href="#" class="selflink" @@ -834,9 +834,9 @@ ><p class="src" ><a href="#" >bar</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a - > [a] -> <a href="#" title="GHC.Maybe" + > [a] -> <a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Data.Bool" >Bool</a @@ -846,15 +846,15 @@ ><p class="src" ><a href="#" >bar'</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a - > [a]) -> <a href="#" title="GHC.Maybe" + > [a]) -> <a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > b)) <a href="#" class="selflink" >#</a @@ -862,13 +862,13 @@ ><p class="src" ><a href="#" >bar0</a - > :: (<a href="#" title="GHC.Maybe" + > :: (<a href="#" title="Data.Maybe" >Maybe</a - > [a], <a href="#" title="GHC.Maybe" + > [a], <a href="#" title="Data.Maybe" >Maybe</a - > [a]) -> (<a href="#" title="GHC.Maybe" + > [a]) -> (<a href="#" title="Data.Maybe" >Maybe</a - > b, <a href="#" title="GHC.Maybe" + > b, <a href="#" title="Data.Maybe" >Maybe</a > c) <a href="#" class="selflink" >#</a @@ -876,13 +876,13 @@ ><p class="src" ><a href="#" >bar1</a - > :: (<a href="#" title="GHC.Maybe" + > :: (<a href="#" title="Data.Maybe" >Maybe</a - > [a], <a href="#" title="GHC.Maybe" + > [a], <a href="#" title="Data.Maybe" >Maybe</a - > [a]) -> (<a href="#" title="GHC.Maybe" + > [a]) -> (<a href="#" title="Data.Maybe" >Maybe</a - > b, <a href="#" title="GHC.Maybe" + > b, <a href="#" title="Data.Maybe" >Maybe</a > c) <a href="#" class="selflink" >#</a @@ -2038,8 +2038,6 @@ >Int</a > c <a href="#" title="Data.Bool" >Bool</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -2050,9 +2048,7 @@ >Thud</a > <a href="#" title="Data.Int" >Int</a - > c :: <a href="#" title="Data.Kind" - >Type</a - > <a href="#" class="selflink" + > c <a href="#" class="selflink" >#</a ></p ></div @@ -2112,9 +2108,7 @@ >type</span > <a href="#" title="Instances" >Plugh</a - > [a] c [b] :: <a href="#" title="Data.Kind" - >Type</a - > <a href="#" class="selflink" + > [a] c [b] <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -2122,9 +2116,7 @@ >data</span > <a href="#" title="Instances" >Thud</a - > [a] c :: <a href="#" title="Data.Kind" - >Type</a - > <a href="#" class="selflink" + > [a] c <a href="#" class="selflink" >#</a ></p ></div diff --git a/html-test/ref/NamespacedIdentifiers.html b/html-test/ref/NamespacedIdentifiers.html new file mode 100644 index 00000000..c005727a --- /dev/null +++ b/html-test/ref/NamespacedIdentifiers.html @@ -0,0 +1,146 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >NamespacedIdentifiers</title + ><link href="linuwial.css" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="quick-jump.css" + /><link rel="stylesheet" type="text/css" href="https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="index.html" + >Contents</a + ></li + ><li + ><a href="doc-index.html" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >NamespacedIdentifiers</p + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#t:Foo" + >Foo</a + > = <a href="#v:Bar" + >Bar</a + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#t:Bar" + >Bar</a + ></li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Foo" class="def" + >Foo</a + > <a href="#t:Foo" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A link to:</p + ><ul + ><li + >the type <code + ><a href="NamespacedIdentifiers.html#t:Bar" title="NamespacedIdentifiers" + >Bar</a + ></code + ></li + ><li + >the constructor <code + ><a href="NamespacedIdentifiers.html#v:Bar" title="NamespacedIdentifiers" + >Bar</a + ></code + ></li + ><li + >the unimported but qualified type <code + ><a href="A.html#t:A" title="A" + >A</a + ></code + ></li + ><li + >the unimported but qualified value <code + ><a href="A.html#v:A" title="A" + >A</a + ></code + ></li + ></ul + ></div + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:Bar" class="def" + >Bar</a + ></td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Bar" class="def" + >Bar</a + > <a href="#t:Bar" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >A link to the value <code + >Foo</code + > (which shouldn't exist).</p + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html index 7eca93e4..6a185b8a 100644 --- a/html-test/ref/Operators.html +++ b/html-test/ref/Operators.html @@ -96,9 +96,7 @@ >pattern</span > <a href="#" >(:+)</a - > :: <span class="keyword" - >forall</span - > a. a -> a -> [a]</li + > :: a -> a -> [a]</li ><li class="src short" ><span class="keyword" >data</span @@ -285,9 +283,7 @@ >pattern</span > <a id="v::-43-" class="def" >(:+)</a - > :: <span class="keyword" - >forall</span - > a. a -> a -> [a] <span class="fixity" + > :: a -> a -> [a] <span class="fixity" >infixr 3</span ><span class="rightedge" ></span diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 7e10b755..249a6e12 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -68,9 +68,7 @@ >pattern</span > <a href="#" >Foo</a - > :: <span class="keyword" - >forall</span - > x. x -> <a href="#" title="PatternSyns" + > :: x -> <a href="#" title="PatternSyns" >FooType</a > x</li ><li class="src short" @@ -78,9 +76,7 @@ >pattern</span > <a href="#" >Bar</a - > :: <span class="keyword" - >forall</span - > x. x -> <a href="#" title="PatternSyns" + > :: x -> <a href="#" title="PatternSyns" >FooType</a > (<a href="#" title="PatternSyns" >FooType</a @@ -90,9 +86,7 @@ >pattern</span > <a href="#" >(:<->)</a - > :: <span class="keyword" - >forall</span - > x x1. x -> x1 -> (<a href="#" title="PatternSyns" + > :: x -> x1 -> (<a href="#" title="PatternSyns" >FooType</a > x, <a href="#" title="PatternSyns" >FooType</a @@ -116,9 +110,7 @@ >pattern</span > <a href="#" >Blub</a - > :: () => <span class="keyword" - >forall</span - > x. <a href="#" title="Text.Show" + > :: () => <a href="#" title="Text.Show" >Show</a > x => x -> <a href="#" title="PatternSyns" >BlubType</a @@ -136,9 +128,7 @@ >pattern</span > <a href="#" >E</a - > :: <span class="keyword" - >forall</span - > k a (b :: k). a <a href="#" title="PatternSyns" + > :: a <a href="#" title="PatternSyns" >><</a > b</li ><li class="src short" @@ -191,9 +181,7 @@ >pattern</span > <a id="v:Foo" class="def" >Foo</a - > :: <span class="keyword" - >forall</span - > x. x -> <a href="#" title="PatternSyns" + > :: x -> <a href="#" title="PatternSyns" >FooType</a > x <a href="#" class="selflink" >#</a @@ -213,9 +201,7 @@ >pattern</span > <a id="v:Bar" class="def" >Bar</a - > :: <span class="keyword" - >forall</span - > x. x -> <a href="#" title="PatternSyns" + > :: x -> <a href="#" title="PatternSyns" >FooType</a > (<a href="#" title="PatternSyns" >FooType</a @@ -237,9 +223,7 @@ >pattern</span > <a id="v::-60--45--62-" class="def" >(:<->)</a - > :: <span class="keyword" - >forall</span - > x x1. x -> x1 -> (<a href="#" title="PatternSyns" + > :: x -> x1 -> (<a href="#" title="PatternSyns" >FooType</a > x, <a href="#" title="PatternSyns" >FooType</a @@ -295,9 +279,7 @@ >pattern</span > <a id="v:Blub" class="def" >Blub</a - > :: () => <span class="keyword" - >forall</span - > x. <a href="#" title="Text.Show" + > :: () => <a href="#" title="Text.Show" >Show</a > x => x -> <a href="#" title="PatternSyns" >BlubType</a @@ -351,9 +333,7 @@ >pattern</span > <a id="v:E" class="def" >E</a - > :: <span class="keyword" - >forall</span - > k a (b :: k). a <a href="#" title="PatternSyns" + > :: a <a href="#" title="PatternSyns" >><</a > b <a href="#" class="selflink" >#</a diff --git a/html-test/ref/PromotedTypes.html b/html-test/ref/PromotedTypes.html index 80a0ff7e..e002ab4a 100644 --- a/html-test/ref/PromotedTypes.html +++ b/html-test/ref/PromotedTypes.html @@ -108,7 +108,7 @@ ><td class="src" ><a id="v:Cons" class="def" >Cons</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > h -> <a href="#" title="PromotedTypes" >Pattern</a @@ -154,7 +154,7 @@ ><td class="src" ><a id="v:RevCons" class="def" >RevCons</a - > :: <a href="#" title="GHC.Maybe" + > :: <a href="#" title="Data.Maybe" >Maybe</a > h -> <a href="#" title="PromotedTypes" >RevPattern</a diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html index 183a466c..2115d14f 100644 --- a/html-test/ref/Test.html +++ b/html-test/ref/Test.html @@ -173,7 +173,7 @@ >A</a > <a href="#" title="Data.Int" >Int</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Prelude" >Float</a @@ -724,7 +724,7 @@ >A</a > <a href="#" title="Data.Int" >Int</a - > (<a href="#" title="GHC.Maybe" + > (<a href="#" title="Data.Maybe" >Maybe</a > <a href="#" title="Prelude" >Float</a @@ -2376,7 +2376,7 @@ is at the beginning of the line).</pre >f'</a ></code > - but f' doesn't get link'd 'f\''</p + but f' doesn't get link'd 'f''</p ></div ></div ><div class="top" diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index f857df2a..135f29c2 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -224,11 +224,11 @@ ><span class="inst-left" ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:X:-62--60-:1" ></span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a > <a href="#" title="TypeFamilies" >><</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a ></span > <a href="#" class="selflink" @@ -286,8 +286,6 @@ >AssocD</a > <a href="#" title="TypeFamilies" >X</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -298,8 +296,6 @@ >AssocT</a > <a href="#" title="TypeFamilies" >X</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -386,11 +382,11 @@ ></span > <span class="keyword" >type</span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a > <a href="#" title="TypeFamilies" ><></a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a ></span > <a href="#" class="selflink" @@ -411,13 +407,13 @@ > <div class="src" ><span class="keyword" >type</span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a > <a href="#" title="TypeFamilies" ><></a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a - > = <a href="#" title="TypeFamilies" + > = '<a href="#" title="TypeFamilies" >X</a ></div ></details @@ -497,13 +493,13 @@ >AssocT</a > <a href="#" title="TypeFamilies" >X</a - > = (<a href="#" title="TypeFamilies" + > = <a href="#" title="TypeFamilies" >Foo</a > <a href="#" title="TypeFamilies" >X</a > :: <a href="#" title="Data.Kind" >Type</a - >)</div + ></div ></details ></td ></tr @@ -720,8 +716,6 @@ >AssocD</a > <a href="#" title="TypeFamilies" >Y</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -732,8 +726,6 @@ >AssocT</a > <a href="#" title="TypeFamilies" >Y</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -1107,27 +1099,19 @@ ><li class="inst" ><a id="v:BatZ1" class="def" >BatZ1</a - > :: <span class="keyword" - >forall</span - > (z :: <a href="#" title="TypeFamilies" - >Z</a - >). <a href="#" title="TypeFamilies" + > :: <a href="#" title="TypeFamilies" >Z</a > -> <a href="#" title="TypeFamilies" >Bat</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >ZA</a ></li ><li class="inst" ><a id="v:BatZ2" class="def" >BatZ2</a - > :: <span class="keyword" - >forall</span - > (z :: <a href="#" title="TypeFamilies" - >Z</a - >). {..} -> <a href="#" title="TypeFamilies" + > :: {..} -> <a href="#" title="TypeFamilies" >Bat</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >ZB</a ></li ></ul @@ -1393,27 +1377,19 @@ ><li class="inst" ><a id="v:BatZ1" class="def" >BatZ1</a - > :: <span class="keyword" - >forall</span - > (z :: <a href="#" title="TypeFamilies" - >Z</a - >). <a href="#" title="TypeFamilies" + > :: <a href="#" title="TypeFamilies" >Z</a > -> <a href="#" title="TypeFamilies" >Bat</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >ZA</a ></li ><li class="inst" ><a id="v:BatZ2" class="def" >BatZ2</a - > :: <span class="keyword" - >forall</span - > (z :: <a href="#" title="TypeFamilies" - >Z</a - >). {..} -> <a href="#" title="TypeFamilies" + > :: {..} -> <a href="#" title="TypeFamilies" >Bat</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >ZB</a ></li ></ul @@ -1620,8 +1596,6 @@ >AssocD</a > <a href="#" title="TypeFamilies" >Y</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -1632,8 +1606,6 @@ >AssocT</a > <a href="#" title="TypeFamilies" >Y</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -1678,8 +1650,6 @@ >AssocD</a > <a href="#" title="TypeFamilies" >X</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -1690,8 +1660,6 @@ >AssocT</a > <a href="#" title="TypeFamilies" >X</a - > :: <a href="#" title="Data.Kind" - >Type</a > <a href="#" class="selflink" >#</a ></p @@ -1770,11 +1738,11 @@ ></span > <span class="keyword" >type</span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a > <a href="#" title="TypeFamilies" ><></a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a ></span > <a href="#" class="selflink" @@ -1795,13 +1763,13 @@ > <div class="src" ><span class="keyword" >type</span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a > <a href="#" title="TypeFamilies" ><></a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a - > = <a href="#" title="TypeFamilies" + > = '<a href="#" title="TypeFamilies" >X</a ></div ></details @@ -1918,11 +1886,11 @@ ><span class="inst-left" ><span class="instance details-toggle-control details-toggle" data-details-id="i:ic:-62--60-:-62--60-:1" ></span - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XX</a > <a href="#" title="TypeFamilies" >><</a - > <a href="#" title="TypeFamilies" + > '<a href="#" title="TypeFamilies" >XXX</a ></span > <a href="#" class="selflink" diff --git a/html-test/ref/UnboxedStuff.html b/html-test/ref/UnboxedStuff.html new file mode 100644 index 00000000..cb688cdb --- /dev/null +++ b/html-test/ref/UnboxedStuff.html @@ -0,0 +1,202 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><meta name="viewport" content="width=device-width, initial-scale=1" + /><title + >UnboxedStuff</title + ><link href="#" rel="stylesheet" type="text/css" title="Linuwial" + /><link rel="stylesheet" type="text/css" href="#" + /><link rel="stylesheet" type="text/css" href="#" + /><script src="haddock-bundle.min.js" async="async" type="text/javascript" + ></script + ><script type="text/x-mathjax-config" + >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ></head + ><body + ><div id="package-header" + ><span class="caption empty" + ></span + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >UnboxedStuff</p + ></div + ><div id="table-of-contents" + ><div id="contents-list" + ><p class="caption" onclick="window.scrollTo(0,0)" + >Contents</p + ><ul + ><li + ><a href="#" + >Unboxed type constructors</a + ></li + ></ul + ></div + ></div + ><div id="synopsis" + ><details id="syn" + ><summary + >Synopsis</summary + ><ul class="details-toggle" data-details-id="syn" + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >X</a + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >Y</a + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >Z</a + ></li + ><li class="src short" + ><a href="#" + >unboxedUnit</a + > :: (# #) -> (# #)</li + ><li class="src short" + ><a href="#" + >unboxedTuple</a + > :: (# <a href="#" title="UnboxedStuff" + >X</a + >, <a href="#" title="UnboxedStuff" + >Y</a + > #) -> (# <a href="#" title="UnboxedStuff" + >X</a + >, <a href="#" title="UnboxedStuff" + >Y</a + >, <a href="#" title="UnboxedStuff" + >Z</a + > #)</li + ><li class="src short" + ><a href="#" + >unboxedSum</a + > :: (# <a href="#" title="UnboxedStuff" + >X</a + > | <a href="#" title="UnboxedStuff" + >Y</a + > #) -> (# <a href="#" title="UnboxedStuff" + >X</a + > | <a href="#" title="UnboxedStuff" + >Y</a + > | <a href="#" title="UnboxedStuff" + >Z</a + > #)</li + ></ul + ></details + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:X" class="def" + >X</a + > <a href="#" class="selflink" + >#</a + ></p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Y" class="def" + >Y</a + > <a href="#" class="selflink" + >#</a + ></p + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:Z" class="def" + >Z</a + > <a href="#" class="selflink" + >#</a + ></p + ></div + ><a href="#" id="g:1" + ><h1 + >Unboxed type constructors</h1 + ></a + ><div class="top" + ><p class="src" + ><a id="v:unboxedUnit" class="def" + >unboxedUnit</a + > :: (# #) -> (# #) <a href="#" class="selflink" + >#</a + ></p + ></div + ><div class="top" + ><p class="src" + ><a id="v:unboxedTuple" class="def" + >unboxedTuple</a + > :: (# <a href="#" title="UnboxedStuff" + >X</a + >, <a href="#" title="UnboxedStuff" + >Y</a + > #) -> (# <a href="#" title="UnboxedStuff" + >X</a + >, <a href="#" title="UnboxedStuff" + >Y</a + >, <a href="#" title="UnboxedStuff" + >Z</a + > #) <a href="#" class="selflink" + >#</a + ></p + ></div + ><div class="top" + ><p class="src" + ><a id="v:unboxedSum" class="def" + >unboxedSum</a + > :: (# <a href="#" title="UnboxedStuff" + >X</a + > | <a href="#" title="UnboxedStuff" + >Y</a + > #) -> (# <a href="#" title="UnboxedStuff" + >X</a + > | <a href="#" title="UnboxedStuff" + >Y</a + > | <a href="#" title="UnboxedStuff" + >Z</a + > #) <a href="#" class="selflink" + >#</a + ></p + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/src/Bug1035.hs b/html-test/src/Bug1035.hs new file mode 100644 index 00000000..3516c08f --- /dev/null +++ b/html-test/src/Bug1035.hs @@ -0,0 +1,9 @@ +module Bug1035 where + +data Foo = Bar + +data Bar = Foo + +-- | A link to 'Bar' +foo :: () +foo = () diff --git a/html-test/src/Bug865.hs b/html-test/src/Bug865.hs new file mode 100644 index 00000000..71a6add1 --- /dev/null +++ b/html-test/src/Bug865.hs @@ -0,0 +1,9 @@ +module Bug865 where + +-- | An emphasized link [yes /this/ is emphasized while this is +-- @monospaced@](https://www.haskell.org/). And here is an image: +-- +--  +-- +link :: () +link = () diff --git a/html-test/src/Bug923.hs b/html-test/src/Bug923.hs new file mode 100644 index 00000000..bb5bca0a --- /dev/null +++ b/html-test/src/Bug923.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE KindSignatures, FlexibleInstances, GADTs, DataKinds #-} +module Bug923 where + +-- | A promoted tuple type +data T :: (* -> (*,*)) -> * where + T :: a -> T ('(,) a) + +-- | A promoted tuple type in an instance +instance Eq a => Eq (T ('(,) a)) where + T x == T y = x == y + diff --git a/html-test/src/Identifiers.hs b/html-test/src/Identifiers.hs new file mode 100644 index 00000000..75f12109 --- /dev/null +++ b/html-test/src/Identifiers.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeOperators #-} +module Identifiers where + +import Data.List (elem, (++)) + +data Id = Id +data a :* b = a :* b + +{-| + + * Unadorned: + + - Unqualified: '++', 'elem' + - Qualified: 'Data.List.++', 'Data.Lis.elem' + - Namespaced: v'++', t'++', v'elem', t'elem', v'Id', t'Id', v':*', t':*' + + * Parenthesized: + + - Unqualified: @'(++)' [1,2,3] [4,5,6]@ + - Qualified: @'(Data.List.++)' [1,2,3] [4,5,6]@ + - Namespaced: v'(++)', t'++', v'(:*)', t'(:*)' + + * Backticked: + + - Unqualified: @1 '`elem`' [-3..3]@ + - Qualified: @1 '`Data.List.elem`' [-3..3]@ + - Namespaced: v'`elem`', t'`elem`', v'`Id`', t'`Id`' + + * Edge cases: + + - Tuples: '()', '(,,,)' + +-} +foo :: () +foo = () diff --git a/html-test/src/NamespacedIdentifiers.hs b/html-test/src/NamespacedIdentifiers.hs new file mode 100644 index 00000000..6f59d247 --- /dev/null +++ b/html-test/src/NamespacedIdentifiers.hs @@ -0,0 +1,13 @@ +module NamespacedIdentifiers where + +-- | A link to: +-- +-- * the type t'Bar' +-- * the constructor v'Bar' +-- * the unimported but qualified type t'A.A' +-- * the unimported but qualified value v'A.A' +-- +data Foo = Bar + +-- | A link to the value v'Foo' (which shouldn't exist). +data Bar diff --git a/html-test/src/UnboxedStuff.hs b/html-test/src/UnboxedStuff.hs new file mode 100644 index 00000000..bd1b1302 --- /dev/null +++ b/html-test/src/UnboxedStuff.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples #-} +module UnboxedStuff where + +data X +data Y +data Z + +-- * Unboxed type constructors + +unboxedUnit :: (# #) -> (# #) +unboxedUnit = undefined + +unboxedTuple :: (# X, Y #) -> (# X, Y, Z #) +unboxedTuple = undefined + +unboxedSum :: (# X | Y #) -> (# X | Y | Z #) +unboxedSum = undefined + diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs index d3ab79a8..1963753d 100644 --- a/hypsrc-test/Main.hs +++ b/hypsrc-test/Main.hs @@ -15,14 +15,23 @@ import Test.Haddock.Xhtml checkConfig :: CheckConfig Xml checkConfig = CheckConfig { ccfgRead = parseXml - , ccfgClean = \_ -> strip + , ccfgClean = strip , ccfgDump = dumpXml , ccfgEqual = (==) `on` dumpXml } where - strip = stripAnchors' . stripLinks' . stripFooter + -- The whole point of the ClangCppBug is to demonstrate a situation where + -- line numbers may vary (and test that links still work). Consequently, we + -- strip out line numbers for this test case. + strip f | takeBaseName f == "ClangCppBug" + = stripAnchors' . stripLinks' . stripIds' . stripIds'' . stripFooter + | otherwise + = stripAnchors' . stripLinks' . stripIds' . stripFooter + stripLinks' = stripLinksWhen $ \href -> "#local-" `isPrefixOf` href stripAnchors' = stripAnchorsWhen $ \name -> "local-" `isPrefixOf` name + stripIds' = stripIdsWhen $ \name -> "local-" `isPrefixOf` name + stripIds'' = stripIdsWhen $ \name -> "line-" `isPrefixOf` name dirConfig :: DirConfig diff --git a/hypsrc-test/ref/src/CPP.html b/hypsrc-test/ref/src/CPP.html index fb85bd2f..2ebcae90 100644 --- a/hypsrc-test/ref/src/CPP.html +++ b/hypsrc-test/ref/src/CPP.html @@ -11,8 +11,8 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span class="hs-keyword" >module</span ><span @@ -23,45 +23,48 @@ > </span ><span class="hs-keyword" >where</span - ><span - > -</span - ><a name="line-3" - ></a - ><span - > -</span - ><a name="line-4" - ></a ><span class="hs-cpp" - >#define SOMETHING1 + > + +#define SOMETHING1 </span ><span > </span - ><a name="line-6" - ></a - ><span class="hs-identifier" - >foo</span + ><span id="line-6" + ></span + ><span class="annot" + ><a href="CPP.html#foo" + ><span class="hs-identifier hs-type" + >foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >String</span + >String</span + ></span ><span > </span - ><a name="line-7" - ></a - ><a name="foo" - ><a href="CPP.html#foo" - ><span class="hs-identifier" - >foo</span - ></a - ></a + ><span id="line-7" + ></span + ><span id="foo" + ><span class="annot" + ><span class="annottext" + >foo :: String +</span + ><a href="CPP.html#foo" + ><span class="hs-identifier hs-var hs-var" + >foo</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -74,142 +77,150 @@ -}</span ><span > </span + ><span class="annot" ><span class="hs-string" - >"foo"</span - ><span - > -</span - ><a name="line-10" - ></a - ><span - > -</span - ><a name="line-11" - ></a + >"foo"</span + ></span ><span class="hs-cpp" - >#define SOMETHING2 + > + +#define SOMETHING2 </span ><span > </span - ><a name="line-13" - ></a - ><span class="hs-identifier" - >bar</span + ><span id="line-13" + ></span + ><span class="annot" + ><a href="CPP.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >String</span + >String</span + ></span ><span > </span - ><a name="line-14" - ></a - ><a name="bar" - ><a href="CPP.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a + ><span id="line-14" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: String +</span + ><a href="CPP.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-string" - >"block comment in a string is not a comment {- "</span - ><span - > -</span - ><a name="line-15" - ></a - ><span - > -</span - ><a name="line-16" - ></a + >"block comment in a string is not a comment {- "</span + ></span ><span class="hs-cpp" - >#define SOMETHING3 + > + +#define SOMETHING3 </span ><span > </span - ><a name="line-18" - ></a + ><span id="line-18" + ></span ><span class="hs-comment" >-- " single quotes are fine in line comments</span ><span > </span - ><a name="line-19" - ></a + ><span id="line-19" + ></span ><span class="hs-comment" >-- {- unclosed block comments are fine in line comments</span ><span > </span - ><a name="line-20" - ></a + ><span id="line-20" + ></span ><span > </span - ><a name="line-21" - ></a + ><span id="line-21" + ></span ><span class="hs-comment" >-- Multiline CPP is also fine</span - ><span - > -</span - ><a name="line-22" - ></a ><span class="hs-cpp" - >#define FOO\ + > +#define FOO\ 1 </span ><span > </span - ><a name="line-25" - ></a - ><span class="hs-identifier" - >baz</span + ><span id="line-25" + ></span + ><span class="annot" + ><a href="CPP.html#baz" + ><span class="hs-identifier hs-type" + >baz</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >String</span + >String</span + ></span ><span > </span - ><a name="line-26" - ></a - ><a name="baz" - ><a href="CPP.html#baz" - ><span class="hs-identifier" - >baz</span - ></a - ></a + ><span id="line-26" + ></span + ><span id="baz" + ><span class="annot" + ><span class="annottext" + >baz :: String +</span + ><a href="CPP.html#baz" + ><span class="hs-identifier hs-var hs-var" + >baz</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-string" - >"line comment in a string is not a comment --"</span + >"line comment in a string is not a comment --"</span + ></span ><span > </span - ><a name="line-27" - ></a + ><span id="line-27" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/ClangCppBug.html b/hypsrc-test/ref/src/ClangCppBug.html new file mode 100644 index 00000000..d03c92e1 --- /dev/null +++ b/hypsrc-test/ref/src/ClangCppBug.html @@ -0,0 +1,306 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><link rel="stylesheet" type="text/css" href="style.css" + /><script type="text/javascript" src="highlight.js" + ></script + ></head + ><body + ><pre + ><span class="hs-pragma" + >{-# LANGUAGE CPP #-}</span + ><span + > +</span + ><span id="" + ></span + ><span class="hs-keyword" + >module</span + ><span + > </span + ><span class="hs-identifier" + >ClangCppBug</span + ><span + > </span + ><span class="hs-keyword" + >where</span + ><span + > +</span + ><span id="" + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="annot" + ><a href="ClangCppBug.html#foo" + ><span class="hs-identifier hs-type" + >foo</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > +</span + ><span id="" + ></span + ><span id="foo" + ><span class="annot" + ><span class="annottext" + >foo :: Int +</span + ><a href="ClangCppBug.html#foo" + ><span class="hs-identifier hs-var hs-var" + >foo</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >1</span + ></span + ><span + > +</span + ><span id="" + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="hs-comment" + >-- Clang doesn't mind these:</span + ><span class="hs-cpp" + > +#define BAX 2 +</span + ><span class="hs-pragma" + >{-# INLINE</span + ><span + > </span + ><span class="annot" + ><a href="ClangCppBug.html#bar" + ><span class="hs-pragma hs-type" + >bar</span + ></a + ></span + ><span + > </span + ><span class="hs-pragma" + >#-}</span + ><span + > +</span + ><span id="" + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="annot" + ><a href="ClangCppBug.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > +</span + ><span id="" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: Int +</span + ><a href="ClangCppBug.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >3</span + ></span + ><span + > +</span + ><span id="" + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="hs-comment" + >-- But it doesn't like this:</span + ><span + > +</span + ><span id="" + ></span + ><span class="hs-pragma" + >{-# RULES</span + ><span + > +</span + ><span id="" + ></span + ><span class="annot" + ><span class="hs-pragma" + >"bar/qux"</span + ></span + ><span + > </span + ><span class="annot" + ><a href="ClangCppBug.html#bar" + ><span class="hs-pragma hs-type" + >bar</span + ></a + ></span + ><span + > </span + ><span class="hs-pragma" + >=</span + ><span + > </span + ><span class="annot" + ><a href="ClangCppBug.html#qux" + ><span class="hs-pragma hs-type" + >qux</span + ></a + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="annot" + ><span class="hs-pragma" + >"qux/foo"</span + ></span + ><span + > </span + ><span class="annot" + ><a href="ClangCppBug.html#qux" + ><span class="hs-pragma hs-type" + >qux</span + ></a + ></span + ><span + > </span + ><span class="hs-pragma" + >=</span + ><span + > </span + ><span class="annot" + ><a href="ClangCppBug.html#foo" + ><span class="hs-pragma hs-type" + >foo</span + ></a + ></span + ><span + > +</span + ><span id="" + ></span + ><span + > </span + ><span class="hs-pragma" + >#-}</span + ><span + > +</span + ><span id="" + ></span + ><span + > +</span + ><span id="" + ></span + ><span class="annot" + ><a href="ClangCppBug.html#qux" + ><span class="hs-identifier hs-type" + >qux</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > +</span + ><span id="" + ></span + ><span id="qux" + ><span class="annot" + ><span class="annottext" + >qux :: Int +</span + ><a href="ClangCppBug.html#qux" + ><span class="hs-identifier hs-var hs-var" + >qux</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >88</span + ></span + ><span + > +</span + ><span id="" + ></span + ></pre + ></body + ></html +>
\ No newline at end of file diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html index d2604e82..443d7f96 100644 --- a/hypsrc-test/ref/src/Classes.html +++ b/hypsrc-test/ref/src/Classes.html @@ -19,36 +19,40 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a + ><span id="line-4" + ></span ><span class="hs-keyword" >class</span ><span > </span - ><a name="Foo" - ><a href="Classes.html#Foo" - ><span class="hs-identifier" - >Foo</span - ></a - ></a + ><span id="Foo" + ><span class="annot" + ><a href="Classes.html#Foo" + ><span class="hs-identifier hs-var" + >Foo</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span ><span class="hs-keyword" @@ -56,55 +60,65 @@ ><span > </span - ><a name="line-5" - ></a + ><span id="line-5" + ></span ><span > </span - ><a name="bar" - ><a href="Classes.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a + ><span id="bar" + ><span class="annot" + ><a href="Classes.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span - ><a name="baz" - ><a href="Classes.html#baz" - ><span class="hs-identifier" - >baz</span - ></a - ></a + ><span id="baz" + ><span class="annot" + ><a href="Classes.html#baz" + ><span class="hs-identifier hs-type" + >baz</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" @@ -113,42 +127,50 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-7" - ></a + ><span id="line-7" + ></span ><span > </span - ><a name="line-8" - ></a + ><span id="line-8" + ></span ><span class="hs-keyword" >instance</span ><span > </span + ><span class="annot" ><a href="Classes.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-keyword" @@ -156,45 +178,66 @@ ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >bar :: Int -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >id</span + ><span class="annot" + ><span class="annottext" + >Int -> Int +forall a. a -> a +</span + ><span class="hs-identifier hs-var" + >id</span + ></span ><span > </span - ><a name="line-10" - ></a + ><span id="line-10" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#baz" - ><span class="hs-identifier" - >baz</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >baz :: Int -> (Int, Int) +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >baz</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -203,161 +246,201 @@ > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-11" - ></a + ><span id="line-11" + ></span ><span > </span - ><a name="line-12" - ></a + ><span id="line-12" + ></span + ><span id="" ><span class="hs-keyword" - >instance</span - ><span - > </span - ><a href="Classes.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-keyword" - >where</span - ><span - > + >instance</span + ><span + > </span + ><span class="annot" + ><a href="Classes.html#Foo" + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-keyword" + >where</span + ><span + > </span - ><a name="line-13" - ></a - ><span - > </span - ><a name="" - ><a href="Classes.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >length</span - ><span - > + ><span id="line-13" + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >bar :: [a] -> Int </span - ><a name="line-14" - ></a - ><span - > </span - ><a name="" - ><a href="Classes.html#baz" + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >bar</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >[a] -> Int +forall (t :: * -> *) a. Foldable t => t a -> Int +</span + ><span class="hs-identifier hs-var" + >length</span + ></span + ><span + > +</span + ><span id="line-14" + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >baz :: Int -> ([a], [a]) +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >baz</span + ></a + ></span + ></span + ><span + > </span ><span class="hs-identifier" - >baz</span - ></a - ></a - ><span - > </span - ><span class="hs-identifier" - >_</span - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-special" - >(</span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >]</span - ><span class="hs-special" - >,</span - ><span - > </span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >]</span - ><span class="hs-special" - >)</span + >_</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >)</span + ></span ><span > </span - ><a name="line-15" - ></a + ><span id="line-15" + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a + ><span id="line-17" + ></span ><span class="hs-keyword" >class</span ><span > </span + ><span class="annot" ><a href="Classes.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=></span ><span > </span - ><a name="Foo%27" - ><a href="Classes.html#Foo%27" - ><span class="hs-identifier" - >Foo'</span - ></a - ></a + ><span id="Foo%27" + ><span class="annot" + ><a href="Classes.html#Foo%27" + ><span class="hs-identifier hs-var" + >Foo'</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span ><span class="hs-keyword" @@ -365,16 +448,18 @@ ><span > </span - ><a name="line-18" - ></a + ><span id="line-18" + ></span ><span > </span - ><a name="quux" - ><a href="Classes.html#quux" - ><span class="hs-identifier" - >quux</span - ></a - ></a + ><span id="quux" + ><span class="annot" + ><a href="Classes.html#quux" + ><span class="hs-identifier hs-type" + >quux</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -383,18 +468,22 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -403,91 +492,123 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span - ><a name="line-19" - ></a + ><span id="line-19" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#quux" - ><span class="hs-identifier" - >quux</span - ></a - ></a - ><span - > </span - ><span class="hs-special" - >(</span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span class="hs-special" - >,</span - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="Classes.html#norf" - ><span class="hs-identifier hs-var" - >norf</span - ></a - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a - ><span class="hs-special" - >,</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a - ><span class="hs-special" - >]</span + ><span id="" + ><span class="annot" + ><a href="Classes.html#quux" + ><span class="hs-identifier hs-var hs-var" + >quux</span + ></a + ></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >[a] -> a +forall a. Foo' a => [a] -> a +</span + ><a href="Classes.html#norf" + ><span class="hs-identifier hs-var" + >norf</span + ></a + ></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span ><span > </span - ><a name="line-20" - ></a + ><span id="line-20" + ></span ><span > </span - ><a name="line-21" - ></a + ><span id="line-21" + ></span ><span > </span - ><a name="norf" - ><a href="Classes.html#norf" - ><span class="hs-identifier" - >norf</span - ></a - ></a + ><span id="norf" + ><span class="annot" + ><a href="Classes.html#norf" + ><span class="hs-identifier hs-type" + >norf</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -496,10 +617,12 @@ > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >]</span ><span @@ -508,87 +631,145 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span - ><a name="line-22" - ></a + ><span id="line-22" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#norf" - ><span class="hs-identifier" - >norf</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="Classes.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a - ><span - > </span - ><span class="hs-operator hs-var" - >.</span - ><span - > </span - ><a href="Classes.html#baz" - ><span class="hs-identifier hs-var" - >baz</span - ></a - ><span - > </span - ><span class="hs-operator hs-var" - >.</span - ><span - > </span - ><span class="hs-identifier hs-var" - >sum</span - ><span - > </span - ><span class="hs-operator hs-var" - >.</span - ><span - > </span - ><span class="hs-identifier hs-var" - >map</span - ><span - > </span - ><a href="Classes.html#bar" - ><span class="hs-identifier hs-var" - >bar</span - ></a + ><span id="" + ><span class="annot" + ><a href="Classes.html#norf" + ><span class="hs-identifier hs-var hs-var" + >norf</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >(a, a) -> a +forall a. Foo' a => (a, a) -> a +</span + ><a href="Classes.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >((a, a) -> a) -> ([a] -> (a, a)) -> [a] -> a +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> (a, a) +forall a. Foo a => Int -> (a, a) +</span + ><a href="Classes.html#baz" + ><span class="hs-identifier hs-var" + >baz</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >(Int -> (a, a)) -> ([a] -> Int) -> [a] -> (a, a) +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >[Int] -> Int +forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a +</span + ><span class="hs-identifier hs-var" + >sum</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >(a -> Int) -> [a] -> [Int] +forall a b. (a -> b) -> [a] -> [b] +</span + ><span class="hs-identifier hs-var" + >map</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >a -> Int +forall a. Foo a => a -> Int +</span + ><a href="Classes.html#bar" + ><span class="hs-identifier hs-var" + >bar</span + ></a + ></span + ></span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ><span > </span - ><a name="line-24" - ></a + ><span id="line-24" + ></span ><span class="hs-keyword" >instance</span ><span > </span - ><a href="Classes.html#Foo%27" - ><span class="hs-identifier hs-type" - >Foo'</span - ></a - ><span - > </span - ><span class="hs-identifier hs-type" - >Int</span + ><span id="" + ><span class="annot" + ><a href="Classes.html#Foo%27" + ><span class="hs-identifier hs-type" + >Foo'</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ></span ><span > </span ><span class="hs-keyword" @@ -596,118 +777,154 @@ ><span > </span - ><a name="line-25" - ></a + ><span id="line-25" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#norf" - ><span class="hs-identifier" - >norf</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >norf :: [Int] -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >norf</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >sum</span + ><span class="annot" + ><span class="annottext" + >[Int] -> Int +forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a +</span + ><span class="hs-identifier hs-var" + >sum</span + ></span ><span > </span - ><a name="line-26" - ></a + ><span id="line-26" + ></span ><span > </span - ><a name="line-27" - ></a - ><span class="hs-keyword" - >instance</span - ><span - > </span - ><a href="Classes.html#Foo%27" - ><span class="hs-identifier hs-type" - >Foo'</span - ></a - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span + ><span id="line-27" + ></span + ><span id="" ><span class="hs-keyword" - >where</span - ><span - > + >instance</span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="Classes.html#Foo%27" + ><span class="hs-identifier hs-type" + >Foo'</span + ></a + ></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span + ><span + > </span + ><span class="hs-keyword" + >where</span + ><span + > </span - ><a name="line-28" - ></a - ><span - > </span - ><a name="" - ><a href="Classes.html#quux" - ><span class="hs-identifier" - >quux</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >uncurry</span - ><span - > </span - ><span class="hs-special" - >(</span - ><span class="hs-operator hs-var" - >++</span - ><span class="hs-special" - >)</span + ><span id="line-28" + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >quux :: ([a], [a]) -> [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >quux</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >([a] -> [a] -> [a]) -> ([a], [a]) -> [a] +forall a b c. (a -> b -> c) -> (a, b) -> c +</span + ><span class="hs-identifier hs-var" + >uncurry</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><span class="hs-operator hs-var" + >(++)</span + ></span + ></span ><span > </span - ><a name="line-29" - ></a + ><span id="line-29" + ></span ><span > </span - ><a name="line-30" - ></a + ><span id="line-30" + ></span ><span > </span - ><a name="line-31" - ></a + ><span id="line-31" + ></span ><span class="hs-keyword" >class</span ><span > </span - ><a name="Plugh" - ><a href="Classes.html#Plugh" - ><span class="hs-identifier" - >Plugh</span - ></a - ></a + ><span id="Plugh" + ><span class="annot" + ><a href="Classes.html#Plugh" + ><span class="hs-identifier hs-var" + >Plugh</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >p</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >p</span + ></a + ></span + ></span ><span > </span ><span class="hs-keyword" @@ -715,132 +932,164 @@ ><span > </span - ><a name="line-32" - ></a + ><span id="line-32" + ></span ><span > </span - ><a name="plugh" - ><a href="Classes.html#plugh" - ><span class="hs-identifier" - >plugh</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >p</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >p</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >p</span - ></a - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >)</span + ><span id="" + ><span id="" + ><span id="plugh" + ><span class="annot" + ><a href="Classes.html#plugh" + ><span class="hs-identifier hs-type" + >plugh</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >p</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >p</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >p</span + ></a + ></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >)</span + ></span + ></span ><span > </span - ><a name="line-33" - ></a + ><span id="line-33" + ></span ><span > </span - ><a name="line-34" - ></a + ><span id="line-34" + ></span ><span class="hs-keyword" >instance</span ><span > </span + ><span class="annot" ><a href="Classes.html#Plugh" - ><span class="hs-identifier hs-type" - >Plugh</span - ></a + ><span class="hs-identifier hs-type" + >Plugh</span + ></a + ></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Either</span + >Either</span + ></span ><span > </span ><span class="hs-keyword" @@ -848,30 +1097,42 @@ ><span > </span - ><a name="line-35" - ></a + ><span id="line-35" + ></span ><span > </span - ><a name="" - ><a href="Classes.html#plugh" - ><span class="hs-identifier" - >plugh</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >plugh :: Either a a -> Either b b -> Either (a -> b) (b -> a) +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var hs-var hs-var" + >plugh</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span - ><span class="hs-identifier hs-var" - >Left</span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Left</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -884,45 +1145,80 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >Right</span + ><span class="annot" + ><span class="annottext" + >(b -> a) -> Either (a -> b) (b -> a) +forall a b. b -> Either a b +</span + ><span class="hs-identifier hs-var" + >Right</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >((b -> a) -> Either (a -> b) (b -> a)) +-> (b -> a) -> Either (a -> b) (b -> a) +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >const</span + ><span class="annot" + ><span class="annottext" + >a -> b -> a +forall a b. a -> b -> a +</span + ><span class="hs-identifier hs-var" + >const</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a name="line-36" - ></a + ><span id="line-36" + ></span ><span > </span - ><span class="hs-identifier" - >plugh</span + ><span class="annot" + ><a href="Classes.html#plugh" + ><span class="hs-identifier hs-var" + >plugh</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span - ><span class="hs-identifier hs-var" - >Right</span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Right</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -935,31 +1231,59 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >Right</span + ><span class="annot" + ><span class="annottext" + >(b -> a) -> Either (a -> b) (b -> a) +forall a b. b -> Either a b +</span + ><span class="hs-identifier hs-var" + >Right</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >((b -> a) -> Either (a -> b) (b -> a)) +-> (b -> a) -> Either (a -> b) (b -> a) +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >const</span + ><span class="annot" + ><span class="annottext" + >a -> b -> a +forall a b. a -> b -> a +</span + ><span class="hs-identifier hs-var" + >const</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a name="line-37" - ></a + ><span id="line-37" + ></span ><span > </span - ><span class="hs-identifier" - >plugh</span + ><span class="annot" + ><a href="Classes.html#plugh" + ><span class="hs-identifier hs-var" + >plugh</span + ></a + ></span ><span > </span ><span class="hs-identifier" @@ -968,16 +1292,23 @@ > </span ><span class="hs-special" >(</span - ><span class="hs-identifier hs-var" - >Left</span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Left</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -986,31 +1317,59 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >Left</span + ><span class="annot" + ><span class="annottext" + >(a -> b) -> Either (a -> b) (b -> a) +forall a b. a -> Either a b +</span + ><span class="hs-identifier hs-var" + >Left</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >((a -> b) -> Either (a -> b) (b -> a)) +-> (a -> b) -> Either (a -> b) (b -> a) +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >const</span + ><span class="annot" + ><span class="annottext" + >b -> a -> b +forall a b. a -> b -> a +</span + ><span class="hs-identifier hs-var" + >const</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span > </span - ><a name="line-38" - ></a + ><span id="line-38" + ></span ><span > </span - ><span class="hs-identifier" - >plugh</span + ><span class="annot" + ><a href="Classes.html#plugh" + ><span class="hs-identifier hs-var" + >plugh</span + ></a + ></span ><span > </span ><span class="hs-identifier" @@ -1019,16 +1378,23 @@ > </span ><span class="hs-special" >(</span - ><span class="hs-identifier hs-var" - >Right</span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Right</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -1037,27 +1403,51 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >Left</span + ><span class="annot" + ><span class="annottext" + >(a -> b) -> Either (a -> b) (b -> a) +forall a b. a -> Either a b +</span + ><span class="hs-identifier hs-var" + >Left</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >((a -> b) -> Either (a -> b) (b -> a)) +-> (a -> b) -> Either (a -> b) (b -> a) +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >const</span + ><span class="annot" + ><span class="annottext" + >b -> a -> b +forall a b. a -> b -> a +</span + ><span class="hs-identifier hs-var" + >const</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span > </span - ><a name="line-39" - ></a + ><span id="line-39" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html index e35ca0b1..970ec741 100644 --- a/hypsrc-test/ref/src/Constructors.html +++ b/hypsrc-test/ref/src/Constructors.html @@ -19,375 +19,489 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a + ><span id="line-4" + ></span ><span class="hs-keyword" >data</span ><span > </span - ><a name="Foo" - ><a href="Constructors.html#Foo" - ><span class="hs-identifier" - >Foo</span - ></a - ></a + ><span id="Foo" + ><span class="annot" + ><a href="Constructors.html#Foo" + ><span class="hs-identifier hs-var" + >Foo</span + ></a + ></span + ></span ><span > </span - ><a name="line-5" - ></a + ><span id="line-5" + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="Bar" - ><a href="Constructors.html#Bar" - ><span class="hs-identifier" - >Bar</span - ></a - ></a + ><span id="Bar" + ><span class="annot" + ><a href="Constructors.html#Bar" + ><span class="hs-identifier hs-var" + >Bar</span + ></a + ></span + ></span ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a name="Baz" - ><a href="Constructors.html#Baz" - ><span class="hs-identifier" - >Baz</span - ></a - ></a + ><span id="Baz" + ><span class="annot" + ><a href="Constructors.html#Baz" + ><span class="hs-identifier hs-var" + >Baz</span + ></a + ></span + ></span ><span > </span - ><a name="line-7" - ></a + ><span id="line-7" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a name="Quux" - ><a href="Constructors.html#Quux" - ><span class="hs-identifier" - >Quux</span - ></a - ></a + ><span id="Quux" + ><span class="annot" + ><a href="Constructors.html#Quux" + ><span class="hs-identifier hs-var" + >Quux</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-8" - ></a + ><span id="line-8" + ></span ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span class="hs-keyword" >newtype</span ><span > </span - ><a name="Norf" - ><a href="Constructors.html#Norf" - ><span class="hs-identifier" - >Norf</span - ></a - ></a + ><span id="Norf" + ><span class="annot" + ><a href="Constructors.html#Norf" + ><span class="hs-identifier hs-var" + >Norf</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="Norf" - ><a href="Constructors.html#Norf" - ><span class="hs-identifier" - >Norf</span - ></a - ></a + ><span id="Norf" + ><span class="annot" + ><a href="Constructors.html#Norf" + ><span class="hs-identifier hs-var" + >Norf</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >]</span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-10" - ></a + ><span id="line-10" + ></span ><span > </span - ><a name="line-11" - ></a + ><span id="line-11" + ></span ><span > </span - ><a name="line-12" - ></a - ><span class="hs-identifier" - >bar</span + ><span id="line-12" + ></span + ><span class="annot" + ><a href="Constructors.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >baz</span + ><span class="annot" + ><a href="Constructors.html#baz" + ><span class="hs-identifier hs-type" + >baz</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >quux</span + ><span class="annot" + ><a href="Constructors.html#quux" + ><span class="hs-identifier hs-type" + >quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span - ><a name="line-13" - ></a - ><a name="bar" - ><a href="Constructors.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a + ><span id="line-13" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: Foo +</span + ><a href="Constructors.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Bar" + ><span class="hs-identifier hs-var" + >Bar</span + ></a + ></span ><span > </span - ><a name="line-14" - ></a - ><a name="baz" - ><a href="Constructors.html#baz" - ><span class="hs-identifier" - >baz</span - ></a - ></a + ><span id="line-14" + ></span + ><span id="baz" + ><span class="annot" + ><span class="annottext" + >baz :: Foo +</span + ><a href="Constructors.html#baz" + ><span class="hs-identifier hs-var hs-var" + >baz</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Baz" + ><span class="hs-identifier hs-var" + >Baz</span + ></a + ></span ><span > </span - ><a name="line-15" - ></a - ><a name="quux" - ><a href="Constructors.html#quux" - ><span class="hs-identifier" - >quux</span - ></a - ></a + ><span id="line-15" + ></span + ><span id="quux" + ><span class="annot" + ><span class="annottext" + >quux :: Foo +</span + ><a href="Constructors.html#quux" + ><span class="hs-identifier hs-var hs-var" + >quux</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Constructors.html#Quux" - ><span class="hs-identifier hs-var" - >Quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int -> Foo +</span + ><a href="Constructors.html#Quux" + ><span class="hs-identifier hs-var" + >Quux</span + ></a + ></span ><span > </span - ><a href="Constructors.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a + ><span id="line-17" + ></span ><span > </span - ><a name="line-18" - ></a - ><span class="hs-identifier" - >unfoo</span + ><span id="line-18" + ></span + ><span class="annot" + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-type" + >unfoo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-19" - ></a - ><a name="unfoo" - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier" - >unfoo</span - ></a - ></a + ><span id="line-19" + ></span + ><span id="unfoo" + ><span class="annot" + ><span class="annottext" + >unfoo :: Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var hs-var" + >unfoo</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-20" - ></a - ><span class="hs-identifier" - >unfoo</span + ><span id="line-20" + ></span + ><span class="annot" + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-21" - ></a - ><span class="hs-identifier" - >unfoo</span + ><span id="line-21" + ></span + ><span class="annot" + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Quux" - ><span class="hs-identifier hs-var" - >Quux</span - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >foo</span + ><span class="hs-identifier hs-type" + >Quux</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >n</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >foo :: Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >foo</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >n :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >n</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -396,61 +510,96 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >42</span + >42</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >n</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >n</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >foo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >foo</span + ></a + ></span ><span > </span - ><a name="line-22" - ></a + ><span id="line-22" + ></span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ><span > </span - ><a name="line-24" - ></a - ><span class="hs-identifier" - >unnorf</span + ><span id="line-24" + ></span + ><span class="annot" + ><a href="Constructors.html#unnorf" + ><span class="hs-identifier hs-type" + >unnorf</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -459,57 +608,75 @@ > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="Constructors.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >]</span ><span > </span - ><a name="line-25" - ></a - ><a name="unnorf" - ><a href="Constructors.html#unnorf" - ><span class="hs-identifier" - >unnorf</span - ></a - ></a + ><span id="line-25" + ></span + ><span id="unnorf" + ><span class="annot" + ><span class="annottext" + >unnorf :: Norf -> [Foo] +</span + ><a href="Constructors.html#unnorf" + ><span class="hs-identifier hs-var hs-var" + >unnorf</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Norf" - ><span class="hs-identifier hs-var" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >xs</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >xs :: [Foo] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >xs</span + ></a + ></span + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span class="hs-special" >)</span ><span class="hs-special" @@ -520,51 +687,71 @@ >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >xs</span - ></a + ><span class="annot" + ><span class="annottext" + >[Foo] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >xs</span + ></a + ></span ><span > </span - ><a name="line-26" - ></a - ><span class="hs-identifier" - >unnorf</span + ><span id="line-26" + ></span + ><span class="annot" + ><a href="Constructors.html#unnorf" + ><span class="hs-identifier hs-var" + >unnorf</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Norf" - ><span class="hs-identifier hs-var" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >xs</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >xs :: [Foo] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >xs</span + ></a + ></span + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span class="hs-special" >)</span ><span class="hs-special" @@ -575,21 +762,36 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >reverse</span + ><span class="annot" + ><span class="annottext" + >[Foo] -> [Foo] +forall a. [a] -> [a] +</span + ><span class="hs-identifier hs-var" + >reverse</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >xs</span - ></a + ><span class="annot" + ><span class="annottext" + >[Foo] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >xs</span + ></a + ></span ><span > </span - ><a name="line-27" - ></a - ><span class="hs-identifier" - >unnorf</span + ><span id="line-27" + ></span + ><span class="annot" + ><a href="Constructors.html#unnorf" + ><span class="hs-identifier hs-var" + >unnorf</span + ></a + ></span ><span > </span ><span class="hs-identifier" @@ -600,100 +802,138 @@ >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >[Foo] +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-28" - ></a + ><span id="line-28" + ></span ><span > </span - ><a name="line-29" - ></a + ><span id="line-29" + ></span ><span > </span - ><a name="line-30" - ></a - ><span class="hs-identifier" - >unnorf'</span + ><span id="line-30" + ></span + ><span class="annot" + ><a href="Constructors.html#unnorf%27" + ><span class="hs-identifier hs-type" + >unnorf'</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Constructors.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-31" - ></a - ><a name="unnorf%27" - ><a href="Constructors.html#unnorf%27" - ><span class="hs-identifier" - >unnorf'</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="line-31" + ></span + ><span id="unnorf%27" + ><span class="annot" + ><span class="annottext" + >unnorf' :: Norf -> Int +</span + ><a href="Constructors.html#unnorf%27" + ><span class="hs-identifier hs-var hs-var" + >unnorf'</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Norf +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span class="hs-glyph" >@</span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Norf" - ><span class="hs-identifier hs-var" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f1</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f1 :: Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f1</span + ></a + ></span + ></span ><span class="hs-glyph" >@</span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Quux" - ><span class="hs-identifier hs-var" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span ><span class="hs-identifier" >_</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >n</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >n :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >n</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span class="hs-special" @@ -706,28 +946,40 @@ >,</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f2</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f2 :: Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f2</span + ></a + ></span + ></span ><span class="hs-glyph" >@</span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Constructors.html#Quux" - ><span class="hs-identifier hs-var" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f3</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f3 :: Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f3</span + ></a + ></span + ></span ><span > </span ><span class="hs-identifier" @@ -745,61 +997,109 @@ ><span > </span - ><a name="line-32" - ></a + ><span id="line-32" + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x'</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x'</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >n</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >n</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f1</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f1</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >aux</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >aux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f3</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f3</span + ></a + ></span ><span > </span - ><a name="line-33" - ></a + ><span id="line-33" + ></span ><span > </span ><span class="hs-keyword" @@ -807,132 +1107,234 @@ ><span > </span - ><a name="line-34" - ></a + ><span id="line-34" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >aux</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >fx</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >aux :: Foo -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >aux</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >fx :: Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >fx</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f2</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f2</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >fx</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >fx</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f3</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f3</span + ></a + ></span ><span > </span - ><a name="line-35" - ></a + ><span id="line-35" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x'</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >x' :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >x'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >sum</span + ><span class="annot" + ><span class="annottext" + >[Int] -> Int +forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a +</span + ><span class="hs-identifier hs-var" + >sum</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >.</span + ><span class="annot" + ><span class="annottext" + >([Int] -> Int) -> (Norf -> [Int]) -> Norf -> Int +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >map</span + ><span class="annot" + ><span class="annottext" + >(Foo -> Int) -> [Foo] -> [Int] +forall a b. (a -> b) -> [a] -> [b] +</span + ><span class="hs-identifier hs-var" + >map</span + ></span ><span > </span - ><a href="Constructors.html#unfoo" - ><span class="hs-identifier hs-var" - >unfoo</span - ></a + ><span class="annot" + ><span class="annottext" + >Foo -> Int +</span + ><a href="Constructors.html#unfoo" + ><span class="hs-identifier hs-var" + >unfoo</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >.</span + ><span class="annot" + ><span class="annottext" + >([Foo] -> [Int]) -> (Norf -> [Foo]) -> Norf -> [Int] +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span ><span > </span - ><a href="Constructors.html#unnorf" - ><span class="hs-identifier hs-var" - >unnorf</span - ></a + ><span class="annot" + ><span class="annottext" + >Norf -> [Foo] +</span + ><a href="Constructors.html#unnorf" + ><span class="hs-identifier hs-var" + >unnorf</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >(Norf -> Int) -> Norf -> Int +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Norf +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a name="line-36" - ></a + ><span id="line-36" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html index ce69ad37..5268031d 100644 --- a/hypsrc-test/ref/src/Identifiers.html +++ b/hypsrc-test/ref/src/Identifiers.html @@ -19,641 +19,1040 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a - ><span class="hs-identifier" - >foo</span + ><span id="line-4" + ></span + ><span class="annot" + ><a href="Identifiers.html#foo" + ><span class="hs-identifier hs-type" + >foo</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >bar</span + ><span class="annot" + ><a href="Identifiers.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >baz</span + ><span class="annot" + ><a href="Identifiers.html#baz" + ><span class="hs-identifier hs-type" + >baz</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-5" - ></a - ><a name="foo" - ><a href="Identifiers.html#foo" - ><span class="hs-identifier" - >foo</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="line-5" + ></span + ><span id="foo" + ><span class="annot" + ><span class="annottext" + >foo :: Int -> Int -> Int +</span + ><a href="Identifiers.html#foo" + ><span class="hs-identifier hs-var hs-var" + >foo</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a - ><span - > </span - ><span class="hs-operator hs-var" - >+</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="Identifiers.html#bar" - ><span class="hs-identifier hs-var" - >bar</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#bar" + ><span class="hs-identifier hs-var" + >bar</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a - ><span - > + ><span class="annot" + ><span class="annottext" + >Int </span - ><a name="line-6" - ></a - ><a name="bar" - ><a href="Identifiers.html#bar" - ><span class="hs-identifier" - >bar</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" >y</span ></a - ></a + ></span + ><span + > +</span + ><span id="line-6" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: Int -> Int -> Int +</span + ><a href="Identifiers.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a - ><span - > </span - ><span class="hs-operator hs-var" - >+</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-glyph" - >-</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="Identifiers.html#baz" - ><span class="hs-identifier hs-var" - >baz</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-glyph hs-var" + >-</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#baz" + ><span class="hs-identifier hs-var" + >baz</span + ></a + ></span ><span > </span - ><span class="hs-glyph" - >-</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-glyph hs-var" + >-</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a - ><span - > + ><span class="annot" + ><span class="annottext" + >Int </span - ><a name="line-7" - ></a - ><a name="baz" - ><a href="Identifiers.html#baz" - ><span class="hs-identifier" - >baz</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" >y</span ></a - ></a + ></span + ><span + > +</span + ><span id="line-7" + ></span + ><span id="baz" + ><span class="annot" + ><span class="annottext" + >baz :: Int -> Int -> Int +</span + ><a href="Identifiers.html#baz" + ><span class="hs-identifier hs-var hs-var" + >baz</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a name="line-8" - ></a + ><span id="line-8" + ></span ><span > </span - ><a name="line-9" - ></a - ><span class="hs-identifier" - >quux</span + ><span id="line-9" + ></span + ><span class="annot" + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-type" + >quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-10" - ></a - ><a name="quux" - ><a href="Identifiers.html#quux" - ><span class="hs-identifier" - >quux</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="line-10" + ></span + ><span id="quux" + ><span class="annot" + ><span class="annottext" + >quux :: Int -> Int +</span + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-var hs-var" + >quux</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Identifiers.html#foo" - ><span class="hs-identifier hs-var" - >foo</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#foo" + ><span class="hs-identifier hs-var" + >foo</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span - ><a href="Identifiers.html#bar" - ><span class="hs-identifier hs-var" - >bar</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#bar" + ><span class="hs-identifier hs-var" + >bar</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span ><span class="hs-special" >(</span - ><a href="Identifiers.html#bar" - ><span class="hs-identifier hs-var" - >bar</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#bar" + ><span class="hs-identifier hs-var" + >bar</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-11" - ></a + ><span id="line-11" + ></span ><span > </span - ><a name="line-12" - ></a - ><span class="hs-identifier" - >norf</span + ><span id="line-12" + ></span + ><span class="annot" + ><a href="Identifiers.html#norf" + ><span class="hs-identifier hs-type" + >norf</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-13" - ></a - ><a name="norf" - ><a href="Identifiers.html#norf" - ><span class="hs-identifier" - >norf</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >z</span - ></a - ></a + ><span id="line-13" + ></span + ><span id="norf" + ><span class="annot" + ><span class="annottext" + >norf :: Int -> Int -> Int -> Int +</span + ><a href="Identifiers.html#norf" + ><span class="hs-identifier hs-var hs-var" + >norf</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >z :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span + ></span ><span > </span - ><a name="line-14" - ></a + ><span id="line-14" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - ><</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Bool +forall a. Ord a => a -> a -> Bool +</span + ><span class="hs-operator hs-var" + ><</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Identifiers.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int +</span + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a name="line-15" - ></a + ><span id="line-15" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - ><</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Bool +forall a. Ord a => a -> a -> Bool +</span + ><span class="hs-operator hs-var" + ><</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Identifiers.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int +</span + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >z</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - ><</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Bool +forall a. Ord a => a -> a -> Bool +</span + ><span class="hs-operator hs-var" + ><</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Identifiers.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int +</span + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >z</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span ><span > </span - ><a name="line-17" - ></a + ><span id="line-17" + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><span class="hs-identifier hs-var" - >otherwise</span + ><span class="annot" + ><span class="annottext" + >Bool +</span + ><span class="hs-identifier hs-var" + >otherwise</span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Identifiers.html#norf" - ><span class="hs-identifier hs-var" - >norf</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int -> Int +</span + ><a href="Identifiers.html#norf" + ><span class="hs-identifier hs-var" + >norf</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span ><span class="hs-glyph" >-</span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -662,10 +1061,15 @@ >(</span ><span class="hs-glyph" >-</span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -674,37 +1078,48 @@ >(</span ><span class="hs-glyph" >-</span - ><a href="#" - ><span class="hs-identifier hs-var" - >z</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-18" - ></a + ><span id="line-18" + ></span ><span > </span - ><a name="line-19" - ></a + ><span id="line-19" + ></span ><span > </span - ><a name="line-20" - ></a - ><span class="hs-identifier" - >main</span + ><span id="line-20" + ></span + ><span class="annot" + ><a href="Identifiers.html#main" + ><span class="hs-identifier hs-type" + >main</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >IO</span + >IO</span + ></span ><span > </span ><span class="hs-special" @@ -714,14 +1129,19 @@ ><span > </span - ><a name="line-21" - ></a - ><a name="main" - ><a href="Identifiers.html#main" - ><span class="hs-identifier" - >main</span - ></a - ></a + ><span id="line-21" + ></span + ><span id="main" + ><span class="annot" + ><span class="annottext" + >main :: IO () +</span + ><a href="Identifiers.html#main" + ><span class="hs-identifier hs-var hs-var" + >main</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -733,125 +1153,239 @@ ><span > </span - ><a name="line-22" - ></a + ><span id="line-22" + ></span ><span > </span - ><span class="hs-identifier hs-var" - >putStrLn</span + ><span class="annot" + ><span class="annottext" + >String -> IO () +</span + ><span class="hs-identifier hs-var" + >putStrLn</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >.</span + ><span class="annot" + ><span class="annottext" + >(String -> IO ()) -> (Int -> String) -> Int -> IO () +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >show</span + ><span class="annot" + ><span class="annottext" + >Int -> String +forall a. Show a => a -> String +</span + ><span class="hs-identifier hs-var" + >show</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >(Int -> IO ()) -> Int -> IO () +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><a href="Identifiers.html#foo" - ><span class="hs-identifier hs-var" - >foo</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="Identifiers.html#foo" + ><span class="hs-identifier hs-var" + >foo</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ><span > </span - ><span class="hs-identifier hs-var" - >putStrLn</span + ><span class="annot" + ><span class="annottext" + >String -> IO () +</span + ><span class="hs-identifier hs-var" + >putStrLn</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >.</span + ><span class="annot" + ><span class="annottext" + >(String -> IO ()) -> (Int -> String) -> Int -> IO () +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >show</span + ><span class="annot" + ><span class="annottext" + >Int -> String +forall a. Show a => a -> String +</span + ><span class="hs-identifier hs-var" + >show</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >(Int -> IO ()) -> Int -> IO () +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><a href="Identifiers.html#quux" - ><span class="hs-identifier hs-var" - >quux</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int +</span + ><a href="Identifiers.html#quux" + ><span class="hs-identifier hs-var" + >quux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >z</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span ><span > </span - ><a name="line-24" - ></a + ><span id="line-24" + ></span ><span > </span - ><span class="hs-identifier hs-var" - >putStrLn</span + ><span class="annot" + ><span class="annottext" + >String -> IO () +</span + ><span class="hs-identifier hs-var" + >putStrLn</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >.</span + ><span class="annot" + ><span class="annottext" + >(String -> IO ()) -> (Int -> String) -> Int -> IO () +forall b c a. (b -> c) -> (a -> b) -> a -> c +</span + ><span class="hs-operator hs-var" + >.</span + ></span ><span > </span - ><span class="hs-identifier hs-var" - >show</span + ><span class="annot" + ><span class="annottext" + >Int -> String +forall a. Show a => a -> String +</span + ><span class="hs-identifier hs-var" + >show</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >(Int -> IO ()) -> Int -> IO () +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span - ><a href="Identifiers.html#norf" - ><span class="hs-identifier hs-var" - >Identifiers.norf</span - ></a + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int -> Int +</span + ><a href="Identifiers.html#norf" + ><span class="hs-identifier hs-var" + >Identifiers.norf</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >z</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >z</span + ></a + ></span ><span > </span - ><a name="line-25" - ></a + ><span id="line-25" + ></span ><span > </span ><span class="hs-keyword" @@ -859,72 +1393,93 @@ ><span > </span - ><a name="line-26" - ></a + ><span id="line-26" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >10</span + >10</span + ></span ><span > </span - ><a name="line-27" - ></a + ><span id="line-27" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >20</span + >20</span + ></span ><span > </span - ><a name="line-28" - ></a + ><span id="line-28" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >z</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >z :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >z</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >30</span + >30</span + ></span ><span > </span - ><a name="line-29" - ></a + ><span id="line-29" + ></span ></pre ></body ></html -> +>
\ No newline at end of file diff --git a/hypsrc-test/ref/src/LinkingIdentifiers.html b/hypsrc-test/ref/src/LinkingIdentifiers.html new file mode 100644 index 00000000..52b20200 --- /dev/null +++ b/hypsrc-test/ref/src/LinkingIdentifiers.html @@ -0,0 +1,572 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><link rel="stylesheet" type="text/css" href="style.css" + /><script type="text/javascript" src="highlight.js" + ></script + ></head + ><body + ><pre + ><span class="hs-comment" + >-- Tests that the identifers/operators are properly linked even when:</span + ><span + > +</span + ><span id="line-2" + ></span + ><span class="hs-comment" + >--</span + ><span + > +</span + ><span id="line-3" + ></span + ><span class="hs-comment" + >-- * backquoted, parenthesized, vanilla</span + ><span + > +</span + ><span id="line-4" + ></span + ><span class="hs-comment" + >-- * qualified, not-qualified</span + ><span + > +</span + ><span id="line-5" + ></span + ><span class="hs-comment" + >--</span + ><span + > +</span + ><span id="line-6" + ></span + ><span class="hs-keyword" + >module</span + ><span + > </span + ><span class="hs-identifier" + >LinkingIdentifiers</span + ><span + > </span + ><span class="hs-keyword" + >where</span + ><span + > +</span + ><span id="line-7" + ></span + ><span + > +</span + ><span id="line-8" + ></span + ><span class="annot" + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-identifier hs-type" + >ident</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > +</span + ><span id="line-9" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="ident" + ><span class="annot" + ><span class="annottext" + >ident :: Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-operator hs-var hs-var" + >`ident`</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-number" + >2</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-operator hs-var" + >`ident`</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-operator hs-var" + >`LinkingIdentifiers.ident`</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span class="hs-special" + >)</span + ><span + > +</span + ><span id="line-10" + ></span + ><span class="annot" + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-identifier hs-var" + >ident</span + ></a + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-number" + >2</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-identifier hs-var" + >ident</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#ident" + ><span class="hs-identifier hs-var" + >LinkingIdentifiers.ident</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span + > +</span + ><span id="line-11" + ></span + ><span + > +</span + ><span id="line-12" + ></span + ><span class="annot" + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-type" + >(++:++)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Int</span + ></span + ><span + > +</span + ><span id="line-13" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="%2B%2B%3A%2B%2B" + ><span class="annot" + ><span class="annottext" + >++:++ :: Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var hs-var" + >++:++</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-number" + >2</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var" + >++:++</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var" + >LinkingIdentifiers.++:++</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span class="hs-special" + >)</span + ><span + > +</span + ><span id="line-14" + ></span + ><span class="annot" + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var" + >(++:++)</span + ></a + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-number" + >2</span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var" + >(++:++)</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +</span + ><a href="LinkingIdentifiers.html#%2B%2B%3A%2B%2B" + ><span class="hs-operator hs-var" + >(LinkingIdentifiers.++:++)</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><span class="hs-number" + >2</span + ></span + ><span + > +</span + ><span id="line-15" + ></span + ></pre + ></body + ></html +>
\ No newline at end of file diff --git a/hypsrc-test/ref/src/Literals.html b/hypsrc-test/ref/src/Literals.html index dfcefc97..f0d05fbc 100644 --- a/hypsrc-test/ref/src/Literals.html +++ b/hypsrc-test/ref/src/Literals.html @@ -19,238 +19,334 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a - ><span class="hs-identifier" - >str</span + ><span id="line-4" + ></span + ><span class="annot" + ><a href="Literals.html#str" + ><span class="hs-identifier hs-type" + >str</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >String</span + >String</span + ></span ><span > </span - ><a name="line-5" - ></a - ><a name="str" - ><a href="Literals.html#str" - ><span class="hs-identifier" - >str</span - ></a - ></a + ><span id="line-5" + ></span + ><span id="str" + ><span class="annot" + ><span class="annottext" + >str :: String +</span + ><a href="Literals.html#str" + ><span class="hs-identifier hs-var hs-var" + >str</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-string" - >"str literal"</span + >"str literal"</span + ></span ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span - ><a name="line-7" - ></a - ><span class="hs-identifier" - >num</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Num</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >=></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span id="line-7" + ></span + ><span id="" + ><span class="annot" + ><a href="Literals.html#num" + ><span class="hs-identifier hs-type" + >num</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Num</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span - ><a name="line-8" - ></a - ><a name="num" - ><a href="Literals.html#num" - ><span class="hs-identifier" - >num</span - ></a - ></a + ><span id="line-8" + ></span + ><span id="num" + ><span class="annot" + ><span class="annottext" + >num :: a +</span + ><a href="Literals.html#num" + ><span class="hs-identifier hs-var hs-var" + >num</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >1</span + >1</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >1010011</span + >1010011</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >41231</span + >41231</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span + ><span class="annot" ><span class="hs-number" - >12131</span + >12131</span + ></span ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span > </span - ><a name="line-10" - ></a - ><span class="hs-identifier" - >frac</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Fractional</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >=></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span id="line-10" + ></span + ><span id="" + ><span class="annot" + ><a href="Literals.html#frac" + ><span class="hs-identifier hs-type" + >frac</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Fractional</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span - ><a name="line-11" - ></a - ><a name="frac" - ><a href="Literals.html#frac" - ><span class="hs-identifier" - >frac</span - ></a - ></a + ><span id="line-11" + ></span + ><span id="frac" + ><span class="annot" + ><span class="annottext" + >frac :: a +</span + ><a href="Literals.html#frac" + ><span class="hs-identifier hs-var hs-var" + >frac</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >42.0000001</span + >42.0000001</span + ></span ><span > </span - ><a name="line-12" - ></a + ><span id="line-12" + ></span ><span > </span - ><a name="line-13" - ></a - ><span class="hs-identifier" - >list</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span + ><span id="line-13" + ></span + ><span id="" + ><span class="annot" + ><a href="Literals.html#list" + ><span class="hs-identifier hs-type" + >list</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ></span ><span > </span - ><a name="line-14" - ></a - ><a name="list" - ><a href="Literals.html#list" - ><span class="hs-identifier" - >list</span - ></a - ></a + ><span id="line-14" + ></span + ><span id="list" + ><span class="annot" + ><span class="annottext" + >list :: [[[[a]]]] +</span + ><a href="Literals.html#list" + ><span class="hs-identifier hs-var hs-var" + >list</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -296,15 +392,19 @@ ><span > </span - ><a name="line-15" - ></a + ><span id="line-15" + ></span ><span > </span - ><a name="line-16" - ></a - ><span class="hs-identifier" - >pair</span + ><span id="line-16" + ></span + ><span class="annot" + ><a href="Literals.html#pair" + ><span class="hs-identifier hs-type" + >pair</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -358,14 +458,19 @@ ><span > </span - ><a name="line-17" - ></a - ><a name="pair" - ><a href="Literals.html#pair" - ><span class="hs-identifier" - >pair</span - ></a - ></a + ><span id="line-17" + ></span + ><span id="pair" + ><span class="annot" + ><span class="annottext" + >pair :: ((), ((), (), ()), ()) +</span + ><a href="Literals.html#pair" + ><span class="hs-identifier hs-var hs-var" + >pair</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -419,8 +524,8 @@ ><span > </span - ><a name="line-18" - ></a + ><span id="line-18" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html index 8ce0b9ce..4d5693c2 100644 --- a/hypsrc-test/ref/src/Operators.html +++ b/hypsrc-test/ref/src/Operators.html @@ -19,311 +19,414 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >+++</span - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >::</span + ><span id="line-4" + ></span + ><span id="" + ><span class="annot" + ><a href="Operators.html#%2B%2B%2B" + ><span class="hs-operator hs-type" + >(+++)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span + > +</span + ><span id="line-5" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="%2B%2B%2B" + ><span class="annot" + ><span class="annottext" + >+++ :: [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2B%2B%2B" + ><span class="hs-operator hs-var hs-var" + >+++</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > + ><span class="annot" + ><span class="annottext" + >[a] </span - ><a name="line-5" - ></a - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><a href="#" + ><span class="hs-identifier hs-var" >a</span ></a - ></a + ></span ><span > </span - ><a name="%2B%2B%2B" - ><a href="Operators.html#%2B%2B%2B" - ><span class="hs-operator" - >+++</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><span class="hs-operator hs-var" + >++</span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" >b</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a - ><span - > </span - ><span class="hs-operator hs-var" - >++</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >++</span + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><span class="hs-operator hs-var" + >++</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span - ><a name="line-7" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >$$$</span - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >::</span + ><span id="line-7" + ></span + ><span id="" + ><span class="annot" + ><a href="Operators.html#%24%24%24" + ><span class="hs-operator hs-type" + >($$$)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span + > +</span + ><span id="line-8" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="%24%24%24" + ><span class="annot" + ><span class="annottext" + >$$$ :: [a] -> [a] -> [a] +</span + ><a href="Operators.html#%24%24%24" + ><span class="hs-operator hs-var hs-var" + >$$$</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > + ><span class="annot" + ><span class="annottext" + >[a] </span - ><a name="line-8" - ></a - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span ></a - ></a + ></span ><span > </span - ><a name="%24%24%24" - ><a href="Operators.html#%24%24%24" - ><span class="hs-operator" - >$$$</span + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2B%2B%2B" + ><span class="hs-operator hs-var" + >+++</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a - ><span - > </span - ><a href="Operators.html#%2B%2B%2B" - ><span class="hs-operator hs-var" - >+++</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ></span ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span > </span - ><a name="line-10" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >***</span - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span + ><span id="line-10" + ></span + ><span id="" + ><span class="annot" + ><a href="Operators.html#%2A%2A%2A" + ><span class="hs-operator hs-type" + >(***)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span ><span > </span - ><a name="line-11" - ></a - ><span class="hs-special" - >(</span - ><a name="%2A%2A%2A" - ><a href="Operators.html#%2A%2A%2A" - ><span class="hs-operator" - >***</span - ></a - ></a - ><span class="hs-special" - >)</span - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="line-11" + ></span + ><span id="%2A%2A%2A" + ><span class="annot" + ><span class="annottext" + >*** :: [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2A%2A%2A" + ><span class="hs-operator hs-var hs-var" + >(***)</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" @@ -336,43 +439,60 @@ >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a name="line-12" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >***</span - ><span class="hs-special" - >)</span + ><span id="line-12" + ></span + ><span class="annot" + ><a href="Operators.html#%2A%2A%2A" + ><span class="hs-operator hs-var" + >(***)</span + ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span ><span class="hs-identifier" >_</span - ><span class="hs-glyph" - >:</span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span class="annot" + ><span class="hs-glyph hs-type" + >:</span + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -381,455 +501,643 @@ >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a href="Operators.html#%2B%2B%2B" - ><span class="hs-operator hs-var" - >+++</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2B%2B%2B" + ><span class="hs-operator hs-var" + >+++</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a href="Operators.html#%2A%2A%2A" - ><span class="hs-operator hs-var" - >***</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2A%2A%2A" + ><span class="hs-operator hs-var" + >***</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-13" - ></a + ><span id="line-13" + ></span ><span > </span - ><a name="line-14" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >*/\*</span - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span + ><span id="line-14" + ></span + ><span id="" + ><span class="annot" + ><a href="Operators.html#%2A%2F%5C%2A" + ><span class="hs-operator hs-type" + >(*/\*)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ></span ><span > </span - ><a name="line-15" - ></a - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="%2A%2F%5C%2A" - ><a href="Operators.html#%2A%2F%5C%2A" - ><span class="hs-operator" - >*/\*</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="line-15" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="%2A%2F%5C%2A" + ><span class="annot" + ><span class="annottext" + >*/\* :: [[a]] -> [a] -> [a] +</span + ><a href="Operators.html#%2A%2F%5C%2A" + ><span class="hs-operator hs-var hs-var" + >*/\*</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: [a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >concatMap</span + ><span class="annot" + ><span class="annottext" + >([a] -> [a]) -> [[a]] -> [a] +forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] +</span + ><span class="hs-identifier hs-var" + >concatMap</span + ></span ><span > </span ><span class="hs-special" >(</span - ><a href="Operators.html#%2A%2A%2A" - ><span class="hs-operator hs-var" - >***</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] -> [a] -> [a] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2A%2A%2A" + ><span class="hs-operator hs-var" + >***</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >[a] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >**/\**</span - ><span class="hs-special" - >)</span + ><span id="line-17" + ></span + ><span id="" + ><span class="annot" + ><a href="Operators.html#%2A%2A%2F%5C%2A%2A" + ><span class="hs-operator hs-type" + >(**/\**)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span class="hs-special" + >]</span + ></span ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span + > +</span + ><span id="line-18" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: [[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="%2A%2A%2F%5C%2A%2A" + ><span class="annot" + ><span class="annottext" + >**/\** :: [[a]] -> [[a]] -> [[a]] +</span + ><a href="Operators.html#%2A%2A%2F%5C%2A%2A" + ><span class="hs-operator hs-var hs-var" + >**/\**</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: [[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><span class="hs-special" - >[</span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span + ><span class="annot" + ><span class="annottext" + >([[a]] -> [a] -> [a]) -> [[[a]]] -> [[a]] -> [[a]] +forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] +</span + ><span class="hs-identifier hs-var" + >zipWith</span + ></span ><span > </span - ><span class="hs-glyph" - >-></span + ><span class="annot" + ><span class="annottext" + >[[a]] -> [a] -> [a] +forall a. [[a]] -> [a] -> [a] +</span + ><a href="Operators.html#%2A%2F%5C%2A" + ><span class="hs-operator hs-var" + >(*/\*)</span + ></a + ></span ><span > </span ><span class="hs-special" >[</span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span class="hs-special" - >]</span - ><span - > + ><span class="annot" + ><span class="annottext" + >[[a]] </span - ><a name="line-18" - ></a - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><a href="#" + ><span class="hs-identifier hs-var" >a</span ></a - ></a + ></span ><span > </span - ><a name="%2A%2A%2F%5C%2A%2A" - ><a href="Operators.html#%2A%2A%2F%5C%2A%2A" - ><span class="hs-operator" - >**/\**</span + ><span class="annot" + ><span class="annottext" + >[[a]] -> [[a]] -> [[a]] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%2B%2B%2B" + ><span class="hs-operator hs-var" + >+++</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><span class="annot" + ><span class="annottext" + >[[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" >b</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >zipWith</span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="Operators.html#%2A%2F%5C%2A" - ><span class="hs-operator hs-var" - >*/\*</span - ></a - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a - ><span - > </span - ><a href="Operators.html#%2B%2B%2B" - ><span class="hs-operator hs-var" - >+++</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ></span ><span class="hs-special" >]</span ><span > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >[[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span > </span - ><a href="Operators.html#%24%24%24" - ><span class="hs-operator hs-var" - >$$$</span - ></a + ><span class="annot" + ><span class="annottext" + >[[a]] -> [[a]] -> [[a]] +forall a. [a] -> [a] -> [a] +</span + ><a href="Operators.html#%24%24%24" + ><span class="hs-operator hs-var" + >$$$</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >[[a]] +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-19" - ></a + ><span id="line-19" + ></span ><span > </span - ><a name="line-20" - ></a + ><span id="line-20" + ></span ><span > </span - ><a name="line-21" - ></a - ><span class="hs-special" - >(</span - ><span class="hs-operator" - >#.#</span - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >c</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >,</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span - ><span class="hs-special" - >)</span + ><span id="line-21" + ></span + ><span id="" + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Operators.html#%23.%23" + ><span class="hs-operator hs-type" + >(#.#)</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >c</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span class="hs-special" + >)</span + ></span + ></span + ></span ><span > </span - ><a name="line-22" - ></a - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="%23.%23" - ><a href="Operators.html#%23.%23" - ><span class="hs-operator" - >#.#</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="line-22" + ></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >a :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="%23.%23" + ><span class="annot" + ><span class="annottext" + >#.# :: a -> b -> c -> (a, b) +</span + ><a href="Operators.html#%23.%23" + ><span class="hs-operator hs-var hs-var" + >#.#</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >b :: b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >const</span + ><span class="annot" + ><span class="annottext" + >(a, b) -> c -> (a, b) +forall a b. a -> b -> a +</span + ><span class="hs-identifier hs-var" + >const</span + ></span ><span > </span - ><span class="hs-operator hs-var" - >$</span + ><span class="annot" + ><span class="annottext" + >((a, b) -> c -> (a, b)) -> (a, b) -> c -> (a, b) +forall a b. (a -> b) -> a -> b +</span + ><span class="hs-operator hs-var" + >$</span + ></span ><span > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >a</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >b</span - ></a + ><span class="annot" + ><span class="annottext" + >b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/Polymorphism.html b/hypsrc-test/ref/src/Polymorphism.html index 602246e0..ec9c49e8 100644 --- a/hypsrc-test/ref/src/Polymorphism.html +++ b/hypsrc-test/ref/src/Polymorphism.html @@ -11,25 +11,25 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span class="hs-pragma" >{-# LANGUAGE ScopedTypeVariables #-}</span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a + ><span id="line-4" + ></span ><span > </span - ><a name="line-5" - ></a + ><span id="line-5" + ></span ><span class="hs-keyword" >module</span ><span @@ -43,81 +43,108 @@ ><span > </span - ><a name="line-6" - ></a - ><span - > -</span - ><a name="line-7" - ></a - ><span - > -</span - ><a name="line-8" - ></a - ><span class="hs-identifier" - >foo</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-9" - ></a - ><a name="foo" - ><a href="Polymorphism.html#foo" - ><span class="hs-identifier" - >foo</span - ></a - ></a + ><span id="line-6" + ></span + ><span + > +</span + ><span id="line-7" + ></span + ><span + > +</span + ><span id="line-8" + ></span + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#foo" + ><span class="hs-identifier hs-type" + >foo</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > +</span + ><span id="line-9" + ></span + ><span id="foo" + ><span class="annot" + ><span class="annottext" + >foo :: a -> a -> a +</span + ><a href="Polymorphism.html#foo" + ><span class="hs-identifier hs-var hs-var" + >foo</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-10" - ></a + ><span id="line-10" + ></span ><span > </span - ><a name="line-11" - ></a - ><span class="hs-identifier" - >foo'</span + ><span id="line-11" + ></span + ><span class="annot" + ><a href="Polymorphism.html#foo%27" + ><span class="hs-identifier hs-type" + >foo'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -128,144 +155,194 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-12" - ></a - ><a name="foo%27" - ><a href="Polymorphism.html#foo%27" - ><span class="hs-identifier" - >foo'</span + ><span class="hs-identifier hs-type" + >a</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span + ></span ><span > </span - ><a name="line-13" - ></a - ><span - > + ><span id="line-12" + ></span + ><span id="foo%27" + ><span class="annot" + ><span class="annottext" + >foo' :: a -> a -> a </span - ><a name="line-14" - ></a - ><span class="hs-identifier" - >bar</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><a href="Polymorphism.html#foo%27" + ><span class="hs-identifier hs-var hs-var" + >foo'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >,</span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span - ><span - > -</span - ><a name="line-15" - ></a - ><a name="bar" - ><a href="Polymorphism.html#bar" - ><span class="hs-identifier" - >bar</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-13" + ></span + ><span + > +</span + ><span id="line-14" + ></span + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ></span + ></span + ><span + > +</span + ><span id="line-15" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: a -> b -> (a, b) +</span + ><a href="Polymorphism.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >a -> b -> (a, b) +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a - ><span class="hs-identifier" - >bar'</span + ><span id="line-17" + ></span + ><span class="annot" + ><a href="Polymorphism.html#bar%27" + ><span class="hs-identifier hs-type" + >bar'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -276,38 +353,46 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -316,150 +401,200 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-18" - ></a - ><a name="bar%27" - ><a href="Polymorphism.html#bar%27" - ><span class="hs-identifier" - >bar'</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span - ><span - > -</span - ><a name="line-19" - ></a - ><span - > + ><span id="line-18" + ></span + ><span id="bar%27" + ><span class="annot" + ><span class="annottext" + >bar' :: a -> b -> (a, b) </span - ><a name="line-20" - ></a - ><span class="hs-identifier" - >baz</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><a href="Polymorphism.html#bar%27" + ><span class="hs-identifier hs-var hs-var" + >bar'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span + >=</span ><span > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > -</span - ><a name="line-21" - ></a - ><a name="baz" - ><a href="Polymorphism.html#baz" - ><span class="hs-identifier" - >baz</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >a -> b -> (a, b) +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-19" + ></span + ><span + > +</span + ><span id="line-20" + ></span + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#baz" + ><span class="hs-identifier hs-type" + >baz</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span + ></span + ><span + > +</span + ><span id="line-21" + ></span + ><span id="baz" + ><span class="annot" + ><span class="annottext" + >baz :: a -> (a -> [a -> a] -> b) -> b +</span + ><a href="Polymorphism.html#baz" + ><span class="hs-identifier hs-var hs-var" + >baz</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >a -> (a -> [a -> a] -> b) -> b +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-22" - ></a + ><span id="line-22" + ></span ><span > </span - ><a name="line-23" - ></a - ><span class="hs-identifier" - >baz'</span + ><span id="line-23" + ></span + ><span class="annot" + ><a href="Polymorphism.html#baz%27" + ><span class="hs-identifier hs-type" + >baz'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -470,28 +605,34 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -500,10 +641,12 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -512,20 +655,24 @@ > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >]</span ><span @@ -534,10 +681,12 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -546,154 +695,213 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span - > -</span - ><a name="line-24" - ></a - ><a name="baz%27" - ><a href="Polymorphism.html#baz%27" - ><span class="hs-identifier" - >baz'</span + ><span class="hs-identifier hs-type" + >b</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span + ></span ><span > </span - ><a name="line-25" - ></a - ><span - > + ><span id="line-24" + ></span + ><span id="baz%27" + ><span class="annot" + ><span class="annottext" + >baz' :: a -> (a -> [a -> a] -> b) -> b </span - ><a name="line-26" - ></a - ><span class="hs-identifier" - >quux</span + ><a href="Polymorphism.html#baz%27" + ><span class="hs-identifier hs-var hs-var" + >baz'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><span class="hs-keyword" - >forall</span - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span class="hs-operator" - >.</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >)</span + ><span class="annot" + ><span class="annottext" + >a -> (a -> [a -> a] -> b) -> b +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-25" + ></span + ><span + > +</span + ><span id="line-26" + ></span + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#quux" + ><span class="hs-identifier hs-type" + >quux</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="hs-keyword" + >forall</span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span class="hs-operator" + >.</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > +</span + ><span id="line-27" + ></span + ><span id="quux" + ><span class="annot" + ><span class="annottext" + >quux :: a -> (forall a. a -> a) -> a +</span + ><a href="Polymorphism.html#quux" + ><span class="hs-identifier hs-var hs-var" + >quux</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >f :: forall a. a -> a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > + ><span class="annot" + ><span class="annottext" + >a -> a +forall a. a -> a </span - ><a name="line-27" - ></a - ><a name="quux" - ><a href="Polymorphism.html#quux" - ><span class="hs-identifier" - >quux</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span ></a - ></a + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" >x</span ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ></span ><span > </span - ><a name="line-28" - ></a + ><span id="line-28" + ></span ><span > </span - ><a name="line-29" - ></a - ><span class="hs-identifier" - >quux'</span + ><span id="line-29" + ></span + ><span class="annot" + ><a href="Polymorphism.html#quux%27" + ><span class="hs-identifier hs-type" + >quux'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -704,20 +912,24 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -730,30 +942,36 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -762,145 +980,204 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-30" - ></a - ><a name="quux%27" - ><a href="Polymorphism.html#quux%27" - ><span class="hs-identifier" - >quux'</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f</span + ><span class="hs-identifier hs-type" + >a</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >f</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ></span ><span > </span - ><a name="line-31" - ></a - ><span - > + ><span id="line-30" + ></span + ><span id="quux%27" + ><span class="annot" + ><span class="annottext" + >quux' :: a -> (forall a. a -> a) -> a </span - ><a name="line-32" - ></a - ><span - > -</span - ><a name="line-33" - ></a - ><span class="hs-identifier" - >num</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Num</span + ><a href="Polymorphism.html#quux%27" + ><span class="hs-identifier hs-var hs-var" + >quux'</span + ></a + ></span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >=></span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f :: forall a. a -> a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + >=</span ><span > </span - ><span class="hs-glyph" - >-></span + ><span class="annot" + ><span class="annottext" + >a -> a +forall a. a -> a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > + ><span class="annot" + ><span class="annottext" + >a </span - ><a name="line-34" - ></a - ><a name="num" - ><a href="Polymorphism.html#num" - ><span class="hs-identifier" - >num</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span ></a - ></a + ></span + ><span + > +</span + ><span id="line-31" + ></span + ><span + > +</span + ><span id="line-32" + ></span + ><span + > +</span + ><span id="line-33" + ></span + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#num" + ><span class="hs-identifier hs-type" + >num</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Num</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > +</span + ><span id="line-34" + ></span + ><span id="num" + ><span class="annot" + ><span class="annottext" + >num :: a -> a -> a +</span + ><a href="Polymorphism.html#num" + ><span class="hs-identifier hs-var hs-var" + >num</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-35" - ></a + ><span id="line-35" + ></span ><span > </span - ><a name="line-36" - ></a - ><span class="hs-identifier" - >num'</span + ><span id="line-36" + ></span + ><span class="annot" + ><a href="Polymorphism.html#num%27" + ><span class="hs-identifier hs-type" + >num'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -911,196 +1188,258 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Num</span + >Num</span + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-37" - ></a - ><a name="num%27" - ><a href="Polymorphism.html#num%27" - ><span class="hs-identifier" - >num'</span + ><span class="hs-identifier hs-type" + >a</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span + ></span ><span > </span - ><a name="line-38" - ></a - ><span - > + ><span id="line-37" + ></span + ><span id="num%27" + ><span class="annot" + ><span class="annottext" + >num' :: a -> a -> a </span - ><a name="line-39" - ></a - ><span class="hs-identifier" - >eq</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-special" - >(</span - ><span class="hs-identifier hs-type" - >Eq</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >,</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Eq</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span + ><a href="Polymorphism.html#num%27" + ><span class="hs-identifier hs-var hs-var" + >num'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >=></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >[</span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >]</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >,</span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a - ><span class="hs-special" - >)</span - ><span - > -</span - ><a name="line-40" - ></a - ><a name="eq" - ><a href="Polymorphism.html#eq" - ><span class="hs-identifier" - >eq</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >a -> a -> a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-38" + ></span + ><span + > +</span + ><span id="line-39" + ></span + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#eq" + ><span class="hs-identifier hs-type" + >eq</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Eq</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Eq</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >[</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >]</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >,</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ><span class="hs-special" + >)</span + ></span + ></span + ><span + > +</span + ><span id="line-40" + ></span + ><span id="eq" + ><span class="annot" + ><span class="annottext" + >eq :: [a] -> [b] -> (a, b) +</span + ><a href="Polymorphism.html#eq" + ><span class="hs-identifier hs-var hs-var" + >eq</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >[a] -> [b] -> (a, b) +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-41" - ></a + ><span id="line-41" + ></span ><span > </span - ><a name="line-42" - ></a - ><span class="hs-identifier" - >eq'</span + ><span id="line-42" + ></span + ><span class="annot" + ><a href="Polymorphism.html#eq%27" + ><span class="hs-identifier hs-type" + >eq'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1111,46 +1450,58 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><span class="hs-identifier hs-type" - >Eq</span + >Eq</span + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Eq</span + >Eq</span + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -1161,10 +1512,12 @@ > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >]</span ><span @@ -1175,10 +1528,12 @@ > </span ><span class="hs-special" >[</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >]</span ><span @@ -1189,142 +1544,194 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-43" - ></a - ><a name="eq%27" - ><a href="Polymorphism.html#eq%27" - ><span class="hs-identifier" - >eq'</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span - ><span - > -</span - ><a name="line-44" - ></a - ><span - > + ><span id="line-43" + ></span + ><span id="eq%27" + ><span class="annot" + ><span class="annottext" + >eq' :: [a] -> [b] -> (a, b) </span - ><a name="line-45" - ></a - ><span class="hs-identifier" - >mon</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Monad</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a - ><span - > </span - ><span class="hs-glyph" - >=></span - ><span - > </span - ><span class="hs-special" - >(</span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><a href="Polymorphism.html#eq%27" + ><span class="hs-identifier hs-var hs-var" + >eq'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >)</span - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-46" - ></a - ><a name="mon" - ><a href="Polymorphism.html#mon" - ><span class="hs-identifier" - >mon</span - ></a - ></a + ><span class="annot" + ><span class="annottext" + >[a] -> [b] -> (a, b) +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-44" + ></span + ><span + > +</span + ><span id="line-45" + ></span + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#mon" + ><span class="hs-identifier hs-type" + >mon</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Monad</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ></span + ><span + > +</span + ><span id="line-46" + ></span + ><span id="mon" + ><span class="annot" + ><span class="annottext" + >mon :: (a -> m a) -> m a +</span + ><a href="Polymorphism.html#mon" + ><span class="hs-identifier hs-var hs-var" + >mon</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier hs-var" - >undefined</span + ><span class="annot" + ><span class="annottext" + >(a -> m a) -> m a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span ><span > </span - ><a name="line-47" - ></a + ><span id="line-47" + ></span ><span > </span - ><a name="line-48" - ></a - ><span class="hs-identifier" - >mon'</span + ><span id="line-48" + ></span + ><span class="annot" + ><a href="Polymorphism.html#mon%27" + ><span class="hs-identifier hs-type" + >mon'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1335,32 +1742,40 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >m</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Monad</span + >Monad</span + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1369,26 +1784,32 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -1397,173 +1818,232 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >m</span - ></a + ><span class="hs-identifier hs-type" + >m</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > -</span - ><a name="line-49" - ></a - ><a name="mon%27" - ><a href="Polymorphism.html#mon%27" - ><span class="hs-identifier" - >mon'</span + ><span class="hs-identifier hs-type" + >a</span ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><span class="hs-identifier hs-var" - >undefined</span + ></span ><span > </span - ><a name="line-50" - ></a - ><span - > -</span - ><a name="line-51" - ></a - ><span - > + ><span id="line-49" + ></span + ><span id="mon%27" + ><span class="annot" + ><span class="annottext" + >mon' :: (a -> m a) -> m a </span - ><a name="line-52" - ></a - ><span class="hs-identifier" - >norf</span - ><span - > </span - ><span class="hs-glyph" - >::</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span - ><span - > </span - ><span class="hs-special" - >(</span - ><span class="hs-keyword" - >forall</span - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span class="hs-operator" - >.</span - ><span - > </span - ><span class="hs-identifier hs-type" - >Ord</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><a href="Polymorphism.html#mon%27" + ><span class="hs-identifier hs-var hs-var" + >mon'</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >=></span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > </span - ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span class="hs-special" - >)</span + ><span class="annot" + ><span class="annottext" + >(a -> m a) -> m a +forall a. HasCallStack => a +</span + ><span class="hs-identifier hs-var" + >undefined</span + ></span + ><span + > +</span + ><span id="line-50" + ></span + ><span + > +</span + ><span id="line-51" + ></span + ><span + > +</span + ><span id="line-52" + ></span + ><span id="" + ><span class="annot" + ><a href="Polymorphism.html#norf" + ><span class="hs-identifier hs-type" + >norf</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="hs-special" + >(</span + ><span class="hs-keyword" + >forall</span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span class="hs-operator" + >.</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >Ord</span + ></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >=></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ><span class="hs-special" + >)</span + ><span + > </span + ><span class="hs-glyph" + >-></span + ><span + > </span + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > +</span + ><span id="line-53" + ></span + ><span id="norf" + ><span class="annot" + ><span class="annottext" + >norf :: a -> (forall a. Ord a => a -> a) -> a +</span + ><a href="Polymorphism.html#norf" + ><span class="hs-identifier hs-var hs-var" + >norf</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >f :: forall a. Ord a => a -> a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" - >-></span + >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a - ><span - > + ><span class="annot" + ><span class="annottext" + >a </span - ><a name="line-53" - ></a - ><a name="norf" - ><a href="Polymorphism.html#norf" - ><span class="hs-identifier" - >norf</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" + ><a href="#" + ><span class="hs-identifier hs-var" >x</span ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f</span - ></a - ></a - ><span - > </span - ><span class="hs-glyph" - >=</span - ><span - > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ></span ><span > </span - ><a name="line-54" - ></a + ><span id="line-54" + ></span ><span > </span - ><a name="line-55" - ></a - ><span class="hs-identifier" - >norf'</span + ><span id="line-55" + ></span + ><span class="annot" + ><a href="Polymorphism.html#norf%27" + ><span class="hs-identifier hs-type" + >norf'</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1574,20 +2054,24 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1600,44 +2084,54 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Ord</span + >Ord</span + ></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -1646,64 +2140,90 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span - ><a name="line-56" - ></a - ><a name="norf%27" - ><a href="Polymorphism.html#norf%27" - ><span class="hs-identifier" - >norf'</span - ></a - ></a + ><span id="line-56" + ></span + ><span id="norf%27" + ><span class="annot" + ><span class="annottext" + >norf' :: a -> (forall a. Ord a => a -> a) -> a +</span + ><a href="Polymorphism.html#norf%27" + ><span class="hs-identifier hs-var hs-var" + >norf'</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f :: forall a. Ord a => a -> a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a name="line-57" - ></a + ><span id="line-57" + ></span ><span > </span - ><a name="line-58" - ></a + ><span id="line-58" + ></span ><span > </span - ><a name="line-59" - ></a - ><span class="hs-identifier" - >plugh</span + ><span id="line-59" + ></span + ><span class="annot" + ><a href="Polymorphism.html#plugh" + ><span class="hs-identifier hs-type" + >plugh</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1714,81 +2234,108 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span - ><a name="line-60" - ></a - ><a name="plugh" - ><a href="Polymorphism.html#plugh" - ><span class="hs-identifier" - >plugh</span - ></a - ></a + ><span id="line-60" + ></span + ><span id="plugh" + ><span class="annot" + ><span class="annottext" + >plugh :: a -> a +</span + ><a href="Polymorphism.html#plugh" + ><span class="hs-identifier hs-var hs-var" + >plugh</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span - ><a name="line-61" - ></a + ><span id="line-61" + ></span ><span > </span - ><a name="line-62" - ></a - ><span class="hs-identifier" - >thud</span + ><span id="line-62" + ></span + ><span class="annot" + ><a href="Polymorphism.html#thud" + ><span class="hs-identifier hs-type" + >thud</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1799,40 +2346,48 @@ >forall</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span class="hs-operator" >.</span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -1841,10 +2396,12 @@ >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -1853,47 +2410,66 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-63" - ></a - ><a name="thud" - ><a href="Polymorphism.html#thud" - ><span class="hs-identifier" - >thud</span - ></a - ></a + ><span id="line-63" + ></span + ><span id="thud" + ><span class="annot" + ><span class="annottext" + >thud :: (a -> b) -> a -> (a, b) +</span + ><a href="Polymorphism.html#thud" + ><span class="hs-identifier hs-var hs-var" + >thud</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >f</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >f :: a -> b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -1901,34 +2477,46 @@ ><span > </span - ><a name="line-64" - ></a + ><span id="line-64" + ></span ><span > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -1939,25 +2527,29 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-65" - ></a + ><span id="line-65" + ></span ><span > </span ><span class="hs-keyword" @@ -1965,16 +2557,21 @@ ><span > </span - ><a name="line-66" - ></a + ><span id="line-66" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: b +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -1983,53 +2580,69 @@ > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >f</span - ></a + ><span class="annot" + ><span class="annottext" + >a -> b +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >f</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >a</span - ></a + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >a +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="#" - ><span class="hs-identifier hs-type" - >b</span - ></a + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span ><span > </span - ><a name="line-67" - ></a + ><span id="line-67" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/PositionPragmas.html b/hypsrc-test/ref/src/PositionPragmas.html new file mode 100644 index 00000000..ddd73f31 --- /dev/null +++ b/hypsrc-test/ref/src/PositionPragmas.html @@ -0,0 +1,172 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><link rel="stylesheet" type="text/css" href="style.css" + /><script type="text/javascript" src="highlight.js" + ></script + ></head + ><body + ><pre + ><span class="hs-keyword" + >module</span + ><span + > </span + ><span class="hs-identifier" + >PositionPragmas</span + ><span + > </span + ><span class="hs-keyword" + >where</span + ><span + > +</span + ><span id="line-2" + ></span + ><span + > +</span + ><span id="line-3" + ></span + ><span class="hs-pragma" + >{-# LINE 8 "hypsrc-test/src/PositionPragmas.hs" #-}</span + ><span + > +</span + ><span id="line-8" + ></span + ><span + > +</span + ><span id="line-9" + ></span + ><span class="annot" + ><a href="PositionPragmas.html#foo" + ><span class="hs-identifier hs-type" + >foo</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >String</span + ></span + ><span + > +</span + ><span id="line-10" + ></span + ><span id="foo" + ><span class="annot" + ><span class="annottext" + >foo :: String +</span + ><a href="PositionPragmas.html#foo" + ><span class="hs-identifier hs-var hs-var" + >foo</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >String +</span + ><a href="PositionPragmas.html#bar" + ><span class="hs-identifier hs-var" + >bar</span + ></a + ></span + ><span + > +</span + ><span id="line-11" + ></span + ><span + > +</span + ><span id="line-12" + ></span + ><span class="hs-pragma" + >{-# LINE 23 "hypsrc-test/src/PositionPragmas.hs" #-}</span + ><span + > +</span + ><span id="line-23" + ></span + ><span + > +</span + ><span id="line-24" + ></span + ><span class="annot" + ><a href="PositionPragmas.html#bar" + ><span class="hs-identifier hs-type" + >bar</span + ></a + ></span + ><span + > </span + ><span class="hs-glyph" + >::</span + ><span + > </span + ><span class="annot" + ><span class="hs-identifier hs-type" + >String</span + ></span + ><span + > +</span + ><span id="line-25" + ></span + ><span id="bar" + ><span class="annot" + ><span class="annottext" + >bar :: String +</span + ><a href="PositionPragmas.html#bar" + ><span class="hs-identifier hs-var hs-var" + >bar</span + ></a + ></span + ></span + ><span + > </span + ><span class="hs-glyph" + >=</span + ><span + > </span + ><span class="annot" + ><span class="annottext" + >String +</span + ><a href="PositionPragmas.html#foo" + ><span class="hs-identifier hs-var" + >foo</span + ></a + ></span + ><span + > </span + ><span + > +</span + ><span id="line-26" + ></span + ><span + > +</span + ><span id="line-27" + ></span + ></pre + ></body + ></html +>
\ No newline at end of file diff --git a/hypsrc-test/ref/src/Records.html b/hypsrc-test/ref/src/Records.html index 7d23d114..5057b8a4 100644 --- a/hypsrc-test/ref/src/Records.html +++ b/hypsrc-test/ref/src/Records.html @@ -11,25 +11,25 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span class="hs-pragma" >{-# LANGUAGE RecordWildCards #-}</span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a + ><span id="line-4" + ></span ><span > </span - ><a name="line-5" - ></a + ><span id="line-5" + ></span ><span class="hs-keyword" >module</span ><span @@ -43,57 +43,66 @@ ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span - ><a name="line-7" - ></a + ><span id="line-7" + ></span ><span > </span - ><a name="line-8" - ></a + ><span id="line-8" + ></span ><span class="hs-keyword" >data</span ><span > </span - ><a name="Point" - ><a href="Records.html#Point" - ><span class="hs-identifier" - >Point</span - ></a - ></a + ><span id="Point" + ><span class="annot" + ><a href="Records.html#Point" + ><span class="hs-identifier hs-var" + >Point</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="Point" - ><a href="Records.html#Point" - ><span class="hs-identifier" - >Point</span - ></a - ></a + ><span id="Point" + ><span class="annot" + ><a href="Records.html#Point" + ><span class="hs-identifier hs-var" + >Point</span + ></a + ></span + ></span ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><a name="x" - ><a href="Records.html#x" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="x" + ><span class="annot" + ><span class="annottext" + >Point -> Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var hs-var" + >x</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -102,25 +111,32 @@ > </span ><span class="hs-glyph" >!</span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-10" - ></a + ><span id="line-10" + ></span ><span > </span ><span class="hs-special" >,</span ><span > </span - ><a name="y" - ><a href="Records.html#y" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="y" + ><span class="annot" + ><span class="annottext" + >Point -> Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -129,13 +145,15 @@ > </span ><span class="hs-glyph" >!</span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-11" - ></a + ><span id="line-11" + ></span ><span > </span ><span class="hs-special" @@ -143,117 +161,171 @@ ><span > </span - ><a name="line-12" - ></a + ><span id="line-12" + ></span ><span > </span - ><a name="line-13" - ></a + ><span id="line-13" + ></span ><span > </span - ><a name="line-14" - ></a - ><span class="hs-identifier" - >point</span + ><span id="line-14" + ></span + ><span class="annot" + ><a href="Records.html#point" + ><span class="hs-identifier hs-type" + >point</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span - ><a name="line-15" - ></a - ><a name="point" - ><a href="Records.html#point" - ><span class="hs-identifier" - >point</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="line-15" + ></span + ><span id="point" + ><span class="annot" + ><span class="annottext" + >point :: Int -> Int -> Point +</span + ><a href="Records.html#point" + ><span class="hs-identifier hs-var hs-var" + >point</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="Records.html#Point" - ><span class="hs-identifier hs-var" - >Point</span - ></a + ><span class="annot" + ><span class="annottext" + >$WPoint :: Int -> Int -> Point +</span + ><a href="Records.html#%24WPoint" + ><span class="hs-identifier hs-type hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><span class="hs-identifier" - >x</span + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >y</span + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -261,95 +333,134 @@ ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a + ><span id="line-17" + ></span ><span > </span - ><a name="line-18" - ></a - ><span class="hs-identifier" - >lengthSqr</span + ><span id="line-18" + ></span + ><span class="annot" + ><a href="Records.html#lengthSqr" + ><span class="hs-identifier hs-type" + >lengthSqr</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-19" - ></a - ><a name="lengthSqr" - ><a href="Records.html#lengthSqr" - ><span class="hs-identifier" - >lengthSqr</span - ></a - ></a + ><span id="line-19" + ></span + ><span id="lengthSqr" + ><span class="annot" + ><span class="annottext" + >lengthSqr :: Point -> Int +</span + ><a href="Records.html#lengthSqr" + ><span class="hs-identifier hs-var hs-var" + >lengthSqr</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-var" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><span class="hs-identifier" - >x</span + ><span class="annot" + ><span class="annottext" + >x :: Point -> Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >y</span + ><span class="annot" + ><span class="annottext" + >y :: Point -> Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" @@ -362,111 +473,178 @@ >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><a name="line-20" - ></a + ><span id="line-20" + ></span ><span > </span - ><a name="line-21" - ></a - ><span class="hs-identifier" - >lengthSqr'</span + ><span id="line-21" + ></span + ><span class="annot" + ><a href="Records.html#lengthSqr%27" + ><span class="hs-identifier hs-type" + >lengthSqr'</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-22" - ></a - ><a name="lengthSqr%27" - ><a href="Records.html#lengthSqr%27" - ><span class="hs-identifier" - >lengthSqr'</span - ></a - ></a + ><span id="line-22" + ></span + ><span id="lengthSqr%27" + ><span class="annot" + ><span class="annottext" + >lengthSqr' :: Point -> Int +</span + ><a href="Records.html#lengthSqr%27" + ><span class="hs-identifier hs-var hs-var" + >lengthSqr'</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-var" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >Int +x :: Int +x :: Point -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >x</span + ></a + ></span + ></span ><span class="hs-special" >,</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >Int +y :: Int +y :: Point -> Int +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >y</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" @@ -479,160 +657,262 @@ >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >*</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >*</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ><span > </span - ><a name="line-24" - ></a + ><span id="line-24" + ></span ><span > </span - ><a name="line-25" - ></a - ><span class="hs-identifier" - >translateX</span + ><span id="line-25" + ></span + ><span class="annot" + ><a href="Records.html#translateX" + ><span class="hs-identifier hs-type" + >translateX</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >translateY</span + ><span class="annot" + ><a href="Records.html#translateY" + ><span class="hs-identifier hs-type" + >translateY</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span - ><a name="line-26" - ></a - ><a name="translateX" - ><a href="Records.html#translateX" - ><span class="hs-identifier" - >translateX</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >p</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >d</span - ></a - ></a + ><span id="line-26" + ></span + ><span id="translateX" + ><span class="annot" + ><span class="annottext" + >translateX :: Point -> Int -> Point +</span + ><a href="Records.html#translateX" + ><span class="hs-identifier hs-var hs-var" + >translateX</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >p :: Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >d :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >d</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><span class="hs-identifier" - >x</span + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier" - >x</span + ><span class="annot" + ><span class="annottext" + >Point -> Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var hs-var" + >x</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >d</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >d</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -640,72 +920,122 @@ ><span > </span - ><a name="line-27" - ></a - ><a name="translateY" - ><a href="Records.html#translateY" - ><span class="hs-identifier" - >translateY</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >p</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >d</span - ></a - ></a + ><span id="line-27" + ></span + ><span id="translateY" + ><span class="annot" + ><span class="annottext" + >translateY :: Point -> Int -> Point +</span + ><a href="Records.html#translateY" + ><span class="hs-identifier hs-var hs-var" + >translateY</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >p :: Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >d :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >d</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><span class="hs-identifier" - >y</span + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><span class="hs-identifier" - >y</span + ><span class="annot" + ><span class="annottext" + >Point -> Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var hs-var" + >y</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >d</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >d</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -713,86 +1043,118 @@ ><span > </span - ><a name="line-28" - ></a + ><span id="line-28" + ></span ><span > </span - ><a name="line-29" - ></a - ><span class="hs-identifier" - >translate</span + ><span id="line-29" + ></span + ><span class="annot" + ><a href="Records.html#translate" + ><span class="hs-identifier hs-type" + >translate</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span - ></a + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span ><span > </span - ><a name="line-30" - ></a - ><a name="translate" - ><a href="Records.html#translate" - ><span class="hs-identifier" - >translate</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >x</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >y</span - ></a - ></a - ><span - > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >p</span - ></a - ></a + ><span id="line-30" + ></span + ><span id="translate" + ><span class="annot" + ><span class="annottext" + >translate :: Int -> Int -> Point -> Point +</span + ><a href="Records.html#translate" + ><span class="hs-identifier hs-var hs-var" + >translate</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span class="annot" + ><span class="annottext" + >p :: Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -800,25 +1162,35 @@ ><span > </span - ><a name="line-31" - ></a + ><span id="line-31" + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >aux</span - ></a + ><span class="annot" + ><span class="annottext" + >Point -> Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >aux</span + ></a + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span - ><a name="line-32" - ></a + ><span id="line-32" + ></span ><span > </span ><span class="hs-keyword" @@ -826,28 +1198,38 @@ ><span > </span - ><a name="line-33" - ></a + ><span id="line-33" + ></span ><span > </span ><span class="hs-special" >(</span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >dx</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >dx :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >dx</span + ></a + ></span + ></span ><span class="hs-special" >,</span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >dy</span - ></a - ></a + ><span id="" + ><span class="annot" + ><span class="annottext" + >dy :: Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >dy</span + ></a + ></span + ></span ><span class="hs-special" >)</span ><span @@ -858,109 +1240,181 @@ > </span ><span class="hs-special" >(</span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-34" - ></a + ><span id="line-34" + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >aux</span - ></a - ></a - ><span - > </span - ><a href="Records.html#Point" - ><span class="hs-identifier hs-var" - >Point</span - ></a - ><span class="hs-special" - >{</span - ><span class="hs-glyph" - >..</span - ><span class="hs-special" - >}</span + ><span id="" + ><span class="annot" + ><span class="annottext" + >aux :: Point -> Point +</span + ><a href="#" + ><span class="hs-identifier hs-var hs-var" + >aux</span + ></a + ></span + ></span + ><span + > </span + ><span id="" + ><span id="" + ><span class="annot" + ><a href="Records.html#Point" + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span + ><span class="hs-special" + >{</span + ><span class="hs-glyph" + >..</span + ><span class="hs-special" + >}</span + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >p</span - ></a + ><span class="annot" + ><span class="annottext" + >Point +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >p</span + ></a + ></span ><span > </span ><span class="hs-special" >{</span ><span > </span - ><span class="hs-identifier" - >x</span + ><span class="annot" + ><span class="annottext" + >x :: Int +</span + ><a href="Records.html#x" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >x</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >x</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >dx</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >dx</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span - ><span class="hs-identifier" - >y</span + ><span class="annot" + ><span class="annottext" + >y :: Int +</span + ><a href="Records.html#y" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >y</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >y</span + ></a + ></span ><span > </span - ><span class="hs-operator hs-var" - >+</span + ><span class="annot" + ><span class="annottext" + >Int -> Int -> Int +forall a. Num a => a -> a -> a +</span + ><span class="hs-operator hs-var" + >+</span + ></span ><span > </span - ><a href="#" - ><span class="hs-identifier hs-var" - >dy</span - ></a + ><span class="annot" + ><span class="annottext" + >Int +</span + ><a href="#" + ><span class="hs-identifier hs-var" + >dy</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -968,8 +1422,8 @@ ><span > </span - ><a name="line-35" - ></a + ><span id="line-35" + ></span ></pre ></body ></html diff --git a/hypsrc-test/ref/src/Types.html b/hypsrc-test/ref/src/Types.html index a8be9e78..22012ad1 100644 --- a/hypsrc-test/ref/src/Types.html +++ b/hypsrc-test/ref/src/Types.html @@ -11,18 +11,18 @@ ><span > </span - ><a name="line-2" - ></a + ><span id="line-2" + ></span ><span > </span - ><a name="line-3" - ></a + ><span id="line-3" + ></span ><span > </span - ><a name="line-4" - ></a + ><span id="line-4" + ></span ><span class="hs-keyword" >module</span ><span @@ -36,84 +36,94 @@ ><span > </span - ><a name="line-5" - ></a + ><span id="line-5" + ></span ><span > </span - ><a name="line-6" - ></a + ><span id="line-6" + ></span ><span > </span - ><a name="line-7" - ></a + ><span id="line-7" + ></span ><span class="hs-keyword" >data</span ><span > </span - ><a name="Quux" - ><a href="Types.html#Quux" - ><span class="hs-identifier" - >Quux</span - ></a - ></a + ><span id="Quux" + ><span class="annot" + ><a href="Types.html#Quux" + ><span class="hs-identifier hs-var" + >Quux</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="Bar" - ><a href="Types.html#Bar" - ><span class="hs-identifier" - >Bar</span - ></a - ></a + ><span id="Bar" + ><span class="annot" + ><a href="Types.html#Bar" + ><span class="hs-identifier hs-var" + >Bar</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >|</span ><span > </span - ><a name="Baz" - ><a href="Types.html#Baz" - ><span class="hs-identifier" - >Baz</span - ></a - ></a + ><span id="Baz" + ><span class="annot" + ><a href="Types.html#Baz" + ><span class="hs-identifier hs-var" + >Baz</span + ></a + ></span + ></span ><span > </span - ><a name="line-8" - ></a + ><span id="line-8" + ></span ><span > </span - ><a name="line-9" - ></a + ><span id="line-9" + ></span ><span class="hs-keyword" >newtype</span ><span > </span - ><a name="Foo" - ><a href="Types.html#Foo" - ><span class="hs-identifier" - >Foo</span - ></a - ></a + ><span id="Foo" + ><span class="annot" + ><a href="Types.html#Foo" + ><span class="hs-identifier hs-var" + >Foo</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="Foo" - ><a href="Types.html#Foo" - ><span class="hs-identifier" - >Foo</span - ></a - ></a + ><span id="Foo" + ><span class="annot" + ><a href="Types.html#Foo" + ><span class="hs-identifier hs-var" + >Foo</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" @@ -123,23 +133,25 @@ ><span > </span - ><a name="line-10" - ></a + ><span id="line-10" + ></span ><span > </span - ><a name="line-11" - ></a + ><span id="line-11" + ></span ><span class="hs-keyword" >type</span ><span > </span - ><a name="FooQuux" - ><a href="Types.html#FooQuux" - ><span class="hs-identifier" - >FooQuux</span - ></a - ></a + ><span id="FooQuux" + ><span class="annot" + ><a href="Types.html#FooQuux" + ><span class="hs-identifier hs-var" + >FooQuux</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -148,35 +160,41 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-12" - ></a + ><span id="line-12" + ></span ><span class="hs-keyword" >type</span ><span > </span - ><a name="QuuxFoo" - ><a href="Types.html#QuuxFoo" - ><span class="hs-identifier" - >QuuxFoo</span - ></a - ></a + ><span id="QuuxFoo" + ><span class="annot" + ><a href="Types.html#QuuxFoo" + ><span class="hs-identifier hs-var" + >QuuxFoo</span + ></a + ></span + ></span ><span > </span ><span class="hs-glyph" @@ -185,35 +203,39 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-13" - ></a + ><span id="line-13" + ></span ><span > </span - ><a name="line-14" - ></a + ><span id="line-14" + ></span ><span > </span - ><a name="line-15" - ></a + ><span id="line-15" + ></span ><span class="hs-keyword" >data</span ><span @@ -222,38 +244,44 @@ >family</span ><span > </span - ><a name="Norf" - ><a href="Types.html#Norf" - ><span class="hs-identifier" - >Norf</span - ></a - ></a + ><span id="Norf" + ><span class="annot" + ><a href="Types.html#Norf" + ><span class="hs-identifier hs-var" + >Norf</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span > </span - ><a name="line-16" - ></a + ><span id="line-16" + ></span ><span > </span - ><a name="line-17" - ></a + ><span id="line-17" + ></span ><span class="hs-keyword" >data</span ><span @@ -262,51 +290,65 @@ >instance</span ><span > </span - ><a href="Types.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span id="Norf" + ><span class="annot" + ><a href="Types.html#Norf" + ><span class="hs-identifier hs-var" + >Norf</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="NFQ" - ><a href="Types.html#NFQ" - ><span class="hs-identifier" - >NFQ</span - ></a - ></a + ><span id="NFQ" + ><span class="annot" + ><a href="Types.html#NFQ" + ><span class="hs-identifier hs-var" + >NFQ</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span - ><a name="line-18" - ></a + ><span id="line-18" + ></span ><span class="hs-keyword" >data</span ><span @@ -315,61 +357,75 @@ >instance</span ><span > </span - ><a href="Types.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span id="Norf" + ><span class="annot" + ><a href="Types.html#Norf" + ><span class="hs-identifier hs-var" + >Norf</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >=</span ><span > </span - ><a name="NQF" - ><a href="Types.html#NQF" - ><span class="hs-identifier" - >NQF</span - ></a - ></a + ><span id="NQF" + ><span class="annot" + ><a href="Types.html#NQF" + ><span class="hs-identifier hs-var" + >NQF</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span - ><a name="line-19" - ></a + ><span id="line-19" + ></span ><span > </span - ><a name="line-20" - ></a + ><span id="line-20" + ></span ><span > </span - ><a name="line-21" - ></a + ><span id="line-21" + ></span ><span class="hs-keyword" >type</span ><span @@ -378,38 +434,44 @@ >family</span ><span > </span - ><a name="Norf%27" - ><a href="Types.html#Norf%27" - ><span class="hs-identifier" - >Norf'</span - ></a - ></a + ><span id="Norf%27" + ><span class="annot" + ><a href="Types.html#Norf%27" + ><span class="hs-identifier hs-var" + >Norf'</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >a</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >a</span + ></a + ></span + ></span ><span > </span - ><a name="" - ><a href="#" - ><span class="hs-identifier" - >b</span - ></a - ></a + ><span id="" + ><span class="annot" + ><a href="#" + ><span class="hs-identifier hs-type" + >b</span + ></a + ></span + ></span ><span > </span - ><a name="line-22" - ></a + ><span id="line-22" + ></span ><span > </span - ><a name="line-23" - ></a + ><span id="line-23" + ></span ><span class="hs-keyword" >type</span ><span @@ -418,22 +480,30 @@ >instance</span ><span > </span - ><a href="Types.html#Norf%27" - ><span class="hs-identifier hs-type" - >Norf'</span - ></a + ><span id="Norf%27" + ><span class="annot" + ><a href="Types.html#Norf%27" + ><span class="hs-identifier hs-var" + >Norf'</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -442,25 +512,29 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-24" - ></a + ><span id="line-24" + ></span ><span class="hs-keyword" >type</span ><span @@ -469,22 +543,30 @@ >instance</span ><span > </span - ><a href="Types.html#Norf%27" - ><span class="hs-identifier hs-type" - >Norf'</span - ></a + ><span id="Norf%27" + ><span class="annot" + ><a href="Types.html#Norf%27" + ><span class="hs-identifier hs-var" + >Norf'</span + ></a + ></span + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" @@ -493,94 +575,119 @@ > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span class="hs-special" >)</span ><span > </span - ><a name="line-25" - ></a + ><span id="line-25" + ></span ><span > </span - ><a name="line-26" - ></a + ><span id="line-26" + ></span ><span > </span - ><a name="line-27" - ></a - ><span class="hs-identifier" - >norf1</span + ><span id="line-27" + ></span + ><span class="annot" + ><a href="Types.html#norf1" + ><span class="hs-identifier hs-type" + >norf1</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Types.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-28" - ></a - ><a name="norf1" - ><a href="Types.html#norf1" - ><span class="hs-identifier" - >norf1</span - ></a - ></a + ><span id="line-28" + ></span + ><span id="norf1" + ><span class="annot" + ><span class="annottext" + >norf1 :: Norf Foo Quux -> Int +</span + ><a href="Types.html#norf1" + ><span class="hs-identifier hs-var hs-var" + >norf1</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#NFQ" - ><span class="hs-identifier hs-var" - >NFQ</span - ></a + ><span class="hs-identifier hs-type" + >NFQ</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -591,10 +698,12 @@ >)</span ><span > </span + ><span class="annot" ><a href="Types.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -603,31 +712,41 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-29" - ></a - ><span class="hs-identifier" - >norf1</span + ><span id="line-29" + ></span + ><span class="annot" + ><a href="Types.html#norf1" + ><span class="hs-identifier hs-var" + >norf1</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#NFQ" - ><span class="hs-identifier hs-var" - >NFQ</span - ></a + ><span class="hs-identifier hs-type" + >NFQ</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -638,10 +757,12 @@ >)</span ><span > </span + ><span class="annot" ><a href="Types.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -650,83 +771,108 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >1</span + >1</span + ></span ><span > </span - ><a name="line-30" - ></a + ><span id="line-30" + ></span ><span > </span - ><a name="line-31" - ></a - ><span class="hs-identifier" - >norf2</span + ><span id="line-31" + ></span + ><span class="annot" + ><a href="Types.html#norf2" + ><span class="hs-identifier hs-type" + >norf2</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Types.html#Norf" - ><span class="hs-identifier hs-type" - >Norf</span - ></a + ><span class="hs-identifier hs-type" + >Norf</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-32" - ></a - ><a name="norf2" - ><a href="Types.html#norf2" - ><span class="hs-identifier" - >norf2</span - ></a - ></a + ><span id="line-32" + ></span + ><span id="norf2" + ><span class="annot" + ><span class="annottext" + >norf2 :: Norf Quux Foo -> Int +</span + ><a href="Types.html#norf2" + ><span class="hs-identifier hs-var hs-var" + >norf2</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#NQF" - ><span class="hs-identifier hs-var" - >NQF</span - ></a + ><span class="hs-identifier hs-type" + >NQF</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -743,37 +889,49 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-33" - ></a - ><span class="hs-identifier" - >norf2</span + ><span id="line-33" + ></span + ><span class="annot" + ><a href="Types.html#norf2" + ><span class="hs-identifier hs-var" + >norf2</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#NQF" - ><span class="hs-identifier hs-var" - >NQF</span - ></a + ><span class="hs-identifier hs-type" + >NQF</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -790,74 +948,95 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >1</span + >1</span + ></span ><span > </span - ><a name="line-34" - ></a + ><span id="line-34" + ></span ><span > </span - ><a name="line-35" - ></a + ><span id="line-35" + ></span ><span > </span - ><a name="line-36" - ></a - ><span class="hs-identifier" - >norf1'</span + ><span id="line-36" + ></span + ><span class="annot" + ><a href="Types.html#norf1%27" + ><span class="hs-identifier hs-type" + >norf1'</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Types.html#Norf%27" - ><span class="hs-identifier hs-type" - >Norf'</span - ></a + ><span class="hs-identifier hs-type" + >Norf'</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-37" - ></a - ><a name="norf1%27" - ><a href="Types.html#norf1%27" - ><span class="hs-identifier" - >norf1'</span - ></a - ></a + ><span id="line-37" + ></span + ><span id="norf1%27" + ><span class="annot" + ><span class="annottext" + >norf1' :: Norf' Foo Quux -> Int +</span + ><a href="Types.html#norf1%27" + ><span class="hs-identifier hs-var hs-var" + >norf1'</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -868,10 +1047,12 @@ >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -880,23 +1061,31 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-38" - ></a - ><span class="hs-identifier" - >norf1'</span + ><span id="line-38" + ></span + ><span class="annot" + ><a href="Types.html#norf1%27" + ><span class="hs-identifier hs-var" + >norf1'</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -907,10 +1096,12 @@ >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span class="hs-special" >)</span ><span @@ -919,77 +1110,100 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >1</span + >1</span + ></span ><span > </span - ><a name="line-39" - ></a + ><span id="line-39" + ></span ><span > </span - ><a name="line-40" - ></a - ><span class="hs-identifier" - >norf2'</span + ><span id="line-40" + ></span + ><span class="annot" + ><a href="Types.html#norf2%27" + ><span class="hs-identifier hs-type" + >norf2'</span + ></a + ></span ><span > </span ><span class="hs-glyph" >::</span ><span > </span + ><span class="annot" ><a href="Types.html#Norf%27" - ><span class="hs-identifier hs-type" - >Norf'</span - ></a + ><span class="hs-identifier hs-type" + >Norf'</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Quux" - ><span class="hs-identifier hs-type" - >Quux</span - ></a + ><span class="hs-identifier hs-type" + >Quux</span + ></a + ></span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-type" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-glyph" >-></span ><span > </span + ><span class="annot" ><span class="hs-identifier hs-type" - >Int</span + >Int</span + ></span ><span > </span - ><a name="line-41" - ></a - ><a name="norf2%27" - ><a href="Types.html#norf2%27" - ><span class="hs-identifier" - >norf2'</span - ></a - ></a + ><span id="line-41" + ></span + ><span id="norf2%27" + ><span class="annot" + ><span class="annottext" + >norf2' :: Norf' Quux Foo -> Int +</span + ><a href="Types.html#norf2%27" + ><span class="hs-identifier hs-var hs-var" + >norf2'</span + ></a + ></span + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Bar" - ><span class="hs-identifier hs-var" - >Bar</span - ></a + ><span class="hs-identifier hs-type" + >Bar</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -1004,31 +1218,41 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >0</span + >0</span + ></span ><span > </span - ><a name="line-42" - ></a - ><span class="hs-identifier" - >norf2'</span + ><span id="line-42" + ></span + ><span class="annot" + ><a href="Types.html#norf2%27" + ><span class="hs-identifier hs-var" + >norf2'</span + ></a + ></span ><span > </span ><span class="hs-special" >(</span + ><span class="annot" ><a href="Types.html#Baz" - ><span class="hs-identifier hs-var" - >Baz</span - ></a + ><span class="hs-identifier hs-type" + >Baz</span + ></a + ></span ><span class="hs-special" >,</span ><span > </span + ><span class="annot" ><a href="Types.html#Foo" - ><span class="hs-identifier hs-var" - >Foo</span - ></a + ><span class="hs-identifier hs-type" + >Foo</span + ></a + ></span ><span > </span ><span class="hs-special" @@ -1043,13 +1267,15 @@ >=</span ><span > </span + ><span class="annot" ><span class="hs-number" - >1</span + >1</span + ></span ><span > </span - ><a name="line-43" - ></a + ><span id="line-43" + ></span ></pre ></body ></html diff --git a/hypsrc-test/src/ClangCppBug.hs b/hypsrc-test/src/ClangCppBug.hs new file mode 100644 index 00000000..4b0bc35f --- /dev/null +++ b/hypsrc-test/src/ClangCppBug.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} +module ClangCppBug where + +foo :: Int +foo = 1 + +-- Clang doesn't mind these: +#define BAX 2 +{-# INLINE bar #-} + +bar :: Int +bar = 3 + +-- But it doesn't like this: +{-# RULES +"bar/qux" bar = qux +"qux/foo" qux = foo + #-} + +qux :: Int +qux = 88 diff --git a/hypsrc-test/src/LinkingIdentifiers.hs b/hypsrc-test/src/LinkingIdentifiers.hs new file mode 100644 index 00000000..4fff9776 --- /dev/null +++ b/hypsrc-test/src/LinkingIdentifiers.hs @@ -0,0 +1,14 @@ +-- Tests that the identifers/operators are properly linked even when: +-- +-- * backquoted, parenthesized, vanilla +-- * qualified, not-qualified +-- +module LinkingIdentifiers where + +ident :: Int -> Int -> Int +x `ident` 2 = (x `ident` 2) + (x `LinkingIdentifiers.ident` 2) +ident x 2 = ident x 2 + LinkingIdentifiers.ident x 2 + +(++:++) :: Int -> Int -> Int +x ++:++ 2 = (x ++:++ 2) + (x LinkingIdentifiers.++:++ 2) +(++:++) x 2 = (++:++) x 2 + (LinkingIdentifiers.++:++) x 2 diff --git a/hypsrc-test/src/PositionPragmas.hs b/hypsrc-test/src/PositionPragmas.hs new file mode 100644 index 00000000..907316fd --- /dev/null +++ b/hypsrc-test/src/PositionPragmas.hs @@ -0,0 +1,12 @@ +module PositionPragmas where + +{-# LINE 8 "hypsrc-test/src/PositionPragmas.hs" #-} + +foo :: String +foo = bar + +{-# LINE 23 "hypsrc-test/src/PositionPragmas.hs" #-} + +bar :: String +bar = foo + diff --git a/latex-test/ref/NamespacedIdentifier/NamespacedIdentifiers.tex b/latex-test/ref/NamespacedIdentifier/NamespacedIdentifiers.tex new file mode 100644 index 00000000..f39bd0ec --- /dev/null +++ b/latex-test/ref/NamespacedIdentifier/NamespacedIdentifiers.tex @@ -0,0 +1,41 @@ +\haddockmoduleheading{NamespacedIdentifiers} +\label{module:NamespacedIdentifiers} +\haddockbeginheader +{\haddockverb\begin{verbatim} +module NamespacedIdentifiers ( + Foo(Bar), Bar + ) where\end{verbatim}} +\haddockendheader + +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +data\ Foo +\end{tabular}]\haddockbegindoc +A link to:\par +\begin{itemize} +\item +the type \haddockid{Bar}\par + +\item +the constructor \haddockid{Bar}\par + +\item +the unimported but qualified type \haddockid{A}\par + +\item +the unimported but qualified value \haddockid{A}\par + +\end{itemize} + +\enspace \emph{Constructors}\par +\haddockbeginconstrs +\haddockdecltt{=} & \haddockdecltt{Bar} & \\ +\end{tabulary}\par +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +data\ Bar +\end{tabular}]\haddockbegindoc +A link to the value \haddocktt{Foo} (which shouldn't exist).\par + +\end{haddockdesc}
\ No newline at end of file diff --git a/latex-test/ref/NamespacedIdentifier/haddock.sty b/latex-test/ref/NamespacedIdentifier/haddock.sty new file mode 100644 index 00000000..6e031a98 --- /dev/null +++ b/latex-test/ref/NamespacedIdentifier/haddock.sty @@ -0,0 +1,57 @@ +% Default Haddock style definitions. To use your own style, invoke +% Haddock with the option --latex-style=mystyle. + +\usepackage{tabulary} % see below + +% make hyperlinks in the PDF, and add an expandabale index +\usepackage[pdftex,bookmarks=true]{hyperref} + +\newenvironment{haddocktitle} + {\begin{center}\bgroup\large\bfseries} + {\egroup\end{center}} +\newenvironment{haddockprologue}{\vspace{1in}}{} + +\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}} + +\newcommand{\haddockbeginheader}{\hrulefill} +\newcommand{\haddockendheader}{\noindent\hrulefill} + +% a little gap before the ``Methods'' header +\newcommand{\haddockpremethods}{\vspace{2ex}} + +% inserted before \\begin{verbatim} +\newcommand{\haddockverb}{\small} + +% an identifier: add an index entry +\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}} + +% The tabulary environment lets us have a column that takes up ``the +% rest of the space''. Unfortunately it doesn't allow +% the \end{tabulary} to be in the expansion of a macro, it must appear +% literally in the document text, so Haddock inserts +% the \end{tabulary} itself. +\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} +\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} + +\newcommand{\haddocktt}[1]{{\small \texttt{#1}}} +\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}} + +\makeatletter +\newenvironment{haddockdesc} + {\list{}{\labelwidth\z@ \itemindent-\leftmargin + \let\makelabel\haddocklabel}} + {\endlist} +\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}} +\makeatother + +% after a declaration, start a new line for the documentation. +% Otherwise, the documentation starts right after the declaration, +% because we're using the list environment and the declaration is the +% ``label''. I tried making this newline part of the label, but +% couldn't get that to work reliably (the space seemed to stretch +% sometimes). +\newcommand{\haddockbegindoc}{\hfill\\[1ex]} + +% spacing between paragraphs and no \parindent looks better +\parskip=10pt plus2pt minus2pt +\setlength{\parindent}{0cm} diff --git a/latex-test/ref/NamespacedIdentifier/main.tex b/latex-test/ref/NamespacedIdentifier/main.tex new file mode 100644 index 00000000..75493e12 --- /dev/null +++ b/latex-test/ref/NamespacedIdentifier/main.tex @@ -0,0 +1,11 @@ +\documentclass{book} +\usepackage{haddock} +\begin{document} +\begin{titlepage} +\begin{haddocktitle} + +\end{haddocktitle} +\end{titlepage} +\tableofcontents +\input{NamespacedIdentifiers} +\end{document}
\ No newline at end of file diff --git a/latex-test/ref/UnboxedStuff/UnboxedStuff.tex b/latex-test/ref/UnboxedStuff/UnboxedStuff.tex new file mode 100644 index 00000000..36d5c12b --- /dev/null +++ b/latex-test/ref/UnboxedStuff/UnboxedStuff.tex @@ -0,0 +1,36 @@ +\haddockmoduleheading{UnboxedStuff} +\label{module:UnboxedStuff} +\haddockbeginheader +{\haddockverb\begin{verbatim} +module UnboxedStuff ( + X, Y, Z, unboxedUnit, unboxedTuple, unboxedSum + ) where\end{verbatim}} +\haddockendheader + +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +data\ X +\end{tabular}] +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +data\ Y +\end{tabular}] +\end{haddockdesc} +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +data\ Z +\end{tabular}] +\end{haddockdesc} +\section{Unboxed type constructors} +\begin{haddockdesc} +\item[ +unboxedUnit\ ::\ ({\char '43}\ {\char '43})\ ->\ ({\char '43}\ {\char '43}) +] +\item[ +unboxedTuple\ ::\ ({\char '43}\ X,\ Y\ {\char '43})\ ->\ ({\char '43}\ X,\ Y,\ Z\ {\char '43}) +] +\item[ +unboxedSum\ ::\ ({\char '43}\ X\ |\ Y\ {\char '43})\ ->\ ({\char '43}\ X\ |\ Y\ |\ Z\ {\char '43}) +] +\end{haddockdesc}
\ No newline at end of file diff --git a/latex-test/ref/UnboxedStuff/haddock.sty b/latex-test/ref/UnboxedStuff/haddock.sty new file mode 100644 index 00000000..6e031a98 --- /dev/null +++ b/latex-test/ref/UnboxedStuff/haddock.sty @@ -0,0 +1,57 @@ +% Default Haddock style definitions. To use your own style, invoke +% Haddock with the option --latex-style=mystyle. + +\usepackage{tabulary} % see below + +% make hyperlinks in the PDF, and add an expandabale index +\usepackage[pdftex,bookmarks=true]{hyperref} + +\newenvironment{haddocktitle} + {\begin{center}\bgroup\large\bfseries} + {\egroup\end{center}} +\newenvironment{haddockprologue}{\vspace{1in}}{} + +\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}} + +\newcommand{\haddockbeginheader}{\hrulefill} +\newcommand{\haddockendheader}{\noindent\hrulefill} + +% a little gap before the ``Methods'' header +\newcommand{\haddockpremethods}{\vspace{2ex}} + +% inserted before \\begin{verbatim} +\newcommand{\haddockverb}{\small} + +% an identifier: add an index entry +\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}} + +% The tabulary environment lets us have a column that takes up ``the +% rest of the space''. Unfortunately it doesn't allow +% the \end{tabulary} to be in the expansion of a macro, it must appear +% literally in the document text, so Haddock inserts +% the \end{tabulary} itself. +\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} +\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} + +\newcommand{\haddocktt}[1]{{\small \texttt{#1}}} +\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}} + +\makeatletter +\newenvironment{haddockdesc} + {\list{}{\labelwidth\z@ \itemindent-\leftmargin + \let\makelabel\haddocklabel}} + {\endlist} +\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}} +\makeatother + +% after a declaration, start a new line for the documentation. +% Otherwise, the documentation starts right after the declaration, +% because we're using the list environment and the declaration is the +% ``label''. I tried making this newline part of the label, but +% couldn't get that to work reliably (the space seemed to stretch +% sometimes). +\newcommand{\haddockbegindoc}{\hfill\\[1ex]} + +% spacing between paragraphs and no \parindent looks better +\parskip=10pt plus2pt minus2pt +\setlength{\parindent}{0cm} diff --git a/latex-test/ref/UnboxedStuff/main.tex b/latex-test/ref/UnboxedStuff/main.tex new file mode 100644 index 00000000..e34c5f14 --- /dev/null +++ b/latex-test/ref/UnboxedStuff/main.tex @@ -0,0 +1,11 @@ +\documentclass{book} +\usepackage{haddock} +\begin{document} +\begin{titlepage} +\begin{haddocktitle} + +\end{haddocktitle} +\end{titlepage} +\tableofcontents +\input{UnboxedStuff} +\end{document}
\ No newline at end of file diff --git a/latex-test/src/NamespacedIdentifier/NamespacedIdentifier.hs b/latex-test/src/NamespacedIdentifier/NamespacedIdentifier.hs new file mode 100644 index 00000000..6f59d247 --- /dev/null +++ b/latex-test/src/NamespacedIdentifier/NamespacedIdentifier.hs @@ -0,0 +1,13 @@ +module NamespacedIdentifiers where + +-- | A link to: +-- +-- * the type t'Bar' +-- * the constructor v'Bar' +-- * the unimported but qualified type t'A.A' +-- * the unimported but qualified value v'A.A' +-- +data Foo = Bar + +-- | A link to the value v'Foo' (which shouldn't exist). +data Bar diff --git a/latex-test/src/UnboxedStuff/UnboxedStuff.hs b/latex-test/src/UnboxedStuff/UnboxedStuff.hs new file mode 100644 index 00000000..bd1b1302 --- /dev/null +++ b/latex-test/src/UnboxedStuff/UnboxedStuff.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples #-} +module UnboxedStuff where + +data X +data Y +data Z + +-- * Unboxed type constructors + +unboxedUnit :: (# #) -> (# #) +unboxedUnit = undefined + +unboxedTuple :: (# X, Y #) -> (# X, Y, Z #) +unboxedTuple = undefined + +unboxedSum :: (# X | Y #) -> (# X | Y | Z #) +unboxedSum = undefined + |