From 65fccc0fec773a745b1b6363aa5c0cd433949830 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 25 Apr 2017 07:16:05 +0200 Subject: Use new MathJax URL in html-test 18ed871afb82560d5433b2f53e31b4db9353a74e switched to a new MathJax URL but didn't update the tests. --- html-test/ref/PatternSyns.html | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'html-test/ref/PatternSyns.html') diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 70e9230b..242803c2 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -6,7 +6,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/B.html b/html-test/ref/B.html index b1e43a51..f4ce89d4 100644 --- a/html-test/ref/B.html +++ b/html-test/ref/B.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bold.html b/html-test/ref/Bold.html index d8f8b3d4..a7cb4e7f 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/Bold.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug1.html b/html-test/ref/Bug1.html index 5ea4ff26..37a37527 100644 --- a/html-test/ref/Bug1.html +++ b/html-test/ref/Bug1.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug195.html b/html-test/ref/Bug195.html index b7f10741..ca5c2cc0 100644 --- a/html-test/ref/Bug195.html +++ b/html-test/ref/Bug195.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug2.html b/html-test/ref/Bug2.html index 98d7f06d..5b88feae 100644 --- a/html-test/ref/Bug2.html +++ b/html-test/ref/Bug2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug201.html b/html-test/ref/Bug201.html index 19cb1aae..04cb0991 100644 --- a/html-test/ref/Bug201.html +++ b/html-test/ref/Bug201.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug253.html b/html-test/ref/Bug253.html index 2210b023..28482b24 100644 --- a/html-test/ref/Bug253.html +++ b/html-test/ref/Bug253.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html index 9382a738..8b0644aa 100644 --- a/html-test/ref/Bug26.html +++ b/html-test/ref/Bug26.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug280.html b/html-test/ref/Bug280.html index fa8ca0de..6c533a28 100644 --- a/html-test/ref/Bug280.html +++ b/html-test/ref/Bug280.html @@ -1,4 +1,3 @@ -

CopyrightFoo
Bar
BazBar
Baz

Description

The module description

