aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Names.hs2
-rw-r--r--haddock-api/src/Haddock/Convert.hs11
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs28
-rw-r--r--haddock-api/src/Haddock/Types.hs2
8 files changed, 34 insertions, 18 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 40106491..86a73c33 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -85,7 +85,7 @@ dropHsDocTy = f
f (HsDocTy a _) = f $ unL a
f x = x
-outHsType :: (OutputableBndrId a, HasOccNameId a)
+outHsType :: (OutputableBndrId a)
=> DynFlags -> HsType a -> String
outHsType dflags = out dflags . dropHsDocTy
@@ -182,6 +182,7 @@ ppClass dflags decl subdocs = (out dflags decl{tcdSigs=[]} ++ ppTyFams) : ppMet
tyFamEqnToSyn tfe = SynDecl
{ tcdLName = tfe_tycon tfe
, tcdTyVars = tfe_pats tfe
+ , tcdFixity = tfe_fixity tfe
, tcdRhs = tfe_rhs tfe
, tcdFVs = emptyNameSet
}
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 1d9fbe20..aff61cfc 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -118,7 +118,7 @@ decls (group, _, _, _) = concatMap ($ group)
where
typ (GHC.L _ t) = case t of
GHC.DataDecl { tcdLName = name } -> pure . decl $ name
- GHC.SynDecl name _ _ _ -> pure . decl $ name
+ GHC.SynDecl name _ _ _ _ -> pure . decl $ name
GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
fun term = case cast term of
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 8e9fd7ae..9fd55e49 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -47,7 +47,7 @@ import Data.Function
import Data.Ord ( comparing )
import DynFlags (Language(..))
-import GHC hiding ( NoLink, moduleInfo,FunctionFixity(..) )
+import GHC hiding ( NoLink, moduleInfo,LexicalFixity(..) )
import Name
import Module
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 499d9e11..adee2b67 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -34,7 +34,7 @@ import qualified Data.Map as Map
import Data.Maybe
import Text.XHtml hiding ( name, title, p, quote )
-import GHC hiding (FunctionFixity(..))
+import GHC hiding (LexicalFixity(..))
import GHC.Exts
import Name
import BooleanFormula
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index 0f4dd51a..a84a55e8 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -26,7 +26,7 @@ import Text.XHtml hiding ( name, title, p, quote )
import qualified Data.Map as M
import qualified Data.List as List
-import GHC hiding (FunctionFixity(..))
+import GHC hiding (LexicalFixity(..))
import Name
import RdrName
import FastString (unpackFS)
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index a99c5886..6cf77de0 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -17,7 +17,7 @@ module Haddock.Convert where
-- instance heads, which aren't TyThings, so just export everything.
import Bag ( emptyBag )
-import BasicTypes ( TupleSort(..), SourceText(..) )
+import BasicTypes ( TupleSort(..), SourceText(..), LexicalFixity(..) )
import Class
import CoAxiom
import ConLike
@@ -77,6 +77,7 @@ tyThingToLHsDecl t = case t of
{ tcdCtxt = synifyCtx (classSCTheta cl)
, tcdLName = synifyName cl
, tcdTyVars = synifyTyVars (classTyVars cl)
+ , tcdFixity = Prefix
, tcdFDs = map (\ (l,r) -> noLoc
(map (noLoc . getName) l, map (noLoc . getName) r) ) $
snd $ classTvsFds cl
@@ -114,6 +115,7 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
in TyFamEqn { tfe_tycon = name
, tfe_pats = HsIB { hsib_body = typats
, hsib_vars = map tyVarName tkvs }
+ , tfe_fixity = Prefix
, tfe_rhs = hs_rhs }
synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl Name)
@@ -146,6 +148,8 @@ synifyTyCon _coax tc
alphaTyVars --a, b, c... which are unfortunately all kind *
, hsq_dependent = emptyNameSet }
+ , tcdFixity = Prefix
+
, tcdDataDefn = HsDataDefn { dd_ND = DataType -- arbitrary lie, they are neither
-- algebraic data nor newtype:
, dd_ctxt = noLoc []
@@ -180,6 +184,7 @@ synifyTyCon _coax tc
FamilyDecl { fdInfo = i
, fdLName = synifyName tc
, fdTyVars = synifyTyVars (tyConTyVars tc)
+ , fdFixity = Prefix
, fdResultSig =
synifyFamilyResultSig resultVar (tyConResKind tc)
, fdInjectivityAnn =
@@ -191,6 +196,7 @@ synifyTyCon coax tc
| Just ty <- synTyConRhs_maybe tc
= return $ SynDecl { tcdLName = synifyName tc
, tcdTyVars = synifyTyVars (tyConTyVars tc)
+ , tcdFixity = Prefix
, tcdRhs = synifyType WithinType ty
, tcdFVs = placeHolderNamesTc }
| otherwise =
@@ -233,7 +239,8 @@ synifyTyCon coax tc
, dd_derivs = alg_deriv }
in case lefts consRaw of
[] -> return $
- DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
+ DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdFixity = Prefix
+ , tcdDataDefn = defn
, tcdDataCusk = False, tcdFVs = placeHolderNamesTc }
dataConErrs -> Left $ unlines dataConErrs
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 40a10675..f88d9f4e 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -344,19 +344,19 @@ renameTyClD d = case d of
decl' <- renameFamilyDecl decl
return (FamDecl { tcdFam = decl' })
- SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = _fvs } -> do
+ SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs, tcdFVs = _fvs } -> do
lname' <- renameL lname
tyvars' <- renameLHsQTyVars tyvars
rhs' <- renameLType rhs
- return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = placeHolderNames })
+ return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdRhs = rhs', tcdFVs = placeHolderNames })
- DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = _fvs } -> do
+ DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn, tcdFVs = _fvs } -> do
lname' <- renameL lname
tyvars' <- renameLHsQTyVars tyvars
defn' <- renameDataDefn defn
- return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
+ return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
- ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
+ ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
lcontext' <- renameLContext lcontext
lname' <- renameL lname
@@ -367,6 +367,7 @@ renameTyClD d = case d of
at_defs' <- mapM renameLTyFamDefltEqn at_defs
-- we don't need the default methods or the already collected doc entities
return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
+ , tcdFixity = fixity
, tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
, tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames })
@@ -380,7 +381,9 @@ renameTyClD d = case d of
renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName)
renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
- , fdTyVars = ltyvars, fdResultSig = result
+ , fdTyVars = ltyvars
+ , fdFixity = fixity
+ , fdResultSig = result
, fdInjectivityAnn = injectivity }) = do
info' <- renameFamilyInfo info
lname' <- renameL lname
@@ -388,7 +391,9 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
result' <- renameFamilyResultSig result
injectivity' <- renameMaybeInjectivityAnn injectivity
return (FamilyDecl { fdInfo = info', fdLName = lname'
- , fdTyVars = ltyvars', fdResultSig = result'
+ , fdTyVars = ltyvars'
+ , fdFixity = fixity
+ , fdResultSig = result'
, fdInjectivityAnn = injectivity' })
@@ -537,30 +542,33 @@ renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
, tfid_fvs = placeHolderNames }) }
renameLTyFamInstEqn :: LTyFamInstEqn Name -> RnM (LTyFamInstEqn DocName)
-renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs }))
+renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_fixity = fixity, tfe_rhs = rhs }))
= do { tc' <- renameL tc
; pats' <- renameImplicit (mapM renameLType) pats
; rhs' <- renameLType rhs
; return (L loc (TyFamEqn { tfe_tycon = tc'
, tfe_pats = pats'
+ , tfe_fixity = fixity
, tfe_rhs = rhs' })) }
renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName)
-renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_rhs = rhs }))
+renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_fixity = fixity, tfe_rhs = rhs }))
= do { tc' <- renameL tc
; tvs' <- renameLHsQTyVars tvs
; rhs' <- renameLType rhs
; return (L loc (TyFamEqn { tfe_tycon = tc'
, tfe_pats = tvs'
+ , tfe_fixity = fixity
, tfe_rhs = rhs' })) }
renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName)
-renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats, dfid_defn = defn })
+renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats, dfid_fixity = fixity, dfid_defn = defn })
= do { tc' <- renameL tc
; pats' <- renameImplicit (mapM renameLType) pats
; defn' <- renameDataDefn defn
; return (DataFamInstDecl { dfid_tycon = tc'
, dfid_pats = pats'
+ , dfid_fixity = fixity
, dfid_defn = defn', dfid_fvs = placeHolderNames }) }
renameImplicit :: (in_thing -> RnM out_thing)
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 951faf5b..1f446224 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -344,7 +344,7 @@ data InstType name
| TypeInst (Maybe (HsType name)) -- ^ Body (right-hand side)
| DataInst (TyClDecl name) -- ^ Data constructors
-instance (OutputableBndrId a, HasOccNameId a)
+instance (OutputableBndrId a)
=> Outputable (InstType a) where
ppr (ClassInst { .. }) = text "ClassInst"
<+> ppr clsiCtx
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 02:01:16 +0000