From 8d3df49ae1aa2eb58af530bba0c71817411fd49d Mon Sep 17 00:00:00 2001 From: jpmoresmau Date: Wed, 21 Jan 2015 21:31:24 +0100 Subject: support GHC 7.10: no Safe-Inferred, Foldable instance --- html-test/src/Bug8.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'html-test/src') diff --git a/html-test/src/Bug8.hs b/html-test/src/Bug8.hs index e569b01d..30afae1f 100644 --- a/html-test/src/Bug8.hs +++ b/html-test/src/Bug8.hs @@ -7,6 +7,7 @@ data Typ = Type (Typ,[Typ]) | TFree (Typ, [Typ]) x --> y = Type(s,[s,t]) +(--->) :: (Foldable t0) => t0 t -> Typ -> Typ (--->) = flip $ foldr (-->) s = undefined -- cgit v1.2.3 From 7d8ece225e5387d0d08a675bda82bd2a1af5a173 Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Thu, 26 Mar 2015 19:29:25 +0000 Subject: Test for anchor defaulting I delete the old tests because it turns out that: * test runner would never put them in scope of each other even with imports so just one would suffice * test runner actually needed some hacking to keep links so in the end we would end up with no anchors making them useless --- html-test/ref/Bug253.html | 99 ++++++++++++++++++++++++++++++++++++ html-test/ref/Ticket253_1.html | 91 --------------------------------- html-test/ref/Ticket253_2.html | 111 ----------------------------------------- html-test/run.lhs | 24 ++++++--- html-test/src/Bug253.hs | 10 ++++ html-test/src/Ticket253_1.hs | 6 --- html-test/src/Ticket253_2.hs | 6 --- 7 files changed, 126 insertions(+), 221 deletions(-) create mode 100644 html-test/ref/Bug253.html delete mode 100644 html-test/ref/Ticket253_1.html delete mode 100644 html-test/ref/Ticket253_2.html create mode 100644 html-test/src/Bug253.hs delete mode 100644 html-test/src/Ticket253_1.hs delete mode 100644 html-test/src/Ticket253_2.hs (limited to 'html-test/src') diff --git a/html-test/ref/Bug253.html b/html-test/ref/Bug253.html new file mode 100644 index 00000000..0802d91e --- /dev/null +++ b/html-test/ref/Bug253.html @@ -0,0 +1,99 @@ + +Bug253
Safe HaskellSafe

Bug253

Description

This module tests that if we're trying to link to a qualified + identifier that's not in scope, we get an anchor as if it was a + variable. Previous behaviour was to treat it as a type constructor + so issue like #253 arose. Also see rename function comments in + source.

Synopsis

Documentation

foo :: ()

This link should generate #v anchor: fakeFakeFake

diff --git a/html-test/ref/Ticket253_1.html b/html-test/ref/Ticket253_1.html deleted file mode 100644 index ade128e9..00000000 --- a/html-test/ref/Ticket253_1.html +++ /dev/null @@ -1,91 +0,0 @@ - -Ticket253_1
Safe HaskellSafe

Ticket253_1

Synopsis

Documentation

foo :: Int

See bar.

Also see Baz

diff --git a/html-test/ref/Ticket253_2.html b/html-test/ref/Ticket253_2.html deleted file mode 100644 index 0b03a874..00000000 --- a/html-test/ref/Ticket253_2.html +++ /dev/null @@ -1,111 +0,0 @@ - -Ticket253_2
Safe HaskellSafe

Ticket253_2

Synopsis

Documentation

bar :: Int

Comment

data Baz

Constructors

