Refactor names + unused functions (#982)

This commit should not introduce any change in functionality!

  * consistently use `getOccString` to convert `Name`s to strings
  * compare names directly when possible (instead of comparing strings)
  * get rid of unused utility functions

7 files changed, 26 insertions, 62 deletions

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index b66116bb..1222b3f1 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1049,8 +1049,8 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode
 ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode
   = ppr_mono_lty ty1 unicode <+> ppr_op <+> ppr_mono_lty ty2 unicode
   where
-    ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
-    occName = nameOccName . getName . unLoc $ op
+    ppr_op | isSymOcc (getOccName op) = ppLDocName op
+           | otherwise = char '`' <> ppLDocName op <> char '`'
 
 ppr_mono_ty (HsParTy _ ty) unicode
   = parens (ppr_mono_lty ty unicode)
@@ -1079,16 +1079,13 @@ ppr_tylit (HsStrTy _ s) _ = text (show s)
 
 ppBinder :: OccName -> LaTeX
 ppBinder n
-  | isInfixName n = parens $ ppOccName n
-  | otherwise     = ppOccName n
+  | isSymOcc n = parens $ ppOccName n
+  | otherwise  = ppOccName n
 
 ppBinderInfix :: OccName -> LaTeX
 ppBinderInfix n
-  | isInfixName n = ppOccName n
-  | otherwise     = cat [ char '`', ppOccName n, char '`' ]
-
-isInfixName :: OccName -> Bool
-isInfixName n = isVarSym n || isConSym n
+  | isSymOcc n = ppOccName n
+  | otherwise  = cat [ char '`', ppOccName n, char '`' ]
 
 ppSymName :: Name -> LaTeX
 ppSymName name
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index da8f7a53..9add4cae 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -39,7 +39,7 @@ import Haddock.GhcUtils
 import Control.Monad         ( when, unless )
 import qualified Data.ByteString.Builder as Builder
 import Data.Char             ( toUpper, isSpace )
-import Data.List             ( sortBy, isPrefixOf, intercalate, intersperse )
+import Data.List             ( sortBy, isPrefixOf, intersperse )
 import Data.Maybe
 import System.Directory
 import System.FilePath hiding ( (</>) )
@@ -388,7 +388,7 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = d
       | Just item_html <- processExport True links_info unicode pkg qual item
       = [ Object
             [ "display_html" .= String (showHtmlFragment item_html)
-            , "name"         .= String (intercalate " " (map nameString names))
+            , "name"         .= String (unwords (map getOccString names))
             , "module"       .= String (moduleString mdl)
             , "link"         .= String (fromMaybe "" (listToMaybe (map (nameLink mdl) names)))
             ]
@@ -406,9 +406,6 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = d
     exportName ExportNoDecl { expItemName } = [expItemName]
     exportName _ = []
 
-    nameString :: NamedThing name => name -> String
-    nameString = occNameString . nameOccName . getName
-
     nameLink :: NamedThing name => Module -> name -> String
     nameLink mdl = moduleNameUrl' (moduleName mdl) . nameOccName . getName
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 395c0837..4492739b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -696,7 +696,7 @@ instanceId origin no orphan ihd = concat $
     [ "o:" | orphan ] ++
     [ qual origin
     , ":" ++ getOccString origin
-    , ":" ++ (occNameString . getOccName . ihdClsName) ihd
+    , ":" ++ getOccString (ihdClsName ihd)
     , ":" ++ show no
     ]
   where
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 1acfb25b..7f45bb61 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -25,7 +25,6 @@ import Exception
 import Outputable
 import Name
 import NameSet
-import Lexeme
 import Module
 import HscTypes
 import GHC
@@ -39,14 +38,6 @@ moduleString = moduleNameString . moduleName
 isNameSym :: Name -> Bool
 isNameSym = isSymOcc . nameOccName
 
-
-isVarSym :: OccName -> Bool
-isVarSym = isLexVarSym . occNameFS
-
-isConSym :: OccName -> Bool
-isConSym = isLexConSym . occNameFS
-
-
 getMainDeclBinder :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
                      HsDecl p -> [IdP p]
 getMainDeclBinder (TyClD _ d) = [tcdName d]
@@ -141,12 +132,6 @@ isValD :: HsDecl a -> Bool
 isValD (ValD _ _) = True
 isValD _ = False
 
-
-declATs :: HsDecl a -> [IdP a]
-declATs (TyClD _ d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d
-declATs _ = []
-
-
 pretty :: Outputable a => DynFlags -> a -> String
 pretty = showPpr
 
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 8f7abd16..dd6c70a5 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
+{-# LANGUAGE MagicHash, BangPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
@@ -32,7 +32,6 @@ import DynFlags
 import CoreSyn (isOrphan)
 import ErrUtils
 import FamInstEnv
-import FastString
 import GHC
 import InstEnv
 import Module ( ModuleSet, moduleSetElts )
@@ -40,13 +39,11 @@ import MonadUtils (liftIO)
 import Name
 import NameEnv
 import Outputable (text, sep, (<+>))
-import PrelNames
 import SrcLoc
 import TyCon
 import TyCoRep
-import TysPrim( funTyCon )
+import TysPrim( funTyConName )
 import Var hiding (varName)
-#define FSLIT(x) (mkFastString# (x#))
 
 type ExportedNames = Set.Set Name
 type Modules = Set.Set Module
@@ -224,13 +221,6 @@ instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
   = (map argCount ts, n, map simplify ts, argCount t, simplify t)
 
 
-funTyConName :: Name
-funTyConName = mkWiredInName gHC_PRIM
-                        (mkOccNameFS tcName FSLIT("(->)"))
-                        funTyConKey
-                        (ATyCon funTyCon)       -- Relevant TyCon
-                        BuiltInSyntax
-
 --------------------------------------------------------------------------------
 -- Filtering hidden instances
 --------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index e9511e3d..5ab3a7ee 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -15,6 +15,8 @@ import Haddock.Types
 import GHC
 import Name
 import FastString
+import TysPrim ( funTyConName )
+import TysWiredIn ( listTyConName )
 
 import Control.Monad
 import Control.Monad.Trans.State
@@ -110,10 +112,7 @@ sugar = sugarOperators . sugarTuples . sugarLists
 
 sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
 sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp)
-    | isBuiltInSyntax name' && strName == "[]" = HsListTy NoExt ltyp
-  where
-    name' = getName name
-    strName = occNameString . nameOccName $ name'
+    | getName name == listTyConName = HsListTy NoExt ltyp
 sugarLists typ = typ
 
 
@@ -127,7 +126,7 @@ sugarTuples typ =
         | isBuiltInSyntax name' && suitable = HsTupleTy NoExt HsBoxedTuple apps
       where
         name' = getName name
-        strName = occNameString . nameOccName $ name'
+        strName = getOccString name
         suitable = case parseTupleArity strName of
             Just arity -> arity == length apps
             Nothing -> False
@@ -137,7 +136,7 @@ sugarTuples typ =
 sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
 sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
     | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
-    | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy NoExt la lb
+    | funTyConName == name' = HsFunTy NoExt la lb
   where
     name' = getName name
 sugarOperators typ = typ
@@ -182,7 +181,7 @@ parseTupleArity _ = Nothing
 type NameRep = FastString
 
 getNameRep :: NamedThing name => name -> NameRep
-getNameRep = occNameFS . getOccName
+getNameRep = getOccFS
 
 nameRepString :: NameRep -> String
 nameRepString = unpackFS
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
index 58500f1b..e31ea6a8 100644
--- a/haddock-api/src/Haddock/Parser.hs
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving
-             , FlexibleInstances, UndecidableInstances
-             , IncoherentInstances #-}
-{-# LANGUAGE LambdaCase #-}
 -- |
 -- Module      :  Haddock.Parser
 -- Copyright   :  (c) Mateusz Kowalczyk 2013,
@@ -19,14 +14,15 @@ module Haddock.Parser ( parseParas
                       ) where
 
 import qualified Documentation.Haddock.Parser as P
-import DynFlags (DynFlags)
-import FastString (mkFastString)
 import Documentation.Haddock.Types
-import Lexer (mkPState, unP, ParseResult(POk))
-import Parser (parseIdentifier)
-import RdrName (RdrName)
-import SrcLoc (mkRealSrcLoc, unLoc)
-import StringBuffer (stringToStringBuffer)
+
+import DynFlags     ( DynFlags )
+import FastString   ( fsLit )
+import Lexer        ( mkPState, unP, ParseResult(POk) )
+import Parser       ( parseIdentifier )
+import RdrName      ( RdrName )
+import SrcLoc       ( mkRealSrcLoc, unLoc )
+import StringBuffer ( stringToStringBuffer )
 
 parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName
 parseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p
@@ -37,7 +33,7 @@ parseString d = P.overIdentifier (parseIdent d) . P.parseString
 parseIdent :: DynFlags -> String -> Maybe RdrName
 parseIdent dflags str0 =
   let buffer = stringToStringBuffer str0
-      realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
+      realSrcLc = mkRealSrcLoc (fsLit "<unknown file>") 0 0
       pstate = mkPState dflags buffer realSrcLc
   in case unP parseIdentifier pstate of
     POk _ name -> Just (unLoc name)