Haddock support for bundled pattern synonyms (#627)

* Haddock support for bundled pattern synonyms

* Add fixities to bundled pattern synonyms

* Add bundled pattern synonyms to the synopsis

* Store bundled pattern fixities in expItemFixities

* Add test for bundled pattern synonyms

* Stop threading fixities

* Include bundled pattern synonyms for re-exported data types

Sadly, fixity information isn't found for re-exported data types

* Support for pattern synonyms

* Modify tests after #631

* Test some reexport variations

* Also lookup bundled pattern synonyms from `InstalledInterface`s

* Check isExported for bundled pattern synonyms

* Pattern synonym is exported check

* Always look for pattern synonyms in the current module

Another overlooked cornercase

* Account for types named twice in export lists

Also introduce a fast function for nubbing on a `Name` and use it
throughout the code base.

* correct fixities for reexported pattern synonyms

* Fuse concatMap and map

* Remove obsolete import

* Add pattern synonyms to visible exports

* Fix test

* Remove corner case

1 files changed, 13 insertions, 1 deletions

diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 4280cd80..02867833 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, ViewPatterns #-}
+{-# LANGUAGE BangPatterns, FlexibleInstances, ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
@@ -21,6 +21,7 @@ import Control.Arrow
 import Exception
 import Outputable
 import Name
+import NameSet
 import Lexeme
 import Module
 import HscTypes
@@ -135,6 +136,17 @@ declATs _ = []
 pretty :: Outputable a => DynFlags -> a -> String
 pretty = showPpr
 
+nubByName :: (a -> Name) -> [a] -> [a]
+nubByName f ns = go emptyNameSet ns
+  where
+    go !_ [] = []
+    go !s (x:xs)
+      | y `elemNameSet` s = go s xs
+      | otherwise         = let !s' = extendNameSet s y
+                            in x : go s' xs
+      where
+        y = f x
+
 -------------------------------------------------------------------------------
 -- * Located
 -------------------------------------------------------------------------------