Baz 
diff --git a/html-test/run.lhs b/html-test/run.lhs index a80b265e..1f19b723 100755 --- a/html-test/run.lhs +++ b/html-test/run.lhs @@ -21,7 +21,6 @@ import System.Exit import System.FilePath import System.Process (ProcessHandle, runProcess, waitForProcess, system) - packageRoot, dataDir, haddockPath, baseDir, testDir, outDir :: FilePath baseDir = takeDirectory __FILE__ testDir = baseDir "src" @@ -112,11 +111,11 @@ check modules strict = do then do out <- readFile outfile ref <- readFile reffile - if not $ haddockEq out ref + if not $ haddockEq (outfile, out) (reffile, ref) then do putStrLn $ "Output for " ++ mod ++ " has changed! Exiting with diff:" - let ref' = stripLinks ref - out' = stripLinks out + let ref' = maybeStripLinks outfile ref + out' = maybeStripLinks reffile out let reffile' = outDir takeFileName reffile ++ ".nolinks" outfile' = outDir takeFileName outfile ++ ".ref.nolinks" writeFile reffile' ref' @@ -134,6 +133,10 @@ check modules strict = do else do putStrLn $ "Pass: " ++ mod ++ " (no .ref file)" +-- | List of modules in which we don't 'stripLinks' +preserveLinksModules :: [String] +preserveLinksModules = map (++ ".html") ["Bug253"] + -- | A rather nasty way to drop the Haddock version string from the -- end of the generated HTML files so that we don't have to change -- every single test every time we change versions. We rely on the the @@ -146,9 +149,16 @@ dropVersion = reverse . dropTillP . reverse dropTillP ('p':'<':xs) = xs dropTillP (_:xs) = dropTillP xs -haddockEq :: String -> String -> Bool -haddockEq file1 file2 = - stripLinks (dropVersion file1) == stripLinks (dropVersion file2) +haddockEq :: (FilePath, String) -> (FilePath, String) -> Bool +haddockEq (fn1, file1) (fn2, file2) = + maybeStripLinks fn1 (dropVersion file1) + == maybeStripLinks fn2 (dropVersion file2) + +maybeStripLinks :: String -- ^ Module we're considering for stripping + -> String -> String +maybeStripLinks m = if any (`isSuffixOf` m) preserveLinksModules + then id + else stripLinks stripLinks :: String -> String stripLinks str = diff --git a/html-test/src/Bug253.hs b/html-test/src/Bug253.hs new file mode 100644 index 00000000..499f6cd4 --- /dev/null +++ b/html-test/src/Bug253.hs @@ -0,0 +1,10 @@ +-- | This module tests that if we're trying to link to a /qualified/ +-- identifier that's not in scope, we get an anchor as if it was a +-- variable. Previous behaviour was to treat it as a type constructor +-- so issue like #253 arose. Also see @rename@ function comments in +-- source. +module Bug253 where + +-- | This link should generate @#v@ anchor: 'DoesNotExist.fakeFakeFake' +foo :: () +foo = () diff --git a/html-test/src/Ticket253_1.hs b/html-test/src/Ticket253_1.hs deleted file mode 100644 index 62ab4b17..00000000 --- a/html-test/src/Ticket253_1.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Ticket253_1 where --- | See 'Ticket253_2.bar'. --- --- Also see 'Ticket253_2.Baz' -foo :: Int -foo = 0 diff --git a/html-test/src/Ticket253_2.hs b/html-test/src/Ticket253_2.hs deleted file mode 100644 index a19d4cee..00000000 --- a/html-test/src/Ticket253_2.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Ticket253_2 where --- | Comment -bar :: Int -bar = 0 - -data Baz = Baz -- cgit v1.2.3 From 5d04e313cc52ecf88b0fd0b3d0d39ce6a8dc7406 Mon Sep 17 00:00:00 2001 From: watashi Date: Sun, 26 Apr 2015 16:35:28 -0700 Subject: Do not insert anchor for section headings in contents box --- .gitignore | 3 + .../src/Haddock/Backends/Xhtml/DocMarkup.hs | 5 +- html-test/ref/Bug387.html | 111 +++++++++++++++++++++ html-test/src/Bug387.hs | 12 +++ 4 files changed, 130 insertions(+), 1 deletion(-) create mode 100644 html-test/ref/Bug387.html create mode 100644 html-test/src/Bug387.hs (limited to 'html-test/src') diff --git a/.gitignore b/.gitignore index 6b8d26e0..2d3f4516 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,6 @@ /doc/configure tags TAGS + +.cabal-sandbox +cabal.sandbox.config diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index e807eb94..c23f3f08 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -62,7 +62,10 @@ parHtmlMarkup qual insertAnchors ppId = Markup { then anchor ! [href url] << fromMaybe url mLabel else toHtml $ fromMaybe url mLabel, - markupAName = \aname -> namedAnchor aname << "", + markupAName = \aname + -> if insertAnchors + then namedAnchor aname << "" + else noHtml, markupPic = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)), markupProperty = pre . toHtml, markupExample = examplesToHtml, diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html new file mode 100644 index 00000000..2d2009b1 --- /dev/null +++ b/html-test/ref/Bug387.html @@ -0,0 +1,111 @@ + +Bug387
Safe HaskellSafe

