diff options
| -rw-r--r-- | CHANGES.md | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 5 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 1 | ||||
| -rw-r--r-- | html-test/ref/PatternSyns.html | 29 | ||||
| -rw-r--r-- | html-test/src/PatternSyns.hs | 5 |
5 files changed, 42 insertions, 0 deletions
@@ -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). <a href="#" >(><)</a > k a b</li + ><li class="src short" + ><span class="keyword" + >pattern</span + > <a href="#" + >PatWithExplicitSig</a + > :: <a href="#" + >Eq</a + > somex => somex -> <a href="#" + >FooType</a + > somex</li ></ul ></div ><div id="interface" @@ -279,6 +289,25 @@ window.onload = function () {pageLoad();}; ></p ></div ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >pattern</span + > <a id="v:PatWithExplicitSig" class="def" + >PatWithExplicitSig</a + > :: <a href="#" + >Eq</a + > somex => somex -> <a href="#" + >FooType</a + > somex <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >Earlier ghc versions didn't allow explicit signatures + on pattern synonyms.</p + ></div + ></div ></div ></div ><div id="footer" diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs index 8af5eb23..a8de113c 100644 --- a/html-test/src/PatternSyns.hs +++ b/html-test/src/PatternSyns.hs @@ -20,3 +20,8 @@ data (a :: *) >< 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 |