+> \ No newline at end of file diff --git a/html-test/ref/Bug294.html b/html-test/ref/Bug294.html index 44aad9d1..3a82af80 100644 --- a/html-test/ref/Bug294.html +++ b/html-test/ref/Bug294.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug298.html b/html-test/ref/Bug298.html index a748e92a..cba626b6 100644 --- a/html-test/ref/Bug298.html +++ b/html-test/ref/Bug298.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug3.html b/html-test/ref/Bug3.html index d5f589ed..4a9cf8bc 100644 --- a/html-test/ref/Bug3.html +++ b/html-test/ref/Bug3.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug308.html b/html-test/ref/Bug308.html index 03f287d5..d816fef5 100644 --- a/html-test/ref/Bug308.html +++ b/html-test/ref/Bug308.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug308CrossModule.html b/html-test/ref/Bug308CrossModule.html index d9ed0b19..60f371af 100644 --- a/html-test/ref/Bug308CrossModule.html +++ b/html-test/ref/Bug308CrossModule.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug310.html b/html-test/ref/Bug310.html index 2ba8dfb9..468e64eb 100644 --- a/html-test/ref/Bug310.html +++ b/html-test/ref/Bug310.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug313.html b/html-test/ref/Bug313.html index a6573eaa..4fc1682c 100644 --- a/html-test/ref/Bug313.html +++ b/html-test/ref/Bug313.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug335.html b/html-test/ref/Bug335.html index f9eec481..d1602c7b 100644 --- a/html-test/ref/Bug335.html +++ b/html-test/ref/Bug335.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html index 6305a38d..27d47e75 100644 --- a/html-test/ref/Bug387.html +++ b/html-test/ref/Bug387.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug4.html b/html-test/ref/Bug4.html index 722d4102..fe6f47d1 100644 --- a/html-test/ref/Bug4.html +++ b/html-test/ref/Bug4.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug6.html b/html-test/ref/Bug6.html index 34fc4054..678f4070 100644 --- a/html-test/ref/Bug6.html +++ b/html-test/ref/Bug6.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug7.html b/html-test/ref/Bug7.html index cf6f2f2a..ef26d62f 100644 --- a/html-test/ref/Bug7.html +++ b/html-test/ref/Bug7.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html index d6cef1b2..1b6c1525 100644 --- a/html-test/ref/Bug8.html +++ b/html-test/ref/Bug8.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/BugDeprecated.html b/html-test/ref/BugDeprecated.html index 2fb509d8..96fdab34 100644 --- a/html-test/ref/BugDeprecated.html +++ b/html-test/ref/BugDeprecated.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/BugExportHeadings.html b/html-test/ref/BugExportHeadings.html index 8d444e26..2a05bed9 100644 --- a/html-test/ref/BugExportHeadings.html +++ b/html-test/ref/BugExportHeadings.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bugs.html b/html-test/ref/Bugs.html index b83036c8..c29004f3 100644 --- a/html-test/ref/Bugs.html +++ b/html-test/ref/Bugs.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html index ac14b0d4..f055f36f 100644 --- a/html-test/ref/DeprecatedClass.html +++ b/html-test/ref/DeprecatedClass.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedData.html b/html-test/ref/DeprecatedData.html index 248de4cb..aeb2a7c8 100644 --- a/html-test/ref/DeprecatedData.html +++ b/html-test/ref/DeprecatedData.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction.html b/html-test/ref/DeprecatedFunction.html index 59206ac9..f4381d96 100644 --- a/html-test/ref/DeprecatedFunction.html +++ b/html-test/ref/DeprecatedFunction.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction2.html b/html-test/ref/DeprecatedFunction2.html index 36159359..b8985bcd 100644 --- a/html-test/ref/DeprecatedFunction2.html +++ b/html-test/ref/DeprecatedFunction2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction3.html b/html-test/ref/DeprecatedFunction3.html index 1bfc7d90..b62e1ee3 100644 --- a/html-test/ref/DeprecatedFunction3.html +++ b/html-test/ref/DeprecatedFunction3.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedModule.html b/html-test/ref/DeprecatedModule.html index a6b2e0e8..84c7a885 100644 --- a/html-test/ref/DeprecatedModule.html +++ b/html-test/ref/DeprecatedModule.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedModule2.html b/html-test/ref/DeprecatedModule2.html index bd7a7f31..862f79ee 100644 --- a/html-test/ref/DeprecatedModule2.html +++ b/html-test/ref/DeprecatedModule2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedNewtype.html b/html-test/ref/DeprecatedNewtype.html index 3d826f57..a03d63fb 100644 --- a/html-test/ref/DeprecatedNewtype.html +++ b/html-test/ref/DeprecatedNewtype.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedReExport.html b/html-test/ref/DeprecatedReExport.html index e5a3c38c..52f2b8e9 100644 --- a/html-test/ref/DeprecatedReExport.html +++ b/html-test/ref/DeprecatedReExport.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedRecord.html b/html-test/ref/DeprecatedRecord.html index ff217c4d..79b7b7f9 100644 --- a/html-test/ref/DeprecatedRecord.html +++ b/html-test/ref/DeprecatedRecord.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedTypeFamily.html b/html-test/ref/DeprecatedTypeFamily.html index 4a5028f3..1d94e99b 100644 --- a/html-test/ref/DeprecatedTypeFamily.html +++ b/html-test/ref/DeprecatedTypeFamily.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedTypeSynonym.html b/html-test/ref/DeprecatedTypeSynonym.html index 8f1896df..cb7a3afe 100644 --- a/html-test/ref/DeprecatedTypeSynonym.html +++ b/html-test/ref/DeprecatedTypeSynonym.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Examples.html b/html-test/ref/Examples.html index 7f742f2f..f706eef1 100644 --- a/html-test/ref/Examples.html +++ b/html-test/ref/Examples.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Extensions.html b/html-test/ref/Extensions.html index 01dde2d3..e21785c0 100644 --- a/html-test/ref/Extensions.html +++ b/html-test/ref/Extensions.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index 4c285c41..df597e12 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/GADTRecords.html b/html-test/ref/GADTRecords.html index 6c091ac3..3b036aae 100644 --- a/html-test/ref/GADTRecords.html +++ b/html-test/ref/GADTRecords.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html index ac422955..4ad1c27e 100644 --- a/html-test/ref/Hash.html +++ b/html-test/ref/Hash.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/HiddenInstances.html b/html-test/ref/HiddenInstances.html index 5071e702..8c7312d7 100644 --- a/html-test/ref/HiddenInstances.html +++ b/html-test/ref/HiddenInstances.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/HiddenInstancesB.html b/html-test/ref/HiddenInstancesB.html index b3cf9ef9..77af69d0 100644 --- a/html-test/ref/HiddenInstancesB.html +++ b/html-test/ref/HiddenInstancesB.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Hyperlinks.html b/html-test/ref/Hyperlinks.html index 66b14d7a..db1953e3 100644 --- a/html-test/ref/Hyperlinks.html +++ b/html-test/ref/Hyperlinks.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/IgnoreExports.html index 235d601c..262bb769 100644 --- a/html-test/ref/IgnoreExports.html +++ b/html-test/ref/IgnoreExports.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index c08a565a..d22e7f4c 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index ba6ef185..b014e8df 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Minimal.html b/html-test/ref/Minimal.html index ac28b0d9..b7507bd7 100644 --- a/html-test/ref/Minimal.html +++ b/html-test/ref/Minimal.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NamedDoc.html b/html-test/ref/NamedDoc.html index 631f2043..a10aa305 100644 --- a/html-test/ref/NamedDoc.html +++ b/html-test/ref/NamedDoc.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index 370c6a88..7ce0c0d8 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NoLayout.html b/html-test/ref/NoLayout.html index d8148b0e..43352864 100644 --- a/html-test/ref/NoLayout.html +++ b/html-test/ref/NoLayout.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NonGreedy.html b/html-test/ref/NonGreedy.html index c389fc6a..6ed1563f 100644 --- a/html-test/ref/NonGreedy.html +++ b/html-test/ref/NonGreedy.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html index 27b3427d..d498a906 100644 --- a/html-test/ref/Operators.html +++ b/html-test/ref/Operators.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/OrphanInstancesClass.html b/html-test/ref/OrphanInstancesClass.html index 98641d0b..93594d90 100644 --- a/html-test/ref/OrphanInstancesClass.html +++ b/html-test/ref/OrphanInstancesClass.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/OrphanInstancesType.html b/html-test/ref/OrphanInstancesType.html index d616edf9..5d7a76c9 100644 --- a/html-test/ref/OrphanInstancesType.html +++ b/html-test/ref/OrphanInstancesType.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 2052d87c..9f0caaa2 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Properties.html b/html-test/ref/Properties.html index 27f3a93a..4ce37acd 100644 --- a/html-test/ref/Properties.html +++ b/html-test/ref/Properties.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/PruneWithWarning.html b/html-test/ref/PruneWithWarning.html index 7523c657..e714ec21 100644 --- a/html-test/ref/PruneWithWarning.html +++ b/html-test/ref/PruneWithWarning.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/QuasiExpr.html b/html-test/ref/QuasiExpr.html index c51ac526..0b5b8054 100644 --- a/html-test/ref/QuasiExpr.html +++ b/html-test/ref/QuasiExpr.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/QuasiQuote.html b/html-test/ref/QuasiQuote.html index 251c48dc..4919e48d 100644 --- a/html-test/ref/QuasiQuote.html +++ b/html-test/ref/QuasiQuote.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 285ab05c..b7c707c5 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TH2.html b/html-test/ref/TH2.html index 71bc1083..5562cb67 100644 --- a/html-test/ref/TH2.html +++ b/html-test/ref/TH2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Threaded.html b/html-test/ref/Threaded.html index bb31f300..ac6a66b9 100644 --- a/html-test/ref/Threaded.html +++ b/html-test/ref/Threaded.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Threaded_TH.html b/html-test/ref/Threaded_TH.html index 2890ca6b..89f276c9 100644 --- a/html-test/ref/Threaded_TH.html +++ b/html-test/ref/Threaded_TH.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Ticket61.html b/html-test/ref/Ticket61.html index cb9ba8bd..cfc2e7f7 100644 --- a/html-test/ref/Ticket61.html +++ b/html-test/ref/Ticket61.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Ticket75.html b/html-test/ref/Ticket75.html index 07e75296..616f5d47 100644 --- a/html-test/ref/Ticket75.html +++ b/html-test/ref/Ticket75.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TitledPicture.html b/html-test/ref/TitledPicture.html index 04d1476b..927631f8 100644 --- a/html-test/ref/TitledPicture.html +++ b/html-test/ref/TitledPicture.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index db6ee1c3..c6301a56 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html index 156486d0..65ab0317 100644 --- a/html-test/ref/TypeFamilies2.html +++ b/html-test/ref/TypeFamilies2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index 53428892..b461ac71 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Unicode.html b/html-test/ref/Unicode.html index 59f715e8..ae1d4293 100644 --- a/html-test/ref/Unicode.html +++ b/html-test/ref/Unicode.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Visible.html b/html-test/ref/Visible.html index 47568b65..d9b8cd11 100644 --- a/html-test/ref/Visible.html +++ b/html-test/ref/Visible.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/haddock-util.js b/html-test/ref/haddock-util.js index 92d07d2a..05bdaef5 100644 --- a/html-test/ref/haddock-util.js +++ b/html-test/ref/haddock-util.js @@ -1,7 +1,7 @@ // Haddock JavaScript utilities var rspace = /\s\s+/g, - rtrim = /^\s+|\s+$/g; + rtrim = /^\s+|\s+$/g; function spaced(s) { return (" " + s + " ").replace(rspace, " "); } function trim(s) { return s.replace(rtrim, ""); } @@ -109,136 +109,6 @@ function getCookie(name) { return null; } - - -var max_results = 75; // 50 is not enough to search for map in the base libraries -var shown_range = null; -var last_search = null; - -function quick_search() -{ - perform_search(false); -} - -function full_search() -{ - perform_search(true); -} - - -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)); - - if (first == -1) - { - table.className = ""; - status.innerHTML = "No results found, displaying all"; - } - else if (first == 0 && last == children.length - 1) - { - table.className = ""; - status.innerHTML = ""; - } - else if (last - first >= max_results && !full) - { - table.className = ""; - status.innerHTML = "More than " + max_results + ", press Search to display"; - } - else - { - // decide what you need to clear/show - if (shown_range) - setclass(shown_range[0], shown_range[1], "indexrow"); - setclass(first, last, "indexshow"); - shown_range = [first, last]; - table.className = "indexsearch"; - status.innerHTML = ""; - } - - - function setclass(first, last, status) - { - for (var i = first; i <= last; i++) - { - 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) - { - var first = 0, finish = children.length - 1; - var mid, success = false; - - while (finish - first > 3) - { - mid = Math.floor((finish + first) / 2); - - var i = checkitem(mid); - if (i == 0) i = dir; - if (i == -1) - finish = mid; - else - first = mid; - } - var a = (dir == 1 ? first : finish); - var b = (dir == 1 ? finish : first); - for (var i = b; i != a - dir; i -= dir) - { - 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) - { - var s = getitem(i).toLowerCase().substr(0, text.length); - if (s == text) return 0; - else return (s > text ? -1 : 1); - } - - - // from an index, get its string - // this abstracts over alternates - function getitem(i) - { - for ( ; i >= 0; i--) - { - var s = children[i].firstChild.firstChild.data; - if (s.indexOf(' ') == -1) - return s; - } - return ""; // should never be reached - } -} - -function setSynopsis(filename) { - if (parent.window.synopsis && parent.window.synopsis.location) { - if (parent.window.synopsis.location.replace) { - // In Firefox this avoids adding the change to the history. - parent.window.synopsis.location.replace(filename); - } else { - parent.window.synopsis.location = filename; - } - } -} - function addMenuItem(html) { var menu = document.getElementById("page-menu"); if (menu) { -- cgit v1.2.3 From bfb3563f730fd1c973a6611a0fba3435fb1df489 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sat, 3 Jun 2017 20:37:28 +0200 Subject: Allow user defined signatures for pattern synonyms (#631) --- CHANGES.md | 2 ++ haddock-api/src/Haddock/GhcUtils.hs | 5 +++++ haddock-api/src/Haddock/Interface/Create.hs | 1 + html-test/ref/PatternSyns.html | 29 +++++++++++++++++++++++++++++ html-test/src/PatternSyns.hs | 5 +++++ 5 files changed, 42 insertions(+) (limited to 'html-test/ref/PatternSyns.html') diff --git a/CHANGES.md b/CHANGES.md index 6c2b5d32..95e1763a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,7 @@ ## Changes in version 2.18.0 + * Support user defined signatures on pattern synonyms + * Synopsis is working again (#599) ## Changes in version 2.17.4 diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index dcc1d834..4280cd80 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -88,6 +88,10 @@ filterSigNames p (ClassOpSig is_default ns ty) = case filter (p . unLoc) ns of [] -> Nothing filtered -> Just (ClassOpSig is_default filtered ty) +filterSigNames p (PatSynSig ns ty) = + case filter (p . unLoc) ns of + [] -> Nothing + filtered -> Just (PatSynSig filtered ty) filterSigNames _ _ = Nothing ifTrueJust :: Bool -> name -> Maybe name @@ -110,6 +114,7 @@ sigNameNoLoc _ = [] isUserLSig :: LSig name -> Bool isUserLSig (L _(TypeSig {})) = True isUserLSig (L _(ClassOpSig {})) = True +isUserLSig (L _(PatSynSig {})) = True isUserLSig _ = False diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 26ac0281..98d4dbe8 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -842,6 +842,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap expandSig :: Sig name -> [Sig name] expandSig (TypeSig names t) = [ TypeSig [n] t | n <- names ] expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ] + expandSig (PatSynSig names t) = [ PatSynSig [n] t | n <- names ] expandSig x = [x] mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name)) diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 9f0caaa2..2cf936b3 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -118,6 +118,16 @@ window.onload = function () {pageLoad();}; > k a (b :: k). (><) k a b