Bug387

Synopsis

Section1

test1 :: Int

Section2

test2 :: Int

diff --git a/html-test/src/Bug387.hs b/html-test/src/Bug387.hs new file mode 100644 index 00000000..d9fed34e --- /dev/null +++ b/html-test/src/Bug387.hs @@ -0,0 +1,12 @@ +module Bug387 + ( -- * Section1#a:section1# + test1 + -- * Section2#a:section2# + , test2 + ) where + +test1 :: Int +test1 = 223 + +test2 :: Int +test2 = 42 -- cgit v1.2.3 From c4a73b5b0fb7574bd519584c16b5be0675f3f430 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Wed, 27 May 2015 22:46:13 +0200 Subject: Add simple test case for arbitrary-depth list nesting. --- html-test/ref/Nesting.html | 49 ++++++++++++++++++++++++++++++++++++---------- html-test/src/Nesting.hs | 15 ++++++++++++++ 2 files changed, 54 insertions(+), 10 deletions(-) (limited to 'html-test/src') diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index 37ee7af3..542d6db7 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -73,6 +73,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_Nesting.html");}; >j :: t
  • k :: t
    • No newline separation even in indented lists. We can have any paragraph level element that we normally - can, like headers

    Level 3 header

    with some content…

    • and even more lists inside

    Level 3 header

    with some content…

    • and even more lists inside

    k :: t

    • list may start at arbitrary depth
    • and consecutive items at that depth + belong to the same list

    • of course we can still

      • nest items like we are used to
    • and then get back to initial list
    Date: Sat, 23 May 2015 04:56:18 -0700 Subject: Build executable with '-threaded' (fixes #399) --- haddock.cabal | 2 +- html-test/ref/Threaded.html | 94 ++++++++++++++++++++++++++++++++++++++++++++ html-test/src/Threaded.hs | 10 +++++ html-test/src/Threaded_TH.hs | 13 ++++++ 4 files changed, 118 insertions(+), 1 deletion(-) create mode 100644 html-test/ref/Threaded.html create mode 100644 html-test/src/Threaded.hs create mode 100644 html-test/src/Threaded_TH.hs (limited to 'html-test/src') diff --git a/haddock.cabal b/haddock.cabal index 03bb28ab..ed570f53 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -42,7 +42,7 @@ executable haddock default-language: Haskell2010 main-is: Main.hs hs-source-dirs: driver - ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded build-depends: base >= 4.3 && < 4.9 diff --git a/html-test/ref/Threaded.html b/html-test/ref/Threaded.html new file mode 100644 index 00000000..95a18933 --- /dev/null +++ b/html-test/ref/Threaded.html @@ -0,0 +1,94 @@ + +Threaded
    Safe HaskellNone

    Threaded

    Description

    Ensures haddock built with -threaded.

    Synopsis

    Documentation

    f :: Integer

    $(forkTH) fails at compile time if haddock isn't using the + threaded RTS.

    diff --git a/html-test/src/Threaded.hs b/html-test/src/Threaded.hs new file mode 100644 index 00000000..7f3073ad --- /dev/null +++ b/html-test/src/Threaded.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | Ensures haddock built with @-threaded@. +module Threaded where + +import Threaded_TH + +-- | @$(forkTH)@ fails at compile time if haddock isn't using the +-- threaded RTS. +f = $(forkTH) diff --git a/html-test/src/Threaded_TH.hs b/html-test/src/Threaded_TH.hs new file mode 100644 index 00000000..53e5a399 --- /dev/null +++ b/html-test/src/Threaded_TH.hs @@ -0,0 +1,13 @@ +-- | Imported by 'Threaded', since a TH splice can't be used in the +-- module where it is defined. +module Threaded_TH where + +import Control.Concurrent (forkOS) +import Language.Haskell.TH.Syntax (Exp (LitE), Lit (IntegerL), Q, runIO) + +-- | forkOS requires the threaded RTS, so this TH fails if haddock was +-- built without @-threaded@. +forkTH :: Q Exp +forkTH = do + _ <- runIO (forkOS (return ())) + return (LitE (IntegerL 0)) -- cgit v1.2.3 From 06e675167cc217d5346d706e0d52af0726710e3d Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Tue, 7 Jul 2015 23:58:52 +0100 Subject: Delete trailing whitespace --- haddock-api/resources/html/frames.html | 2 +- haddock-api/resources/html/haddock-util.js | 22 +++++++++++----------- haddock-api/src/Haddock/Backends/HaddockDB.hs | 18 +++++++++--------- haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 2 +- haddock-api/src/Haddock/Version.hs | 2 +- haddock-library/LICENSE | 4 ++-- html-test/README.markdown | 2 +- html-test/ref/frames.html | 2 +- html-test/ref/haddock-util.js | 22 +++++++++++----------- html-test/src/Bugs.hs | 2 +- hypsrc-test/ref/src/Classes.html | 2 +- hypsrc-test/src/Classes.hs | 2 +- 12 files changed, 41 insertions(+), 41 deletions(-) (limited to 'html-test/src') diff --git a/haddock-api/resources/html/frames.html b/haddock-api/resources/html/frames.html index 1b4e38d4..e86edb66 100644 --- a/haddock-api/resources/html/frames.html +++ b/haddock-api/resources/html/frames.html @@ -1,4 +1,4 @@ - diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js index 9a6fccf7..ba574356 100644 --- a/haddock-api/resources/html/haddock-util.js +++ b/haddock-api/resources/html/haddock-util.js @@ -131,11 +131,11 @@ function perform_search(full) var text = document.getElementById("searchbox").value.toLowerCase(); if (text == last_search && !full) return; last_search = text; - + var table = document.getElementById("indexlist"); var status = document.getElementById("searchmsg"); var children = table.firstChild.childNodes; - + // first figure out the first node with the prefix var first = bisect(-1); var last = (first == -1 ? -1 : bisect(1)); @@ -166,7 +166,7 @@ function perform_search(full) status.innerHTML = ""; } - + function setclass(first, last, status) { for (var i = first; i <= last; i++) @@ -174,8 +174,8 @@ function perform_search(full) children[i].className = status; } } - - + + // do a binary search, treating 0 as ... // return either -1 (no 0's found) or location of most far match function bisect(dir) @@ -201,9 +201,9 @@ function perform_search(full) if (checkitem(i) == 0) return i; } return -1; - } - - + } + + // from an index, decide what the result is // 0 = match, -1 is lower, 1 is higher function checkitem(i) @@ -212,8 +212,8 @@ function perform_search(full) if (s == text) return 0; else return (s > text ? -1 : 1); } - - + + // from an index, get its string // this abstracts over alternates function getitem(i) @@ -250,7 +250,7 @@ function addMenuItem(html) { function adjustForFrames() { var bodyCls; - + if (parent.location.href == window.location.href) { // not in frames, so add Frames button addMenuItem("Frames"); diff --git a/haddock-api/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs index 1c248bfb..0bdc9057 100644 --- a/haddock-api/src/Haddock/Backends/HaddockDB.hs +++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs @@ -40,7 +40,7 @@ ppIfaces mods where do_mod (Module mod, iface) = text " text mod <> text "\">" - $$ text "<literal>" + $$ text "<title><literal>" <> text mod <> text "</literal>" $$ text "" @@ -50,10 +50,10 @@ ppIfaces mods $$ vcat (map (do_export mod) (eltsFM (iface_decls iface))) $$ text "" $$ text "" - + do_export mod decl | (nm:_) <- declBinders decl = text "" + $$ text "" <> do_decl decl <> text "" $$ text "" @@ -63,11 +63,11 @@ ppIfaces mods $$ text "" do_export _ _ = empty - do_decl (HsTypeSig _ [nm] ty _) + do_decl (HsTypeSig _ [nm] ty _) = ppHsName nm <> text " :: " <> ppHsType ty do_decl (HsTypeDecl _ nm args ty _) = hsep ([text "type", ppHsName nm ] - ++ map ppHsName args + ++ map ppHsName args ++ [equals, ppHsType ty]) do_decl (HsNewTypeDecl loc ctx nm args con drv _) = hsep ([text "data", ppHsName nm] -- data, not newtype @@ -87,7 +87,7 @@ ppHsConstr :: HsConDecl -> Doc ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) = ppHsName name <> (braces . hsep . punctuate comma . map ppField $ fieldList) -ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = +ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = hsep (ppHsName name : map ppHsBangType typeList) ppField (HsFieldDecl ns ty doc) @@ -100,7 +100,7 @@ ppHsBangType (HsUnBangedTy ty) = ppHsType ty ppHsContext :: HsContext -> Doc ppHsContext [] = empty -ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> +ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> hsep (map ppHsAType b)) context) ppHsType :: HsType -> Doc @@ -109,7 +109,7 @@ ppHsType (HsForAllType Nothing context 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 "." : + hsep (text "forall" : map ppHsName tvs ++ text "." : 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] @@ -135,7 +135,7 @@ ppHsQName (UnQual str) = ppHsName str ppHsQName n@(Qual (Module mod) str) | n == unit_con_name = ppHsName str | isSpecial str = ppHsName str - | otherwise + | otherwise = text "" diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index 5166549a..26bcbf6d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -215,7 +215,7 @@ collapseSection id_ state classes = [ identifier sid, theclass cs ] collapseToggle :: String -> [HtmlAttr] collapseToggle id_ = [ strAttr "onclick" js ] where js = "toggleSection('" ++ id_ ++ "')"; - + -- | Attributes for an area that toggles a collapsed area, -- and displays a control. collapseControl :: String -> Bool -> String -> [HtmlAttr] diff --git a/haddock-api/src/Haddock/Version.hs b/haddock-api/src/Haddock/Version.hs index 2ef3a257..4e9a581a 100644 --- a/haddock-api/src/Haddock/Version.hs +++ b/haddock-api/src/Haddock/Version.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Portability : portable ----------------------------------------------------------------------------- -module Haddock.Version ( +module Haddock.Version ( projectName, projectVersion, projectUrl ) where diff --git a/haddock-library/LICENSE b/haddock-library/LICENSE index 1636bfcd..460decfc 100644 --- a/haddock-library/LICENSE +++ b/haddock-library/LICENSE @@ -5,11 +5,11 @@ modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR diff --git a/html-test/README.markdown b/html-test/README.markdown index 8d57acab..717bac5c 100644 --- a/html-test/README.markdown +++ b/html-test/README.markdown @@ -1,7 +1,7 @@ This is a testsuite for Haddock that uses the concept of "golden files". That is, it compares output files against a set of reference files. -To add a new test: +To add a new test: 1. Create a module in the `html-test/src` directory. diff --git a/html-test/ref/frames.html b/html-test/ref/frames.html index 1b4e38d4..e86edb66 100644 --- a/html-test/ref/frames.html +++ b/html-test/ref/frames.html @@ -1,4 +1,4 @@ - diff --git a/html-test/ref/haddock-util.js b/html-test/ref/haddock-util.js index 9a6fccf7..ba574356 100644 --- a/html-test/ref/haddock-util.js +++ b/html-test/ref/haddock-util.js @@ -131,11 +131,11 @@ function perform_search(full) var text = document.getElementById("searchbox").value.toLowerCase(); if (text == last_search && !full) return; last_search = text; - + var table = document.getElementById("indexlist"); var status = document.getElementById("searchmsg"); var children = table.firstChild.childNodes; - + // first figure out the first node with the prefix var first = bisect(-1); var last = (first == -1 ? -1 : bisect(1)); @@ -166,7 +166,7 @@ function perform_search(full) status.innerHTML = ""; } - + function setclass(first, last, status) { for (var i = first; i <= last; i++) @@ -174,8 +174,8 @@ function perform_search(full) children[i].className = status; } } - - + + // do a binary search, treating 0 as ... // return either -1 (no 0's found) or location of most far match function bisect(dir) @@ -201,9 +201,9 @@ function perform_search(full) if (checkitem(i) == 0) return i; } return -1; - } - - + } + + // from an index, decide what the result is // 0 = match, -1 is lower, 1 is higher function checkitem(i) @@ -212,8 +212,8 @@ function perform_search(full) if (s == text) return 0; else return (s > text ? -1 : 1); } - - + + // from an index, get its string // this abstracts over alternates function getitem(i) @@ -250,7 +250,7 @@ function addMenuItem(html) { function adjustForFrames() { var bodyCls; - + if (parent.location.href == window.location.href) { // not in frames, so add Frames button addMenuItem("Frames"); diff --git a/html-test/src/Bugs.hs b/html-test/src/Bugs.hs index 8e1f0079..e60bbe8f 100644 --- a/html-test/src/Bugs.hs +++ b/html-test/src/Bugs.hs @@ -1,3 +1,3 @@ module Bugs where -data A a = A a (a -> Int) +data A a = A a (a -> Int) diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html index a5a3d243..13c8389a 100644 --- a/hypsrc-test/ref/src/Classes.html +++ b/hypsrc-test/ref/src/Classes.html @@ -408,7 +408,7 @@ >] + > Foo' a where quux :: (a, a) -> a - quux (x, y) = norf [x, y] + quux (x, y) = norf [x, y] norf :: [a] -> a norf = quux . baz . sum . map bar -- cgit v1.2.3 From 3ad8ada0ea2982ba7974e381f07e84c35c9559af Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Thu, 6 Aug 2015 21:17:10 +0200 Subject: Extend advanced types test case with other examples. --- html-test/src/AdvanceTypes.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/AdvanceTypes.hs b/html-test/src/AdvanceTypes.hs index 939fdf07..c89d7396 100644 --- a/html-test/src/AdvanceTypes.hs +++ b/html-test/src/AdvanceTypes.hs @@ -4,6 +4,20 @@ {-# LANGUAGE TypeOperators #-} module AdvanceTypes where + +data RevList a = RNil | RevList a :> a + + data Pattern :: [*] -> * where Nil :: Pattern '[] Cons :: Maybe h -> Pattern t -> Pattern (h ': t) + + +-- Unlike (:), (:>) does not have to be quoted on type level. +data RevPattern :: RevList * -> * where + RevNil :: RevPattern RNil + RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h) + + +data Tuple :: (*, *) -> * where + Tuple :: a -> b -> Tuple '(a, b) -- cgit v1.2.3 From 66c91a3c20d18f2a2f9ccfbbc7a04bddd5507008 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Thu, 6 Aug 2015 21:22:06 +0200 Subject: Rename advanced types test case and accept new output. --- html-test/ref/AdvanceTypes.html | 97 ------------------- html-test/ref/PromotedTypes.html | 201 +++++++++++++++++++++++++++++++++++++++ html-test/src/AdvanceTypes.hs | 23 ----- html-test/src/PromotedTypes.hs | 25 +++++ 4 files changed, 226 insertions(+), 120 deletions(-) delete mode 100644 html-test/ref/AdvanceTypes.html create mode 100644 html-test/ref/PromotedTypes.html delete mode 100644 html-test/src/AdvanceTypes.hs create mode 100644 html-test/src/PromotedTypes.hs (limited to 'html-test/src') diff --git a/html-test/ref/AdvanceTypes.html b/html-test/ref/AdvanceTypes.html deleted file mode 100644 index f608efea..00000000 --- a/html-test/ref/AdvanceTypes.html +++ /dev/null @@ -1,97 +0,0 @@ - -AdvanceTypes
    Safe HaskellSafe

    AdvanceTypes

    Documentation

    data Pattern :: [*] -> * where

    Constructors

    Nil :: Pattern [] 
    Cons :: Maybe h -> Pattern t -> Pattern (h : t) 
    diff --git a/html-test/ref/PromotedTypes.html b/html-test/ref/PromotedTypes.html new file mode 100644 index 00000000..db42f637 --- /dev/null +++ b/html-test/ref/PromotedTypes.html @@ -0,0 +1,201 @@ + +PromotedTypes
    Safe HaskellSafe

    PromotedTypes

    Documentation

    data RevList a

    Constructors

    RNil 
    (RevList a) :> a 

    data Pattern :: [*] -> * where

    Constructors

    Nil :: Pattern '[] 
    Cons :: Maybe h -> Pattern t -> Pattern (h ': t) 

    data RevPattern :: RevList * -> * where

    Constructors

    RevNil :: RevPattern RNil 
    RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h) 

    data Tuple :: (*, *) -> * where

    Constructors

    Tuple :: a -> b -> Tuple '(a, b) 
    diff --git a/html-test/src/AdvanceTypes.hs b/html-test/src/AdvanceTypes.hs deleted file mode 100644 index c89d7396..00000000 --- a/html-test/src/AdvanceTypes.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} -module AdvanceTypes where - - -data RevList a = RNil | RevList a :> a - - -data Pattern :: [*] -> * where - Nil :: Pattern '[] - Cons :: Maybe h -> Pattern t -> Pattern (h ': t) - - --- Unlike (:), (:>) does not have to be quoted on type level. -data RevPattern :: RevList * -> * where - RevNil :: RevPattern RNil - RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h) - - -data Tuple :: (*, *) -> * where - Tuple :: a -> b -> Tuple '(a, b) diff --git a/html-test/src/PromotedTypes.hs b/html-test/src/PromotedTypes.hs new file mode 100644 index 00000000..ae3ad375 --- /dev/null +++ b/html-test/src/PromotedTypes.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} + + +module PromotedTypes where + + +data RevList a = RNil | RevList a :> a + + +data Pattern :: [*] -> * where + Nil :: Pattern '[] + Cons :: Maybe h -> Pattern t -> Pattern (h ': t) + + +-- Unlike (:), (:>) does not have to be quoted on type level. +data RevPattern :: RevList * -> * where + RevNil :: RevPattern RNil + RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h) + + +data Tuple :: (*, *) -> * where + Tuple :: a -> b -> Tuple '(a, b) -- cgit v1.2.3 From 6e0fe19f52445f0a231073b3eff116924d631588 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 13 Jul 2015 19:26:45 +0200 Subject: Add basic HTML test case for checking instance specialization. --- html-test/src/Instances.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 html-test/src/Instances.hs (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs new file mode 100644 index 00000000..d0d68dc3 --- /dev/null +++ b/html-test/src/Instances.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} + + +module Instances where + + +class Foo f where + + foo :: f Int -> a -> f a + foo' :: f (f a) -> Int -> f (f Int) + + foo = undefined + foo' = undefined + +instance Foo Maybe +instance Foo [] +instance (Eq a, Foo f) => Foo ((,) (f a)) +instance Foo (Either a) +instance Foo ((,,) a a) + + +class Foo f => Bar f a where + + bar :: f a -> f Bool -> a + bar' :: f (f a) -> f (f (f b)) + + bar = undefined + bar' = undefined + +instance Bar Maybe Bool +instance Bar Maybe [a] +instance Bar [] (a, a) +instance Foo f => Bar (Either a) (f a) +instance Foo ((,,) a b) => Bar ((,,) a b) (a, b, a) -- cgit v1.2.3 From a314ebd0af69cc1f6c76bfd8242d88d47277fcda Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 20 Jul 2015 18:16:26 +0200 Subject: Add some test cases for type renamer. --- html-test/src/Instances.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index d0d68dc3..8e237fe7 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ImpredicativeTypes #-} module Instances where @@ -34,3 +35,20 @@ instance Bar Maybe [a] instance Bar [] (a, a) instance Foo f => Bar (Either a) (f a) instance Foo ((,,) a b) => Bar ((,,) a b) (a, b, a) + + +class Baz a where + + baz :: a -> (forall a. a -> a) -> (b, forall c. c -> a) -> (b, c) + baz' :: b -> (forall b. b -> a) -> (forall b. b -> a) -> [(b, a)] + baz'' :: b -> (forall b. (forall b. b -> a) -> c) -> (forall c. c -> b) + + baz = undefined + baz' = undefined + baz'' = undefined + + +instance Baz (a -> b) +instance Baz [c] +instance Baz (a, b, c) +instance Baz (a, [b], b, a) -- cgit v1.2.3 From dbe6f2ce44d28cbd0cad7e5ed3b9e1766fdae8ee Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Tue, 21 Jul 2015 14:47:35 +0200 Subject: Extend instances test case to also test multi-name type signatures. --- html-test/src/Instances.hs | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index 8e237fe7..85c21754 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -26,9 +26,13 @@ class Foo f => Bar f a where bar :: f a -> f Bool -> a bar' :: f (f a) -> f (f (f b)) + bar0, bar1 :: (f a, f a) -> (f b, f c) bar = undefined bar' = undefined + bar0 = undefined + bar1 = undefined + instance Bar Maybe Bool instance Bar Maybe [a] -- cgit v1.2.3 From 2d9b75f5f656aecbc30410350a6e9059a78b1516 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Tue, 21 Jul 2015 14:49:58 +0200 Subject: Fix tab-based indentation in instances test case. --- html-test/src/Instances.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index 85c21754..9886fb69 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -43,13 +43,13 @@ instance Foo ((,,) a b) => Bar ((,,) a b) (a, b, a) class Baz a where - baz :: a -> (forall a. a -> a) -> (b, forall c. c -> a) -> (b, c) - baz' :: b -> (forall b. b -> a) -> (forall b. b -> a) -> [(b, a)] - baz'' :: b -> (forall b. (forall b. b -> a) -> c) -> (forall c. c -> b) + baz :: a -> (forall a. a -> a) -> (b, forall c. c -> a) -> (b, c) + baz' :: b -> (forall b. b -> a) -> (forall b. b -> a) -> [(b, a)] + baz'' :: b -> (forall b. (forall b. b -> a) -> c) -> (forall c. c -> b) - baz = undefined - baz' = undefined - baz'' = undefined + baz = undefined + baz' = undefined + baz'' = undefined instance Baz (a -> b) -- cgit v1.2.3 From 1700278e2d5978d098f2acb610442df2bc0ae02a Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Tue, 21 Jul 2015 19:29:58 +0200 Subject: Add new data type declaration to instance specialization test case. --- html-test/src/Instances.hs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index 9886fb69..58bdc873 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -56,3 +56,10 @@ instance Baz (a -> b) instance Baz [c] instance Baz (a, b, c) instance Baz (a, [b], b, a) + + +data Quux a b c = Qx a | Qux a b | Quux a b c + +instance Foo (Quux a b) +instance Bar (Quux a c) (Quux a b c) +instance Baz (Quux a b c) -- cgit v1.2.3 From 3827f2557a52c78ead03350d9e8576278b649745 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Wed, 29 Jul 2015 09:37:41 +0200 Subject: Add basic tests for associated types in instances test case. --- html-test/src/Instances.hs | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index 58bdc873..b7bc8921 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE TypeFamilies #-} module Instances where @@ -63,3 +64,30 @@ data Quux a b c = Qx a | Qux a b | Quux a b c instance Foo (Quux a b) instance Bar (Quux a c) (Quux a b c) instance Baz (Quux a b c) + + +class Norf a b where + + type Plugh a c b + data Thud a c + + norf :: Plugh a c b -> a -> (a -> c) -> b + + norf = undefined + + +instance Norf Int Bool where + + type Plugh Int [a] Bool = a + type Plugh Int (a, b) Bool = (a, [b]) + + data Thud Int (Quux a [a] c) = Thuud a | Thuuud Int Int + data Thud Int [a] = Thuuuud Bool + + +instance Norf [a] [b] where + + type Plugh [a] (Maybe a) [b] = a + type Plugh [a] [b] [b] = Quux a b (a, b) + + data Thud [a] (a, a, a) = Thd a -- cgit v1.2.3 From 25ea9a3a8fab29490d0957f3b4e55e03458183d2 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Wed, 5 Aug 2015 21:08:42 +0200 Subject: Add examples with type operators to the instances test case. --- html-test/src/Instances.hs | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'html-test/src') diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs index b7bc8921..545c8534 100644 --- a/html-test/src/Instances.hs +++ b/html-test/src/Instances.hs @@ -3,11 +3,15 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Instances where +newtype (<~~) a b = Xyzzy (b -> (a, a)) + + class Foo f where foo :: f Int -> a -> f a @@ -21,6 +25,8 @@ instance Foo [] instance (Eq a, Foo f) => Foo ((,) (f a)) instance Foo (Either a) instance Foo ((,,) a a) +instance Foo ((->) a) +instance Foo ((<~~) a) class Foo f => Bar f a where -- cgit v1.2.3