diff options
Diffstat (limited to 'haddock-api/src/Haddock/GhcUtils.hs')
| -rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 23 | 
1 files changed, 18 insertions, 5 deletions
| diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 83e4dbd8..561c126f 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 #-}  ----------------------------------------------------------------------------- @@ -17,17 +17,14 @@ module Haddock.GhcUtils where  import Control.Arrow -import Data.Function  import Exception  import Outputable  import Name +import NameSet  import Lexeme  import Module -import RdrName (GlobalRdrEnv) -import GhcMonad (withSession)  import HscTypes -import UniqFM  import GHC  import Class @@ -92,6 +89,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 @@ -114,6 +115,7 @@ sigNameNoLoc _                         = []  isUserLSig :: LSig name -> Bool  isUserLSig (L _(TypeSig {}))    = True  isUserLSig (L _(ClassOpSig {})) = True +isUserLSig (L _(PatSynSig {}))  = True  isUserLSig _                    = False @@ -134,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  ------------------------------------------------------------------------------- | 
