aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs15
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs7
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs2
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs15
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs14
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs13
-rw-r--r--haddock-api/src/Haddock/Parser.hs22
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 19:55:17 +0000