pattern PatWithExplicitSig :: Eq somex => somex -> FooType somex

pattern PatWithExplicitSig :: Eq somex => somex -> FooType somex #

Earlier ghc versions didn't allow explicit signatures + on pattern synonyms.

< b = Empty -- | Pattern for 'Empty' pattern E = Empty + +-- | Earlier ghc versions didn't allow explicit signatures +-- on pattern synonyms. +pattern PatWithExplicitSig :: Eq somex => somex -> FooType somex +pattern PatWithExplicitSig x = FooCtor x -- cgit v1.2.3 From 3fddb62913c72f29843335aa796c2e444ded1608 Mon Sep 17 00:00:00 2001 From: Tim Baumann Date: Sun, 6 Aug 2017 11:33:38 +0200 Subject: Fix: Generate pattern signatures for constructors exported as patterns (#663) * Fix pretty-printing of pattern signatures Pattern synonyms can have up to two contexts, both having a different semantic meaning: The first holds the constraints required to perform the matching, the second contains the constraints provided by a successful pattern match. When the first context is empty but the second is not it is necessary to render the first, empty context. * Generate pattern synonym signatures for ctors exported as patterns This fixes #653. * Simplify extractPatternSyn It is not necessary to generate the simplest type signature since it will be simplified when pretty-printed. * Add changelog entries for PR #663 * Fix extractPatternSyn error message --- CHANGES.md | 5 + haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 242 ++++++++++++++----------- haddock-api/src/Haddock/Interface/Create.hs | 34 +++- haddock-api/src/Haddock/Types.hs | 6 + html-test/ref/ConstructorPatternExport.html | 124 +++++++++++++ html-test/ref/PatternSyns.html | 76 ++++++++ html-test/src/ConstructorPatternExport.hs | 26 +++ html-test/src/PatternSyns.hs | 8 +- 8 files changed, 412 insertions(+), 109 deletions(-) create mode 100644 html-test/ref/ConstructorPatternExport.html create mode 100644 html-test/src/ConstructorPatternExport.hs (limited to 'html-test/ref/PatternSyns.html') diff --git a/CHANGES.md b/CHANGES.md index 5050339d..f96ac325 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,11 @@ * Move markup related data types to haddock-library + * Fix: Show empty constraint contexts in pattern type signatures (#663) + + * Fix: Generate constraint signatures for constructors exported as pattern + synonyms (#663) + ## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index cda0611a..c78bee2d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -71,9 +71,9 @@ ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> Splice -> Unicode -> Qualification -> Html ppFunSig summary links loc doc docnames typ fixities splice unicode qual = ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ) - splice unicode qual + splice unicode qual HideEmptyContexts where - pp_typ = ppLType unicode qual typ + pp_typ = ppLType unicode qual HideEmptyContexts typ ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> [Located DocName] -> LHsSigType DocName -> @@ -87,20 +87,20 @@ ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode pref1 = hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName -> [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) -> - Splice -> Unicode -> Qualification -> Html + Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) - splice unicode qual = + splice unicode qual emptyCtxts = ppTypeOrFunSig summary links loc docnames typ doc ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames , dcolon unicode ) - splice unicode qual + splice unicode qual emptyCtxts where occnames = map (nameOccName . getName) docnames addFixities html @@ -110,8 +110,8 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName -> DocForDecl DocName -> (Html, Html, Html) - -> Splice -> Unicode -> Qualification -> Html -ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual + -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts | summary = pref1 | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName qual doc | otherwise = topDeclElem links loc splice docnames pref2 +++ @@ -132,14 +132,14 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) | null (unLoc lctxt) = do_largs n leader ltype | otherwise - = (leader <+> ppLContextNoArrow lctxt unicode qual, Nothing, []) + = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, []) : do_largs n (darrow unicode) ltype do_args n leader (HsFunTy lt r) - = (leader <+> ppLFunLhType unicode qual lt, argDoc n, []) + = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, []) : do_largs (n+1) (arrow unicode) r do_args n leader t - = [(leader <+> ppType unicode qual t, argDoc n, [])] + = [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])] ppForAll :: [LHsTyVarBndr DocName] -> Unicode -> Qualification -> Html ppForAll tvs unicode qual = @@ -197,11 +197,11 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars splice unicode qual = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals) - splice unicode qual + splice unicode qual ShowEmptyToplevelContexts where hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars unicode qual (hsQTvExplicit ltyvars)) - full = hdr <+> equals <+> ppLType unicode qual ltype + full = hdr <+> equals <+> ppPatSigType unicode qual ltype occ = nameOccName . getName $ name fixs | summary = noHtml @@ -220,14 +220,14 @@ ppTyName :: Name -> Html ppTyName = ppName Prefix -ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> SrcSpan +ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan -> [DocName] -> HsType DocName -> Html -ppSimpleSig links splice unicode qual loc names typ = +ppSimpleSig links splice unicode qual emptyCtxts loc names typ = topDeclElem' names $ ppTypeSig True occNames ppTyp unicode where topDeclElem' = topDeclElem links loc splice - ppTyp = ppType unicode qual typ + ppTyp = ppType unicode qual emptyCtxts typ occNames = map getOccName names @@ -321,7 +321,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs , tfe_pats = HsIB { hsib_body = ts }} = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual - <+> equals <+> ppType unicode qual (unLoc rhs) + <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs) , Nothing, [] ) @@ -377,7 +377,7 @@ ppAppDocNameTyVarBndrs summ unicode qual n vs = ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Unicode -> Qualification -> Html ppAppNameTypes n ks ts unicode qual = - ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual) + ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts) -- | General printing of type applications @@ -398,32 +398,35 @@ ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts) ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode - -> Qualification -> Html + -> Qualification -> HideEmptyContexts -> Html ppLContext = ppContext . unLoc ppLContextNoArrow = ppContextNoArrow . unLoc -ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> Html -ppContextNoArrow cxt unicode qual = fromMaybe noHtml $ - ppContextNoLocsMaybe (map unLoc cxt) unicode qual +ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $ + ppContextNoLocsMaybe (map unLoc cxt) unicode qual emptyCtxts -ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> Html -ppContextNoLocs cxt unicode qual = maybe noHtml (<+> darrow unicode) $ - ppContextNoLocsMaybe cxt unicode qual +ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContextNoLocs cxt unicode qual emptyCtxts = maybe noHtml (<+> darrow unicode) $ + ppContextNoLocsMaybe cxt unicode qual emptyCtxts -ppContextNoLocsMaybe :: [HsType DocName] -> Unicode -> Qualification -> Maybe Html -ppContextNoLocsMaybe [] _ _ = Nothing -ppContextNoLocsMaybe cxt unicode qual = Just $ ppHsContext cxt unicode qual +ppContextNoLocsMaybe :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html +ppContextNoLocsMaybe [] _ _ emptyCtxts = + case emptyCtxts of + HideEmptyContexts -> Nothing + ShowEmptyToplevelContexts -> Just (toHtml "()") +ppContextNoLocsMaybe cxt unicode qual _ = Just $ ppHsContext cxt unicode qual -ppContext :: HsContext DocName -> Unicode -> Qualification -> Html -ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual +ppContext :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContext cxt unicode qual emptyCtxts = ppContextNoLocs (map unLoc cxt) unicode qual emptyCtxts -ppHsContext :: [HsType DocName] -> Unicode -> Qualification-> Html -ppHsContext [] _ _ = noHtml +ppHsContext :: [HsType DocName] -> Unicode -> Qualification -> Html +ppHsContext [] _ _ = noHtml ppHsContext [p] unicode qual = ppCtxType unicode qual p -ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt) +ppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyContexts) cxt) ------------------------------------------------------------------------------- @@ -436,7 +439,7 @@ ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName -> Unicode -> Qualification -> Html ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" - <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml) + <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual HideEmptyContexts else noHtml) <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicit tvs) <+> ppFds fds unicode qual @@ -592,7 +595,7 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = case ihdInstType of ClassInst { .. } -> - ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ + ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ , mdoc , [subInstDetails iid ats sigs] ) @@ -607,7 +610,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = where ptype = keyword "type" <+> typ prhs = ptype <+> maybe noHtml - (\t -> equals <+> ppType unicode qual t) rhs + (\t -> equals <+> ppType unicode qual HideEmptyContexts t) rhs DataInst dd -> ( subInstHead iid pdata , mdoc @@ -636,9 +639,9 @@ ppInstanceSigs links splice unicode qual sigs = do TypeSig lnames typ <- sigs let names = map unLoc lnames L _ rtyp = hsSigWcType typ - -- Instance methods signatures are synified and thus don't have a useful + -- Instance methods signatures are synified and thus don't have a useful -- SrcSpan value. Use the methods name location instead. - return $ ppSimpleSig links splice unicode qual (getLoc $ head $ lnames) names rtyp + return $ ppSimpleSig links splice unicode qual HideEmptyContexts (getLoc $ head $ lnames) names rtyp lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2 @@ -698,7 +701,7 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual pats1 = [ hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] | (SigD (PatSynSig lnames typ),_) <- pats ] @@ -744,7 +747,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats [ (hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] <+> ppFixities subfixs qual ,combineDocumentation (fst d), []) | (SigD (PatSynSig lnames typ),d) <- pats @@ -769,17 +772,17 @@ ppShortConstrParts summary dataInst con unicode qual = case con of ConDeclH98{} -> case con_details con of PrefixCon args -> (header_ unicode qual +++ hsep (ppOcc - : map (ppLParendType unicode qual) args), noHtml, noHtml) + : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml) RecCon (L _ fields) -> (header_ unicode qual +++ ppOcc <+> char '{', doRecordFields fields, char '}') InfixCon arg1 arg2 -> - (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1, - ppOccInfix, ppLParendType unicode qual arg2], + (header_ unicode qual +++ hsep [ppLParendType unicode qual HideEmptyContexts arg1, + ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2], noHtml, noHtml) - ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual resTy,noHtml,noHtml) + ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml) where resTy = hsib_body (con_type con) @@ -811,7 +814,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual = (if null tvs then noHtml else ppForall) +++ (if null ctxt then noHtml - else ppContextNoArrow ctxt unicode qual + else ppContextNoArrow ctxt unicode qual HideEmptyContexts <+> darrow unicode +++ toHtml " ") where ppForall | forall_ = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs) @@ -827,15 +830,15 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) ConDeclH98{} -> case con_details con of PrefixCon args -> hsep ((header_ +++ ppOcc) - : map (ppLParendType unicode qual) args) + : map (ppLParendType unicode qual HideEmptyContexts) args) <+> fixity RecCon _ -> header_ +++ ppOcc <+> fixity InfixCon arg1 arg2 -> - hsep [header_ +++ ppLParendType unicode qual arg1, + hsep [header_ +++ ppLParendType unicode qual HideEmptyContexts arg1, ppOccInfix, - ppLParendType unicode qual arg2] + ppLParendType unicode qual HideEmptyContexts arg2] <+> fixity ConDeclGADT{} -> doGADTCon resTy @@ -852,7 +855,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) doGADTCon :: Located (HsType DocName) -> Html doGADTCon ty = ppOcc <+> dcolon unicode -- ++AZ++ make this prepend "{..}" when it is a record style GADT - <+> ppLType unicode qual ty + <+> ppLType unicode qual HideEmptyContexts ty <+> fixity fixity = ppFixities fixities qual @@ -879,9 +882,12 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification -> ConDeclField DocName -> SubDecl ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) = - (hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype, - mbDoc, - []) + ( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) + <+> dcolon unicode + <+> ppLType unicode qual HideEmptyContexts ltype + , mbDoc + , [] + ) where -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation @@ -891,7 +897,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) = ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html ppShortField summary unicode qual (ConDeclField names ltype _) = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) - <+> dcolon unicode <+> ppLType unicode qual ltype + <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype -- | Print the LHS of a data\/newtype declaration. @@ -906,7 +912,7 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn = (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+> -- context - ppLContext ctxt unicode qual <+> + ppLContext ctxt unicode qual HideEmptyContexts <+> -- T a b c ..., or a :+: b ppDataBinderWithVars summary unicode qual decl <+> case ks of @@ -958,19 +964,18 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p | otherwise = p -ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification - -> Located (HsType DocName) -> Html -ppLType unicode qual y = ppType unicode qual (unLoc y) -ppLParendType unicode qual y = ppParendType unicode qual (unLoc y) -ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y) +ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocName) -> Html +ppLType unicode qual emptyCtxts y = ppType unicode qual emptyCtxts (unLoc y) +ppLParendType unicode qual emptyCtxts y = ppParendType unicode qual emptyCtxts (unLoc y) +ppLFunLhType unicode qual emptyCtxts y = ppFunLhType unicode qual emptyCtxts (unLoc y) +ppCtxType :: Unicode -> Qualification -> HsType DocName -> Html +ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual HideEmptyContexts -ppType, ppCtxType, ppParendType, ppFunLhType :: Unicode -> Qualification - -> HsType DocName -> Html -ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual -ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual -ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual -ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual +ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocName -> Html +ppType unicode qual emptyCtxts ty = ppr_mono_ty pREC_TOP ty unicode qual emptyCtxts +ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual emptyCtxts +ppFunLhType unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html ppHsTyVarBndr _ qual (UserTyVar (L _ name)) = @@ -983,62 +988,85 @@ ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y) ppKind :: Unicode -> Qualification -> HsKind DocName -> Html -ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual +ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts + +ppPatSigType :: Unicode -> Qualification -> LHsType DocName -> Html +ppPatSigType unicode qual typ = + let emptyCtxts = + if hasNonEmptyContext typ && isFirstContextEmpty typ + then ShowEmptyToplevelContexts + else HideEmptyContexts + in ppLType unicode qual emptyCtxts typ + where + 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 + _ -> False + isFirstContextEmpty :: LHsType name -> Bool + isFirstContextEmpty t = + case unLoc t of + HsForAllTy _ s -> isFirstContextEmpty s + HsQualTy cxt _ -> null (unLoc cxt) + HsFunTy _ s -> isFirstContextEmpty s + _ -> False ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> Html ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot -ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html +ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) -ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html -ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual +ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts = maybeParen ctxt_prec pREC_FUN $ - ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual + ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts -ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual +ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts = maybeParen ctxt_prec pREC_FUN $ - ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual + ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts -- UnicodeSyntax alternatives -ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ +ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ _ | getOccString (getName name) == "*" = toHtml "★" | getOccString (getName name) == "(->)" = toHtml "(→)" -ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty -ppr_mono_ty _ (HsTyVar _ (L _ name)) _ q = ppDocName q Prefix True name -ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q -ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys) -ppr_mono_ty _ (HsSumTy tys) u q = sumParens (map (ppLType u q) tys) -ppr_mono_ty _ (HsKindSig ty kind) u q = - parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) -ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q) -ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q) -ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q = - maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q -ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy" -ppr_mono_ty _ (HsRecTy {}) _ _ = toHtml "{..}" +ppr_mono_ty _ (HsBangTy b ty) u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty +ppr_mono_ty _ (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name +ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e +ppr_mono_ty _ (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys) +ppr_mono_ty _ (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys) +ppr_mono_ty _ (HsKindSig ty kind) u q e = + parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind) +ppr_mono_ty _ (HsListTy ty) u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts) +ppr_mono_ty _ (HsPArrTy ty) u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts) +ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q _ = + maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts +ppr_mono_ty _ (HsSpliceTy {}) _ _ _ = error "ppr_mono_ty HsSpliceTy" +ppr_mono_ty _ (HsRecTy {}) _ _ _ = toHtml "{..}" -- Can now legally occur in ConDeclGADT, the output here is to provide a -- placeholder in the signature, which is followed by the field -- declarations. -ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy" -ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys -ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u q = brackets $ hsep $ punctuate comma $ map (ppLType u q) tys -ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = promoQuote $ parenList $ map (ppLType u q) tys -ppr_mono_ty _ (HsAppsTy {}) _ _ = error "ppr_mono_ty HsAppsTy" +ppr_mono_ty _ (HsCoreTy {}) _ _ _ = error "ppr_mono_ty HsCoreTy" +ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsAppsTy {}) _ _ _ = error "ppr_mono_ty HsAppsTy" -ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual +ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _ = maybeParen ctxt_prec pREC_CTX $ - ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual + ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts -ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual +ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual _ = maybeParen ctxt_prec pREC_CON $ - hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual] + hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts] -ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual +ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _ = maybeParen ctxt_prec pREC_FUN $ - ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual + ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts where -- `(:)` is valid in type signature only as constructor to promoted list -- and needs to be quoted in code so we explicitly quote it here too. @@ -1047,25 +1075,25 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual | otherwise = ppr_op' ppr_op' = ppLDocName qual Infix op -ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual +ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts -- = parens (ppr_mono_lty pREC_TOP ty) - = ppr_mono_lty ctxt_prec ty unicode qual + = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts -ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual - = ppr_mono_lty ctxt_prec ty unicode qual +ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts + = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts -ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_' -ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n +ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_' +ppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n ppr_tylit :: HsTyLit -> Html ppr_tylit (HsNumTy _ n) = toHtml (show n) ppr_tylit (HsStrTy _ s) = toHtml (show s) -ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html -ppr_fun_ty ctxt_prec ty1 ty2 unicode qual - = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual - p2 = ppr_mono_lty pREC_TOP ty2 unicode qual +ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppr_fun_ty ctxt_prec ty1 ty2 unicode qual emptyCtxts + = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual HideEmptyContexts + p2 = ppr_mono_lty pREC_TOP ty2 unicode qual emptyCtxts in maybeParen ctxt_prec pREC_FUN $ hsep [p1, arrow unicode <+> p2] diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index b9179d11..89f7f71b 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -985,7 +985,9 @@ extractDecl name decl O.$$ O.nest 4 (O.ppr matches)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) - in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) + in if isDataConName name + then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d)) + else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n , dfid_pats = HsIB { hsib_body = tys } , dfid_defn = defn }) -> @@ -1003,6 +1005,36 @@ extractDecl name decl _ -> error "internal: extractDecl (ClsInstD)" _ -> error "internal: extractDecl" +extractPatternSyn :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name +extractPatternSyn nm t tvs cons = + case filter matches cons of + [] -> error "extractPatternSyn: constructor pattern not found" + con:_ -> extract <$> con + where + matches :: LConDecl Name -> Bool + matches (L _ con) = nm `elem` (unLoc <$> getConNames con) + extract :: ConDecl Name -> Sig Name + extract con = + let args = + case getConDetails con of + PrefixCon args' -> args' + RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields + InfixCon arg1 arg2 -> [arg1, arg2] + typ = longArrow args (data_ty con) + typ' = + case con of + ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ) + _ -> typ + typ'' = noLoc (HsQualTy (noLoc []) typ') + in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'') + + longArrow :: [LHsType name] -> LHsType name -> LHsType name + longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs + + data_ty con + | ConDeclGADT{} <- con = hsib_body $ con_type con + | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs + extractRecSel :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name extractRecSel _ _ _ [] = error "extractRecSel: selector not found" diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index de599bd8..724f59bc 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -579,6 +579,12 @@ makeModuleQual qual aliases mdl = OptFullQual -> FullQual OptNoQual -> NoQual +-- | Whether to hide empty contexts +-- Since pattern synonyms have two contexts with different semantics, it is +-- important to all of them, even if one of them is empty. +data HideEmptyContexts + = HideEmptyContexts + | ShowEmptyToplevelContexts ----------------------------------------------------------------------------- -- * Error handling diff --git a/html-test/ref/ConstructorPatternExport.html b/html-test/ref/ConstructorPatternExport.html new file mode 100644 index 00000000..20f00d0f --- /dev/null +++ b/html-test/ref/ConstructorPatternExport.html @@ -0,0 +1,124 @@ +ConstructorPatternExport

Safe Haskell	Safe

ConstructorPatternExport

Documentation

pattern FooCons :: String -> a -> Foo a #

pattern MyRecCons :: Bool -> Int -> MyRec #

pattern (:+) :: String -> a -> MyInfix a #

pattern BlubCons :: () => Show b => b -> Blub #

pattern MyGADTCons :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String) #

