From 29bb1ce86e12b368c4eb91dbf515391a0958b8c3 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Thu, 2 Jul 2015 19:05:58 +0200 Subject: Create hyperlinker test case for type classes. --- hypsrc-test/src/Classes.hs | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 hypsrc-test/src/Classes.hs (limited to 'hypsrc-test/src/Classes.hs') diff --git a/hypsrc-test/src/Classes.hs b/hypsrc-test/src/Classes.hs new file mode 100644 index 00000000..bddb9939 --- /dev/null +++ b/hypsrc-test/src/Classes.hs @@ -0,0 +1,38 @@ +module Classes where + + +class Foo a where + bar :: a -> Int + baz :: Int -> (a, a) + +instance Foo Int where + bar = id + baz x = (x, x) + +instance Foo [a] where + bar = length + baz _ = ([], []) + + +class Foo a => Foo' a where + quux :: (a, a) -> a + quux (x, y) = norf [x, y] + + norf :: [a] -> a + norf = quux . baz . sum . map bar + +instance Foo' Int where + norf = sum + +instance Foo' [a] where + quux = uncurry (++) + + +class Plugh p where + plugh :: p a a -> p b b -> p (a -> b) (b -> a) + +instance Plugh Either where + plugh (Left a) _ = Right $ const a + plugh (Right a) _ = Right $ const a + plugh _ (Left b) = Left $ const b + plugh _ (Right b) = Left $ const b -- 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 'hypsrc-test/src/Classes.hs') 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