diff options
165 files changed, 1839 insertions, 2095 deletions
diff --git a/.travis.yml b/.travis.yml index 9215057a..88292b40 100644 --- a/.travis.yml +++ b/.travis.yml @@ -26,8 +26,11 @@ before_cache: - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: ghc-8.8.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.3","cabal-install-3.0"]}} + - 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-deb9' + before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - WITHCOMPILER="-w $HC" @@ -1,23 +1,26 @@ -Copyright 2002-2010, Simon Marlow. All rights reserved. +Copyright (c) 2002-2010, Simon Marlow +All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +modification, are permitted provided that the following conditions are +met: -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY -EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR -BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN -IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/doc/invoking.rst b/doc/invoking.rst index 12a127f0..4e4b8764 100644 --- a/doc/invoking.rst +++ b/doc/invoking.rst @@ -548,5 +548,5 @@ Using literate or pre-processed source Since Haddock uses GHC internally, both plain and literate Haskell sources are accepted without the need for the user to do anything. To -use the C pre-processor, however, the user must pass the the :option:`-cpp` +use the C pre-processor, however, the user must pass the ``-cpp`` option to GHC using :option:`--optghc`. diff --git a/doc/markup.rst b/doc/markup.rst index 56238855..08510804 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -8,7 +8,7 @@ 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 +.. _top-level-declaration: Documenting a Top-Level Declaration ----------------------------------- diff --git a/haddock-api/LICENSE b/haddock-api/LICENSE index 460decfc..d5f0b37c 100644 --- a/haddock-api/LICENSE +++ b/haddock-api/LICENSE @@ -1,23 +1,26 @@ -Copyright 2002-2010, Simon Marlow. All rights reserved. +Copyright (c) 2002-2010, Simon Marlow +All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +modification, are permitted provided that the following conditions are +met: -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY -EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR -BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN -IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index f8558dca..8ad0ae64 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -4,7 +4,7 @@ version: 2.23.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries -license: BSD3 +license: BSD2 license-file: LICENSE author: Simon Marlow, David Waern maintainer: Alec Theriault <alec.theriault@gmail.com>, Alex Biehl <alexbiehl@gmail.com>, Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> @@ -42,8 +42,8 @@ library default-language: Haskell2010 -- this package typically supports only single major versions - build-depends: base ^>= 4.13.0 - , ghc ^>= 8.8 + build-depends: base ^>= 4.14.0 + , ghc ^>= 8.10 , ghc-paths ^>= 0.1.0.9 , haddock-library ^>= 1.8.0 , xhtml ^>= 3000.2.2 @@ -165,7 +165,7 @@ test-suite spec Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Types - build-depends: ghc ^>= 8.8 + build-depends: ghc ^>= 8.10 , ghc-paths ^>= 0.1.0.12 , haddock-library ^>= 1.8.0 , xhtml ^>= 3000.2.2 diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 1b49fba3..cf7bd857 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -55,20 +55,14 @@ import qualified Data.Map as Map import System.IO import System.Exit -#if defined(mingw32_HOST_OS) -import Foreign -import Foreign.C -import Data.Int -#endif - #ifdef IN_GHC_TREE import System.FilePath +import System.Environment (getExecutablePath) #else import qualified GHC.Paths as GhcPaths import Paths_haddock_api (getDataDir) -import System.Directory (doesDirectoryExist) #endif -import System.Directory (getTemporaryDirectory) +import System.Directory (doesDirectoryExist, getTemporaryDirectory) import System.FilePath ((</>)) import Text.ParserCombinators.ReadP (readP_to_S) @@ -237,7 +231,7 @@ noCheckWarning = "Warning: `--bypass-interface-version-check' can cause " ++ withGhc :: [Flag] -> Ghc a -> IO a withGhc flags action = do - libDir <- fmap snd (getGhcDirs flags) + libDir <- fmap (fromMaybe (error "No GhcDir found") . snd) (getGhcDirs flags) -- Catches all GHC source errors, then prints and re-throws them. let handleSrcErrors action' = flip handleSourceError action' $ \err -> do @@ -368,7 +362,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do let withQuickjump = Flag_QuickJumpIndex `elem` flags when (Flag_GenIndex `elem` flags) $ do - withTiming (pure dflags') "ppHtmlIndex" (const ()) $ do + withTiming dflags' "ppHtmlIndex" (const ()) $ do _ <- {-# SCC ppHtmlIndex #-} ppHtmlIndex odir title pkgStr themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls @@ -378,7 +372,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do copyHtmlBits odir libDir themes withQuickjump when (Flag_GenContents `elem` flags) $ do - withTiming (pure dflags') "ppHtmlContents" (const ()) $ do + withTiming dflags' "ppHtmlContents" (const ()) $ do _ <- {-# SCC ppHtmlContents #-} ppHtmlContents dflags' odir title pkgStr themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls @@ -388,7 +382,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do copyHtmlBits odir libDir themes withQuickjump when (Flag_Html `elem` flags) $ do - withTiming (pure dflags') "ppHtml" (const ()) $ do + withTiming dflags' "ppHtml" (const ()) $ do _ <- {-# SCC ppHtml #-} ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir prologue @@ -423,14 +417,14 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do ] when (Flag_LaTeX `elem` flags) $ do - withTiming (pure dflags') "ppLatex" (const ()) $ do + withTiming dflags' "ppLatex" (const ()) $ do _ <- {-# SCC ppLatex #-} ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style libDir return () when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do - withTiming (pure dflags') "ppHyperlinkedSource" (const ()) $ do + withTiming dflags' "ppHyperlinkedSource" (const ()) $ do _ <- {-# SCC ppHyperlinkedSource #-} ppHyperlinkedSource (verbosity flags) odir libDir opt_source_css pretty srcMap ifaces return () @@ -474,8 +468,7 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do -- We disable pattern match warnings because than can be very -- expensive to check let dynflags'' = unsetPatternMatchWarnings $ - updOptLevel 0 $ - gopt_unset dynflags' Opt_SplitObjs + updOptLevel 0 dynflags' -- ignore the following return-value, which is a list of packages -- that may need to be re-linked: Haddock doesn't do any -- dynamic or static linking at all! @@ -528,51 +521,87 @@ unsetPatternMatchWarnings dflags = ------------------------------------------------------------------------------- -getHaddockLibDir :: [Flag] -> IO String +getHaddockLibDir :: [Flag] -> IO FilePath getHaddockLibDir flags = case [str | Flag_Lib str <- flags] of [] -> do #ifdef IN_GHC_TREE - getInTreeDir + + -- When in the GHC tree, we should be able to locate the "lib" folder + -- based on the location of the current executable. + base_dir <- getBaseDir -- Provided by GHC + let res_dirs = [ d | Just d <- [base_dir] ] ++ + #else - -- if data directory does not exist we are probably - -- invoking from either ./haddock-api or ./ - let res_dirs = [ getDataDir -- provided by Cabal - , pure "resources" - , pure "haddock-api/resources" - ] - check get_path = do - p <- get_path - exists <- doesDirectoryExist p - pure $ if exists then Just p else Nothing + -- When Haddock was installed by @cabal@, the resources (which are listed + -- under @data-files@ in the Cabal file) will have been copied to a + -- special directory. + data_dir <- getDataDir -- Provided by Cabal + let res_dirs = [ data_dir ] ++ - dirs <- mapM check res_dirs - case [p | Just p <- dirs] of - (p : _) -> return p - _ -> die "Haddock's resource directory does not exist!\n" #endif - fs -> return (last fs) + -- When Haddock is built locally (eg. regular @cabal new-build@), the data + -- directory does not exist and we are probably invoking from either + -- @./haddock-api@ or @./@ + [ "resources" + , "haddock-api/resources" + ] + + res_dir <- check res_dirs + case res_dir of + Just p -> return p + _ -> die "Haddock's resource directory does not exist!\n" -getGhcDirs :: [Flag] -> IO (String, String) + fs -> return (last fs) + where + -- Pick the first path that corresponds to a directory that exists + check :: [FilePath] -> IO (Maybe FilePath) + check [] = pure Nothing + check (path : other_paths) = do + exists <- doesDirectoryExist path + if exists then pure (Just path) else check other_paths + +-- | Find the @lib@ directory for GHC and the path to @ghc@ +getGhcDirs :: [Flag] -> IO (Maybe FilePath, Maybe FilePath) getGhcDirs flags = do - case [ dir | Flag_GhcLibDir dir <- flags ] of - [] -> do + #ifdef IN_GHC_TREE - libDir <- getInTreeDir - return (ghcPath, libDir) + base_dir <- getBaseDir + let ghc_path = Nothing #else - return (ghcPath, GhcPaths.libdir) + let base_dir = Just GhcPaths.libdir + ghc_path = Just GhcPaths.ghc #endif - xs -> return (ghcPath, last xs) - where + + -- If the user explicitly specifies a lib dir, use that + let ghc_dir = case [ dir | Flag_GhcLibDir dir <- flags ] of + [] -> base_dir + xs -> Just (last xs) + + pure (ghc_path, ghc_dir) + + #ifdef IN_GHC_TREE - ghcPath = "not available" -#else - ghcPath = GhcPaths.ghc -#endif +-- | See 'getBaseDir' in "SysTools.BaseDir" +getBaseDir :: IO (Maybe FilePath) +getBaseDir = do + + -- Getting executable path can fail. Turn that into 'Nothing' + exec_path_opt <- catch (Just <$> getExecutablePath) + (\(_ :: SomeException) -> pure Nothing) + + -- Check that the path we are about to return actually exists + case exec_path_opt of + Nothing -> pure Nothing + Just exec_path -> do + let base_dir = takeDirectory (takeDirectory exec_path) </> "lib" + exists <- doesDirectoryExist base_dir + pure (if exists then Just base_dir else Nothing) + +#endif shortcutFlags :: [Flag] -> IO () shortcutFlags flags = do @@ -586,12 +615,12 @@ shortcutFlags flags = do when (Flag_GhcVersion `elem` flags) (bye (cProjectVersion ++ "\n")) when (Flag_PrintGhcPath `elem` flags) $ do - dir <- fmap fst (getGhcDirs flags) - bye $ dir ++ "\n" + path <- fmap fst (getGhcDirs flags) + bye $ fromMaybe "not available" path ++ "\n" when (Flag_PrintGhcLibDir `elem` flags) $ do dir <- fmap snd (getGhcDirs flags) - bye $ dir ++ "\n" + bye $ fromMaybe "not available" dir ++ "\n" when (Flag_UseUnicode `elem` flags && Flag_Html `notElem` flags) $ throwE "Unicode can only be enabled for HTML output." @@ -668,38 +697,3 @@ rightOrThrowE :: Either String b -> IO b rightOrThrowE (Left msg) = throwE msg rightOrThrowE (Right x) = pure x - -#ifdef IN_GHC_TREE - -getInTreeDir :: IO String -getInTreeDir = getExecDir >>= \case - Nothing -> error "No GhcDir found" - Just d -> return (d </> ".." </> "lib") - - -getExecDir :: IO (Maybe String) -#if defined(mingw32_HOST_OS) -getExecDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. - where - try_size size = allocaArray (fromIntegral size) $ \buf -> do - ret <- c_GetModuleFileName nullPtr buf size - case ret of - 0 -> return Nothing - _ | ret < size -> fmap (Just . dropFileName) $ peekCWString buf - | otherwise -> try_size (size * 2) - -# if defined(i386_HOST_ARCH) -# define WINDOWS_CCONV stdcall -# elif defined(x86_64_HOST_ARCH) -# define WINDOWS_CCONV ccall -# else -# error Unknown mingw32 arch -# endif - -foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" - c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 -#else -getExecDir = return Nothing -#endif - -#endif diff --git a/haddock-api/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs index 0bdc9057..6c48804a 100644 --- a/haddock-api/src/Haddock/Backends/HaddockDB.hs +++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs @@ -104,17 +104,22 @@ ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> hsep (map ppHsAType b)) context) ppHsType :: HsType -> Doc -ppHsType (HsForAllType Nothing context htype) = +ppHsType (HsForAllType _ Nothing context htype) = hsep [ ppHsContext context, text "=>", ppHsType htype] -ppHsType (HsForAllType (Just tvs) [] htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype]) -ppHsType (HsForAllType (Just tvs) context htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : +ppHsType (HsForAllType fvf (Just tvs) [] htype) = + hsep (text "forall" : map ppHsName tvs ++ pprHsForAllSeparator fvf : + [ppHsType htype]) +ppHsType (HsForAllType fvf (Just tvs) context htype) = + hsep (text "forall" : map ppHsName tvs ++ pprHsForAllSeparator fvf : ppHsContext context : text "=>" : [ppHsType htype]) ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b] ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t] ppHsType t = ppHsBType t +ppHsForAllSeparator :: ForallVisFlag -> Doc +ppHsForAllSeparator ForallVis = text "->" +ppHsForAllSeparator ForallInvis = text "." + ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) = brackets $ ppHsType b ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b] diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 149f4815..1f98ef9c 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -18,7 +18,7 @@ module Haddock.Backends.Hoogle ( ) where import BasicTypes ( OverlapFlag(..), OverlapMode(..), SourceText(..) - , PromotionFlag(..) ) + , PromotionFlag(..), TopLevelFlag(..) ) import InstEnv (ClsInst(..)) import Documentation.Haddock.Markup import Haddock.GhcUtils @@ -72,7 +72,7 @@ dropHsDocTy :: HsType a -> HsType a dropHsDocTy = f where g (L src x) = L src (f x) - f (HsForAllTy x a e) = HsForAllTy x a (g e) + f (HsForAllTy x fvf a e) = HsForAllTy x fvf a (g e) 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) @@ -86,8 +86,8 @@ dropHsDocTy = f f (HsDocTy _ a _) = f $ unL a f x = x -outHsType :: (a ~ GhcPass p, OutputableBndrId a) - => DynFlags -> HsType a -> String +outHsType :: (OutputableBndrId p) + => DynFlags -> HsType (GhcPass p) -> String outHsType dflags = out dflags . reparenType . dropHsDocTy @@ -174,7 +174,7 @@ ppClass dflags decl subdocs = | null $ tcdATs decl = "" | otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat [ map pprTyFam (tcdATs decl) - , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl) + , map (pprTyFamInstDecl NotTopLevel . unLoc) (tcdATDefs decl) ] pprTyFam :: LFamilyDecl GhcRn -> SDoc @@ -187,15 +187,6 @@ ppClass dflags decl subdocs = , rbrace ] - tyFamEqnToSyn :: TyFamDefltEqn GhcRn -> TyClDecl GhcRn - tyFamEqnToSyn tfe = SynDecl - { tcdLName = feqn_tycon tfe - , tcdTyVars = feqn_pats tfe - , tcdFixity = feqn_fixity tfe - , tcdRhs = feqn_rhs tfe - , tcdSExt = emptyNameSet - } - ppFam :: DynFlags -> FamilyDecl GhcRn -> [String] ppFam dflags decl@(FamilyDecl { fdInfo = info }) = [out dflags decl'] @@ -205,7 +196,7 @@ ppFam dflags decl@(FamilyDecl { fdInfo = info }) -- for Hoogle, so pretend it doesn't have any. ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily } _ -> decl -ppFam _ XFamilyDecl {} = panic "ppFam" +ppFam _ (XFamilyDecl nec) = noExtCon nec ppInstance :: DynFlags -> ClsInst -> [String] ppInstance dflags x = @@ -254,8 +245,8 @@ ppCtor dflags dat subdocs con@ConDeclH98 {} [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] | r <- map unLoc recs] - funs = foldr1 (\x y -> reL $ HsFunTy NoExt x y) - apps = foldl1 (\x y -> reL $ HsAppTy NoExt x y) + funs = foldr1 (\x y -> reL $ HsFunTy noExtField x y) + apps = foldl1 (\x y -> reL $ HsAppTy noExtField x y) typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds) @@ -263,13 +254,13 @@ ppCtor dflags dat subdocs con@ConDeclH98 {} -- docs for con_names on why it is a list to begin with. name = commaSeparate dflags . map unL $ getConNames con - resType = let c = HsTyVar NoExt NotPromoted (noLoc (tcdName dat)) + resType = let c = HsTyVar noExtField NotPromoted (reL (tcdName dat)) as = map (tyVarBndr2Type . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat) - in apps (map noLoc (c : as)) + in apps (map reL (c : as)) tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn - tyVarBndr2Type (UserTyVar _ n) = HsTyVar NoExt NotPromoted n - tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted n)) k + tyVarBndr2Type (UserTyVar _ n) = HsTyVar noExtField NotPromoted n + tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig noExtField (reL (HsTyVar noExtField NotPromoted n)) k tyVarBndr2Type (XTyVarBndr _) = panic "haddock:ppCtor" ppCtor dflags _dat subdocs con@(ConDeclGADT { }) @@ -279,10 +270,10 @@ ppCtor dflags _dat subdocs con@(ConDeclGADT { }) typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty) name = out dflags $ map unL $ getConNames con -ppCtor _ _ _ XConDecl {} = panic "haddock:ppCtor" +ppCtor _ _ _ (XConDecl nec) = noExtCon nec ppFixity :: DynFlags -> (Name, Fixity) -> [String] -ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExt [noLoc name] fixity) :: FixitySig GhcRn)] +ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExtField [noLoc name] fixity) :: FixitySig GhcRn)] --------------------------------------------------------------------- diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 2e665204..3f5483fe 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -18,7 +18,7 @@ import Data.Maybe import System.Directory import System.FilePath -import HieTypes ( HieFile(..), HieASTs(..), HieAST(..), NodeInfo(..) ) +import HieTypes ( HieFile(..), HieAST(..), HieASTs(..), NodeInfo(..) ) import HieBin ( readHieFile, hie_file_result) import Data.Map as M import FastString ( mkFastString ) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 0bd467e1..0247d567 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -9,11 +9,12 @@ import qualified Data.ByteString as BS import BasicTypes ( IntegralLit(..) ) import DynFlags -import ErrUtils ( emptyMessages ) +import ErrUtils ( pprLocErrMsg ) import FastString ( mkFastString ) import Lexer ( P(..), ParseResult(..), PState(..), Token(..) - , mkPStatePure, lexer, mkParserFlags' ) -import Outputable ( showSDoc, panic ) + , mkPStatePure, lexer, mkParserFlags', getErrorMessages, addFatalError ) +import Bag ( bagToList ) +import Outputable ( showSDoc, panic, text, ($$) ) import SrcLoc import StringBuffer ( StringBuffer, atEnd ) @@ -31,8 +32,10 @@ parse -> [T.Token] parse 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 + PFailed pst -> + let err:_ = bagToList (getErrorMessages pst dflags) in + panic $ showSDoc dflags $ + text "Hyperlinker parse error:" $$ pprLocErrMsg err where initState = mkPStatePure pflags buf start @@ -145,7 +148,7 @@ parse dflags fpath bs = case unP (go False []) initState of -- | Get the input getInput :: P (StringBuffer, RealSrcLoc) -getInput = P $ \p @ PState { buffer = buf, loc = srcLoc } -> POk p (buf, srcLoc) +getInput = P $ \p@PState { buffer = buf, loc = srcLoc } -> POk p (buf, srcLoc) -- | Set the input setInput :: (StringBuffer, RealSrcLoc) -> P () @@ -154,7 +157,7 @@ setInput (buf, srcLoc) = P $ \p -> POk (p { buffer = buf, loc = srcLoc }) () -- | Orphan instance that adds backtracking to 'P' instance Alternative P where - empty = P $ \_ -> PFailed (const emptyMessages) noSrcSpan "Alterative.empty" + empty = addFatalError noSrcSpan (text "Alterative.empty") P x <|> P y = P $ \s -> case x s of { p@POk{} -> p ; _ -> y s } diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index a4dcb77b..404cb9d0 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -88,14 +88,14 @@ renderWithAst srcs Node{..} toks = anchored $ case toks of -- 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] + [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] + [OpenParenTok s1, tok@Token{ tkType = TkOperator }, CloseParenTok s2] | realSrcSpanStart s1 == realSrcSpanStart nodeSpan , realSrcSpanEnd s2 == realSrcSpanEnd nodeSpan -> richToken srcs nodeInfo diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs index 2c48e00b..612f3f08 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs @@ -129,8 +129,8 @@ recoverFullIfaceTypes df flattened ast = fmap (printed A.!) ast 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 (HFunTy a b) = IfaceFunTy VisArg a b + go (HQualTy con b) = IfaceFunTy InvisArg con b go (HCastTy a) = a go HCoercionTy = IfaceTyVar "<coercion type>" go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index c62a9311..f2fb1041 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -311,7 +311,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX ppFor doc (ForeignImport _ (L _ name) typ _) unicode = - ppFunSig Nothing doc [name] (hsSigType typ) unicode + ppFunSig Nothing doc [name] (hsSigTypeI typ) unicode ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX" -- error "foreign declarations are currently not supported by --latex" @@ -355,8 +355,8 @@ ppFamDecl associated doc instances decl unicode = , equals , ppType unicode (unLoc rhs) ] - ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl" - ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl" + ppFamDeclEqn (XHsImplicitBndrs nec) = noExtCon nec + ppFamDeclEqn (HsIB { hsib_body = XFamEqn nec}) = noExtCon nec instancesBit = ppDocInstances unicode instances @@ -365,7 +365,7 @@ ppFamHeader :: FamilyDecl DocNameI -- ^ family header to print -> Bool -- ^ unicode -> Bool -- ^ is the family associated? -> LaTeX -ppFamHeader (XFamilyDecl _) _ _ = panic "haddock;ppFamHeader" +ppFamHeader (XFamilyDecl nec) _ _ = noExtCon nec ppFamHeader (FamilyDecl { fdLName = L _ name , fdTyVars = tvs , fdInfo = info @@ -388,7 +388,7 @@ ppFamHeader (FamilyDecl { fdLName = L _ name NoSig _ -> empty KindSig _ kind -> dcolon unicode <+> ppLKind unicode kind TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode bndr - XFamilyResultSig _ -> panic "haddock:ppFamHeader" + XFamilyResultSig nec -> noExtCon nec injAnn = case injectivity of Nothing -> empty @@ -449,7 +449,7 @@ ppLPatSig :: DocForDecl DocName -- ^ documentation -> Bool -- ^ unicode -> LaTeX ppLPatSig doc docnames ty unicode - = ppFunSig (Just (keyword "pattern")) doc docnames (hsSigType ty) unicode + = ppFunSig (Just (keyword "pattern")) doc docnames (hsSigTypeI ty) unicode -- | Pretty-print a type, adding documentation to the whole type and its -- arguments as needed. @@ -485,9 +485,9 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs do_args :: Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)] - do_args _n leader (HsForAllTy _ tvs ltype) + do_args _n leader (HsForAllTy _ fvf tvs ltype) = [ ( decltt leader - , decltt (ppForAllPart unicode tvs) + , decltt (ppForAllPart unicode tvs fvf) <+> ppLType unicode ltype ) ] do_args n leader (HsQualTy _ lctxt ltype) @@ -517,6 +517,12 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ gadtOpen = char '{' +ppForAllSeparator :: Bool -> ForallVisFlag -> LaTeX +ppForAllSeparator unicode fvf = + case fvf of + ForallVis -> text "\\ " <> arrow unicode + ForallInvis -> dot + ppTypeSig :: [Name] -> HsType DocNameI -> Bool -> LaTeX ppTypeSig nms ty unicode = hsep (punctuate comma $ map ppSymName nms) @@ -530,7 +536,7 @@ ppTyVars unicode = map (ppHsTyVarBndr unicode . unLoc) tyvarNames :: LHsQTyVars DocNameI -> [Name] -tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit +tyvarNames = map (getName . hsLTyVarNameI) . hsQTvExplicit declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX @@ -621,7 +627,7 @@ ppClassDecl instances doc subdocs atTable = text "\\haddockpremethods{}" <> emph (text "Associated Types") $$ - vcat [ ppFamDecl True (fst doc) [] (FamDecl noExt decl) True + vcat [ ppFamDecl True (fst doc) [] (FamDecl noExtField decl) True | L _ decl <- ats , let name = unL . fdLName $ decl doc = lookupAnySubdoc name subdocs @@ -630,7 +636,7 @@ ppClassDecl instances doc subdocs methodTable = text "\\haddockpremethods{}" <> emph (text "Methods") $$ - vcat [ ppFunSig leader doc names (hsSigType typ) unicode + vcat [ ppFunSig leader doc names (hsSigTypeI typ) unicode | L _ (ClassOpSig _ is_def lnames typ) <- lsigs , let doc | is_def = noDocForDecl | otherwise = lookupAnySubdoc (head names) subdocs @@ -750,7 +756,7 @@ ppConstrHdr forall_ tvs ctxt unicode = ppForall <> ppCtxt where ppForall | null tvs || not forall_ = empty - | otherwise = ppForAllPart unicode tvs + | otherwise = ppForAllPart unicode tvs ForallInvis ppCtxt | null ctxt = empty @@ -769,9 +775,9 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = where -- Find the name of a constructors in the decl (`getConName` always returns -- a non-empty list) - aConName = unLoc (head (getConNames con)) + aConName = unLoc (head (getConNamesI con)) - occ = map (nameOccName . getName . unLoc) $ getConNames con + occ = map (nameOccName . getName . unLoc) $ getConNamesI con ppOcc = cat (punctuate comma (map ppBinder occ)) ppOccInfix = cat (punctuate comma (map ppBinderInfix occ)) @@ -816,7 +822,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = -- ++AZ++ make this prepend "{..}" when it is a record style GADT , ppLType unicode (getGADTConType con) ] - XConDecl{} -> panic "haddock:ppSideBySideConstr" + XConDecl nec -> noExtCon nec fieldPart = case (con, getConArgs con) of -- Record style GADTs @@ -850,12 +856,12 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = [ l <+> text "\\enspace" <+> r | (l,r) <- ppSubSigLike unicode (unLoc (getGADTConType con)) argDocs subdocs (dcolon unicode) ] - XConDecl{} -> panic "haddock:doConstrArgsWithDocs" + XConDecl nec -> noExtCon nec -- don't use "con_doc con", in case it's reconstructed from a .hi file, -- or also because we want Haddock to do the doc-parsing, not GHC. - mbDoc = case getConNames con of + mbDoc = case getConNamesI con of [] -> panic "empty con_names" (cn:_) -> lookup (unLoc cn) subdocs >>= fmap _doc . combineDocumentation . fst @@ -870,7 +876,7 @@ ppSideBySideField subdocs unicode (ConDeclField _ names ltype _) = -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst -ppSideBySideField _ _ (XConDeclField _) = panic "haddock:ppSideBySideField" +ppSideBySideField _ _ (XConDeclField nec) = noExtCon nec -- | Pretty-print a bundled pattern synonym @@ -890,7 +896,7 @@ ppSideBySidePat lnames typ (doc, argDocs) unicode = | otherwise = hsep [ keyword "pattern" , ppOcc , dcolon unicode - , ppLType unicode (hsSigType typ) + , ppLType unicode (hsSigTypeI typ) ] fieldPart @@ -900,7 +906,7 @@ ppSideBySidePat lnames typ (doc, argDocs) unicode = | (l,r) <- ppSubSigLike unicode (unLoc patTy) argDocs [] (dcolon unicode) ] - patTy = hsSigType typ + patTy = hsSigTypeI typ mDoc = fmap _doc $ combineDocumentation doc @@ -1037,7 +1043,7 @@ ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name ppHsTyVarBndr unicode (KindedTyVar _ (L _ name) kind) = parens (ppDocName name <+> dcolon unicode <+> ppLKind unicode kind) -ppHsTyVarBndr _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr" +ppHsTyVarBndr _ (XTyVarBndr nec) = noExtCon nec ppLKind :: Bool -> LHsKind DocNameI -> LaTeX ppLKind unicode y = ppKind unicode (unLoc y) @@ -1049,8 +1055,13 @@ ppKind unicode ki = ppr_mono_ty (reparenTypePrec PREC_TOP ki) unicode -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell -ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> LaTeX -ppForAllPart unicode tvs = hsep (forallSymbol unicode : ppTyVars unicode tvs) <> dot +ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX +ppForAllPart unicode tvs fvf = hsep (forallSymbol unicode : tvs') <> fv + where + tvs' = ppTyVars unicode tvs + fv = case fvf of + ForallVis -> text "\\ " <> arrow unicode + ForallInvis -> dot ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX @@ -1058,8 +1069,8 @@ ppr_mono_lty ty unicode = ppr_mono_ty (unLoc ty) unicode ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX -ppr_mono_ty (HsForAllTy _ tvs ty) unicode - = sep [ ppForAllPart unicode tvs +ppr_mono_ty (HsForAllTy _ fvf tvs ty) unicode + = sep [ ppForAllPart unicode tvs fvf , ppr_mono_lty ty unicode ] ppr_mono_ty (HsQualTy _ ctxt ty) unicode = sep [ ppLContext ctxt unicode diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 40d630b0..c7ae15ca 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -41,7 +41,6 @@ import GHC.Exts import Name import BooleanFormula import RdrName ( rdrNameOcc ) -import Outputable ( panic ) -- | Pretty print a declaration ppDecl :: Bool -- ^ print summary info only @@ -65,7 +64,7 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc SigD _ (TypeSig _ lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames (hsSigWcType lty) fixities splice unicode pkg qual SigD _ (PatSynSig _ lnames lty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames - (hsSigType lty) fixities splice unicode pkg qual + (hsSigTypeI lty) fixities splice unicode pkg qual ForD _ d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual InstD _ _ -> noHtml DerivD _ _ -> noHtml @@ -152,8 +151,8 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ do_largs n leader (L _ t) = do_args n leader t do_args :: Int -> Html -> HsType DocNameI -> [SubDecl] - do_args n leader (HsForAllTy _ tvs ltype) - = do_largs n (leader <+> ppForAllPart unicode qual tvs) ltype + do_args n leader (HsForAllTy _ fvf tvs ltype) + = do_largs n (leader <+> ppForAllPart unicode qual tvs fvf) ltype do_args n leader (HsQualTy _ lctxt ltype) | null (unLoc lctxt) @@ -219,7 +218,7 @@ ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> Splice -> Unicode -> Maybe Package -> Qualification -> Html ppFor summary links loc doc (ForeignImport _ (L _ name) typ _) fixities splice unicode pkg qual - = ppFunSig summary links loc noHtml doc [name] (hsSigType typ) fixities splice unicode pkg qual + = ppFunSig summary links loc noHtml doc [name] (hsSigTypeI typ) fixities splice unicode pkg qual ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor" @@ -306,8 +305,8 @@ ppFamDecl summary associated links instances fixities loc doc decl splice unicod , Nothing , [] ) - ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl" - ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl" + ppFamDeclEqn (XHsImplicitBndrs nec) = noExtCon nec + ppFamDeclEqn (HsIB { hsib_body = XFamEqn nec}) = noExtCon nec -- | Print a pseudo family declaration @@ -332,7 +331,7 @@ ppFamHeader :: Bool -- ^ is a summary -> Bool -- ^ is an associated type -> FamilyDecl DocNameI -- ^ family declaration -> Unicode -> Qualification -> Html -ppFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppFamHeader" +ppFamHeader _ _ (XFamilyDecl nec) _ _ = noExtCon nec ppFamHeader summary associated (FamilyDecl { fdInfo = info , fdResultSig = L _ result , fdInjectivityAnn = injectivity @@ -372,7 +371,7 @@ ppResultSig result unicode qual = case result of NoSig _ -> noHtml KindSig _ kind -> dcolon unicode <+> ppLKind unicode qual kind TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr - XFamilyResultSig _ -> panic "haddock:ppResultSig" + XFamilyResultSig nec -> noExtCon nec -------------------------------------------------------------------------------- @@ -497,7 +496,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t -- ToDo: add associated type defaults - [ ppFunSig summary links loc noHtml doc names (hsSigType typ) + [ ppFunSig summary links loc noHtml doc names (hsSigTypeI typ) [] splice unicode pkg qual | L _ (ClassOpSig _ False lnames typ) <- sigs , let doc = lookupAnySubdoc (head names) subdocs @@ -548,31 +547,26 @@ ppClassDecl summary links instances fixities loc d subdocs , let name = unL . fdLName $ unL at doc = lookupAnySubdoc name subdocs subfixs = filter ((== name) . fst) fixities - defTys = ppDefaultAssocTy name <$> lookupDAT name + defTys = (declElem . ppDefaultAssocTy name) <$> lookupDAT name ] -- Default associated types - ppDefaultAssocTy n (vs,t,d') = ppTySyn summary links [] loc d' synDecl - splice unicode pkg qual - where - synDecl = SynDecl { tcdSExt = noExt - , tcdLName = noLoc n - , tcdTyVars = vs - , tcdFixity = GHC.Prefix - , tcdRhs = t } + ppDefaultAssocTy n (vs,rhs) = hsep + [ keyword "type", ppAppNameTypeArgs n vs unicode qual, equals + , ppType unicode qual HideEmptyContexts (unLoc rhs) + ] lookupDAT name = Map.lookup (getName name) defaultAssocTys defaultAssocTys = Map.fromList - [ (getName name, (vs, typ, doc)) - | L _ (FamEqn { feqn_rhs = typ - , feqn_tycon = L _ name - , feqn_pats = vs }) <- atsDefs - , let doc = noDocForDecl -- TODO: get docs for associated type defaults + [ (getName name, (vs, typ)) + | L _ (TyFamInstDecl (HsIB _ (FamEqn { feqn_rhs = typ + , feqn_tycon = L _ name + , feqn_pats = vs }))) <- atsDefs ] -- Methods methodBit = subMethods - [ ppFunSig summary links loc noHtml doc [name] (hsSigType typ) + [ ppFunSig summary links loc noHtml doc [name] (hsSigTypeI typ) subfixs splice unicode pkg qual <+> subDefaults (maybeToList defSigs) @@ -587,7 +581,7 @@ ppClassDecl summary links instances fixities loc d subdocs -- Default methods ppDefaultFunSig n (t, d') = ppFunSig summary links loc (keyword "default") - d' [n] (hsSigType t) [] splice unicode pkg qual + d' [n] (hsSigTypeI t) [] splice unicode pkg qual lookupDM name = Map.lookup (getOccString name) defaultMethods defaultMethods = Map.fromList @@ -777,7 +771,7 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual pats1 = [ hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames , dcolon unicode - , ppPatSigType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigTypeI typ) ] | (SigD _ (PatSynSig _ lnames typ),_) <- pats ] @@ -823,7 +817,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats [ ppSideBySideConstr subdocs subfixs unicode pkg qual c | c <- cons , let subfixs = filter (\(n,_) -> any (\cn -> cn == n) - (map unLoc (getConNames (unLoc c)))) fixities + (map unLoc (getConNamesI (unLoc c)))) fixities ] patternBit = subPatterns pkg qual @@ -888,10 +882,10 @@ ppShortConstrParts summary dataInst con unicode qual , noHtml , noHtml ) - XConDecl {} -> panic "haddock:ppShortConstrParts" + XConDecl nec -> noExtCon nec where - occ = map (nameOccName . getName . unLoc) $ getConNames con + occ = map (nameOccName . getName . unLoc) $ getConNamesI con ppOcc = hsep (punctuate comma (map (ppBinder summary) occ)) ppOccInfix = hsep (punctuate comma (map (ppBinderInfix summary) occ)) @@ -908,10 +902,10 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) ) where -- Find the name of a constructors in the decl (`getConName` always returns a non-empty list) - aConName = unLoc (head (getConNames con)) + aConName = unLoc (head (getConNamesI con)) fixity = ppFixities fixities qual - occ = map (nameOccName . getName . unLoc) $ getConNames con + occ = map (nameOccName . getName . unLoc) $ getConNamesI con ppOcc = hsep (punctuate comma (map (ppBinder False) occ)) ppOccInfix = hsep (punctuate comma (map (ppBinderInfix False) occ)) @@ -957,7 +951,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) , ppLType unicode qual HideEmptyContexts (getGADTConType con) , fixity ] - XConDecl{} -> panic "haddock:ppSideBySideConstr" + XConDecl nec -> noExtCon nec fieldPart = case (con, getConArgs con) of -- Record style GADTs @@ -986,11 +980,11 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) ConDeclGADT{} -> ppSubSigLike unicode qual (unLoc (getGADTConType con)) argDocs subdocs (dcolon unicode) HideEmptyContexts - XConDecl{} -> panic "haddock:doConstrArgsWithDocs" + XConDecl nec -> noExtCon nec -- don't use "con_doc con", in case it's reconstructed from a .hi file, -- or also because we want Haddock to do the doc-parsing, not GHC. - mbDoc = lookup (unLoc $ head $ getConNames con) subdocs >>= + mbDoc = lookup (unLoc $ head $ getConNamesI con) subdocs >>= combineDocumentation . fst @@ -1005,7 +999,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual = ppForall +++ ppCtxt where ppForall | null tvs || not forall_ = noHtml - | otherwise = ppForAllPart unicode qual tvs + | otherwise = ppForAllPart unicode qual tvs ForallInvis ppCtxt | null ctxt = noHtml @@ -1030,14 +1024,14 @@ ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) = -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst -ppSideBySideField _ _ _ (XConDeclField _) = panic "haddock:ppSideBySideField" +ppSideBySideField _ _ _ (XConDeclField nec) = noExtCon nec ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html ppShortField summary unicode qual (ConDeclField _ names ltype _) = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype -ppShortField _ _ _ (XConDeclField _) = panic "haddock:ppShortField" +ppShortField _ _ _ (XConDeclField nec) = noExtCon nec -- | Pretty print an expanded pattern (for bundled patterns) @@ -1060,7 +1054,7 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) = | otherwise = hsep [ keyword "pattern" , ppOcc , dcolon unicode - , ppPatSigType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigTypeI typ) , fixity ] @@ -1070,7 +1064,7 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) = argDocs [] (dcolon unicode) emptyCtxt) ] - patTy = hsSigType typ + patTy = hsSigTypeI typ emptyCtxt = patSigContext patTy @@ -1144,7 +1138,7 @@ ppHsTyVarBndr _ qual (UserTyVar _ (L _ name)) = ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) = parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> ppLKind unicode qual kind) -ppHsTyVarBndr _ _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr" +ppHsTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y) @@ -1159,16 +1153,16 @@ patSigContext typ | hasNonEmptyContext typ && isFirstContextEmpty typ = ShowEmp hasNonEmptyContext :: LHsType name -> Bool hasNonEmptyContext t = case unLoc t of - HsForAllTy _ _ s -> hasNonEmptyContext s - HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True - HsFunTy _ _ s -> hasNonEmptyContext s + HsForAllTy _ _ _ s -> hasNonEmptyContext s + HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True + HsFunTy _ _ s -> hasNonEmptyContext s _ -> False isFirstContextEmpty :: LHsType name -> Bool isFirstContextEmpty t = case unLoc t of - HsForAllTy _ _ s -> isFirstContextEmpty s - HsQualTy _ cxt _ -> null (unLoc cxt) - HsFunTy _ _ s -> isFirstContextEmpty s + HsForAllTy _ _ _ s -> isFirstContextEmpty s + HsQualTy _ cxt _ -> null (unLoc cxt) + HsFunTy _ _ s -> isFirstContextEmpty s _ -> False @@ -1178,16 +1172,22 @@ ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html ppPatSigType unicode qual typ = let emptyCtxts = patSigContext typ in ppLType unicode qual emptyCtxts typ -ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html -ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot + +ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> Html +ppForAllPart unicode qual tvs fvf = hsep (forallSymbol unicode : tvs') +++ fv + where + tvs' = ppTyVars unicode qual tvs + fv = case fvf of + ForallVis -> spaceHtml +++ arrow unicode + ForallInvis -> dot ppr_mono_lty :: LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html ppr_mono_lty ty = ppr_mono_ty (unLoc ty) ppr_mono_ty :: HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html -ppr_mono_ty (HsForAllTy _ tvs ty) unicode qual emptyCtxts - = ppForAllPart unicode qual tvs <+> ppr_mono_lty ty unicode qual emptyCtxts +ppr_mono_ty (HsForAllTy _ fvf tvs ty) unicode qual emptyCtxts + = ppForAllPart unicode qual tvs fvf <+> ppr_mono_lty ty unicode qual emptyCtxts ppr_mono_ty (HsQualTy _ ctxt ty) unicode qual emptyCtxts = ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 709e20d4..d5fa3667 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -28,7 +28,7 @@ import ConLike import Data.Either (lefts, rights) import DataCon import FamInstEnv -import HsSyn +import GHC.Hs import Name import NameSet ( emptyNameSet ) import RdrName ( mkVarUnqual ) @@ -44,7 +44,7 @@ import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName import PrelNames ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey , liftedRepDataConKey ) import Unique ( getUnique ) -import Util ( chkAppend,dropList, filterByList, filterOut, splitAtList ) +import Util ( chkAppend, dropList, filterByList, filterOut ) import Var import VarSet @@ -74,7 +74,7 @@ tyThingToLHsDecl prr 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 prr ImplicitizeForAll [] i) + AnId i -> allOK $ SigD noExtField (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.) @@ -85,19 +85,21 @@ tyThingToLHsDecl prr t = case t of extractFamilyDecl _ = Left "tyThingToLHsDecl: impossible associated tycon" - extractFamDefDecl :: FamilyDecl GhcRn -> Type -> TyFamDefltEqn GhcRn - extractFamDefDecl fd rhs = FamEqn - { feqn_ext = noExt + extractFamDefDecl :: FamilyDecl GhcRn -> Type -> TyFamDefltDecl GhcRn + extractFamDefDecl fd rhs = + TyFamInstDecl $ HsIB { hsib_ext = hsq_ext (fdTyVars fd) + , hsib_body = FamEqn + { feqn_ext = noExtField , feqn_tycon = fdLName fd - , feqn_bndrs = Nothing - -- TODO: this must change eventually - , feqn_pats = fdTyVars fd + , feqn_bndrs = Nothing + , feqn_pats = map (HsValArg . hsLTyVarBndrToType) $ + hsq_explicit $ fdTyVars fd , feqn_fixity = fdFixity fd - , feqn_rhs = synifyType WithinType [] rhs } + , feqn_rhs = synifyType WithinType [] rhs }} extractAtItem :: ClassATItem - -> Either ErrMsg (LFamilyDecl GhcRn, Maybe (LTyFamDefltEqn GhcRn)) + -> Either ErrMsg (LFamilyDecl GhcRn, Maybe (LTyFamDefltDecl GhcRn)) extractAtItem (ATI at_tc def) = do tyDecl <- synifyTyCon prr Nothing at_tc famDecl <- extractFamilyDecl tyDecl @@ -108,7 +110,7 @@ tyThingToLHsDecl prr t = case t of (atFamDecls, atDefFamDecls) = unzip (rights atTyClDecls) vs = tyConVisibleTyVars (classTyCon cl) - in withErrs (lefts atTyClDecls) . TyClD noExt $ ClassDecl + in withErrs (lefts atTyClDecls) . TyClD noExtField $ ClassDecl { tcdCtxt = synifyCtx (classSCTheta cl) , tcdLName = synifyName cl , tcdTyVars = synifyTyVars vs @@ -116,7 +118,7 @@ tyThingToLHsDecl prr t = case t of , 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) : + , tcdSigs = noLoc (MinimalSig noExtField NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) : [ noLoc tcdSig | clsOp <- classOpItems cl , tcdSig <- synifyTcIdSig vs clsOp ] @@ -127,18 +129,18 @@ tyThingToLHsDecl prr t = case t of , tcdDocs = [] --we don't have any docs at this point , tcdCExt = placeHolderNamesTc } | otherwise - -> synifyTyCon prr Nothing tc >>= allOK . TyClD noExt + -> synifyTyCon prr Nothing tc >>= allOK . TyClD noExtField -- type-constructors (e.g. Maybe) are complicated, put the definition -- later in the file (also it's used for class associated-types too.) ACoAxiom ax -> synifyAxiom ax >>= allOK -- a data-constructor alone just gets rendered as a function: - AConLike (RealDataCon dc) -> allOK $ SigD noExt (TypeSig noExt [synifyName dc] + AConLike (RealDataCon dc) -> allOK $ SigD noExtField (TypeSig noExtField [synifyName dc] (synifySigWcType ImplicitizeForAll [] (dataConUserType dc))) AConLike (PatSynCon ps) -> - allOK . SigD noExt $ PatSynSig noExt [synifyName ps] (synifyPatSynSigType ps) + allOK . SigD noExtField $ PatSynSig noExtField [synifyName ps] (synifyPatSynSigType ps) where withErrs e x = return (e, x) allOK x = return (mempty, x) @@ -151,7 +153,7 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) annot_typats = zipWith3 annotHsType args_poly args_types_only typats hs_rhs = synifyType WithinType [] rhs in HsIB { hsib_ext = map tyVarName tkvs - , hsib_body = FamEqn { feqn_ext = noExt + , hsib_body = FamEqn { feqn_ext = noExtField , feqn_tycon = name , feqn_bndrs = Nothing -- TODO: this must change eventually @@ -165,13 +167,13 @@ synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GhcRn) synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) | isOpenTypeFamilyTyCon tc , Just branch <- coAxiomSingleBranch_maybe ax - = return $ InstD noExt - $ TyFamInstD noExt + = return $ InstD noExtField + $ TyFamInstD noExtField $ TyFamInstDecl { tfid_eqn = synifyAxBranch tc branch } | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc , getUnique ax' == getUnique ax -- without the getUniques, type error - = synifyTyCon ShowRuntimeRep (Just ax) tc >>= return . TyClD noExt + = synifyTyCon ShowRuntimeRep (Just ax) tc >>= return . TyClD noExtField | otherwise = Left "synifyAxiom: closed/open family confusion" @@ -186,9 +188,7 @@ synifyTyCon prr _coax tc | isFunTyCon tc || isPrimTyCon tc = return $ DataDecl { tcdLName = synifyName tc - , tcdTyVars = HsQTvs { hsq_ext = - HsQTvsRn { hsq_implicit = [] -- No kind polymorphism - , hsq_dependent = emptyNameSet } + , tcdTyVars = HsQTvs { hsq_ext = [] -- No kind polymorphism , hsq_explicit = zipWith mk_hs_tv tyVarKinds alphaTyVars --a, b, c... which are unfortunately all kind * @@ -196,7 +196,7 @@ synifyTyCon prr _coax tc , tcdFixity = synifyFixity tc - , tcdDataDefn = HsDataDefn { dd_ext = noExt + , tcdDataDefn = HsDataDefn { dd_ext = noExtField , dd_ND = DataType -- arbitrary lie, they are neither -- algebraic data nor newtype: , dd_ctxt = noLoc [] @@ -209,8 +209,8 @@ synifyTyCon prr _coax tc 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) + | isLiftedTypeKind realKind = noLoc $ UserTyVar noExtField (noLoc (getName fakeTyVar)) + | otherwise = noLoc $ KindedTyVar noExtField (noLoc (getName fakeTyVar)) (synifyKindSig realKind) conKind = defaultType prr (tyConKind tc) tyVarKinds = fst . splitFunTys . snd . splitPiTysInvisible $ conKind @@ -234,8 +234,8 @@ synifyTyCon _prr _coax tc -> mkFamDecl DataFamily where resultVar = famTcResVar tc - mkFamDecl i = return $ FamDecl noExt $ - FamilyDecl { fdExt = noExt + mkFamDecl i = return $ FamDecl noExtField $ + FamilyDecl { fdExt = noExtField , fdInfo = i , fdLName = synifyName tc , fdTyVars = synifyTyVars (tyConVisibleTyVars tc) @@ -286,7 +286,7 @@ synifyTyCon _prr coax tc cons = rights consRaw -- "deriving" doesn't affect the signature, no need to specify any. alg_deriv = noLoc [] - defn = HsDataDefn { dd_ext = noExt + defn = HsDataDefn { dd_ext = noExtField , dd_ND = alg_nd , dd_ctxt = alg_ctx , dd_cType = Nothing @@ -331,10 +331,10 @@ synifyInjectivityAnn (Just lhs) tvs (Injective inj) = synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GhcRn synifyFamilyResultSig Nothing kind - | isLiftedTypeKind kind = noLoc $ NoSig noExt - | otherwise = noLoc $ KindSig noExt (synifyKindSig kind) + | isLiftedTypeKind kind = noLoc $ NoSig noExtField + | otherwise = noLoc $ KindSig noExtField (synifyKindSig kind) synifyFamilyResultSig (Just name) kind = - noLoc $ TyVarSig noExt (noLoc $ KindedTyVar noExt (noLoc name) (synifyKindSig kind)) + noLoc $ TyVarSig noExtField (noLoc $ KindedTyVar noExtField (noLoc name) (synifyKindSig kind)) -- User beware: it is your responsibility to pass True (use_gadt_syntax) -- for any constructor that would be misrepresented by omitting its @@ -362,12 +362,12 @@ synifyDataCon use_gadt_syntax dc = let tySyn = synifyType WithinType [] ty in case bang of (HsSrcBang _ NoSrcUnpack NoSrcStrict) -> tySyn - bang' -> noLoc $ HsBangTy noExt bang' tySyn) + bang' -> noLoc $ HsBangTy noExtField bang' tySyn) arg_tys (dataConSrcBangs dc) field_tys = zipWith con_decl_field (dataConFieldLabels dc) linear_tys con_decl_field fl synTy = noLoc $ - ConDeclField noExt [noLoc $ FieldOcc (flSelector fl) (noLoc $ mkVarUnqual $ flLabel fl)] synTy + ConDeclField noExtField [noLoc $ FieldOcc (flSelector fl) (noLoc $ mkVarUnqual $ flLabel fl)] synTy Nothing hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of (True,True) -> Left "synifyDataCon: contradiction!" @@ -381,7 +381,7 @@ synifyDataCon use_gadt_syntax dc = \hat -> if use_gadt_syntax then return $ noLoc $ - ConDeclGADT { con_g_ext = noExt + ConDeclGADT { con_g_ext = noExtField , con_names = [name] , con_forall = noLoc $ not $ null user_tvs , con_qvars = synifyTyVars user_tvs @@ -390,7 +390,7 @@ synifyDataCon use_gadt_syntax dc = , con_res_ty = synifyType WithinType [] res_ty , con_doc = Nothing } else return $ noLoc $ - ConDeclH98 { con_ext = noExt + ConDeclH98 { con_ext = noExtField , con_name = name , con_forall = noLoc False , con_ex_tvs = map synifyTyVar ex_tvs @@ -414,7 +414,7 @@ synifyIdSig -> [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) +synifyIdSig prr s vs i = TypeSig noExtField [synifyName i] (synifySigWcType s vs t) where t = defaultType prr (varType i) @@ -423,8 +423,8 @@ synifyIdSig prr s vs i = TypeSig noExt [synifyName i] (synifySigWcType s vs t) -- '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) + [ ClassOpSig noExtField False [synifyName i] (mainSig (varType i)) ] ++ + [ ClassOpSig noExtField True [noLoc dn] (defSig dt) | Just (dn, GenericDM dt) <- [dm] ] where mainSig t = synifySigType DeleteTopLevelQuantification vs t @@ -435,8 +435,7 @@ synifyCtx = noLoc . map (synifyType WithinType []) synifyTyVars :: [TyVar] -> LHsQTyVars GhcRn -synifyTyVars ktvs = HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = [] - , hsq_dependent = emptyNameSet } +synifyTyVars ktvs = HsQTvs { hsq_ext = [] , hsq_explicit = map synifyTyVar ktvs } synifyTyVar :: TyVar -> LHsTyVarBndr GhcRn @@ -447,8 +446,8 @@ synifyTyVar = synifyTyVar' emptyVarSet 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)) + = noLoc (UserTyVar noExtField (noLoc name)) + | otherwise = noLoc (KindedTyVar noExtField (noLoc name) (synifyKindSig kind)) where kind = tyVarKind tv name = getName tv @@ -466,7 +465,7 @@ annotHsType True ty hs_ty | not $ isEmptyVarSet $ filterVarSet isTyVar $ tyCoVarsOfType ty = let ki = typeKind ty hs_ki = synifyType WithinType [] ki - in noLoc (HsKindSig noExt hs_ty hs_ki) + in noLoc (HsKindSig noExtField hs_ty hs_ki) annotHsType _ _ hs_ty = hs_ty -- | For every argument type that a type constructor accepts, @@ -532,7 +531,7 @@ synifyType -> [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 _ _ (TyVarTy tv) = noLoc $ HsTyVar noExtField NotPromoted $ noLoc (getName tv) synifyType _ vs (TyConApp tc tys) = maybe_sig res_ty where @@ -542,62 +541,62 @@ synifyType _ vs (TyConApp tc tys) | tc `hasKey` tYPETyConKey , [TyConApp lev []] <- tys , lev `hasKey` liftedRepDataConKey - = noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName)) + = noLoc (HsTyVar noExtField NotPromoted (noLoc liftedTypeKindTyConName)) -- Use non-prefix tuple syntax where possible, because it looks nicer. | Just sort <- tyConTuple_maybe tc , tyConArity tc == tys_len - = noLoc $ HsTupleTy noExt + = noLoc $ HsTupleTy noExtField (case sort of BoxedTuple -> HsBoxedTuple ConstraintTuple -> HsConstraintTuple UnboxedTuple -> HsUnboxedTuple) (map (synifyType WithinType vs) vis_tys) - | isUnboxedSumTyCon tc = noLoc $ HsSumTy noExt (map (synifyType WithinType vs) vis_tys) + | isUnboxedSumTyCon tc = noLoc $ HsSumTy noExtField (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) + = noLoc $ HsExplicitTupleTy noExtField (map (synifyType WithinType vs) vis_tys) -- ditto for lists | getName tc == listTyConName, [ty] <- vis_tys = - noLoc $ HsListTy noExt (synifyType WithinType vs ty) + noLoc $ HsListTy noExtField (synifyType WithinType vs ty) | tc == promotedNilDataCon, [] <- vis_tys - = noLoc $ HsExplicitListTy noExt IsPromoted [] + = noLoc $ HsExplicitListTy noExtField 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') + -> noLoc $ HsExplicitListTy noExtField IsPromoted (hTy : tTy') | otherwise - -> noLoc $ HsOpTy noExt hTy (noLoc $ getName tc) tTy + -> noLoc $ HsOpTy noExtField 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 vs ty) + = noLoc $ HsIParamTy noExtField (noLoc $ HsIPName x) (synifyType WithinType vs ty) -- and equalities | tc `hasKey` eqTyConKey , [ty1, ty2] <- tys - = noLoc $ HsOpTy noExt + = noLoc $ HsOpTy noExtField (synifyType WithinType vs ty1) (noLoc eqTyConName) (synifyType WithinType vs ty2) -- and infix type operators | isSymOcc (nameOccName (getName tc)) , ty1:ty2:tys_rest <- vis_tys - = mk_app_tys (HsOpTy noExt + = mk_app_tys (HsOpTy noExtField (synifyType WithinType vs ty1) (noLoc $ getName tc) (synifyType WithinType vs ty2)) tys_rest -- Most TyCons: | otherwise - = mk_app_tys (HsTyVar noExt prom $ noLoc (getName tc)) + = mk_app_tys (HsTyVar noExtField 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) + foldl (\t1 t2 -> noLoc $ HsAppTy noExtField t1 t2) (noLoc ty_app) (map (synifyType WithinType vs) $ filterOut isCoercionTy ty_args) @@ -610,22 +609,23 @@ synifyType _ vs (TyConApp tc tys) | tyConAppNeedsKindSig False tc tys_len = let full_kind = typeKind (mkTyConApp tc tys) full_kind' = synifyType WithinType vs full_kind - in noLoc $ HsKindSig noExt ty' full_kind' + in noLoc $ HsKindSig noExtField ty' full_kind' | otherwise = ty' 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 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 + in noLoc $ HsAppTy noExtField s1 s2 +synifyType s vs funty@(FunTy InvisArg _ _) = synifyForAllType s Inferred vs funty +synifyType _ vs (FunTy VisArg t1 t2) = let + s1 = synifyType WithinType vs t1 + s2 = synifyType WithinType vs t2 + in noLoc $ HsFunTy noExtField s1 s2 +synifyType s vs forallty@(ForAllTy (Bndr _ argf) _ty) = + synifyForAllType s argf vs forallty + +synifyType _ _ (LitTy t) = noLoc $ HsTyLit noExtField $ synifyTyLit t synifyType s vs (CastTy t _) = synifyType s vs t synifyType _ _ (CoercionTy {}) = error "synifyType:Coercion" @@ -633,17 +633,19 @@ synifyType _ _ (CoercionTy {}) = error "synifyType:Coercion" -- an 'HsType' synifyForAllType :: SynifyTypeState -- ^ what to do with the 'forall' + -> ArgFlag -- ^ the visibility of 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 +synifyForAllType s argf vs ty = + let (tvs, ctx, tau) = tcSplitSigmaTySameVisPreserveSynonyms argf ty sPhi = HsQualTy { hst_ctxt = synifyCtx ctx - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = synifyType WithinType (tvs' ++ vs) tau } - sTy = HsForAllTy { hst_bndrs = sTvs - , hst_xforall = noExt + sTy = HsForAllTy { hst_fvf = argToForallVisFlag argf + , hst_bndrs = sTvs + , hst_xforall = noExtField , hst_body = noLoc sPhi } sTvs = map synifyTyVar tvs @@ -683,10 +685,11 @@ implicitForAll tycons vs tvs ctx synInner tau sPhi | null ctx = unLoc sRho | otherwise = HsQualTy { hst_ctxt = synifyCtx ctx - , hst_xqual = noExt + , hst_xqual = noExtField , hst_body = synInner (tvs' ++ vs) tau } - sTy = HsForAllTy { hst_bndrs = sTvs - , hst_xforall = noExt + sTy = HsForAllTy { hst_fvf = ForallInvis + , hst_bndrs = sTvs + , hst_xforall = noExtField , hst_body = noLoc sPhi } no_kinds_needed = noKindTyVars tycons tau @@ -728,7 +731,7 @@ noKindTyVars ts ty _ -> 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 (FunTy _ t1 t2) = noKindTyVars ts t1 `unionVarSet` noKindTyVars ts t2 noKindTyVars ts (CastTy t _) = noKindTyVars ts t noKindTyVars _ _ = emptyVarSet @@ -747,7 +750,7 @@ synifyPatSynType ps = in implicitForAll ts [] (univ_tvs ++ ex_tvs) req_theta' (\vs -> implicitForAll ts vs [] prov_theta (synifyType WithinType)) - (mkFunTys arg_tys res_ty) + (mkVisFunTys arg_tys res_ty) synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n @@ -833,21 +836,22 @@ See https://github.com/haskell/haddock/issues/879 for a bug where this invariant didn't hold. -} --- | A version of 'TcType.tcSplitSigmaTy' that preserves type synonyms. +-- | A version of 'TcType.tcSplitSigmaTySameVis' that preserves type synonyms. -- -- See Note [Invariant: Never expand type synonyms] -tcSplitSigmaTyPreserveSynonyms :: Type -> ([TyVar], ThetaType, Type) -tcSplitSigmaTyPreserveSynonyms ty = - case tcSplitForAllTysPreserveSynonyms ty of +tcSplitSigmaTySameVisPreserveSynonyms :: ArgFlag -> Type -> ([TyVar], ThetaType, Type) +tcSplitSigmaTySameVisPreserveSynonyms argf ty = + case tcSplitForAllTysSameVisPreserveSynonyms argf ty of (tvs, rho) -> case tcSplitPhiTyPreserveSynonyms rho of (theta, tau) -> (tvs, theta, tau) -- | See Note [Invariant: Never expand type synonyms] -tcSplitForAllTysPreserveSynonyms :: Type -> ([TyVar], Type) -tcSplitForAllTysPreserveSynonyms ty = split ty ty [] +tcSplitForAllTysSameVisPreserveSynonyms :: ArgFlag -> Type -> ([TyVar], Type) +tcSplitForAllTysSameVisPreserveSynonyms supplied_argf ty = split ty ty [] where - split _ (ForAllTy (Bndr tv _) ty') tvs = split ty' ty' (tv:tvs) - split orig_ty _ tvs = (reverse tvs, orig_ty) + split _ (ForAllTy (Bndr tv argf) ty') tvs + | argf `sameVis` supplied_argf = split ty' ty' (tv:tvs) + split orig_ty _ tvs = (reverse tvs, orig_ty) -- | See Note [Invariant: Never expand type synonyms] tcSplitPhiTyPreserveSynonyms :: Type -> (ThetaType, Type) @@ -860,7 +864,5 @@ tcSplitPhiTyPreserveSynonyms ty0 = split ty0 [] -- | See Note [Invariant: Never expand type synonyms] tcSplitPredFunTyPreserveSynonyms_maybe :: Type -> Maybe (PredType, Type) -tcSplitPredFunTyPreserveSynonyms_maybe (FunTy arg res) - | isPredTy arg = Just (arg, res) -tcSplitPredFunTyPreserveSynonyms_maybe _ - = Nothing +tcSplitPredFunTyPreserveSynonyms_maybe (FunTy InvisArg arg res) = Just (arg, res) +tcSplitPredFunTyPreserveSynonyms_maybe _ = Nothing diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 5cc005cc..6577e08f 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -21,7 +21,7 @@ module Haddock.GhcUtils where import Control.Arrow import Data.Char ( isSpace ) -import Haddock.Types( DocNameI ) +import Haddock.Types( DocName, DocNameI ) import Exception import FV @@ -38,7 +38,8 @@ import Var ( VarBndr(..), TyVarBinder, tyVarKind, updateTyVarKind, isInvisibleArgFlag ) import VarSet ( VarSet, emptyVarSet ) import VarEnv ( TyVarEnv, extendVarEnv, elemVarEnv, emptyVarEnv ) -import TyCoRep ( Type(..), isRuntimeRepVar ) +import TyCoRep ( Type(..) ) +import Type ( isRuntimeRepVar ) import TysWiredIn( liftedRepDataConTyCon ) import StringBuffer ( StringBuffer ) @@ -48,7 +49,6 @@ import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS - moduleString :: Module -> String moduleString = moduleNameString . moduleName @@ -70,7 +70,7 @@ getMainDeclBinder _ = [] -- Extract the source location where an instance is defined. This is used -- to correlate InstDecls with their Instance/CoAxiom Names, via the -- instanceMap. -getInstLoc :: InstDecl name -> SrcSpan +getInstLoc :: InstDecl (GhcPass p) -> SrcSpan getInstLoc (ClsInstD _ (ClsInstDecl { cid_poly_ty = ty })) = getLoc (hsSigType ty) getInstLoc (DataFamInstD _ (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}})) = l @@ -79,12 +79,12 @@ getInstLoc (TyFamInstD _ (TyFamInstDecl -- in particular, we need to dig a bit deeper to pull out the entire -- equation. This does not happen for data family instances, for some reason. { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}})) = l -getInstLoc (ClsInstD _ (XClsInstDecl _)) = panic "getInstLoc" -getInstLoc (DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _)))) = panic "getInstLoc" -getInstLoc (TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic "getInstLoc" -getInstLoc (XInstDecl _) = panic "getInstLoc" -getInstLoc (DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs _))) = panic "getInstLoc" -getInstLoc (TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic "getInstLoc" +getInstLoc (ClsInstD _ (XClsInstDecl nec)) = noExtCon nec +getInstLoc (DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn nec)))) = noExtCon nec +getInstLoc (TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn nec)))) = noExtCon nec +getInstLoc (XInstDecl nec) = noExtCon nec +getInstLoc (DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs nec))) = noExtCon nec +getInstLoc (TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs nec))) = noExtCon nec @@ -101,20 +101,20 @@ filterSigNames p orig@(InlineSig _ n _) = ifTrueJust (p $ unLoc n) orig filterSigNames p (FixSig _ (FixitySig _ ns ty)) = case filter (p . unLoc) ns of [] -> Nothing - filtered -> Just (FixSig noExt (FixitySig noExt filtered ty)) + filtered -> Just (FixSig noExtField (FixitySig noExtField filtered ty)) filterSigNames _ orig@(MinimalSig _ _ _) = Just orig filterSigNames p (TypeSig _ ns ty) = case filter (p . unLoc) ns of [] -> Nothing - filtered -> Just (TypeSig noExt filtered ty) + filtered -> Just (TypeSig noExtField filtered ty) filterSigNames p (ClassOpSig _ is_default ns ty) = case filter (p . unLoc) ns of [] -> Nothing - filtered -> Just (ClassOpSig noExt is_default filtered ty) + filtered -> Just (ClassOpSig noExtField is_default filtered ty) filterSigNames p (PatSynSig _ ns ty) = case filter (p . unLoc) ns of [] -> Nothing - filtered -> Just (PatSynSig noExt filtered ty) + filtered -> Just (PatSynSig noExtField filtered ty) filterSigNames _ _ = Nothing ifTrueJust :: Bool -> name -> Maybe name @@ -135,10 +135,10 @@ sigNameNoLoc _ = [] -- | Was this signature given by the user? isUserLSig :: LSig name -> Bool -isUserLSig (L _(TypeSig {})) = True -isUserLSig (L _(ClassOpSig {})) = True -isUserLSig (L _(PatSynSig {})) = True -isUserLSig _ = False +isUserLSig (L _ (TypeSig {})) = True +isUserLSig (L _ (ClassOpSig {})) = True +isUserLSig (L _ (PatSynSig {})) = True +isUserLSig _ = False isClassD :: HsDecl a -> Bool @@ -165,8 +165,28 @@ nubByName f ns = go emptyNameSet ns -- --------------------------------------------------------------------- --- This function is duplicated as getGADTConType and getGADTConTypeG, --- as I can't get the types to line up otherwise. AZ. +-- These functions are duplicated from the GHC API, as they must be +-- instantiated at DocNameI instead of (GhcPass _). + +hsTyVarNameI :: HsTyVarBndr DocNameI -> DocName +hsTyVarNameI (UserTyVar _ (L _ n)) = n +hsTyVarNameI (KindedTyVar _ (L _ n) _) = n +hsTyVarNameI (XTyVarBndr nec) = noExtCon nec + +hsLTyVarNameI :: LHsTyVarBndr DocNameI -> DocName +hsLTyVarNameI = hsTyVarNameI . unLoc + +getConNamesI :: ConDecl DocNameI -> [Located DocName] +getConNamesI ConDeclH98 {con_name = name} = [name] +getConNamesI ConDeclGADT {con_names = names} = names +getConNamesI (XConDecl nec) = noExtCon nec + +hsImplicitBodyI :: HsImplicitBndrs DocNameI thing -> thing +hsImplicitBodyI (HsIB { hsib_body = body }) = body +hsImplicitBodyI (XHsImplicitBndrs nec) = noExtCon nec + +hsSigTypeI :: LHsSigType DocNameI -> LHsType DocNameI +hsSigTypeI = hsImplicitBodyI getGADTConType :: ConDecl DocNameI -> LHsType DocNameI -- The full type of a GADT data constructor We really only get this in @@ -177,26 +197,27 @@ getGADTConType (ConDeclGADT { con_forall = L _ has_forall , con_qvars = qtvs , con_mb_cxt = mcxt, con_args = args , con_res_ty = res_ty }) - | has_forall = noLoc (HsForAllTy { hst_xforall = NoExt + | has_forall = noLoc (HsForAllTy { hst_fvf = ForallInvis + , hst_xforall = noExtField , hst_bndrs = hsQTvExplicit qtvs , hst_body = theta_ty }) | otherwise = theta_ty where theta_ty | Just theta <- mcxt - = noLoc (HsQualTy { hst_xqual = NoExt, hst_ctxt = theta, hst_body = tau_ty }) + = noLoc (HsQualTy { hst_xqual = noExtField, hst_ctxt = theta, hst_body = tau_ty }) | otherwise = tau_ty tau_ty = case args of - RecCon flds -> noLoc (HsFunTy noExt (noLoc (HsRecTy noExt (unLoc flds))) res_ty) + RecCon flds -> noLoc (HsFunTy noExtField (noLoc (HsRecTy noExtField (unLoc flds))) res_ty) PrefixCon pos_args -> foldr mkFunTy res_ty pos_args InfixCon arg1 arg2 -> arg1 `mkFunTy` (arg2 `mkFunTy` res_ty) - mkFunTy a b = noLoc (HsFunTy noExt a b) + mkFunTy a b = noLoc (HsFunTy noExtField a b) getGADTConType (ConDeclH98 {}) = panic "getGADTConType" -- Should only be called on ConDeclGADT -getGADTConType (XConDecl {}) = panic "getGADTConType" +getGADTConType (XConDecl nec) = noExtCon nec -- ------------------------------------- @@ -209,26 +230,27 @@ getGADTConTypeG (ConDeclGADT { con_forall = L _ has_forall , con_qvars = qtvs , con_mb_cxt = mcxt, con_args = args , con_res_ty = res_ty }) - | has_forall = noLoc (HsForAllTy { hst_xforall = NoExt + | has_forall = noLoc (HsForAllTy { hst_fvf = ForallInvis + , hst_xforall = noExtField , hst_bndrs = hsQTvExplicit qtvs , hst_body = theta_ty }) | otherwise = theta_ty where theta_ty | Just theta <- mcxt - = noLoc (HsQualTy { hst_xqual = NoExt, hst_ctxt = theta, hst_body = tau_ty }) + = noLoc (HsQualTy { hst_xqual = noExtField, hst_ctxt = theta, hst_body = tau_ty }) | otherwise = tau_ty tau_ty = case args of - RecCon flds -> noLoc (HsFunTy noExt (noLoc (HsRecTy noExt (unLoc flds))) res_ty) + RecCon flds -> noLoc (HsFunTy noExtField (noLoc (HsRecTy noExtField (unLoc flds))) res_ty) PrefixCon pos_args -> foldr mkFunTy res_ty pos_args InfixCon arg1 arg2 -> arg1 `mkFunTy` (arg2 `mkFunTy` res_ty) - mkFunTy a b = noLoc (HsFunTy noExt a b) + mkFunTy a b = noLoc (HsFunTy noExtField a b) getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG" -- Should only be called on ConDeclGADT -getGADTConTypeG (XConDecl {}) = panic "getGADTConTypeG" +getGADTConTypeG (XConDecl nec) = noExtCon nec ------------------------------------------------------------------------------- @@ -258,12 +280,12 @@ data Precedence -- -- We cannot add parens that may be required by fixities because we do not have -- any fixity information to work with in the first place :(. -reparenTypePrec :: (XParTy a ~ NoExt) => Precedence -> HsType a -> HsType a +reparenTypePrec :: (XParTy a ~ NoExtField) => Precedence -> HsType a -> HsType a reparenTypePrec = go where -- Shorter name for 'reparenType' - go :: (XParTy a ~ NoExt) => Precedence -> HsType a -> HsType a + go :: (XParTy a ~ NoExtField) => Precedence -> HsType a -> HsType a 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) @@ -276,8 +298,8 @@ reparenTypePrec = go = paren p PREC_SIG $ HsKindSig x (goL PREC_SIG ty) (goL PREC_SIG kind) go p (HsIParamTy x n ty) = paren p PREC_SIG $ HsIParamTy x n (reparenLType ty) - go p (HsForAllTy x tvs ty) - = paren p PREC_CTX $ HsForAllTy x (map (fmap reparenTyVar) tvs) (reparenLType ty) + go p (HsForAllTy x fvf tvs ty) + = paren p PREC_CTX $ HsForAllTy x fvf (map (fmap reparenTyVar) tvs) (reparenLType ty) go p (HsQualTy x ctxt ty) = let p' [_] = PREC_CTX p' _ = PREC_TOP -- parens will get added anyways later... @@ -299,34 +321,34 @@ reparenTypePrec = go go _ t@XHsType{} = t -- Located variant of 'go' - goL :: (XParTy a ~ NoExt) => Precedence -> LHsType a -> LHsType a + goL :: (XParTy a ~ NoExtField) => Precedence -> LHsType a -> LHsType a goL ctxt_prec = fmap (go ctxt_prec) -- Optionally wrap a type in parens - paren :: (XParTy a ~ NoExt) + paren :: (XParTy a ~ NoExtField) => Precedence -- Precedence of context -> Precedence -- Precedence of top-level operator -> HsType a -> HsType a -- Wrap in parens if (ctxt >= op) - paren ctxt_prec op_prec | ctxt_prec >= op_prec = HsParTy NoExt . noLoc + paren ctxt_prec op_prec | ctxt_prec >= op_prec = HsParTy noExtField . noLoc | otherwise = id -- | Add parenthesis around the types in a 'HsType' (see 'reparenTypePrec') -reparenType :: (XParTy a ~ NoExt) => HsType a -> HsType a +reparenType :: (XParTy a ~ NoExtField) => HsType a -> HsType a reparenType = reparenTypePrec PREC_TOP -- | Add parenthesis around the types in a 'LHsType' (see 'reparenTypePrec') -reparenLType :: (XParTy a ~ NoExt) => LHsType a -> LHsType a +reparenLType :: (XParTy a ~ NoExtField) => LHsType a -> LHsType a reparenLType = fmap reparenType -- | Add parenthesis around the types in a 'HsTyVarBndr' (see 'reparenTypePrec') -reparenTyVar :: (XParTy a ~ NoExt) => HsTyVarBndr a -> HsTyVarBndr a +reparenTyVar :: (XParTy a ~ NoExtField) => HsTyVarBndr a -> HsTyVarBndr a reparenTyVar (UserTyVar x n) = UserTyVar x n reparenTyVar (KindedTyVar x n kind) = KindedTyVar x n (reparenLType kind) reparenTyVar v@XTyVarBndr{} = v -- | Add parenthesis around the types in a 'ConDeclField' (see 'reparenTypePrec') -reparenConDeclField :: (XParTy a ~ NoExt) => ConDeclField a -> ConDeclField a +reparenConDeclField :: (XParTy a ~ NoExtField) => ConDeclField a -> ConDeclField a reparenConDeclField (ConDeclField x n t d) = ConDeclField x n (reparenLType t) d reparenConDeclField c@XConDeclField{} = c @@ -568,7 +590,7 @@ tryCppLine !loc !buf = spanSpace (S.prevChar buf '\n' == '\n') loc buf -- | Get free type variables in a 'Type' in their order of appearance. -- See [Ordering of implicit variables]. orderedFVs - :: VarSet -- ^ free variables to ignore + :: 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 = @@ -582,7 +604,7 @@ orderedFVs vs tys = -- For example, 'tyCoVarsOfTypeList' reports an incorrect order for the type -- of 'const :: a -> b -> a': -- --- >>> import Name +-- >>> import Name -- >>> import TyCoRep -- >>> import TysPrim -- >>> import Var @@ -604,7 +626,7 @@ tyCoFVsOfType' (TyVarTy v) a b c = (FV.unitFV v `unionFV` tyCoFVsOfType' 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' (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 @@ -650,8 +672,8 @@ defaultRuntimeRepVars = go emptyVarEnv 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 (FunTy af arg res) + = FunTy af (go subs arg) (go subs res) go subs (AppTy t u) = AppTy (go subs t) (go subs u) diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 336f122a..c2c0d733 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -59,7 +59,7 @@ import TcRnTypes (tcg_rdr_env) import Name (nameIsFromExternalPackage, nameOccName) import OccName (isTcOcc) import RdrName (unQualOK, gre_name, globalRdrEnvElts) -import ErrUtils (withTiming) +import ErrUtils (withTimingD) import DynamicLoading (initializePlugins) #if defined(mingw32_HOST_OS) @@ -96,7 +96,7 @@ processModules verbosity modules flags extIfaces = do mods = Set.fromList $ map ifaceMod interfaces out verbosity verbose "Attaching instances..." interfaces' <- {-# SCC attachInstances #-} - withTiming getDynFlags "attachInstances" (const ()) $ do + withTimingD "attachInstances" (const ()) $ do attachInstances (exportedNames, mods) interfaces instIfaceMap ms out verbosity verbose "Building cross-linking environment..." @@ -136,7 +136,7 @@ createIfaces verbosity modules flags instIfaceMap = do where f (ifaces, ifaceMap, !ms) modSummary = do x <- {-# SCC processModule #-} - withTiming getDynFlags "processModule" (const ()) $ do + withTimingD "processModule" (const ()) $ do processModule verbosity modSummary flags ifaceMap instIfaceMap return $ case x of Just (iface, ms') -> ( iface:ifaces @@ -161,7 +161,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do if not $ isBootSummary modsum then do out verbosity verbose "Creating interface..." (interface, msgs) <- {-# SCC createIterface #-} - withTiming getDynFlags "createInterface" (const ()) $ do + withTimingD "createInterface" (const ()) $ do runWriterGhc $ createInterface tm flags modMap instIfaceMap -- We need to keep track of which modules were somehow in scope so that when diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index dd6c70a5..35f24ee5 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -194,13 +194,13 @@ instHead (_, _, cls, args) argCount :: Type -> Int argCount (AppTy t _) = argCount t + 1 argCount (TyConApp _ ts) = length ts -argCount (FunTy _ _ ) = 2 +argCount (FunTy _ _ _) = 2 argCount (ForAllTy _ t) = argCount t argCount (CastTy t _) = argCount t argCount _ = 0 simplify :: Type -> SimpleType -simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] +simplify (FunTy _ t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] simplify (ForAllTy _ t) = simplify t simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) where (SimpleType s ts) = simplify t1 @@ -255,7 +255,7 @@ isTypeHidden expInfo = typeHidden case t of TyVarTy {} -> False AppTy t1 t2 -> typeHidden t1 || typeHidden t2 - FunTy t1 t2 -> typeHidden t1 || typeHidden t2 + FunTy _ t1 t2 -> typeHidden t1 || typeHidden t2 TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args ForAllTy bndr ty -> typeHidden (tyVarKind (binderVar bndr)) || typeHidden ty LitTy _ -> False diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index dd1d4eb3..d5cbdaf5 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wwarn #-} ----------------------------------------------------------------------------- -- | @@ -52,7 +53,7 @@ import Packages ( lookupModuleInAllPackages, PackageName(..) ) import Bag import RdrName import TcRnTypes -import FastString ( unpackFS, fastStringToByteString) +import FastString ( unpackFS, bytesFS ) import BasicTypes ( StringLiteral(..), SourceText(..), PromotionFlag(..) ) import qualified Outputable as O @@ -297,8 +298,8 @@ moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name) parseWarning dflags gre w = case w of - DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (fastStringToByteString . sl_fs . unLoc) msg) - WarningTxt _ msg -> format "Warning: " (foldMap (fastStringToByteString . sl_fs . unLoc) msg) + DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (bytesFS . sl_fs . unLoc) msg) + WarningTxt _ msg -> format "Warning: " (foldMap (bytesFS . sl_fs . unLoc) msg) where format x bs = DocWarning . DocParagraph . DocAppend (DocString x) <$> processDocString dflags gre (mkHsDocStringUtf8ByteString bs) @@ -468,11 +469,22 @@ subordinates instMap decl = case decl of , L _ (ConDeclField _ ns _ doc) <- (unLoc flds) , L _ n <- ns ] derivs = [ (instName, [unL doc], M.empty) - | HsIB { hsib_body = L l (HsDocTy _ _ doc) } - <- concatMap (unLoc . deriv_clause_tys . unLoc) $ - unLoc $ dd_derivs dd + | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ + concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ] + extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty ty = + case dL ty of + -- deriving (forall a. C a {- ^ Doc comment -}) + L l (HsForAllTy{ hst_fvf = ForallInvis + , hst_body = dL->L _ (HsDocTy _ _ doc) }) + -> Just (l, doc) + -- deriving (C a {- ^ Doc comment -}) + L l (HsDocTy _ _ doc) -> Just (l, doc) + _ -> Nothing + -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int HsDocString conArgDocs con = case getConArgs con of @@ -515,10 +527,10 @@ classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])] classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls where decls = docs ++ defs ++ sigs ++ ats - docs = mkDecls tcdDocs (DocD noExt) class_ - defs = mkDecls (bagToList . tcdMeths) (ValD noExt) class_ - sigs = mkDecls tcdSigs (SigD noExt) class_ - ats = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_ + docs = mkDecls tcdDocs (DocD noExtField) class_ + defs = mkDecls (bagToList . tcdMeths) (ValD noExtField) class_ + sigs = mkDecls tcdSigs (SigD noExtField) class_ + ats = mkDecls tcdATs (TyClD noExtField . FamDecl noExtField) class_ -- | The top-level declarations of a module that we care about, @@ -537,14 +549,14 @@ mkFixMap group_ = M.fromList [ (n,f) -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'. ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn] ungroup group_ = - mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt) group_ ++ - mkDecls hs_derivds (DerivD noExt) group_ ++ - mkDecls hs_defds (DefD noExt) group_ ++ - mkDecls hs_fords (ForD noExt) group_ ++ - mkDecls hs_docs (DocD noExt) group_ ++ - mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt) group_ ++ - mkDecls (typesigs . hs_valds) (SigD noExt) group_ ++ - mkDecls (valbinds . hs_valds) (ValD noExt) group_ + mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExtField) group_ ++ + mkDecls hs_derivds (DerivD noExtField) group_ ++ + mkDecls hs_defds (DefD noExtField) group_ ++ + mkDecls hs_fords (ForD noExtField) group_ ++ + mkDecls hs_docs (DocD noExtField) group_ ++ + mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExtField) group_ ++ + mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++ + mkDecls (valbinds . hs_valds) (ValD noExtField) group_ where typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs typesigs _ = error "expected ValBindsOut" @@ -736,14 +748,14 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames L loc (SigD _ sig) -> -- fromJust is safe since we already checked in guards -- that 't' is a name declared in this declaration. - let newDecl = L loc . SigD noExt . fromJust $ filterSigNames (== t) sig + let newDecl = L loc . SigD noExtField . fromJust $ filterSigNames (== t) sig in availExportDecl avail newDecl docs_ L loc (TyClD _ cl@ClassDecl{}) -> do mdef <- liftGhcToErrMsgGhc $ minimalDef t - let sig = maybeToList $ fmap (noLoc . MinimalSig noExt NoSourceText . noLoc . fmap noLoc) mdef + let sig = maybeToList $ fmap (noLoc . MinimalSig noExtField NoSourceText . noLoc . fmap noLoc) mdef availExportDecl avail - (L loc $ TyClD noExt cl { tcdSigs = sig ++ tcdSigs cl }) docs_ + (L loc $ TyClD noExtField cl { tcdSigs = sig ++ tcdSigs cl }) docs_ _ -> availExportDecl avail decl docs_ @@ -1057,8 +1069,8 @@ extractDecl declMap name decl in case (matchesMethod, matchesAssociatedType) of ([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) L pos sig = addClassContext n tyvar_names s0 - in L pos (SigD noExt sig) - (_, [L pos fam_decl]) -> L pos (TyClD noExt (FamDecl noExt fam_decl)) + in L pos (SigD noExtField sig) + (_, [L pos fam_decl]) -> L pos (TyClD noExtField (FamDecl noExtField fam_decl)) ([], []) | Just (famInstDecl:_) <- M.lookup name declMap @@ -1070,8 +1082,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 (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) - else SigD noExt <$> extractRecSel name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) + then SigD noExtField <$> extractPatternSyn name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) + else SigD noExtField <$> extractRecSel name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) TyClD _ FamDecl {} | isValName name , Just (famInst:_) <- M.lookup name declMap @@ -1081,8 +1093,8 @@ extractDecl declMap name decl , feqn_pats = tys , feqn_rhs = defn }}))) -> if isDataConName name - then SigD noExt <$> extractPatternSyn name n tys (dd_cons defn) - else SigD noExt <$> extractRecSel name n tys (dd_cons defn) + then SigD noExtField <$> extractPatternSyn name n tys (dd_cons defn) + else SigD noExtField <$> extractRecSel name n tys (dd_cons defn) InstD _ (ClsInstD _ ClsInstDecl { cid_datafam_insts = insts }) | isDataConName name -> let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = @@ -1092,7 +1104,7 @@ extractDecl declMap name decl , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd)) ] in case matches of - [d0] -> extractDecl declMap name (noLoc (InstD noExt (DataFamInstD noExt d0))) + [d0] -> extractDecl declMap name (noLoc (InstD noExtField (DataFamInstD noExtField d0))) _ -> error "internal: extractDecl (ClsInstD)" | otherwise -> let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d })) @@ -1104,7 +1116,7 @@ extractDecl declMap name decl , extFieldOcc n == name ] in case matches of - [d0] -> extractDecl declMap name (noLoc . InstD noExt $ DataFamInstD noExt d0) + [d0] -> extractDecl declMap name (noLoc . InstD noExtField $ DataFamInstD noExtField d0) _ -> error "internal: extractDecl (ClsInstD)" _ -> O.pprPanic "extractDecl" $ O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":" @@ -1128,21 +1140,21 @@ extractPatternSyn nm t tvs cons = typ = longArrow args (data_ty con) typ' = case con of - ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy noExt cxt typ) + ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy noExtField cxt typ) _ -> typ - typ'' = noLoc (HsQualTy noExt (noLoc []) typ') - in PatSynSig noExt [noLoc nm] (mkEmptyImplicitBndrs typ'') + typ'' = noLoc (HsQualTy noExtField (noLoc []) typ') + in PatSynSig noExtField [noLoc nm] (mkEmptyImplicitBndrs typ'') longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn - longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExt x y)) output inputs + longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExtField x y)) output inputs data_ty con | ConDeclGADT{} <- con = con_res_ty con - | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExtField NotPromoted (noLoc t))) tvs where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn - mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsValArg ty) = HsAppTy noExtField f ty mkAppTyArg f (HsTypeArg l ki) = HsAppKindTy l f ki - mkAppTyArg f (HsArgPar _) = HsParTy noExt f + mkAppTyArg f (HsArgPar _) = HsParTy noExtField f extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn @@ -1151,7 +1163,7 @@ extractRecSel _ _ _ [] = error "extractRecSel: selector not found" extractRecSel nm t tvs (L _ con : rest) = case getConArgs con of RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields -> - L l (TypeSig noExt [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExt data_ty (getBangType ty))))) + L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField data_ty (getBangType ty))))) _ -> extractRecSel nm t tvs rest where matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)] @@ -1160,11 +1172,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 (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExtField NotPromoted (noLoc t))) tvs where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn - mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsValArg ty) = HsAppTy noExtField f ty mkAppTyArg f (HsTypeArg l ki) = HsAppKindTy l f ki - mkAppTyArg f (HsArgPar _) = HsParTy noExt f + mkAppTyArg f (HsArgPar _) = HsParTy noExtField f -- | Keep export items with docs. pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn] diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index ceea2444..72d063dc 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -204,14 +204,14 @@ renameMaybeLKind = traverse renameLKind renameFamilyResultSig :: LFamilyResultSig GhcRn -> RnM (LFamilyResultSig DocNameI) renameFamilyResultSig (L loc (NoSig _)) - = return (L loc (NoSig noExt)) + = return (L loc (NoSig noExtField)) renameFamilyResultSig (L loc (KindSig _ ki)) = do { ki' <- renameLKind ki - ; return (L loc (KindSig noExt ki')) } + ; return (L loc (KindSig noExtField ki')) } renameFamilyResultSig (L loc (TyVarSig _ bndr)) = do { bndr' <- renameLTyVarBndr bndr - ; return (L loc (TyVarSig noExt bndr')) } -renameFamilyResultSig (L _ (XFamilyResultSig _)) = panic "haddock:renameFamilyResultSig" + ; return (L loc (TyVarSig noExtField bndr')) } +renameFamilyResultSig (L _ (XFamilyResultSig nec)) = noExtCon nec renameInjectivityAnn :: LInjectivityAnn GhcRn -> RnM (LInjectivityAnn DocNameI) renameInjectivityAnn (L loc (InjectivityAnn lhs rhs)) @@ -225,63 +225,64 @@ renameMaybeInjectivityAnn = traverse renameInjectivityAnn renameType :: HsType GhcRn -> RnM (HsType DocNameI) renameType t = case t of - HsForAllTy { hst_bndrs = tyvars, hst_body = ltype } -> do + HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars, hst_body = ltype } -> do tyvars' <- mapM renameLTyVarBndr tyvars ltype' <- renameLType ltype - return (HsForAllTy { hst_xforall = NoExt, hst_bndrs = tyvars', hst_body = ltype' }) + return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField + , hst_bndrs = tyvars', hst_body = ltype' }) HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do lcontext' <- renameLContext lcontext ltype' <- renameLType ltype - return (HsQualTy { hst_xqual = NoExt, hst_ctxt = lcontext', hst_body = ltype' }) + return (HsQualTy { hst_xqual = noExtField, hst_ctxt = lcontext', hst_body = ltype' }) - HsTyVar _ ip (L l n) -> return . HsTyVar NoExt ip . L l =<< rename n - HsBangTy _ b ltype -> return . HsBangTy NoExt b =<< renameLType ltype + HsTyVar _ ip (L l n) -> return . HsTyVar noExtField ip . L l =<< rename n + HsBangTy _ b ltype -> return . HsBangTy noExtField b =<< renameLType ltype - HsStarTy _ isUni -> return (HsStarTy NoExt isUni) + HsStarTy _ isUni -> return (HsStarTy noExtField isUni) HsAppTy _ a b -> do a' <- renameLType a b' <- renameLType b - return (HsAppTy NoExt a' b') + return (HsAppTy noExtField a' b') HsAppKindTy _ a b -> do a' <- renameLType a b' <- renameLKind b - return (HsAppKindTy NoExt a' b') + return (HsAppKindTy noExtField a' b') HsFunTy _ a b -> do a' <- renameLType a b' <- renameLType b - return (HsFunTy NoExt a' b') + return (HsFunTy noExtField a' b') - HsListTy _ ty -> return . (HsListTy NoExt) =<< renameLType ty - HsIParamTy _ n ty -> liftM (HsIParamTy NoExt n) (renameLType ty) + HsListTy _ ty -> return . (HsListTy noExtField) =<< renameLType ty + HsIParamTy _ n ty -> liftM (HsIParamTy noExtField n) (renameLType ty) - HsTupleTy _ b ts -> return . HsTupleTy NoExt b =<< mapM renameLType ts - HsSumTy _ ts -> HsSumTy NoExt <$> mapM renameLType ts + HsTupleTy _ b ts -> return . HsTupleTy noExtField b =<< mapM renameLType ts + HsSumTy _ ts -> HsSumTy noExtField <$> mapM renameLType ts HsOpTy _ a (L loc op) b -> do op' <- rename op a' <- renameLType a b' <- renameLType b - return (HsOpTy NoExt a' (L loc op') b') + return (HsOpTy noExtField a' (L loc op') b') - HsParTy _ ty -> return . (HsParTy NoExt) =<< renameLType ty + HsParTy _ ty -> return . (HsParTy noExtField) =<< renameLType ty HsKindSig _ ty k -> do ty' <- renameLType ty k' <- renameLKind k - return (HsKindSig NoExt ty' k') + return (HsKindSig noExtField ty' k') HsDocTy _ ty doc -> do ty' <- renameLType ty doc' <- renameLDocHsSyn doc - return (HsDocTy NoExt ty' doc') + return (HsDocTy noExtField ty' doc') - HsTyLit _ x -> return (HsTyLit NoExt x) + HsTyLit _ x -> return (HsTyLit noExtField x) - HsRecTy _ a -> HsRecTy NoExt <$> mapM renameConDeclFieldField a + HsRecTy _ a -> HsRecTy noExtField <$> mapM renameConDeclFieldField a (XHsType (NHsCoreTy a)) -> pure (XHsType (NHsCoreTy a)) HsExplicitListTy i a b -> HsExplicitListTy i a <$> mapM renameLType b HsExplicitTupleTy a b -> HsExplicitTupleTy a <$> mapM renameLType b @@ -302,9 +303,9 @@ renameHsSpliceTy _ = error "renameHsSpliceTy: not an HsSpliced" renameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI) renameLHsQTyVars (HsQTvs { hsq_explicit = tvs }) = do { tvs' <- mapM renameLTyVarBndr tvs - ; return (HsQTvs { hsq_ext = noExt + ; return (HsQTvs { hsq_ext = noExtField , hsq_explicit = tvs' }) } -renameLHsQTyVars (XLHsQTyVars _) = panic "haddock:renameLHsQTyVars" +renameLHsQTyVars (XLHsQTyVars nec) = noExtCon nec renameLTyVarBndr :: LHsTyVarBndr GhcRn -> RnM (LHsTyVarBndr DocNameI) renameLTyVarBndr (L loc (UserTyVar x (L l n))) @@ -352,19 +353,19 @@ renameDecl :: HsDecl GhcRn -> RnM (HsDecl DocNameI) renameDecl decl = case decl of TyClD _ d -> do d' <- renameTyClD d - return (TyClD noExt d') + return (TyClD noExtField d') SigD _ s -> do s' <- renameSig s - return (SigD noExt s') + return (SigD noExtField s') ForD _ d -> do d' <- renameForD d - return (ForD noExt d') + return (ForD noExtField d') InstD _ d -> do d' <- renameInstD d - return (InstD noExt d') + return (InstD noExtField d') DerivD _ d -> do d' <- renameDerivD d - return (DerivD noExt d') + return (DerivD noExtField d') _ -> error "renameDecl" renameLThing :: (a GhcRn -> RnM (a DocNameI)) -> Located (a GhcRn) -> RnM (Located (a DocNameI)) @@ -375,20 +376,20 @@ renameTyClD d = case d of -- TyFamily flav lname ltyvars kind tckind -> do FamDecl { tcdFam = decl } -> do decl' <- renameFamilyDecl decl - return (FamDecl { tcdFExt = noExt, tcdFam = decl' }) + return (FamDecl { tcdFExt = noExtField, tcdFam = decl' }) SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs } -> do lname' <- renameL lname tyvars' <- renameLHsQTyVars tyvars rhs' <- renameLType rhs - return (SynDecl { tcdSExt = noExt, tcdLName = lname', tcdTyVars = tyvars' + return (SynDecl { tcdSExt = noExtField, tcdLName = lname', tcdTyVars = tyvars' , tcdFixity = fixity, tcdRhs = rhs' }) DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn } -> do lname' <- renameL lname tyvars' <- renameLHsQTyVars tyvars defn' <- renameDataDefn defn - return (DataDecl { tcdDExt = noExt, tcdLName = lname', tcdTyVars = tyvars' + return (DataDecl { tcdDExt = noExtField, tcdLName = lname', tcdTyVars = tyvars' , tcdFixity = fixity, tcdDataDefn = defn' }) ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity @@ -399,13 +400,13 @@ renameTyClD d = case d of lfundeps' <- mapM renameLFunDep lfundeps lsigs' <- mapM renameLSig lsigs ats' <- mapM (renameLThing renameFamilyDecl) ats - at_defs' <- mapM renameLTyFamDefltEqn at_defs + at_defs' <- mapM (mapM renameTyFamDefltD) at_defs -- we don't need the default methods or the already collected doc entities return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars' , tcdFixity = fixity , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag - , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdCExt = NoExt }) - XTyClDecl _ -> panic "haddock:renameTyClD" + , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdCExt = noExtField }) + XTyClDecl nec -> noExtCon nec where renameLFunDep (L loc (xs, ys)) = do @@ -426,12 +427,12 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname ltyvars' <- renameLHsQTyVars ltyvars result' <- renameFamilyResultSig result injectivity' <- renameMaybeInjectivityAnn injectivity - return (FamilyDecl { fdExt = noExt, fdInfo = info', fdLName = lname' + return (FamilyDecl { fdExt = noExtField, fdInfo = info', fdLName = lname' , fdTyVars = ltyvars' , fdFixity = fixity , fdResultSig = result' , fdInjectivityAnn = injectivity' }) -renameFamilyDecl (XFamilyDecl _) = panic "renameFamilyDecl" +renameFamilyDecl (XFamilyDecl nec) = noExtCon nec renamePseudoFamilyDecl :: PseudoFamilyDecl GhcRn @@ -457,11 +458,11 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType k' <- renameMaybeLKind k cons' <- mapM (mapM renameCon) cons -- I don't think we need the derivings, so we return Nothing - return (HsDataDefn { dd_ext = noExt + return (HsDataDefn { dd_ext = noExtField , dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType , dd_kindSig = k', dd_cons = cons' , dd_derivs = noLoc [] }) -renameDataDefn (XHsDataDefn _) = panic "haddock:renameDataDefn" +renameDataDefn (XHsDataDefn nec) = noExtCon nec renameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI) renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars @@ -472,7 +473,7 @@ renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars lcontext' <- traverse renameLContext lcontext details' <- renameDetails details mbldoc' <- mapM renameLDocHsSyn mbldoc - return (decl { con_ext = noExt, con_name = lname', con_ex_tvs = ltyvars' + return (decl { con_ext = noExtField, con_name = lname', con_ex_tvs = ltyvars' , con_mb_cxt = lcontext' , con_args = details', con_doc = mbldoc' }) @@ -486,10 +487,10 @@ renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars details' <- renameDetails details res_ty' <- renameLType res_ty mbldoc' <- mapM renameLDocHsSyn mbldoc - return (decl { con_g_ext = noExt, con_names = lnames', con_qvars = ltyvars' + return (decl { con_g_ext = noExtField, con_names = lnames', con_qvars = ltyvars' , con_mb_cxt = lcontext', con_args = details' , con_res_ty = res_ty', con_doc = mbldoc' }) -renameCon (XConDecl _) = panic "haddock:renameCon" +renameCon (XConDecl nec) = noExtCon nec renameDetails :: HsConDeclDetails GhcRn -> RnM (HsConDeclDetails DocNameI) renameDetails (RecCon (L l fields)) = do @@ -506,8 +507,8 @@ renameConDeclFieldField (L l (ConDeclField _ names t doc)) = do names' <- mapM renameLFieldOcc names t' <- renameLType t doc' <- mapM renameLDocHsSyn doc - return $ L l (ConDeclField noExt names' t' doc') -renameConDeclFieldField (L _ (XConDeclField _)) = panic "haddock:renameConDeclFieldField" + return $ L l (ConDeclField noExtField names' t' doc') +renameConDeclFieldField (L _ (XConDeclField nec)) = noExtCon nec renameLFieldOcc :: LFieldOcc GhcRn -> RnM (LFieldOcc DocNameI) renameLFieldOcc (L l (FieldOcc sel lbl)) = do @@ -520,21 +521,21 @@ renameSig sig = case sig of TypeSig _ lnames ltype -> do lnames' <- mapM renameL lnames ltype' <- renameLSigWcType ltype - return (TypeSig noExt lnames' ltype') + return (TypeSig noExtField lnames' ltype') ClassOpSig _ is_default lnames sig_ty -> do lnames' <- mapM renameL lnames ltype' <- renameLSigType sig_ty - return (ClassOpSig noExt is_default lnames' ltype') + return (ClassOpSig noExtField is_default lnames' ltype') PatSynSig _ lnames sig_ty -> do lnames' <- mapM renameL lnames sig_ty' <- renameLSigType sig_ty - return $ PatSynSig noExt lnames' sig_ty' + return $ PatSynSig noExtField lnames' sig_ty' FixSig _ (FixitySig _ lnames fixity) -> do lnames' <- mapM renameL lnames - return $ FixSig noExt (FixitySig noExt lnames' fixity) + return $ FixSig noExtField (FixitySig noExtField lnames' fixity) MinimalSig _ src (L l s) -> do s' <- traverse renameL s - return $ MinimalSig noExt src (L l s') + return $ MinimalSig noExtField src (L l s') -- we have filtered out all other kinds of signatures in Interface.Create _ -> error "expected TypeSig" @@ -543,25 +544,25 @@ renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI) renameForD (ForeignImport _ lname ltype x) = do lname' <- renameL lname ltype' <- renameLSigType ltype - return (ForeignImport noExt lname' ltype' x) + return (ForeignImport noExtField lname' ltype' x) renameForD (ForeignExport _ lname ltype x) = do lname' <- renameL lname ltype' <- renameLSigType ltype - return (ForeignExport noExt lname' ltype' x) -renameForD (XForeignDecl _) = panic "haddock:renameForD" + return (ForeignExport noExtField lname' ltype' x) +renameForD (XForeignDecl nec) = noExtCon nec renameInstD :: InstDecl GhcRn -> RnM (InstDecl DocNameI) renameInstD (ClsInstD { cid_inst = d }) = do d' <- renameClsInstD d - return (ClsInstD { cid_d_ext = noExt, cid_inst = d' }) + return (ClsInstD { cid_d_ext = noExtField, cid_inst = d' }) renameInstD (TyFamInstD { tfid_inst = d }) = do d' <- renameTyFamInstD d - return (TyFamInstD { tfid_ext = noExt, tfid_inst = d' }) + return (TyFamInstD { tfid_ext = noExtField, tfid_inst = d' }) renameInstD (DataFamInstD { dfid_inst = d }) = do d' <- renameDataFamInstD d - return (DataFamInstD { dfid_ext = noExt, dfid_inst = d' }) -renameInstD (XInstDecl _) = panic "haddock:renameInstD" + return (DataFamInstD { dfid_ext = noExtField, dfid_inst = d' }) +renameInstD (XInstDecl nec) = noExtCon nec renameDerivD :: DerivDecl GhcRn -> RnM (DerivDecl DocNameI) renameDerivD (DerivDecl { deriv_type = ty @@ -569,11 +570,11 @@ renameDerivD (DerivDecl { deriv_type = ty , deriv_overlap_mode = omode }) = do ty' <- renameLSigWcType ty strat' <- mapM (mapM renameDerivStrategy) strat - return (DerivDecl { deriv_ext = noExt + return (DerivDecl { deriv_ext = noExtField , deriv_type = ty' , deriv_strategy = strat' , deriv_overlap_mode = omode }) -renameDerivD (XDerivDecl _) = panic "haddock:renameDerivD" +renameDerivD (XDerivDecl nec) = noExtCon nec renameDerivStrategy :: DerivStrategy GhcRn -> RnM (DerivStrategy DocNameI) renameDerivStrategy StockStrategy = pure StockStrategy @@ -588,11 +589,11 @@ renameClsInstD (ClsInstDecl { cid_overlap_mode = omode ltype' <- renameLSigType ltype lATs' <- mapM (mapM renameTyFamInstD) lATs lADTs' <- mapM (mapM renameDataFamInstD) lADTs - return (ClsInstDecl { cid_ext = noExt, cid_overlap_mode = omode + return (ClsInstDecl { cid_ext = noExtField, cid_overlap_mode = omode , cid_poly_ty = ltype', cid_binds = emptyBag , cid_sigs = [] , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' }) -renameClsInstD (XClsInstDecl _) = panic "haddock:renameClsInstD" +renameClsInstD (XClsInstDecl nec) = noExtCon nec renameTyFamInstD :: TyFamInstDecl GhcRn -> RnM (TyFamInstDecl DocNameI) @@ -605,8 +606,8 @@ renameTyFamInstEqn eqn = renameImplicit rename_ty_fam_eqn eqn where rename_ty_fam_eqn - :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn) - -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (LHsType DocNameI)) + :: FamEqn GhcRn (LHsType GhcRn) + -> RnM (FamEqn DocNameI (LHsType DocNameI)) rename_ty_fam_eqn (FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs , feqn_pats = pats, feqn_fixity = fixity , feqn_rhs = rhs }) @@ -614,27 +615,16 @@ renameTyFamInstEqn eqn ; bndrs' <- traverse (mapM renameLTyVarBndr) bndrs ; pats' <- mapM renameLTypeArg pats ; rhs' <- renameLType rhs - ; return (FamEqn { feqn_ext = noExt + ; return (FamEqn { feqn_ext = noExtField , feqn_tycon = tc' , feqn_bndrs = bndrs' , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = rhs' }) } - rename_ty_fam_eqn (XFamEqn _) = panic "haddock:renameTyFamInstEqn" - -renameLTyFamDefltEqn :: LTyFamDefltEqn GhcRn -> RnM (LTyFamDefltEqn DocNameI) -renameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs - , feqn_fixity = fixity, feqn_rhs = rhs })) - = do { tc' <- renameL tc - ; tvs' <- renameLHsQTyVars 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' })) } -renameLTyFamDefltEqn (L _ (XFamEqn _)) = panic "haddock:renameLTyFamDefltEqn" + rename_ty_fam_eqn (XFamEqn nec) = noExtCon nec + +renameTyFamDefltD :: TyFamDefltDecl GhcRn -> RnM (TyFamDefltDecl DocNameI) +renameTyFamDefltD = renameTyFamInstD renameDataFamInstD :: DataFamInstDecl GhcRn -> RnM (DataFamInstDecl DocNameI) renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn }) @@ -642,8 +632,8 @@ renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn }) ; return (DataFamInstDecl { dfid_eqn = eqn' }) } where rename_data_fam_eqn - :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn) - -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (HsDataDefn DocNameI)) + :: FamEqn GhcRn (HsDataDefn GhcRn) + -> RnM (FamEqn DocNameI (HsDataDefn DocNameI)) rename_data_fam_eqn (FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs , feqn_pats = pats, feqn_fixity = fixity , feqn_rhs = defn }) @@ -651,13 +641,13 @@ renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn }) ; bndrs' <- traverse (mapM renameLTyVarBndr) bndrs ; pats' <- mapM renameLTypeArg pats ; defn' <- renameDataDefn defn - ; return (FamEqn { feqn_ext = noExt + ; return (FamEqn { feqn_ext = noExtField , feqn_tycon = tc' , feqn_bndrs = bndrs' , feqn_pats = pats' , feqn_fixity = fixity , feqn_rhs = defn' }) } - rename_data_fam_eqn (XFamEqn _) = panic "haddock:renameDataFamInstD" + rename_data_fam_eqn (XFamEqn nec) = noExtCon nec renameImplicit :: (in_thing -> RnM out_thing) -> HsImplicitBndrs GhcRn in_thing @@ -665,8 +655,8 @@ renameImplicit :: (in_thing -> RnM out_thing) renameImplicit rn_thing (HsIB { hsib_body = thing }) = do { thing' <- rn_thing thing ; return (HsIB { hsib_body = thing' - , hsib_ext = noExt }) } -renameImplicit _ (XHsImplicitBndrs _) = panic "haddock:renameImplicit" + , hsib_ext = noExtField }) } +renameImplicit _ (XHsImplicitBndrs nec) = noExtCon nec renameWc :: (in_thing -> RnM out_thing) -> HsWildCardBndrs GhcRn in_thing @@ -674,8 +664,8 @@ renameWc :: (in_thing -> RnM out_thing) renameWc rn_thing (HsWC { hswc_body = thing }) = do { thing' <- rn_thing thing ; return (HsWC { hswc_body = thing' - , hswc_ext = noExt }) } -renameWc _ (XHsWildCardBndrs _) = panic "haddock:renameWc" + , hswc_ext = noExtField }) } +renameWc _ (XHsWildCardBndrs nec) = noExtCon nec renameDocInstance :: DocInstance GhcRn -> RnM (DocInstance DocNameI) renameDocInstance (inst, idoc, L l n, m) = do diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 6fd528af..03cc1b7e 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -76,7 +76,7 @@ specializeSig :: LHsQTyVars GhcRn -> [HsType GhcRn] -> Sig GhcRn -> Sig GhcRn specializeSig bndrs typs (TypeSig _ lnames typ) = - TypeSig noExt lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}}) + TypeSig noExtField lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}}) where true_type :: HsType GhcRn true_type = unLoc (hsSigWcType typ) @@ -112,7 +112,7 @@ sugar = sugarOperators . sugarTuples . sugarLists sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p) sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp) - | getName name == listTyConName = HsListTy NoExt ltyp + | getName name == listTyConName = HsListTy noExtField ltyp sugarLists typ = typ @@ -123,7 +123,7 @@ sugarTuples typ = aux apps (HsAppTy _ (L _ ftyp) atyp) = aux (atyp:apps) ftyp aux apps (HsParTy _ (L _ typ')) = aux apps typ' aux apps (HsTyVar _ _ (L _ name)) - | isBuiltInSyntax name' && suitable = HsTupleTy NoExt HsBoxedTuple apps + | isBuiltInSyntax name' && suitable = HsTupleTy noExtField HsBoxedTuple apps where name' = getName name strName = getOccString name @@ -136,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 - | funTyConName == name' = HsFunTy NoExt la lb + | funTyConName == name' = HsFunTy noExtField la lb where name' = getName name sugarOperators typ = typ @@ -206,7 +206,7 @@ freeVariables = everythingWithState Set.empty Set.union query where query term ctx = case cast term :: Maybe (HsType GhcRn) of - Just (HsForAllTy _ bndrs _) -> + Just (HsForAllTy _ _ bndrs _) -> (Set.empty, Set.union ctx (bndrsNames bndrs)) Just (HsTyVar _ _ (L _ name)) | getName name `Set.member` ctx -> (Set.empty, ctx) @@ -244,8 +244,8 @@ data RenameEnv name = RenameEnv renameType :: HsType GhcRn -> Rename (IdP GhcRn) (HsType GhcRn) -renameType (HsForAllTy x bndrs lt) = - HsForAllTy x +renameType (HsForAllTy x fvf bndrs lt) = + HsForAllTy x fvf <$> mapM (located renameBinder) bndrs <*> renameLType lt renameType (HsQualTy x lctxt lt) = diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 7645b1bb..b5be311a 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -82,7 +82,7 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if (__GLASGOW_HASKELL__ >= 807) && (__GLASGOW_HASKELL__ < 809) +#if (__GLASGOW_HASKELL__ >= 809) && (__GLASGOW_HASKELL__ < 811) binaryInterfaceVersion = 35 binaryInterfaceVersionCompatibility :: [Word16] diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index a72247e6..28e3caed 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -374,8 +374,8 @@ data InstType name | TypeInst (Maybe (HsType name)) -- ^ Body (right-hand side) | DataInst (TyClDecl name) -- ^ Data constructors -instance (a ~ GhcPass p,OutputableBndrId a) - => Outputable (InstType a) where +instance (OutputableBndrId p) + => Outputable (InstType (GhcPass p)) where ppr (ClassInst { .. }) = text "ClassInst" <+> ppr clsiCtx <+> ppr clsiTyVars @@ -408,12 +408,12 @@ mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl } where mkType (KindedTyVar _ (L loc name) lkind) = - HsKindSig NoExt tvar lkind + HsKindSig noExtField tvar lkind where - tvar = L loc (HsTyVar NoExt NotPromoted (L loc name)) - mkType (UserTyVar _ name) = HsTyVar NoExt NotPromoted name - mkType (XTyVarBndr _ ) = panic "haddock:mkPseudoFamilyDecl" -mkPseudoFamilyDecl (XFamilyDecl {}) = panic "haddock:mkPseudoFamilyDecl" + tvar = L loc (HsTyVar noExtField NotPromoted (L loc name)) + mkType (UserTyVar _ name) = HsTyVar noExtField NotPromoted name + mkType (XTyVarBndr nec) = noExtCon nec +mkPseudoFamilyDecl (XFamilyDecl nec) = noExtCon nec -- | An instance head that may have documentation and a source location. @@ -697,93 +697,86 @@ instance MonadIO ErrMsgGhc where -- * Pass sensitive types ----------------------------------------------------------------------------- -type instance XForAllTy DocNameI = NoExt -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 -type instance XSumTy DocNameI = NoExt -type instance XOpTy DocNameI = NoExt -type instance XParTy DocNameI = NoExt -type instance XIParamTy DocNameI = NoExt -type instance XKindSig DocNameI = NoExt -type instance XSpliceTy DocNameI = NoExt -type instance XDocTy DocNameI = NoExt -type instance XBangTy DocNameI = NoExt -type instance XRecTy DocNameI = NoExt -type instance XExplicitListTy DocNameI = NoExt -type instance XExplicitTupleTy DocNameI = NoExt -type instance XTyLit DocNameI = NoExt -type instance XWildCardTy DocNameI = NoExt +type instance XRec DocNameI f = Located (f DocNameI) + +type instance XForAllTy DocNameI = NoExtField +type instance XQualTy DocNameI = NoExtField +type instance XTyVar DocNameI = NoExtField +type instance XStarTy DocNameI = NoExtField +type instance XAppTy DocNameI = NoExtField +type instance XAppKindTy DocNameI = NoExtField +type instance XFunTy DocNameI = NoExtField +type instance XListTy DocNameI = NoExtField +type instance XTupleTy DocNameI = NoExtField +type instance XSumTy DocNameI = NoExtField +type instance XOpTy DocNameI = NoExtField +type instance XParTy DocNameI = NoExtField +type instance XIParamTy DocNameI = NoExtField +type instance XKindSig DocNameI = NoExtField +type instance XSpliceTy DocNameI = NoExtField +type instance XDocTy DocNameI = NoExtField +type instance XBangTy DocNameI = NoExtField +type instance XRecTy DocNameI = NoExtField +type instance XExplicitListTy DocNameI = NoExtField +type instance XExplicitTupleTy DocNameI = NoExtField +type instance XTyLit DocNameI = NoExtField +type instance XWildCardTy DocNameI = NoExtField type instance XXType DocNameI = NewHsTypeX -type instance XUserTyVar DocNameI = NoExt -type instance XKindedTyVar DocNameI = NoExt -type instance XXTyVarBndr DocNameI = NoExt +type instance XUserTyVar DocNameI = NoExtField +type instance XKindedTyVar DocNameI = NoExtField +type instance XXTyVarBndr DocNameI = NoExtCon type instance XCFieldOcc DocNameI = DocName -type instance XXFieldOcc DocNameI = NoExt - -type instance XFixitySig DocNameI = NoExt -type instance XFixSig DocNameI = NoExt -type instance XPatSynSig DocNameI = NoExt -type instance XClassOpSig DocNameI = NoExt -type instance XTypeSig DocNameI = NoExt -type instance XMinimalSig DocNameI = NoExt - -type instance XForeignExport DocNameI = NoExt -type instance XForeignImport DocNameI = NoExt -type instance XConDeclGADT DocNameI = NoExt -type instance XConDeclH98 DocNameI = NoExt - -type instance XDerivD DocNameI = NoExt -type instance XInstD DocNameI = NoExt -type instance XForD DocNameI = NoExt -type instance XSigD DocNameI = NoExt -type instance XTyClD DocNameI = NoExt - -type instance XNoSig DocNameI = NoExt -type instance XCKindSig DocNameI = NoExt -type instance XTyVarSig DocNameI = NoExt - -type instance XCFamEqn DocNameI _ _ = NoExt - -type instance XCClsInstDecl DocNameI = NoExt -type instance XCDerivDecl DocNameI = NoExt +type instance XXFieldOcc DocNameI = NoExtField + +type instance XFixitySig DocNameI = NoExtField +type instance XFixSig DocNameI = NoExtField +type instance XPatSynSig DocNameI = NoExtField +type instance XClassOpSig DocNameI = NoExtField +type instance XTypeSig DocNameI = NoExtField +type instance XMinimalSig DocNameI = NoExtField + +type instance XForeignExport DocNameI = NoExtField +type instance XForeignImport DocNameI = NoExtField +type instance XConDeclGADT DocNameI = NoExtField +type instance XConDeclH98 DocNameI = NoExtField +type instance XXConDecl DocNameI = NoExtCon + +type instance XDerivD DocNameI = NoExtField +type instance XInstD DocNameI = NoExtField +type instance XForD DocNameI = NoExtField +type instance XSigD DocNameI = NoExtField +type instance XTyClD DocNameI = NoExtField + +type instance XNoSig DocNameI = NoExtField +type instance XCKindSig DocNameI = NoExtField +type instance XTyVarSig DocNameI = NoExtField +type instance XXFamilyResultSig DocNameI = NoExtCon + +type instance XCFamEqn DocNameI _ = NoExtField +type instance XXFamEqn DocNameI _ = NoExtCon + +type instance XCClsInstDecl DocNameI = NoExtField +type instance XCDerivDecl DocNameI = NoExtField type instance XViaStrategy DocNameI = LHsSigType DocNameI -type instance XDataFamInstD DocNameI = NoExt -type instance XTyFamInstD DocNameI = NoExt -type instance XClsInstD DocNameI = NoExt -type instance XCHsDataDefn DocNameI = NoExt -type instance XCFamilyDecl DocNameI = NoExt -type instance XClassDecl DocNameI = NoExt -type instance XDataDecl DocNameI = NoExt -type instance XSynDecl DocNameI = NoExt -type instance XFamDecl DocNameI = NoExt - -type instance XHsIB DocNameI _ = NoExt -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 +type instance XDataFamInstD DocNameI = NoExtField +type instance XTyFamInstD DocNameI = NoExtField +type instance XClsInstD DocNameI = NoExtField +type instance XCHsDataDefn DocNameI = NoExtField +type instance XCFamilyDecl DocNameI = NoExtField +type instance XClassDecl DocNameI = NoExtField +type instance XDataDecl DocNameI = NoExtField +type instance XSynDecl DocNameI = NoExtField +type instance XFamDecl DocNameI = NoExtField +type instance XXFamilyDecl DocNameI = NoExtCon + +type instance XHsIB DocNameI _ = NoExtField +type instance XHsWC DocNameI _ = NoExtField +type instance XXHsImplicitBndrs DocNameI _ = NoExtCon + +type instance XHsQTvs DocNameI = NoExtField +type instance XConDeclField DocNameI = NoExtField +type instance XXConDeclField DocNameI = NoExtCon + +type instance XXPat DocNameI = NoExtCon diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 7673f02d..79673365 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -150,17 +150,17 @@ mkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty) addClassContext :: Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn -- Add the class context to a class-op signature addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype)) - = L pos (TypeSig noExt lname (mkEmptySigWcType (go (hsSigType ltype)))) + = L pos (TypeSig noExtField lname (mkEmptySigWcType (go (hsSigType ltype)))) -- The mkEmptySigWcType is suspicious where - go (L loc (HsForAllTy { hst_bndrs = tvs, hst_body = ty })) - = L loc (HsForAllTy { hst_xforall = noExt + go (L loc (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs, hst_body = ty })) + = L loc (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField , hst_bndrs = tvs, hst_body = go ty }) go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty })) - = L loc (HsQualTy { hst_xqual = noExt + = L loc (HsQualTy { hst_xqual = noExtField , hst_ctxt = add_ctxt ctxt, hst_body = ty }) go (L loc ty) - = L loc (HsQualTy { hst_xqual = noExt + = L loc (HsQualTy { hst_xqual = noExtField , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty }) extra_pred = nlHsTyConApp cls (lHsQTyVarsToTypes tvs0) @@ -170,7 +170,7 @@ addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsType GhcRn] lHsQTyVarsToTypes tvs - = [ noLoc (HsTyVar NoExt NotPromoted (noLoc (hsLTyVarName tv))) + = [ noLoc (HsTyVar noExtField NotPromoted (noLoc (hsLTyVarName tv))) | tv <- hsQTvExplicit tvs ] -------------------------------------------------------------------------------- @@ -216,7 +216,7 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] field_avail :: LConDeclField GhcRn -> Bool field_avail (L _ (ConDeclField _ fs _ _)) = all (\f -> extFieldOcc (unLoc f) `elem` names) fs - field_avail (L _ (XConDeclField _)) = panic "haddock:field_avail" + field_avail (L _ (XConDeclField nec)) = noExtCon nec field_types flds = [ t | ConDeclField _ _ t _ <- flds ] keep _ = Nothing @@ -232,9 +232,7 @@ emptyHsQTvs :: LHsQTyVars GhcRn -- This function is here, rather than in HsTypes, because it *renamed*, but -- does not necessarily have all the rigt kind variables. It is used -- in Haddock just for printing, so it doesn't matter -emptyHsQTvs = HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = error "haddock:emptyHsQTvs" - , hsq_dependent = error "haddock:emptyHsQTvs" } +emptyHsQTvs = HsQTvs { hsq_ext = error "haddock:emptyHsQTvs" , hsq_explicit = [] } diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index 1273a45a..6e065dfb 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -19,7 +19,7 @@ import Haddock.Backends.Hyperlinker.Types withDynFlags :: (DynFlags -> IO ()) -> IO () withDynFlags cont = do libDir <- fmap snd (getGhcDirs []) - runGhc (Just libDir) $ do + runGhc libDir $ do dflags <- getSessionDynFlags liftIO $ cont dflags diff --git a/haddock-library/LICENSE b/haddock-library/LICENSE index 460decfc..d5f0b37c 100644 --- a/haddock-library/LICENSE +++ b/haddock-library/LICENSE @@ -1,23 +1,26 @@ -Copyright 2002-2010, Simon Marlow. All rights reserved. +Copyright (c) 2002-2010, Simon Marlow +All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +modification, are permitted provided that the following conditions are +met: -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY -EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR -BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN -IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 7f91fd19..e58fe2ef 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -26,7 +26,7 @@ common lib-defaults default-language: Haskell2010 build-depends: - , base >= 4.5 && < 4.14 + , base >= 4.5 && < 4.15 , 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 diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal index ed174e4f..0dd3eb47 100644 --- a/haddock-test/haddock-test.cabal +++ b/haddock-test/haddock-test.cabal @@ -1,7 +1,7 @@ name: haddock-test version: 0.0.1 synopsis: Test utilities for Haddock -license: BSD3 +license: BSD2 author: Simon Marlow, David Waern maintainer: Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> homepage: http://www.haskell.org/haddock/ @@ -16,7 +16,7 @@ library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - build-depends: base >= 4.3 && < 4.14, bytestring, directory, process, filepath, Cabal, xml, xhtml + build-depends: base >= 4.3 && < 4.15, bytestring, directory, process, filepath, Cabal exposed-modules: Test.Haddock diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index 25c64cfe..1019e815 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -42,6 +42,7 @@ checkFiles :: Config c -> Bool -> IO () checkFiles cfg@(Config { .. }) somethingCrashed = do putStrLn "Testing output files..." + createDirectoryIfMissing True (cfgOutDir cfg) files <- ignore <$> getDirectoryTree (cfgOutDir cfg) failed <- liftM catMaybes . forM files $ \file -> do putStr $ "Checking \"" ++ file ++ "\"... " diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 51394eff..94ca7759 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -170,6 +170,7 @@ loadConfig :: CheckConfig c -> DirConfig -> [Flag] -> [String] -> IO (Config c) loadConfig ccfg dcfg flags files = do cfgEnv <- (:) ("haddock_datadir", dcfgResDir dcfg) <$> getEnvironment + -- Find Haddock executable systemHaddockPath <- List.lookup "HADDOCK_PATH" <$> getEnvironment haddockOnPath <- findExecutable "haddock" @@ -181,14 +182,25 @@ loadConfig ccfg dcfg flags files = do cfgHaddockPath <- case haddock_path of Just path -> pure path Nothing -> do - hPutStrLn stderr "Haddock executable not found" + hPutStrLn stderr "Haddock executable not found; consider using the `--haddock-path` flag." exitFailure - ghcPath <- case flagsGhcPath flags of - Just fp -> return fp - Nothing -> init <$> rawSystemStdout normal - cfgHaddockPath - ["--print-ghc-path"] + -- Perhaps Haddock knows where you can find GHC? + queriedGhcPath <- do + p <- init <$> rawSystemStdout normal cfgHaddockPath ["--print-ghc-path"] + exists <- doesFileExist p + pure $ if exists then Just p else Nothing + + + let ghc_path = msum [ flagsGhcPath flags + , queriedGhcPath + ] + + ghcPath <- case ghc_path of + Just path -> pure path + Nothing -> do + hPutStrLn stderr "GHC executable not found; consider using the `--ghc-path` flag." + exitFailure printVersions cfgEnv cfgHaddockPath diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs index 6c19dbca..bca2c4cc 100644 --- a/haddock-test/src/Test/Haddock/Xhtml.hs +++ b/haddock-test/src/Test/Haddock/Xhtml.hs @@ -1,107 +1,126 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - module Test.Haddock.Xhtml - ( Xml(..) + ( Xml , parseXml, dumpXml , stripLinks, stripLinksWhen, stripAnchorsWhen, stripIdsWhen, stripFooter ) where -import Data.Data ( Data(..), Typeable, eqT, (:~:)(..) ) -import Text.XML.Light -import Text.XHtml (Html, HtmlAttr, (!)) -import qualified Text.XHtml as Xhtml - - -newtype Xml = Xml - { xmlElement :: Element - } deriving Eq +{- +This module used to actually parse the HTML (using the `xml` parsing library) +which made it was possible to do more proper normalization of things like ids or +names. +However, in the interests of being able to run this from within the GHC +testsuite (where non-bootlib dependencies are a liability), this was swapped +out for some simple string manipulation. Since the test cases aren't very +and since the `xhtml` library already handles the pretty-printing aspect, +this would appear to be a reasonable compromise for now. +-} -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 +import Data.List ( stripPrefix, isPrefixOf ) +import Data.Char ( isSpace ) +-- | Simple wrapper around the pretty-printed HTML source +newtype Xml = Xml { unXml :: String } +-- | Part of parsing involves dropping the @DOCTYPE@ line parseXml :: String -> Maybe Xml -parseXml = fmap Xml . parseXMLDoc - +parseXml = Just . Xml . dropDocTypeLine + where + dropDocTypeLine bs + | "<!DOCTYPE" `isPrefixOf` bs + = drop 1 (dropWhile (/= '\n') bs) + | otherwise + = bs dumpXml :: Xml -> String -dumpXml = Xhtml.renderHtmlFragment. xmlElementToXhtml . xmlElement - - +dumpXml = unXml + +type Attr = String +type Value = String + +-- | Almost all sanitization operations take the form of: +-- +-- * match an attribute key +-- * check something about the value +-- * if the check succeeded, replace the value with a dummy value +-- +stripAttrValueWhen + :: Attr -- ^ attribute key + -> Value -- ^ dummy attribute value + -> (Value -> Bool) -- ^ determine whether we should modify the attribute + -> Xml -- ^ input XML + -> Xml -- ^ output XML +stripAttrValueWhen key fallback p (Xml body) = Xml (filterAttrs body) + where + keyEq = key ++ "=\"" + + filterAttrs "" = "" + filterAttrs b@(c:cs) + | Just valRest <- stripPrefix keyEq b + , Just (val,rest) <- spanToEndOfString valRest + = if p val + then keyEq ++ fallback ++ "\"" ++ filterAttrs rest + else keyEq ++ val ++ "\"" ++ filterAttrs rest + + | otherwise + = c : filterAttrs cs + +-- | Spans to the next (unescaped) @\"@ character. +-- +-- >>> spanToEndOfString "no closing quotation" +-- Nothing +-- >>> spanToEndOfString "foo\" bar \"baz\"" +-- Just ("foo", " bar \"baz\"") +-- >>> spanToEndOfString "foo\\\" bar \"baz\"" +-- Just ("foo\\\" bar ", "baz\"") +-- +spanToEndOfString :: String -> Maybe (String, String) +spanToEndOfString ('"':rest) = Just ("", rest) +spanToEndOfString ('\\':c:rest) + | Just (str, rest') <- spanToEndOfString rest + = Just ('\\':c:str, rest') +spanToEndOfString (c:rest) + | Just (str, rest') <- spanToEndOfString rest + = Just (c:str, rest') +spanToEndOfString _ = Nothing + + +-- | Replace hyperlink targets with @\"#\"@ if they match a predicate +stripLinksWhen :: (Value -> Bool) -> Xml -> Xml +stripLinksWhen = stripAttrValueWhen "href" "#" + +-- | Replace all hyperlink targets with @\"#\"@ stripLinks :: Xml -> Xml stripLinks = stripLinksWhen (const True) +-- | Replace id's with @\"\"@ if they match a predicate +stripIdsWhen :: (Value -> Bool) -> Xml -> Xml +stripIdsWhen = stripAttrValueWhen "id" "" -stripLinksWhen :: (String -> Bool) -> Xml -> Xml -stripLinksWhen p = - processAnchors unlink - where - unlink attr@(Attr { attrKey = key, attrVal = val }) - | qName key == "href" && p val = attr { attrVal = "#" } - | otherwise = attr - - -stripAnchorsWhen :: (String -> Bool) -> Xml -> Xml -stripAnchorsWhen p = - processAnchors unname - where - unname attr@(Attr { attrKey = key, attrVal = val }) - | 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 . gmapEverywhere f . xmlElement - +-- | Replace names's with @\"\"@ if they match a predicate +stripAnchorsWhen :: (Value -> Bool) -> Xml -> Xml +stripAnchorsWhen = stripAttrValueWhen "name" "" +-- | Remove the @div@ which has @id=\"footer\"@ stripFooter :: Xml -> Xml -stripFooter = - Xml . gmapEverywhere defoot . xmlElement - where - defoot el - | isFooter el = el { elContent = [] } - | otherwise = el - isFooter el = any isFooterAttr $ elAttribs el - isFooterAttr (Attr { .. }) = and - [ qName attrKey == "id" - , attrVal == "footer" - ] - - -xmlElementToXhtml :: Element -> Html -xmlElementToXhtml (Element { .. }) = - Xhtml.tag (qName elName) contents ! attrs +stripFooter (Xml body) = Xml (findDiv body) where - contents = mconcat $ map xmlContentToXhtml elContent - attrs = map xmlAttrToXhtml elAttribs + findDiv "" = "" + findDiv b@(c:cs) + | Just divRest <- stripPrefix "<div id=\"footer\"" b + , Just rest <- dropToDiv divRest + = rest + | otherwise + = c : findDiv cs -xmlContentToXhtml :: Content -> Html -xmlContentToXhtml (Elem el) = xmlElementToXhtml el -xmlContentToXhtml (Text text) = Xhtml.toHtml $ cdData text -xmlContentToXhtml (CRef _) = Xhtml.noHtml + dropToDiv "" = Nothing + dropToDiv b@(_:cs) + | Just valRest <- stripPrefix "</div" b + , valRest' <- dropWhile isSpace valRest + , Just valRest'' <- stripPrefix ">" valRest' + = Just valRest'' + | otherwise + = dropToDiv cs -xmlAttrToXhtml :: Attr -> HtmlAttr -xmlAttrToXhtml (Attr { .. }) = Xhtml.strAttr (qName attrKey) attrVal diff --git a/haddock.cabal b/haddock.cabal index fa87e07e..92fe249e 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -23,7 +23,7 @@ description: without any documentation annotations, Haddock can generate useful documentation from your source code. . - <<https://cdn.rawgit.com/haskell/haddock/ghc-8.8/doc/cheatsheet/haddocks.svg>> + <<https://cdn.rawgit.com/haskell/haddock/ghc-8.10/doc/cheatsheet/haddocks.svg>> license: BSD-3-Clause license-file: LICENSE author: Simon Marlow, David Waern @@ -33,7 +33,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -tested-with: GHC==8.8.* +tested-with: GHC==8.10.* extra-source-files: CHANGES.md @@ -66,7 +66,7 @@ executable haddock -- haddock typically only supports a single GHC major version build-depends: - base ^>= 4.13.0.0 + base ^>= 4.14.0.0 if flag(in-ghc-tree) hs-source-dirs: haddock-api/src, haddock-library/src @@ -79,7 +79,8 @@ executable haddock array, xhtml >= 3000.2 && < 3000.3, ghc-boot, - ghc == 8.8.*, + ghc-boot-th, + ghc == 8.10.*, bytestring, parsec, text, diff --git a/html-test/ref/A.html b/html-test/ref/A.html index 53a26042..c27f1888 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -106,7 +106,7 @@ >A</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -181,8 +181,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bold.html b/html-test/ref/Bold.html index 44ee7d6e..2bbe37a4 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/Bold.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -93,8 +93,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug1.html b/html-test/ref/Bug1.html index e264d03c..a14ac387 100644 --- a/html-test/ref/Bug1.html +++ b/html-test/ref/Bug1.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -89,15 +89,13 @@ >T</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html index be215281..b3bc60cc 100644 --- a/html-test/ref/Bug1004.html +++ b/html-test/ref/Bug1004.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -92,7 +92,7 @@ >Pair</a > (f a) (g a)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -1901,7 +1901,7 @@ >)</span ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1991,7 +1991,7 @@ > f g a)</span ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -2071,8 +2071,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html > diff --git a/html-test/ref/Bug1033.html b/html-test/ref/Bug1033.html index d01cef79..736fb2ad 100644 --- a/html-test/ref/Bug1033.html +++ b/html-test/ref/Bug1033.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >Foo</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -167,7 +167,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -215,8 +215,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug1035.html b/html-test/ref/Bug1035.html index f9b04581..5e4d6f82 100644 --- a/html-test/ref/Bug1035.html +++ b/html-test/ref/Bug1035.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -92,7 +92,7 @@ >Bar</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -116,7 +116,7 @@ >Foo</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -139,8 +139,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug1063.html b/html-test/ref/Bug1063.html index a7555971..f311373a 100644 --- a/html-test/ref/Bug1063.html +++ b/html-test/ref/Bug1063.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -73,7 +73,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -93,8 +93,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug1103.html b/html-test/ref/Bug1103.html index cc16017b..4d3772d1 100644 --- a/html-test/ref/Bug1103.html +++ b/html-test/ref/Bug1103.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -81,7 +81,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -121,7 +121,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -181,7 +181,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -219,7 +219,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -261,7 +261,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -303,7 +303,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -361,7 +361,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -397,7 +397,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -437,7 +437,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -477,7 +477,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -519,7 +519,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -549,8 +549,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug195.html b/html-test/ref/Bug195.html index c6104210..af595d5d 100644 --- a/html-test/ref/Bug195.html +++ b/html-test/ref/Bug195.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >A</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -102,7 +102,7 @@ >B</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -140,7 +140,7 @@ >C</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -177,8 +177,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug2.html b/html-test/ref/Bug2.html index a9b63f7a..c0c192c9 100644 --- a/html-test/ref/Bug2.html +++ b/html-test/ref/Bug2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -57,8 +57,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug201.html b/html-test/ref/Bug201.html index 961fcbb2..13ad4556 100644 --- a/html-test/ref/Bug201.html +++ b/html-test/ref/Bug201.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -98,8 +98,6 @@ because there's a space before closing @ ></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 b4581e91..a482a21a 100644 --- a/html-test/ref/Bug253.html +++ b/html-test/ref/Bug253.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="index.html" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -93,8 +93,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html index 2a316f2d..5c6fb34e 100644 --- a/html-test/ref/Bug26.html +++ b/html-test/ref/Bug26.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -205,8 +205,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug280.html b/html-test/ref/Bug280.html index 42dd9596..6a4aa63e 100644 --- a/html-test/ref/Bug280.html +++ b/html-test/ref/Bug280.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -44,7 +44,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -73,8 +73,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug294.html b/html-test/ref/Bug294.html index d0f5f8f3..6ceb3422 100644 --- a/html-test/ref/Bug294.html +++ b/html-test/ref/Bug294.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -77,7 +77,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -119,7 +119,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -217,7 +217,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -279,7 +279,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -339,7 +339,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -367,8 +367,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug298.html b/html-test/ref/Bug298.html index 698fb2b7..fc57d087 100644 --- a/html-test/ref/Bug298.html +++ b/html-test/ref/Bug298.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -135,8 +135,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug3.html b/html-test/ref/Bug3.html index 42e55e37..0c9d8526 100644 --- a/html-test/ref/Bug3.html +++ b/html-test/ref/Bug3.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -76,8 +76,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug308.html b/html-test/ref/Bug308.html index 52f897b1..acd019d3 100644 --- a/html-test/ref/Bug308.html +++ b/html-test/ref/Bug308.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -107,8 +107,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug308CrossModule.html b/html-test/ref/Bug308CrossModule.html index cd141586..f754aa87 100644 --- a/html-test/ref/Bug308CrossModule.html +++ b/html-test/ref/Bug308CrossModule.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -85,8 +85,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug310.html b/html-test/ref/Bug310.html index 1e615fbc..59faf609 100644 --- a/html-test/ref/Bug310.html +++ b/html-test/ref/Bug310.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -99,8 +99,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug313.html b/html-test/ref/Bug313.html index f289644c..83ee7a34 100644 --- a/html-test/ref/Bug313.html +++ b/html-test/ref/Bug313.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -128,8 +128,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug335.html b/html-test/ref/Bug335.html index 9e16b3ef..00e31ca0 100644 --- a/html-test/ref/Bug335.html +++ b/html-test/ref/Bug335.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -125,8 +125,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html > diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html index 7cfd1b0b..12887a83 100644 --- a/html-test/ref/Bug387.html +++ b/html-test/ref/Bug387.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -113,8 +113,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug4.html b/html-test/ref/Bug4.html index 986a5ee6..8a19bc6b 100644 --- a/html-test/ref/Bug4.html +++ b/html-test/ref/Bug4.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -75,8 +75,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug458.html b/html-test/ref/Bug458.html index aa9ce42e..d5b5a768 100644 --- a/html-test/ref/Bug458.html +++ b/html-test/ref/Bug458.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -77,8 +77,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug466.html b/html-test/ref/Bug466.html index a0c1cd87..4f6f6f16 100644 --- a/html-test/ref/Bug466.html +++ b/html-test/ref/Bug466.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -87,7 +87,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -140,7 +140,7 @@ >X</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -165,7 +165,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -211,7 +211,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -241,8 +241,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug546.html b/html-test/ref/Bug546.html index 0e1232e6..bb400a50 100644 --- a/html-test/ref/Bug546.html +++ b/html-test/ref/Bug546.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -270,8 +270,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug548.html b/html-test/ref/Bug548.html index b2a1da0b..dc2128ee 100644 --- a/html-test/ref/Bug548.html +++ b/html-test/ref/Bug548.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -70,7 +70,7 @@ >WrapArrow</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -84,7 +84,7 @@ >unwrapArrow</a > :: a b c</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -501,7 +501,7 @@ >)</span ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -569,7 +569,7 @@ > a b c)</span ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -625,8 +625,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug574.html b/html-test/ref/Bug574.html index 918f0492..3c7cf13f 100644 --- a/html-test/ref/Bug574.html +++ b/html-test/ref/Bug574.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -83,8 +83,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug6.html b/html-test/ref/Bug6.html index 22c05c73..5bd4c030 100644 --- a/html-test/ref/Bug6.html +++ b/html-test/ref/Bug6.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -158,7 +158,7 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -189,7 +189,7 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -229,7 +229,7 @@ >C</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -245,7 +245,7 @@ >Int</a ></dfn ><div class="doc empty" - ></div + > </div ></li ><li ><dfn class="src" @@ -255,7 +255,7 @@ >Int</a ></dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -292,7 +292,7 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -322,15 +322,13 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug613.html b/html-test/ref/Bug613.html index 883ae9a5..4df6037d 100644 --- a/html-test/ref/Bug613.html +++ b/html-test/ref/Bug613.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -117,7 +117,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -159,7 +159,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -214,7 +214,7 @@ >ThreeVars</a > a b</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -239,7 +239,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -273,8 +273,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug647.html b/html-test/ref/Bug647.html index 183e9a5f..0648cf51 100644 --- a/html-test/ref/Bug647.html +++ b/html-test/ref/Bug647.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -99,8 +99,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug679.html b/html-test/ref/Bug679.html index 52fc80e4..2434a857 100644 --- a/html-test/ref/Bug679.html +++ b/html-test/ref/Bug679.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -64,7 +64,7 @@ >Bar</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -89,7 +89,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -163,7 +163,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -197,8 +197,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug7.html b/html-test/ref/Bug7.html index 1ed51b3e..5338bda2 100644 --- a/html-test/ref/Bug7.html +++ b/html-test/ref/Bug7.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -99,7 +99,7 @@ >Foo</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -204,8 +204,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html index 87393695..73890845 100644 --- a/html-test/ref/Bug8.html +++ b/html-test/ref/Bug8.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -68,7 +68,7 @@ >Typ</a >])</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -80,7 +80,7 @@ >Typ</a >])</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -143,8 +143,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug85.html b/html-test/ref/Bug85.html index 18f0b6b0..bbef4d32 100644 --- a/html-test/ref/Bug85.html +++ b/html-test/ref/Bug85.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -68,7 +68,7 @@ >Foo</a > f (f x)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -96,7 +96,7 @@ >Baz</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -124,15 +124,13 @@ >Qux</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug865.html b/html-test/ref/Bug865.html index 16b1714e..96f64daf 100644 --- a/html-test/ref/Bug865.html +++ b/html-test/ref/Bug865.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -81,8 +81,6 @@ ></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 index 387b7192..d657e08e 100644 --- a/html-test/ref/Bug923.html +++ b/html-test/ref/Bug923.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -100,7 +100,7 @@ >(,)</a > a)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -193,8 +193,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bug953.html b/html-test/ref/Bug953.html index 2a430db1..aea7ec5c 100644 --- a/html-test/ref/Bug953.html +++ b/html-test/ref/Bug953.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -100,7 +100,7 @@ >Foo'</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -136,15 +136,13 @@ >Bar'</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html > diff --git a/html-test/ref/Bug973.html b/html-test/ref/Bug973.html index 97d35758..20e27886 100644 --- a/html-test/ref/Bug973.html +++ b/html-test/ref/Bug973.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -94,7 +94,7 @@ >Read</a > b)</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -136,7 +136,7 @@ >Read</a > b)</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -167,8 +167,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/BugDeprecated.html b/html-test/ref/BugDeprecated.html index 2d814f4e..92a963f3 100644 --- a/html-test/ref/BugDeprecated.html +++ b/html-test/ref/BugDeprecated.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -189,8 +189,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/BugExportHeadings.html b/html-test/ref/BugExportHeadings.html index 2e0eed45..ddcb7aa3 100644 --- a/html-test/ref/BugExportHeadings.html +++ b/html-test/ref/BugExportHeadings.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -223,8 +223,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Bugs.html b/html-test/ref/Bugs.html index edf5f2a2..c6c42446 100644 --- a/html-test/ref/Bugs.html +++ b/html-test/ref/Bugs.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -66,15 +66,13 @@ >Int</a >)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/BundledPatterns.html b/html-test/ref/BundledPatterns.html index 58140f5e..fb6518af 100644 --- a/html-test/ref/BundledPatterns.html +++ b/html-test/ref/BundledPatterns.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -165,7 +165,7 @@ >Vec</a > 0 a</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -453,8 +453,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/BundledPatterns2.html b/html-test/ref/BundledPatterns2.html index 05efa10f..b680fe66 100644 --- a/html-test/ref/BundledPatterns2.html +++ b/html-test/ref/BundledPatterns2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -272,7 +272,7 @@ >Vec</a > 0 a</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -451,8 +451,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/ConstructorArgs.html b/html-test/ref/ConstructorArgs.html index 4e5d5025..16ef6780 100644 --- a/html-test/ref/ConstructorArgs.html +++ b/html-test/ref/ConstructorArgs.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -717,8 +717,6 @@ ></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 3296ac93..0822733d 100644 --- a/html-test/ref/ConstructorPatternExport.html +++ b/html-test/ref/ConstructorPatternExport.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -113,8 +113,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DefaultAssociatedTypes.html b/html-test/ref/DefaultAssociatedTypes.html index d456815f..4b39483a 100644 --- a/html-test/ref/DefaultAssociatedTypes.html +++ b/html-test/ref/DefaultAssociatedTypes.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -113,11 +113,9 @@ ><p class="src" ><span class="keyword" >type</span - > <a id="t:Qux" class="def" + > <a href="#" title="DefaultAssociatedTypes" >Qux</a - > a = [a] <a href="#" class="selflink" - >#</a - ></p + > a = [a]</p ></div ></div ><div class="subs methods" @@ -151,8 +149,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DefaultSignatures.html b/html-test/ref/DefaultSignatures.html index 4bf261f7..60d0428f 100644 --- a/html-test/ref/DefaultSignatures.html +++ b/html-test/ref/DefaultSignatures.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -175,8 +175,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html index c43eb043..a0de4858 100644 --- a/html-test/ref/DeprecatedClass.html +++ b/html-test/ref/DeprecatedClass.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -155,8 +155,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedData.html b/html-test/ref/DeprecatedData.html index df7d45ee..001970df 100644 --- a/html-test/ref/DeprecatedData.html +++ b/html-test/ref/DeprecatedData.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -185,8 +185,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedFunction.html b/html-test/ref/DeprecatedFunction.html index 6056c12a..2b3c4a66 100644 --- a/html-test/ref/DeprecatedFunction.html +++ b/html-test/ref/DeprecatedFunction.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -103,8 +103,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedFunction2.html b/html-test/ref/DeprecatedFunction2.html index 4ce19d3d..a2cd84a2 100644 --- a/html-test/ref/DeprecatedFunction2.html +++ b/html-test/ref/DeprecatedFunction2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -77,8 +77,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedFunction3.html b/html-test/ref/DeprecatedFunction3.html index 4d9bc3ef..90bde84d 100644 --- a/html-test/ref/DeprecatedFunction3.html +++ b/html-test/ref/DeprecatedFunction3.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -77,8 +77,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedModule.html b/html-test/ref/DeprecatedModule.html index 962067eb..c4d1c241 100644 --- a/html-test/ref/DeprecatedModule.html +++ b/html-test/ref/DeprecatedModule.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -73,8 +73,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedModule2.html b/html-test/ref/DeprecatedModule2.html index 112d6913..b1d6c12a 100644 --- a/html-test/ref/DeprecatedModule2.html +++ b/html-test/ref/DeprecatedModule2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -67,8 +67,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedNewtype.html b/html-test/ref/DeprecatedNewtype.html index e33374e1..4fad244a 100644 --- a/html-test/ref/DeprecatedNewtype.html +++ b/html-test/ref/DeprecatedNewtype.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -151,8 +151,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedReExport.html b/html-test/ref/DeprecatedReExport.html index f9efdb59..d8dd554f 100644 --- a/html-test/ref/DeprecatedReExport.html +++ b/html-test/ref/DeprecatedReExport.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -124,8 +124,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedRecord.html b/html-test/ref/DeprecatedRecord.html index e5449925..7760386d 100644 --- a/html-test/ref/DeprecatedRecord.html +++ b/html-test/ref/DeprecatedRecord.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -98,7 +98,7 @@ >Foo</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -143,8 +143,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedTypeFamily.html b/html-test/ref/DeprecatedTypeFamily.html index b581c0b2..76a9a039 100644 --- a/html-test/ref/DeprecatedTypeFamily.html +++ b/html-test/ref/DeprecatedTypeFamily.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -101,8 +101,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DeprecatedTypeSynonym.html b/html-test/ref/DeprecatedTypeSynonym.html index ac488d75..32c9721b 100644 --- a/html-test/ref/DeprecatedTypeSynonym.html +++ b/html-test/ref/DeprecatedTypeSynonym.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -109,8 +109,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/DuplicateRecordFields.html b/html-test/ref/DuplicateRecordFields.html index 29630db4..fab57a04 100644 --- a/html-test/ref/DuplicateRecordFields.html +++ b/html-test/ref/DuplicateRecordFields.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >RawReplay</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -153,8 +153,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Examples.html b/html-test/ref/Examples.html index 4d79ff7a..f5a7ba8c 100644 --- a/html-test/ref/Examples.html +++ b/html-test/ref/Examples.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -168,8 +168,6 @@ bar ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Extensions.html b/html-test/ref/Extensions.html index abf77cd8..7be5fd80 100644 --- a/html-test/ref/Extensions.html +++ b/html-test/ref/Extensions.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ><tr ><th @@ -83,8 +83,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index 0b87c47b..03a97522 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >Ord</a > a</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -228,7 +228,7 @@ >()</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -285,8 +285,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/GADTRecords.html b/html-test/ref/GADTRecords.html index 9ea7c8ae..9dac0c13 100644 --- a/html-test/ref/GADTRecords.html +++ b/html-test/ref/GADTRecords.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -122,7 +122,7 @@ >H1</a > a b</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -134,7 +134,7 @@ >H1</a > a a</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -142,7 +142,7 @@ >C3</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -164,7 +164,7 @@ ></li ><li ><dfn class="src" - >} -> <a href="#" title="GADTRecords" + > } -> <a href="#" title="GADTRecords" >H1</a > <a href="#" title="Data.Int" >Int</a @@ -172,7 +172,7 @@ >Int</a ></dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -184,7 +184,7 @@ >C4</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -204,13 +204,13 @@ ></li ><li ><dfn class="src" - >} -> <a href="#" title="GADTRecords" + > } -> <a href="#" title="GADTRecords" >H1</a > <a href="#" title="Data.Int" >Int</a > a</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -221,8 +221,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/GadtConstructorArgs.html b/html-test/ref/GadtConstructorArgs.html index cace8414..c1a4dedf 100644 --- a/html-test/ref/GadtConstructorArgs.html +++ b/html-test/ref/GadtConstructorArgs.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -66,7 +66,7 @@ >Fot</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -92,7 +92,7 @@ ></li ><li ><dfn class="src" - >, <a id="v:y" class="def" + > , <a id="v:y" class="def" >y</a > :: <a href="#" title="Data.Int" >Int</a @@ -108,11 +108,11 @@ ></li ><li ><dfn class="src" - >} -> <a href="#" title="GadtConstructorArgs" + > } -> <a href="#" title="GadtConstructorArgs" >Boo</a ></dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -152,7 +152,7 @@ ></li ><li ><dfn class="src" - >, <a id="v:z" class="def" + > , <a id="v:z" class="def" >z</a > :: <a href="#" title="Data.Int" >Int</a @@ -168,7 +168,7 @@ ></li ><li ><dfn class="src" - >} -> <a href="#" title="GadtConstructorArgs" + > } -> <a href="#" title="GadtConstructorArgs" >Boo</a ></dfn ><div class="doc" @@ -189,8 +189,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html index 29f299f2..8c062e1b 100644 --- a/html-test/ref/Hash.html +++ b/html-test/ref/Hash.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -314,7 +314,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -356,7 +356,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -400,7 +400,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -432,8 +432,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/HiddenInstances.html b/html-test/ref/HiddenInstances.html index c5809845..181b47f8 100644 --- a/html-test/ref/HiddenInstances.html +++ b/html-test/ref/HiddenInstances.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -315,8 +315,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/HiddenInstancesB.html b/html-test/ref/HiddenInstancesB.html index cb42dcbf..579f5754 100644 --- a/html-test/ref/HiddenInstancesB.html +++ b/html-test/ref/HiddenInstancesB.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -175,8 +175,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Hyperlinks.html b/html-test/ref/Hyperlinks.html index e1c3fd61..947d5342 100644 --- a/html-test/ref/Hyperlinks.html +++ b/html-test/ref/Hyperlinks.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -81,8 +81,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html index a9e6fb21..c89e7434 100644 --- a/html-test/ref/Identifiers.html +++ b/html-test/ref/Identifiers.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -92,7 +92,7 @@ >Id</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -116,7 +116,7 @@ >:*</a > b</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -279,8 +279,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/IgnoreExports.html index 8b3390ae..ccaffdad 100644 --- a/html-test/ref/IgnoreExports.html +++ b/html-test/ref/IgnoreExports.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -133,8 +133,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index f302be21..1c0126a9 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >X</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -109,8 +109,6 @@ ></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 7faa9588..4ed71a4b 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >Xyzzy</a > (b -> (a, a))</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -89,7 +89,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -199,7 +199,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -249,7 +249,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -311,7 +311,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -377,7 +377,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -427,7 +427,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -489,7 +489,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -539,7 +539,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -603,7 +603,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -715,7 +715,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -817,7 +817,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -903,7 +903,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -963,7 +963,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1055,7 +1055,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1115,7 +1115,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1279,7 +1279,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1341,7 +1341,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1403,7 +1403,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1467,7 +1467,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1541,7 +1541,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1614,7 +1614,7 @@ >Qx</a > a</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -1622,7 +1622,7 @@ >Qux</a > a b</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -1630,7 +1630,7 @@ >Quux</a > a b c</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -1655,7 +1655,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1719,7 +1719,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1821,7 +1821,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1901,7 +1901,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -2015,7 +2015,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -2089,7 +2089,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -2141,8 +2141,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Math.html b/html-test/ref/Math.html index 318c0acc..627f4840 100644 --- a/html-test/ref/Math.html +++ b/html-test/ref/Math.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -103,8 +103,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Minimal.html b/html-test/ref/Minimal.html index e6e024ef..cacbb86d 100644 --- a/html-test/ref/Minimal.html +++ b/html-test/ref/Minimal.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -337,8 +337,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/ModuleWithWarning.html b/html-test/ref/ModuleWithWarning.html index 3f3d7e83..cb8b8f27 100644 --- a/html-test/ref/ModuleWithWarning.html +++ b/html-test/ref/ModuleWithWarning.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -73,8 +73,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/NamedDoc.html b/html-test/ref/NamedDoc.html index b1300947..1fd0c25b 100644 --- a/html-test/ref/NamedDoc.html +++ b/html-test/ref/NamedDoc.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -59,8 +59,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/NamespacedIdentifiers.html b/html-test/ref/NamespacedIdentifiers.html index c005727a..8424e46d 100644 --- a/html-test/ref/NamespacedIdentifiers.html +++ b/html-test/ref/NamespacedIdentifiers.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="index.html" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -116,7 +116,7 @@ >Bar</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -139,8 +139,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index a5f33882..14905718 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -353,8 +353,6 @@ with more of the indented list content.</p ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/NoLayout.html b/html-test/ref/NoLayout.html index 48d0c62d..a6afc3fc 100644 --- a/html-test/ref/NoLayout.html +++ b/html-test/ref/NoLayout.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -79,8 +79,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/NonGreedy.html b/html-test/ref/NonGreedy.html index a20c2d8f..76861de6 100644 --- a/html-test/ref/NonGreedy.html +++ b/html-test/ref/NonGreedy.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -75,8 +75,6 @@ ></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 6a185b8a..005d3a0c 100644 --- a/html-test/ref/Operators.html +++ b/html-test/ref/Operators.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -330,7 +330,7 @@ ></span ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -521,8 +521,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/OrphanInstances.html b/html-test/ref/OrphanInstances.html index 7518d1e8..cc5b5c7c 100644 --- a/html-test/ref/OrphanInstances.html +++ b/html-test/ref/OrphanInstances.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -105,8 +105,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/OrphanInstancesClass.html b/html-test/ref/OrphanInstancesClass.html index 4ddfc4b2..b90e36e2 100644 --- a/html-test/ref/OrphanInstancesClass.html +++ b/html-test/ref/OrphanInstancesClass.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -125,8 +125,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/OrphanInstancesType.html b/html-test/ref/OrphanInstancesType.html index 02aae12d..16ea1d53 100644 --- a/html-test/ref/OrphanInstancesType.html +++ b/html-test/ref/OrphanInstancesType.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -66,7 +66,7 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -127,8 +127,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/PR643.html b/html-test/ref/PR643.html index 2d5afea2..e19e3343 100644 --- a/html-test/ref/PR643.html +++ b/html-test/ref/PR643.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -75,8 +75,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/PR643_1.html b/html-test/ref/PR643_1.html index 2e7326bc..0582deae 100644 --- a/html-test/ref/PR643_1.html +++ b/html-test/ref/PR643_1.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -75,8 +75,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 249a6e12..7e5cdc1f 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -86,13 +86,13 @@ >pattern</span > <a href="#" >(:<->)</a - > :: x -> x1 -> (<a href="#" title="PatternSyns" + > :: x1 -> x2 -> (<a href="#" title="PatternSyns" >FooType</a - > x, <a href="#" title="PatternSyns" + > x1, <a href="#" title="PatternSyns" >FooType</a > (<a href="#" title="PatternSyns" >FooType</a - > x1))</li + > x2))</li ><li class="src short" ><span class="keyword" >data</span @@ -170,7 +170,7 @@ >FooCtor</a > x</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -223,13 +223,13 @@ >pattern</span > <a id="v::-60--45--62-" class="def" >(:<->)</a - > :: x -> x1 -> (<a href="#" title="PatternSyns" + > :: x1 -> x2 -> (<a href="#" title="PatternSyns" >FooType</a - > x, <a href="#" title="PatternSyns" + > x1, <a href="#" title="PatternSyns" >FooType</a > (<a href="#" title="PatternSyns" >FooType</a - > x1)) <a href="#" class="selflink" + > x2)) <a href="#" class="selflink" >#</a ></p ><div class="doc" @@ -268,7 +268,7 @@ >BlubCtor</a > x</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -322,7 +322,7 @@ >Empty</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -368,8 +368,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/PromotedTypes.html b/html-test/ref/PromotedTypes.html index e002ab4a..b4e4dd7c 100644 --- a/html-test/ref/PromotedTypes.html +++ b/html-test/ref/PromotedTypes.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -64,7 +64,7 @@ >RNil</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -74,7 +74,7 @@ >:></a > a</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -102,7 +102,7 @@ >Pattern</a > '[]</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -116,7 +116,7 @@ >Pattern</a > (h ': t)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -148,7 +148,7 @@ >RNil</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -164,7 +164,7 @@ >:></a > h)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -192,15 +192,13 @@ >Tuple</a > '(a, b)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Properties.html b/html-test/ref/Properties.html index 03f665f4..2adab2b0 100644 --- a/html-test/ref/Properties.html +++ b/html-test/ref/Properties.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -85,8 +85,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/PruneWithWarning.html b/html-test/ref/PruneWithWarning.html index 62ecd6fa..9747a87f 100644 --- a/html-test/ref/PruneWithWarning.html +++ b/html-test/ref/PruneWithWarning.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -60,8 +60,6 @@ ><div id="interface" ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/QuantifiedConstraints.html b/html-test/ref/QuantifiedConstraints.html index 00a508ae..0833f1a8 100644 --- a/html-test/ref/QuantifiedConstraints.html +++ b/html-test/ref/QuantifiedConstraints.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -97,8 +97,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/QuasiExpr.html b/html-test/ref/QuasiExpr.html index cbec9742..2eb2cda3 100644 --- a/html-test/ref/QuasiExpr.html +++ b/html-test/ref/QuasiExpr.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -66,7 +66,7 @@ >Integer</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -76,7 +76,7 @@ >String</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -90,7 +90,7 @@ >Expr</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -100,7 +100,7 @@ >String</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -125,7 +125,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -198,7 +198,7 @@ >AddOp</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -206,7 +206,7 @@ >SubOp</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -214,7 +214,7 @@ >MulOp</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -222,7 +222,7 @@ >DivOp</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -247,7 +247,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -339,8 +339,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/QuasiQuote.html b/html-test/ref/QuasiQuote.html index e4fe6a83..d828ea1d 100644 --- a/html-test/ref/QuasiQuote.html +++ b/html-test/ref/QuasiQuote.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -57,8 +57,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 80b00795..7293a149 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -101,7 +101,7 @@ Fix spurious superclass constraints bug.</pre >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -155,7 +155,7 @@ Fix spurious superclass constraints bug.</pre >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -235,8 +235,6 @@ Fix spurious superclass constraints bug.</pre ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TH.html b/html-test/ref/TH.html index a6d2992c..8ef49ced 100644 --- a/html-test/ref/TH.html +++ b/html-test/ref/TH.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -59,8 +59,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TH2.html b/html-test/ref/TH2.html index c1cec790..f59629a2 100644 --- a/html-test/ref/TH2.html +++ b/html-test/ref/TH2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -55,8 +55,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Table.html b/html-test/ref/Table.html index 6897e8b2..8a299018 100644 --- a/html-test/ref/Table.html +++ b/html-test/ref/Table.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -237,8 +237,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html index 2115d14f..ce2acb60 100644 --- a/html-test/ref/Test.html +++ b/html-test/ref/Test.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -66,7 +66,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -800,7 +800,7 @@ >A1</a > a</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -808,7 +808,7 @@ >B1</a > b</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -832,7 +832,7 @@ >A2</a > a</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -840,7 +840,7 @@ >B2</a > b</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -974,7 +974,7 @@ >N1</a > a</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -1002,7 +1002,7 @@ >N2</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1016,7 +1016,7 @@ >n</a > :: a b</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -1048,7 +1048,7 @@ >N3</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1111,7 +1111,7 @@ >N5</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1171,7 +1171,7 @@ >n6</a > :: a b</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -1223,7 +1223,7 @@ >n7</a > :: a b</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -1398,7 +1398,7 @@ >T5</a > () ()</dfn ><div class="doc empty" - ></div + > </div ></li ><li ><dfn class="src" @@ -1410,7 +1410,7 @@ >Int</a ></dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -1683,7 +1683,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1735,7 +1735,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -2083,7 +2083,7 @@ is at the beginning of the line).</pre >Ex1</a > b</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -2093,7 +2093,7 @@ is at the beginning of the line).</pre >Ex2</a > b</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -2105,7 +2105,7 @@ is at the beginning of the line).</pre >Ex3</a > b</td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -2115,7 +2115,7 @@ is at the beginning of the line).</pre >forall</span > a. a -> a)</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -2273,7 +2273,7 @@ is at the beginning of the line).</pre >R</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -2407,8 +2407,6 @@ is at the beginning of the line).</pre ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Threaded.html b/html-test/ref/Threaded.html index ee92a131..3277c468 100644 --- a/html-test/ref/Threaded.html +++ b/html-test/ref/Threaded.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -88,8 +88,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Threaded_TH.html b/html-test/ref/Threaded_TH.html index f4ff62e2..8850eafb 100644 --- a/html-test/ref/Threaded_TH.html +++ b/html-test/ref/Threaded_TH.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -93,8 +93,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Ticket112.html b/html-test/ref/Ticket112.html index 090d26dc..9d04e8c5 100644 --- a/html-test/ref/Ticket112.html +++ b/html-test/ref/Ticket112.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -75,8 +75,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Ticket61.html b/html-test/ref/Ticket61.html index 01e76a67..5e384b86 100644 --- a/html-test/ref/Ticket61.html +++ b/html-test/ref/Ticket61.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -73,8 +73,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Ticket75.html b/html-test/ref/Ticket75.html index e92725f6..4940b6fb 100644 --- a/html-test/ref/Ticket75.html +++ b/html-test/ref/Ticket75.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -86,7 +86,7 @@ >Q</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -111,8 +111,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TitledPicture.html b/html-test/ref/TitledPicture.html index cdd06b8d..5b936a16 100644 --- a/html-test/ref/TitledPicture.html +++ b/html-test/ref/TitledPicture.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -105,8 +105,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index 135f29c2..998b6d8c 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -235,7 +235,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -393,7 +393,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -435,7 +435,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -475,7 +475,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -629,7 +629,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -779,7 +779,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -817,7 +817,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -857,7 +857,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -987,7 +987,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1038,7 +1038,7 @@ >ZA</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -1046,7 +1046,7 @@ >ZB</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -1700,7 +1700,7 @@ >X</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -1710,7 +1710,7 @@ >Y</a ></td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -1749,7 +1749,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1793,7 +1793,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1835,7 +1835,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1897,7 +1897,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -1917,8 +1917,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html index b4d1faa6..8425a1d4 100644 --- a/html-test/ref/TypeFamilies2.html +++ b/html-test/ref/TypeFamilies2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -361,7 +361,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -389,8 +389,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TypeFamilies3.html b/html-test/ref/TypeFamilies3.html index eb1644fd..88e74dd9 100644 --- a/html-test/ref/TypeFamilies3.html +++ b/html-test/ref/TypeFamilies3.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -100,7 +100,7 @@ >Int</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td class="src" @@ -108,7 +108,7 @@ >Foo</a > _ = ()</td ><td class="doc empty" - ></td + > </td ></tr ></table ></div @@ -149,7 +149,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -185,7 +185,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -247,7 +247,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -289,7 +289,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -329,7 +329,7 @@ >#</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -357,8 +357,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index 21e8bf1c..5588e82a 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -94,7 +94,7 @@ >O</a ></td ><td class="doc empty" - ></td + > </td ></tr ><tr ><td colspan="2" @@ -108,7 +108,7 @@ >unO</a > :: g (f a)</dfn ><div class="doc empty" - ></div + > </div ></li ></ul ></div @@ -183,8 +183,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/UnboxedStuff.html b/html-test/ref/UnboxedStuff.html index cb688cdb..0f7ae983 100644 --- a/html-test/ref/UnboxedStuff.html +++ b/html-test/ref/UnboxedStuff.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -195,8 +195,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Unicode.html b/html-test/ref/Unicode.html index 059b12cf..8f301458 100644 --- a/html-test/ref/Unicode.html +++ b/html-test/ref/Unicode.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -75,8 +75,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Unicode2.html b/html-test/ref/Unicode2.html index 4031d101..b789c2d7 100644 --- a/html-test/ref/Unicode2.html +++ b/html-test/ref/Unicode2.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -97,8 +97,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/html-test/ref/Visible.html b/html-test/ref/Visible.html index 5a814d06..0a932038 100644 --- a/html-test/ref/Visible.html +++ b/html-test/ref/Visible.html @@ -10,14 +10,14 @@ /><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 + >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 + > </span ><ul class="links" id="page-menu" ><li ><a href="#" @@ -36,7 +36,7 @@ ><th >Safe Haskell</th ><td - >Safe</td + >Safe-Inferred</td ></tr ></table ><p class="caption" @@ -59,8 +59,6 @@ ></div ></div ></div - ><div id="footer" - ></div ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Bug1091.html b/hypsrc-test/ref/src/Bug1091.html index 730b6e25..a9c7d163 100644 --- a/hypsrc-test/ref/src/Bug1091.html +++ b/hypsrc-test/ref/src/Bug1091.html @@ -31,4 +31,4 @@ ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/CPP.html b/hypsrc-test/ref/src/CPP.html index 2ebcae90..719be7f8 100644 --- a/hypsrc-test/ref/src/CPP.html +++ b/hypsrc-test/ref/src/CPP.html @@ -78,7 +78,10 @@ ><span > </span ><span class="annot" - ><span class="hs-string" + ><span class="annottext" + >String +</span + ><span class="hs-string" >"foo"</span ></span ><span class="hs-cpp" @@ -130,7 +133,10 @@ ><span > </span ><span class="annot" - ><span class="hs-string" + ><span class="annottext" + >String +</span + ><span class="hs-string" >"block comment in a string is not a comment {- "</span ></span ><span class="hs-cpp" @@ -213,7 +219,10 @@ ><span > </span ><span class="annot" - ><span class="hs-string" + ><span class="annottext" + >String +</span + ><span class="hs-string" >"line comment in a string is not a comment --"</span ></span ><span @@ -224,4 +233,4 @@ ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/ClangCppBug.html b/hypsrc-test/ref/src/ClangCppBug.html deleted file mode 100644 index d03c92e1..00000000 --- a/hypsrc-test/ref/src/ClangCppBug.html +++ /dev/null @@ -1,306 +0,0 @@ -<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 443d7f96..48218a32 100644 --- a/hypsrc-test/ref/src/Classes.html +++ b/hypsrc-test/ref/src/Classes.html @@ -230,7 +230,7 @@ forall a. a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -359,8 +359,13 @@ forall (t :: * -> *) a. Foldable t => t a -> Int ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-glyph" @@ -519,7 +524,7 @@ forall (t :: * -> *) a. Foldable t => t a -> Int ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -534,7 +539,7 @@ forall (t :: * -> *) a. Foldable t => t a -> Int ><span id="" ><span class="annot" ><span class="annottext" - >y :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1125,7 +1130,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1137,8 +1142,13 @@ forall a. [a] -> [a] -> [a] >)</span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Either b b +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-glyph" @@ -1211,7 +1221,7 @@ forall a b. a -> b -> a ><span id="" ><span class="annot" ><span class="annottext" - >a :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1223,8 +1233,13 @@ forall a b. a -> b -> a >)</span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Either b b +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-glyph" @@ -1286,8 +1301,13 @@ forall a b. a -> b -> a ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Either a a +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-special" @@ -1301,7 +1321,7 @@ forall a b. a -> b -> a ><span id="" ><span class="annot" ><span class="annottext" - >b :: b + >b </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1372,8 +1392,13 @@ forall a b. a -> b -> a ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Either a a +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-special" @@ -1387,7 +1412,7 @@ forall a b. a -> b -> a ><span id="" ><span class="annot" ><span class="annottext" - >b :: b + >b </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1451,4 +1476,4 @@ forall a b. a -> b -> a ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html index 970ec741..2cc234ac 100644 --- a/hypsrc-test/ref/src/Constructors.html +++ b/hypsrc-test/ref/src/Constructors.html @@ -346,7 +346,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -411,8 +414,11 @@ ><span > </span ><span class="annot" - ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -423,7 +429,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -440,8 +449,11 @@ ><span > </span ><span class="annot" - ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -452,7 +464,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -481,7 +496,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >foo :: Foo + >Foo </span ><a href="#" ><span class="hs-identifier hs-var" @@ -494,7 +509,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >n :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -511,7 +526,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >42</span ></span ><span @@ -647,8 +665,11 @@ forall a. Num a => a -> a -> a ><span class="hs-special" >(</span ><span class="annot" - ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -659,7 +680,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >xs :: [Foo] + >[Foo] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -672,8 +693,11 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><a href="Constructors.html#Bar" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Bar" + ><span class="hs-identifier hs-var" >Bar</span ></a ></span @@ -722,8 +746,11 @@ forall a. Num a => a -> a -> a ><span class="hs-special" >(</span ><span class="annot" - ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -734,7 +761,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >xs :: [Foo] + >[Foo] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -747,8 +774,11 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><a href="Constructors.html#Baz" - ><span class="hs-identifier hs-type" + ><span class="annottext" + >Foo +</span + ><a href="Constructors.html#Baz" + ><span class="hs-identifier hs-var" >Baz</span ></a ></span @@ -794,8 +824,13 @@ forall a. [a] -> [a] ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Norf +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-glyph" @@ -919,14 +954,19 @@ forall a. HasCallStack => a ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Foo +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span id="" ><span class="annot" ><span class="annottext" - >n :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -940,8 +980,13 @@ forall a. HasCallStack => a >,</span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >[Foo] +</span + ><span class="hs-identifier" + >_</span + ></span ><span class="hs-special" >,</span ><span @@ -972,7 +1017,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >f3 :: Foo + >Foo </span ><a href="#" ><span class="hs-identifier hs-var" @@ -982,8 +1027,13 @@ forall a. HasCallStack => a ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-identifier" + >_</span + ></span ><span class="hs-special" >)</span ><span class="hs-special" @@ -1127,7 +1177,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >fx :: Foo + >Foo </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1338,4 +1388,4 @@ forall a b. (a -> b) -> a -> b ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html index 5268031d..e0f88772 100644 --- a/hypsrc-test/ref/src/Identifiers.html +++ b/hypsrc-test/ref/src/Identifiers.html @@ -108,7 +108,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -121,7 +121,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -271,7 +271,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -284,7 +284,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -434,7 +434,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -447,7 +447,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -611,7 +611,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -785,7 +785,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -798,7 +798,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -811,7 +811,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >z :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -852,7 +852,10 @@ forall a. Ord a => a -> a -> Bool ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -914,7 +917,10 @@ forall a. Ord a => a -> a -> Bool ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -976,7 +982,10 @@ forall a. Ord a => a -> a -> Bool ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -1415,7 +1424,10 @@ forall a b. (a -> b) -> a -> b ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >10</span ></span ><span @@ -1443,7 +1455,10 @@ forall a b. (a -> b) -> a -> b ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >20</span ></span ><span @@ -1471,7 +1486,10 @@ forall a b. (a -> b) -> a -> b ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >30</span ></span ><span @@ -1482,4 +1500,4 @@ forall a b. (a -> b) -> a -> b ></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 index 52b20200..c923b6da 100644 --- a/hypsrc-test/ref/src/LinkingIdentifiers.html +++ b/hypsrc-test/ref/src/LinkingIdentifiers.html @@ -105,7 +105,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -128,8 +128,13 @@ ></span ><span > </span - ><span class="hs-number" - >2</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-number" + >2</span + ></span ><span > </span ><span class="hs-glyph" @@ -161,7 +166,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span class="hs-special" @@ -203,7 +211,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span class="hs-special" @@ -224,7 +235,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -234,8 +245,13 @@ forall a. Num a => a -> a -> a ></span ><span > </span - ><span class="hs-number" - >2</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-number" + >2</span + ></span ><span > </span ><span class="hs-glyph" @@ -265,7 +281,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span @@ -303,7 +322,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span @@ -360,7 +382,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -383,8 +405,13 @@ forall a. Num a => a -> a -> a ></span ><span > </span - ><span class="hs-number" - >2</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-number" + >2</span + ></span ><span > </span ><span class="hs-glyph" @@ -416,7 +443,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span class="hs-special" @@ -458,7 +488,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span class="hs-special" @@ -479,7 +512,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -489,8 +522,13 @@ forall a. Num a => a -> a -> a ></span ><span > </span - ><span class="hs-number" - >2</span + ><span class="annot" + ><span class="annottext" + >Int +</span + ><span class="hs-number" + >2</span + ></span ><span > </span ><span class="hs-glyph" @@ -520,7 +558,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span @@ -558,7 +599,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >2</span ></span ><span @@ -569,4 +613,4 @@ forall a. Num a => a -> a -> a ></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 f0d05fbc..0c7ddf9e 100644 --- a/hypsrc-test/ref/src/Literals.html +++ b/hypsrc-test/ref/src/Literals.html @@ -70,7 +70,10 @@ ><span > </span ><span class="annot" - ><span class="hs-string" + ><span class="annottext" + >String +</span + ><span class="hs-string" >"str literal"</span ></span ><span @@ -144,7 +147,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >0</span ></span ><span @@ -160,7 +166,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >1</span ></span ><span @@ -176,7 +185,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >1010011</span ></span ><span @@ -192,7 +204,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >41231</span ></span ><span @@ -208,7 +223,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >12131</span ></span ><span @@ -282,7 +300,10 @@ forall a. Num a => a -> a -> a ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >a +</span + ><span class="hs-number" >42.0000001</span ></span ><span @@ -529,4 +550,4 @@ forall a. Num a => a -> a -> a ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html index 4d5693c2..289684a0 100644 --- a/hypsrc-test/ref/src/Operators.html +++ b/hypsrc-test/ref/src/Operators.html @@ -95,7 +95,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >a :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -121,7 +121,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >b :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -260,7 +260,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -286,7 +286,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >b :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -419,7 +419,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -464,7 +464,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -476,8 +476,13 @@ forall a. [a] -> [a] -> [a] > </span ><span class="hs-special" >(</span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >a +</span + ><span class="hs-identifier" + >_</span + ></span ><span class="annot" ><span class="hs-glyph hs-type" >:</span @@ -485,7 +490,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >b :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -638,7 +643,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: [[a]] + >[[a]] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -664,7 +669,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >b :: [a] + >[a] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -810,7 +815,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: [[a]] + >[[a]] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -836,7 +841,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >b :: [[a]] + >[[a]] </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1047,7 +1052,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >a :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1073,7 +1078,7 @@ forall a. [a] -> [a] -> [a] ><span id="" ><span class="annot" ><span class="annottext" - >b :: b + >b </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1141,4 +1146,4 @@ forall a b. (a -> b) -> a -> b ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Polymorphism.html b/hypsrc-test/ref/src/Polymorphism.html index ec9c49e8..9f8a1850 100644 --- a/hypsrc-test/ref/src/Polymorphism.html +++ b/hypsrc-test/ref/src/Polymorphism.html @@ -838,7 +838,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -851,7 +851,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >f :: forall a. a -> a + >forall a. a -> a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1007,7 +1007,7 @@ forall a. a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1020,7 +1020,7 @@ forall a. a -> a ><span id="" ><span class="annot" ><span class="annottext" - >f :: forall a. a -> a + >forall a. a -> a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1992,7 +1992,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2005,7 +2005,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >f :: forall a. Ord a => a -> a + >forall a. Ord a => a -> a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2167,7 +2167,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2180,7 +2180,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >f :: forall a. Ord a => a -> a + >forall a. Ord a => a -> a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2285,7 +2285,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2449,7 +2449,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >f :: a -> b + >a -> b </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2462,7 +2462,7 @@ forall a. HasCallStack => a ><span id="" ><span class="annot" ><span class="annottext" - >x :: a + >a </span ><a href="#" ><span class="hs-identifier hs-var" @@ -2646,4 +2646,4 @@ forall a. HasCallStack => a ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/PositionPragmas.html b/hypsrc-test/ref/src/PositionPragmas.html index ddd73f31..8ee123fa 100644 --- a/hypsrc-test/ref/src/PositionPragmas.html +++ b/hypsrc-test/ref/src/PositionPragmas.html @@ -169,4 +169,4 @@ ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Quasiquoter.html b/hypsrc-test/ref/src/Quasiquoter.html index ab631e8c..f53219d7 100644 --- a/hypsrc-test/ref/src/Quasiquoter.html +++ b/hypsrc-test/ref/src/Quasiquoter.html @@ -126,7 +126,7 @@ -> (String -> Q [Dec]) -> QuasiQuoter </span - ><span class="hs-identifier hs-type hs-type" + ><span class="hs-identifier hs-type" >QuasiQuoter</span ></span ><span @@ -382,8 +382,13 @@ forall a. String -> Q a ></span ><span > </span - ><span class="hs-identifier" - >_</span + ><span class="annot" + ><span class="annottext" + >String +</span + ><span class="hs-identifier" + >_</span + ></span ><span > </span ><span class="hs-glyph" @@ -401,7 +406,10 @@ forall (m :: * -> *) a. MonadFail m => String -> m a ><span > </span ><span class="annot" - ><span class="hs-string" + ><span class="annottext" + >String +</span + ><span class="hs-string" >"stringQuoter: only valid in expression context"</span ></span ><span @@ -412,4 +420,4 @@ forall (m :: * -> *) a. MonadFail m => String -> m a ></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 5057b8a4..604ac6ca 100644 --- a/hypsrc-test/ref/src/Records.html +++ b/hypsrc-test/ref/src/Records.html @@ -232,7 +232,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -245,7 +245,7 @@ ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -261,10 +261,10 @@ > </span ><span class="annot" ><span class="annottext" - >$WPoint :: Int -> Int -> Point + >Point :: Int -> Int -> Point </span - ><a href="Records.html#%24WPoint" - ><span class="hs-identifier hs-type hs-type" + ><a href="Records.html#Point" + ><span class="hs-identifier hs-type" >Point</span ></a ></span @@ -815,7 +815,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >p :: Point + >Point </span ><a href="#" ><span class="hs-identifier hs-var" @@ -828,7 +828,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >d :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -938,7 +938,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >p :: Point + >Point </span ><a href="#" ><span class="hs-identifier hs-var" @@ -951,7 +951,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >d :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1121,7 +1121,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >x :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1134,7 +1134,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >y :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1147,7 +1147,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >p :: Point + >Point </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1207,7 +1207,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >dx :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1222,7 +1222,7 @@ forall a. Num a => a -> a -> a ><span id="" ><span class="annot" ><span class="annottext" - >dy :: Int + >Int </span ><a href="#" ><span class="hs-identifier hs-var" @@ -1284,22 +1284,33 @@ forall a. Num a => a -> a -> a ></span ><span > </span + ><span class="annot" + ><a href="Records.html#Point" + ><span class="hs-identifier hs-type" + >Point</span + ></a + ></span + ><span class="hs-special" + >{</span ><span id="" ><span id="" ><span class="annot" - ><a href="Records.html#Point" - ><span class="hs-identifier hs-type" - >Point</span + ><span class="annottext" + >Int +y :: Int +x :: Int +y :: Point -> Int +x :: Point -> Int +</span + ><a href="#" + ><span class="hs-glyph hs-var hs-var hs-var hs-var" + >..</span ></a ></span - ><span class="hs-special" - >{</span - ><span class="hs-glyph" - >..</span - ><span class="hs-special" - >}</span ></span ></span + ><span class="hs-special" + >}</span ><span > </span ><span class="hs-glyph" @@ -1427,4 +1438,4 @@ forall a. Num a => a -> a -> a ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html index 6552b676..68c7b754 100644 --- a/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html +++ b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html @@ -656,4 +656,4 @@ ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/TemplateHaskellSplices.html b/hypsrc-test/ref/src/TemplateHaskellSplices.html index 85288453..6586d299 100644 --- a/hypsrc-test/ref/src/TemplateHaskellSplices.html +++ b/hypsrc-test/ref/src/TemplateHaskellSplices.html @@ -110,6 +110,7 @@ forall a. a -> a ><span class="annot" ><span class="annottext" >Double +Integer Double -> Integer Integer -> Integer -> Integer forall a. Floating a => a @@ -132,4 +133,4 @@ pi :: forall a. Floating a => a ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/Types.html b/hypsrc-test/ref/src/Types.html index 22012ad1..e08382dd 100644 --- a/hypsrc-test/ref/src/Types.html +++ b/hypsrc-test/ref/src/Types.html @@ -713,7 +713,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -772,7 +775,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >1</span ></span ><span @@ -890,7 +896,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -949,7 +958,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >1</span ></span ><span @@ -1062,7 +1074,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -1111,7 +1126,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >1</span ></span ><span @@ -1219,7 +1237,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >0</span ></span ><span @@ -1268,7 +1289,10 @@ ><span > </span ><span class="annot" - ><span class="hs-number" + ><span class="annottext" + >Int +</span + ><span class="hs-number" >1</span ></span ><span @@ -1279,4 +1303,4 @@ ></pre ></body ></html ->
\ No newline at end of file +> diff --git a/hypsrc-test/ref/src/UsingQuasiquotes.html b/hypsrc-test/ref/src/UsingQuasiquotes.html index a5c791c4..ca48775d 100644 --- a/hypsrc-test/ref/src/UsingQuasiquotes.html +++ b/hypsrc-test/ref/src/UsingQuasiquotes.html @@ -101,4 +101,4 @@ forall a. [a] -> [a] -> [a] ></pre ></body ></html ->
\ No newline at end of file +> |