\ No newline at end of file diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 2cf936b3..37596645 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -99,6 +99,28 @@ window.onload = function () {pageLoad();}; >FooType x1))

data BlubType = Show x => BlubCtor x

pattern Blub :: () => forall x. Show x => x -> BlubType

data (a ::

data BlubType #

BlubType is existentially quantified

Constructors

Show x => BlubCtor x

pattern Blub :: () => forall x. Show x => x -> BlubType #

Pattern synonym for Blub x

data BlubCons b + +data MyGADT :: * -> * where + MyGADTCons :: forall a. Eq a => a -> Int -> MyGADT (Maybe String) + +pattern MyGADTCons' :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String) +pattern MyGADTCons' x y = MyGADTCons x y \ No newline at end of file diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs index a8de113c..bf0f7848 100644 --- a/html-test/src/PatternSyns.hs +++ b/html-test/src/PatternSyns.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternSynonyms, PolyKinds, TypeOperators #-} +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, PolyKinds, TypeOperators #-} -- | Testing some pattern synonyms module PatternSyns where @@ -15,6 +15,12 @@ pattern Bar x = FooCtor (Foo x) -- | Pattern synonym for (':<->') pattern x :<-> y = (Foo x, Bar y) +-- | BlubType is existentially quantified +data BlubType = forall x. Show x => BlubCtor x + +-- | Pattern synonym for 'Blub' x +pattern Blub x = BlubCtor x + -- | Doc for ('><') data (a :: *) >< b = Empty -- cgit v1.2.3