aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-12-17 09:25:10 -0500
committerGitHub <noreply@github.com>2018-12-17 09:25:10 -0500
commited43757aa371f9a532665783e27cff1703b4ac90 (patch)
treed797068322124edcd022ebb1a2873a8b7157f0bf /haddock-api/src/Haddock/Interface
parent1380f7fa048ba26f79944452722dff0800b49038 (diff)
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
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs14
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs13
2 files changed, 8 insertions, 19 deletions
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