From ed43757aa371f9a532665783e27cff1703b4ac90 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Mon, 17 Dec 2018 09:25:10 -0500
Subject: 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
---
 haddock-api/src/Haddock/Interface/AttachInstances.hs | 14 ++------------
 haddock-api/src/Haddock/Interface/Specialize.hs      | 13 ++++++-------
 2 files changed, 8 insertions(+), 19 deletions(-)

(limited to 'haddock-api/src/Haddock/Interface')

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
-- 
cgit v1.2.3