From c2e89153c0aaf2dc4e3908701f19d739eb0d8b93 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 15 Jan 2016 11:14:35 +0200
Subject: Update to match wip/T11430 in GHC

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a7a0a2d6..cb6b8cf2 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -164,7 +164,7 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
       _:[] -> const noHtml -- Don't display names for fixities on single names
       _    -> concatHtml . intersperse (stringToHtml ", ") . map (ppDocName qual Infix False)
 
-    uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs
+    uniq_fs = [ (n, the p, the d') | (n, Fixity _ p d) <- fs
                                    , let d' = ppDir d
                                    , then group by Down (p,d') using groupWith ]
 
-- 
cgit v1.2.3


From 2da130a8db8f995c119b544fad807533236cf088 Mon Sep 17 00:00:00 2001
From: RyanGlScott <ryan.gl.scott@gmail.com>
Date: Thu, 11 Feb 2016 15:42:42 -0500
Subject: Collapse type/data family instances by default

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 15 ++++++++++-----
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 18 +++++++++++++-----
 2 files changed, 23 insertions(+), 10 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index cb6b8cf2..151589ff 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -594,20 +594,25 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
             , [subInstDetails iid ats sigs]
             )
           where
-            iid = instanceId origin no orphan ihd
             sigs = ppInstanceSigs links splice unicode qual clsiSigs
             ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys
         TypeInst rhs ->
-            (ptype, mdoc, [])
+            ( subInstHead iid ptype
+            , mdoc
+            , [subFamInstDetails iid prhs]
+            )
           where
-            ptype = keyword "type" <+> typ <+> prhs
+            ptype = keyword "type" <+> typ
             prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
         DataInst dd ->
-            (pdata, mdoc, [])
+            ( subInstHead iid pdata
+            , mdoc
+            , [subFamInstDetails iid pdecl])
           where
-            pdata = keyword "data" <+> typ <+> pdecl
+            pdata = keyword "data" <+> typ
             pdecl = ppShortDataDecl False True dd unicode qual
   where
+    iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 98df09fe..367eec4d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,8 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances, subOrphanInstances, subInstHead, subInstDetails,
+  subInstances, subOrphanInstances,
+  subInstHead, subInstDetails, subFamInstDetails,
   subMethods,
   subMinimal,
 
@@ -178,7 +179,6 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc
 subConstructors :: Qualification -> [SubDecl] -> Html
 subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
 
-
 subFields :: Qualification -> [SubDecl] -> Html
 subFields qual = divSubDecls "fields" "Fields" . subDlist qual
 
@@ -225,10 +225,18 @@ subInstDetails :: String -- ^ Instance unique id (for anchor generation)
                -> [Html] -- ^ Method contents (pretty-printed signatures)
                -> Html
 subInstDetails iid ats mets =
-    section << (subAssociatedTypes ats <+> subMethods mets)
-  where
-    section = thediv ! collapseSection (instAnchorId iid) False "inst-details"
+    subInstSection iid << (subAssociatedTypes ats <+> subMethods mets)
+
+subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
+                  -> Html   -- ^ Type or data family instance
+                  -> Html
+subFamInstDetails iid fi =
+    subInstSection iid << declElem fi
 
+subInstSection :: String -- ^ Instance unique id (for anchor generation)
+               -> Html
+               -> Html
+subInstSection iid = thediv ! collapseSection (instAnchorId iid) False "inst-details"
 
 instAnchorId :: String -> String
 instAnchorId iid = makeAnchorId $ "i:" ++ iid
-- 
cgit v1.2.3


From 1338b5d7c32939de6bbc31af0049477e4f847103 Mon Sep 17 00:00:00 2001
From: RyanGlScott <ryan.gl.scott@gmail.com>
Date: Thu, 11 Feb 2016 20:17:09 -0500
Subject: Ensure expanded family instances render correctly

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 5 +++--
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 2 +-
 2 files changed, 4 insertions(+), 3 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 151589ff..66bb21da 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -603,14 +603,15 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
             )
           where
             ptype = keyword "type" <+> typ
-            prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
+            prhs = ptype <+> maybe noHtml
+                                   (\t -> equals <+> ppType unicode qual t) rhs
         DataInst dd ->
             ( subInstHead iid pdata
             , mdoc
             , [subFamInstDetails iid pdecl])
           where
             pdata = keyword "data" <+> typ
-            pdecl = ppShortDataDecl False True dd unicode qual
+            pdecl = pdata <+> ppShortDataDecl False True dd unicode qual
   where
     iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 367eec4d..7fab3fea 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -231,7 +231,7 @@ subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
                   -> Html   -- ^ Type or data family instance
                   -> Html
 subFamInstDetails iid fi =
-    subInstSection iid << declElem fi
+    subInstSection iid << thediv ! [theclass "src"] << fi
 
 subInstSection :: String -- ^ Instance unique id (for anchor generation)
                -> Html
-- 
cgit v1.2.3


From bb994de1ab0c76d1aaf1e39c54158db2526d31f1 Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <eir@cis.upenn.edu>
Date: Mon, 14 Mar 2016 23:47:23 -0400
Subject: Changes due to fix for GHC#11648.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 +-
 haddock-api/src/Haddock/Backends/LaTeX.hs           | 2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs      | 4 ++--
 haddock-api/src/Haddock/Convert.hs                  | 9 ++++++---
 haddock-api/src/Haddock/Interface/Rename.hs         | 4 ++--
 haddock-api/src/Haddock/Utils.hs                    | 7 +++++--
 6 files changed, 17 insertions(+), 11 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index e8baae88..be17cb8b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -117,7 +117,7 @@ decls (group, _, _, _) = concatMap ($ group)
     ]
   where
     typ (GHC.L _ t) = case t of
-        GHC.DataDecl name _ _ _ -> pure . decl $ name
+        GHC.DataDecl { tcdLName = 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
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index b7be7ffb..81a23a1b 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -641,7 +641,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
     ppOcc   = case occ of
       [one] -> ppBinder one
       _     -> cat (punctuate comma (map ppBinder occ))
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
     context = unLoc (fromMaybe (noLoc []) (con_cxt con))
 
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 2f802aef..b354658d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -776,7 +776,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con of
       [one] -> ppBinderInfix summary one
       _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ))
 
-    ltvs     = fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)
+    ltvs     = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)
     tyVars   = tyvarNames ltvs
     lcontext = fromMaybe (noLoc []) (con_cxt con)
     context  = unLoc lcontext
@@ -846,7 +846,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
       [one] -> ppBinderInfix False one
       _     -> hsep (punctuate comma (map (ppBinderInfix False) occ))
 
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
     context = unLoc (fromMaybe (noLoc []) (con_cxt con))
     forall_ = False
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index fa6d801c..b651c86b 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -26,6 +26,7 @@ import DataCon
 import FamInstEnv
 import HsSyn
 import Name
+import NameSet ( emptyNameSet )
 import RdrName ( mkVarUnqual )
 import PatSyn
 import SrcLoc ( Located, noLoc, unLoc )
@@ -144,7 +145,7 @@ synifyTyCon _coax tc
                          in HsQTvs { hsq_implicit = []   -- No kind polymorphism
                                    , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc)))
                                                                 alphaTyVars --a, b, c... which are unfortunately all kind *
-                                   }
+                                   , hsq_dependent = emptyNameSet }
 
            , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither
                                                     -- algebraic data nor newtype:
@@ -154,6 +155,7 @@ synifyTyCon _coax tc
                                                -- we have their kind accurately:
                                       , dd_cons = []  -- No constructors
                                       , dd_derivs = Nothing }
+           , tcdDataCusk = False
            , tcdFVs = placeHolderNamesTc }
 
 synifyTyCon _coax tc
@@ -233,7 +235,7 @@ synifyTyCon coax tc
  in case lefts consRaw of
   [] -> return $
         DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
-                 , tcdFVs = placeHolderNamesTc }
+                 , tcdDataCusk = False, tcdFVs = placeHolderNamesTc }
   dataConErrs -> Left $ unlines dataConErrs
 
 synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity
@@ -322,7 +324,8 @@ synifyCtx = noLoc . map (synifyType WithinType)
 
 synifyTyVars :: [TyVar] -> LHsQTyVars Name
 synifyTyVars ktvs = HsQTvs { hsq_implicit = []
-                           , hsq_explicit = map synifyTyVar ktvs }
+                           , hsq_explicit = map synifyTyVar ktvs
+                           , hsq_dependent = emptyNameSet }
 
 synifyTyVar :: TyVar -> LHsTyVarBndr Name
 synifyTyVar tv
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 0f97ee3b..3054e2f9 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -270,7 +270,7 @@ renameType t = case t of
 renameLHsQTyVars :: LHsQTyVars Name -> RnM (LHsQTyVars DocName)
 renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs })
   = do { tvs' <- mapM renameLTyVarBndr tvs
-       ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs' }) }
+       ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs', hsq_dependent = error "haddock:renameLHsQTyVars" }) }
                 -- This is rather bogus, but I'm not sure what else to do
 
 renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
@@ -350,7 +350,7 @@ renameTyClD d = case d of
     lname'    <- renameL lname
     tyvars'   <- renameLHsQTyVars tyvars
     defn'     <- renameDataDefn defn
-    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames })
+    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
 
   ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
             , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 325dd710..58a7ef90 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -64,6 +64,7 @@ import Haddock.GhcUtils
 
 import GHC
 import Name
+import NameSet ( emptyNameSet )
 import HsTypes (selectorFieldOcc)
 
 import Control.Monad ( liftM )
@@ -201,7 +202,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
             c' = ConDeclH98
                    { con_name = head (con_names c)
                    , con_qvars = Just $ HsQTvs { hsq_implicit = mempty
-                                               , hsq_explicit = tvs }
+                                               , hsq_explicit = tvs
+                                               , hsq_dependent = emptyNameSet }
                    , con_cxt = Just cxt
                    , con_details = details
                    , con_doc = con_doc c
@@ -226,7 +228,8 @@ emptyHsQTvs :: LHsQTyVars Name
 -- does not necessarily have all the rigt kind variables.  It is used
 -- in Haddock just for printing, so it doesn't matter
 emptyHsQTvs = HsQTvs { hsq_implicit = error "haddock:emptyHsQTvs"
-                     , hsq_explicit = [] }
+                     , hsq_explicit = []
+                     , hsq_dependent = error "haddock:emptyHsQTvs" }
 
 
 --------------------------------------------------------------------------------
-- 
cgit v1.2.3


From 30f20af8c948f2c59799a16293c7c62508a7987b Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed, 4 May 2016 22:15:50 -0400
Subject: Render Haddocks for derived instances

Currently, one can document top-level instance declarations, but derived
instances (both those in `deriving` clauses and standalone `deriving`
instances) do not enjoy the same privilege. This makes the necessary
changes to the Haddock API to enable rendering Haddock comments for
derived instances.

This is part of a fix for Trac #11768.
---
 haddock-api/src/Haddock/Backends/LaTeX.hs      |  1 +
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs |  1 +
 haddock-api/src/Haddock/Interface/Create.hs    | 33 +++++++++++++++++---------
 haddock-api/src/Haddock/Interface/Rename.hs    | 10 ++++++++
 4 files changed, 34 insertions(+), 11 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 81a23a1b..85716f33 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -300,6 +300,7 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
       ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
   ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
   InstD _                        -> empty
+  DerivD _                       -> empty
   _                              -> error "declaration not supported by ppDecl"
   where
     unicode = False
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index fab6bf8d..2bd8c4ad 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -54,6 +54,7 @@ ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs spl
                                          ty fixities splice unicode qual
   ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
   InstD _                        -> noHtml
+  DerivD _                       -> noHtml
   _                              -> error "declaration not supported by ppDecl"
 
 
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index e3ae1175..00cec0cf 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -306,16 +306,16 @@ mkMaps dflags gre instances decls =
       where loc = case d of
               TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
               _ -> getInstLoc d
+    names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
     names _ decl = getMainDeclBinder decl
 
 -- Note [2]:
 ------------
--- We relate ClsInsts to InstDecls using the SrcSpans buried inside them.
--- That should work for normal user-written instances (from looking at GHC
--- sources). We can assume that commented instances are user-written.
--- This lets us relate Names (from ClsInsts) to comments (associated
--- with InstDecls).
-
+-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried
+-- inside them. That should work for normal user-written instances (from
+-- looking at GHC sources). We can assume that commented instances are
+-- user-written. This lets us relate Names (from ClsInsts) to comments
+-- (associated with InstDecls and DerivDecls).
 
 --------------------------------------------------------------------------------
 -- Declarations
@@ -339,7 +339,7 @@ subordinates instMap decl = case decl of
                    , name <- getMainDeclBinder d, not (isValD d)
                    ]
     dataSubs :: HsDataDefn Name -> [(Name, [HsDocString], Map Int HsDocString)]
-    dataSubs dd = constrs ++ fields
+    dataSubs dd = constrs ++ fields ++ derivs
       where
         cons = map unL $ (dd_cons dd)
         constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
@@ -348,6 +348,10 @@ subordinates instMap decl = case decl of
                   | RecCon flds <- map getConDetails cons
                   , L _ (ConDeclField ns _ doc) <- (unLoc flds)
                   , L _ n <- ns ]
+        derivs  = [ (instName, [unL doc], M.empty)
+                  | Just (L _ tys) <- [dd_derivs dd]
+                  , HsIB { hsib_body = L l (HsDocTy _ doc) } <- tys
+                  , Just instName <- [M.lookup l instMap] ]
 
 -- | Extract function argument docs from inside types.
 typeDocs :: HsDecl Name -> Map Int HsDocString
@@ -434,8 +438,9 @@ filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
 filterDecls = filter (isHandled . unL . fst)
   where
     isHandled (ForD (ForeignImport {})) = True
-    isHandled (TyClD {}) = True
-    isHandled (InstD {}) = True
+    isHandled (TyClD {})  = True
+    isHandled (InstD {})  = True
+    isHandled (DerivD {}) = True
     isHandled (SigD d) = isUserLSig (reL d)
     isHandled (ValD _) = True
     -- we keep doc declarations to be able to get at named docs
@@ -757,8 +762,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
       | otherwise = return Nothing
     mkExportItem decl@(L l (InstD d))
       | Just name <- M.lookup (getInstLoc d) instMap =
-        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
-        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+        expInst decl l name
+    mkExportItem decl@(L l (DerivD {}))
+      | Just name <- M.lookup l instMap =
+        expInst decl l name
     mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
       mdef <- liftGhcToErrMsgGhc $ minimalDef name
       let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
@@ -773,6 +780,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
     expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
       where (doc, subs) = lookupDocs name warnings docMap argMap subMap
 
+    expInst decl l name =
+        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
+        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+
 
 -- | Sometimes the declaration we want to export is not the "main" declaration:
 -- it might be an individual record selector or a class method.  In these
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 3054e2f9..1f3f2aab 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -328,6 +328,9 @@ renameDecl decl = case decl of
   InstD d -> do
     d' <- renameInstD d
     return (InstD d')
+  DerivD d -> do
+    d' <- renameDerivD d
+    return (DerivD d')
   _ -> error "renameDecl"
 
 renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName))
@@ -503,6 +506,13 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do
   d' <- renameDataFamInstD d
   return (DataFamInstD { dfid_inst = d' })
 
+renameDerivD :: DerivDecl Name -> RnM (DerivDecl DocName)
+renameDerivD (DerivDecl { deriv_type = ty
+                        , deriv_overlap_mode = omode }) = do
+  ty' <- renameLSigType ty
+  return (DerivDecl { deriv_type = ty'
+                    , deriv_overlap_mode = omode })
+
 renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
 renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
                             , cid_poly_ty =ltype, cid_tyfam_insts = lATs
-- 
cgit v1.2.3


From b8e3380f80da15b1e384ff56f992baac3fd7f3ee Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Tue, 24 May 2016 16:19:46 +0300
Subject: UnfelpfulSpan line number omitted

Kind of resolves https://github.com/haskell/haddock/issues/508
---
 haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 1d49807d..391bb50c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -75,8 +75,7 @@ spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
       case span_ of
       RealSrcSpan span__ ->
         show $ srcSpanStartLine span__
-      UnhelpfulSpan _ ->
-        error "spliceURL UnhelpfulSpan"
+      UnhelpfulSpan _ -> ""
 
   run "" = ""
   run ('%':'M':rest) = mdl  ++ run rest
-- 
cgit v1.2.3


From 7c60df10642d90d7205cb9c4296903b8de094029 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Tue, 24 May 2016 16:53:35 +0300
Subject: Change Hyperlinked lexer to know about DataKinds ticks

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 12 +++++++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs  |  3 +++
 2 files changed, 14 insertions(+), 1 deletion(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index e206413e..e4345602 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -31,12 +31,20 @@ chunk str@(c:_)
 chunk str
     | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
-    | otherwise = case lex str of
+    | otherwise = case lex' str of
         (tok:_) -> chunk' tok
         [] -> [str]
   where
     chunk' (c, rest) = c:(chunk rest)
 
+-- | A bit better lexer then the default, i.e. handles DataKinds quotes
+lex' :: ReadS String
+lex' ('\'' : '\'' : rest)              = [("''", rest)]
+lex' str@('\'' : '\\' : _ : '\'' : _)  = lex str
+lex' str@('\'' : _ : '\'' : _)         = lex str
+lex' ('\'' : rest)                     = [("'", rest)]
+lex' str                               = lex str
+
 -- | Split input to "first line" string and the rest of it.
 --
 -- Ideally, this should be done simply with @'break' (== '\n')@. However,
@@ -124,6 +132,8 @@ classify str
     | "--" `isPrefixOf` str = TkComment
     | "{-#" `isPrefixOf` str = TkPragma
     | "{-" `isPrefixOf` str = TkComment
+classify "''" = TkSpecial
+classify "'"  = TkSpecial
 classify str@(c:_)
     | isSpace c = TkSpace
     | isDigit c = TkNumber
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index 5f4dbc8c..b27ec4d8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -12,16 +12,19 @@ data Token = Token
     , tkValue :: String
     , tkSpan :: Span
     }
+    deriving (Show)
 
 data Position = Position
     { posRow :: !Int
     , posCol :: !Int
     }
+    deriving (Show)
 
 data Span = Span
     { spStart :: Position
     , spEnd :: Position
     }
+    deriving (Show)
 
 data TokenType
     = TkIdentifier
-- 
cgit v1.2.3


From 8d47c8b733a0b9406d99a97c7eaeba3d6b51ec7c Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Wed, 25 May 2016 23:52:02 +0200
Subject: Matching changes for #12105

---
 haddock-api/src/Haddock/Backends/Hoogle.hs      | 4 +++-
 haddock-api/src/Haddock/Backends/Xhtml.hs       | 2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs  | 2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Names.hs | 2 +-
 haddock-api/src/Haddock/Types.hs                | 6 +++++-
 5 files changed, 11 insertions(+), 5 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 9a15c7b3..1c3dea7c 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.Hoogle
@@ -84,7 +85,8 @@ dropHsDocTy = f
         f (HsDocTy a _) = f $ unL a
         f x = x
 
-outHsType :: OutputableBndr a => DynFlags -> HsType a -> String
+outHsType :: (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+          => DynFlags -> HsType a -> String
 outHsType dflags = out dflags . dropHsDocTy
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index f7284062..8e9fd7ae 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 )
+import GHC hiding ( NoLink, moduleInfo,FunctionFixity(..) )
 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 2bd8c4ad..e6dfce67 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
+import GHC hiding (FunctionFixity(..))
 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 5492178b..0f4dd51a 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
+import GHC hiding (FunctionFixity(..))
 import Name
 import RdrName
 import FastString (unpackFS)
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index eacf4473..1a7a0b6f 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.PlaceHolder
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -341,7 +344,8 @@ data InstType name
   | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
   | DataInst (TyClDecl name)        -- ^ Data constructors
 
-instance OutputableBndr a => Outputable (InstType a) where
+instance (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+         => Outputable (InstType a) where
   ppr (ClassInst { .. }) = text "ClassInst"
       <+> ppr clsiCtx
       <+> ppr clsiTyVars
-- 
cgit v1.2.3


From 09054c2c6ac346b19d0dec9a43956fcea1c272fb Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon, 13 Jun 2016 18:26:03 +0100
Subject: Follow changes to LHsSigWcType

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs  | 4 +---
 haddock-api/src/Haddock/Convert.hs              | 2 +-
 haddock-api/src/Haddock/Interface/Rename.hs     | 4 ++--
 haddock-api/src/Haddock/Interface/Specialize.hs | 4 ++--
 haddock-api/src/Haddock/Utils.hs                | 2 +-
 5 files changed, 7 insertions(+), 9 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index e6dfce67..d32c6d1b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -646,10 +646,8 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
 ppInstanceSigs links splice unicode qual sigs = do
     TypeSig lnames typ <- sigs
     let names = map unLoc lnames
-        L loc rtyp = get_type typ
+        L loc rtyp = hsSigWcType typ
     return $ ppSimpleSig links splice unicode qual loc names rtyp
-    where
-      get_type = hswc_body . hsib_body
 
 
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 71a81190..ecc26b9a 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -357,7 +357,7 @@ synifySigType s ty = mkEmptyImplicitBndrs (synifyType s ty)
 
 synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType Name
 -- Ditto (see synifySigType)
-synifySigWcType s ty = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs (synifyType s ty))
+synifySigWcType s ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs (synifyType s ty))
 
 synifyPatSynSigType :: PatSyn -> LHsSigType Name
 -- Ditto (see synifySigType)
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 1f3f2aab..ab23ce3b 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -179,7 +179,7 @@ renameLSigType :: LHsSigType Name -> RnM (LHsSigType DocName)
 renameLSigType = renameImplicit renameLType
 
 renameLSigWcType :: LHsSigWcType Name -> RnM (LHsSigWcType DocName)
-renameLSigWcType = renameImplicit (renameWc renameLType)
+renameLSigWcType = renameWc (renameImplicit renameLType)
 
 renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
 renameLKind = renameLType
@@ -573,7 +573,7 @@ renameWc :: (in_thing -> RnM out_thing)
 renameWc rn_thing (HsWC { hswc_body = thing })
   = do { thing' <- rn_thing thing
        ; return (HsWC { hswc_body = thing'
-                      , hswc_wcs = PlaceHolder, hswc_ctx = Nothing }) }
+                      , hswc_wcs = PlaceHolder }) }
 
 renameDocInstance :: DocInstance Name -> RnM (DocInstance DocName)
 renameDocInstance (inst, idoc, L l n) = do
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index ab719fe8..198bc4ff 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -81,10 +81,10 @@ specializeSig :: forall name . (Eq name, DataId name, SetName name)
               -> Sig name
               -> Sig name
 specializeSig bndrs typs (TypeSig lnames typ) =
-    TypeSig lnames (typ { hsib_body = (hsib_body typ) { hswc_body = noLoc typ'}})
+    TypeSig lnames (typ { hswc_body = (hswc_body typ) { hsib_body = noLoc typ'}})
   where
     true_type :: HsType name
-    true_type = unLoc (hswc_body (hsib_body typ))
+    true_type = unLoc (hsSigWcType typ)
     typ' :: HsType name
     typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs true_type
     fv = foldr Set.union Set.empty . map freeVariables $ typs
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 58a7ef90..da87990c 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -129,7 +129,7 @@ mkMeta x = emptyMetaDoc { _doc = x }
 mkEmptySigWcType :: LHsType Name -> LHsSigWcType Name
 -- Dubious, because the implicit binders are empty even
 -- though the type might have free varaiables
-mkEmptySigWcType ty = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs ty)
+mkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty)
 
 addClassContext :: Name -> LHsQTyVars Name -> LSig Name -> LSig Name
 -- Add the class context to a class-op signature
-- 
cgit v1.2.3


From 008e61d0c4b10713751c2a1de4958acc75367396 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Fri, 1 Jul 2016 11:50:08 +0200
Subject: GhcUtils: Changes for multi-pattern signatures

---
 haddock-api/src/Haddock/Backends/LaTeX.hs      | 12 +++++------
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 30 ++++++++++++--------------
 haddock-api/src/Haddock/Convert.hs             |  2 +-
 haddock-api/src/Haddock/GhcUtils.hs            |  2 +-
 haddock-api/src/Haddock/Interface/Rename.hs    |  6 +++---
 5 files changed, 25 insertions(+), 27 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 85716f33..3b0c38c4 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -251,7 +251,7 @@ declNames :: LHsDecl DocName -> [DocName]
 declNames (L _ decl) = case decl of
   TyClD d  -> [tcdName d]
   SigD (TypeSig lnames _ ) -> map unLoc lnames
-  SigD (PatSynSig lname _) -> [unLoc lname]
+  SigD (PatSynSig lnames _) -> map unLoc lnames
   ForD (ForeignImport (L _ n) _ _ _) -> [n]
   ForD (ForeignExport (L _ n) _ _ _) -> [n]
   _ -> error "declaration not supported by declNames"
@@ -296,8 +296,8 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
   TyClD d@(ClassDecl {})    -> ppClassDecl instances loc doc subdocs d unicode
   SigD (TypeSig lnames t)   -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)
                                         (hsSigWcType t) unicode
-  SigD (PatSynSig lname ty) ->
-      ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
+  SigD (PatSynSig lnames ty) ->
+      ppLPatSig loc (doc, fnArgsDoc) (map unLoc lnames) ty unicode
   ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
   InstD _                        -> empty
   DerivD _                       -> empty
@@ -355,14 +355,14 @@ ppFunSig loc doc docnames (L _ typ) unicode =
  where
    names = map getName docnames
 
-ppLPatSig :: SrcSpan -> DocForDecl DocName -> Located DocName
+ppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName]
           -> LHsSigType DocName
           -> Bool -> LaTeX
-ppLPatSig _loc (doc, _argDocs) (L _ name) ty unicode
+ppLPatSig _loc (doc, _argDocs) docnames ty unicode
   = declWithDoc pref1 (documentationToLaTeX doc)
   where
     pref1 = hsep [ keyword "pattern"
-                 , ppDocBinder name
+                 , hsep $ punctuate comma $ map ppDocBinder docnames
                  , dcolon unicode
                  , ppLType unicode (hsSigType ty)
                  ]
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d32c6d1b..ed9fd964 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -44,18 +44,18 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
        -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
        -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
 ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
-  TyClD (FamDecl d)         -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
-  TyClD d@(DataDecl {})     -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
-  TyClD d@(SynDecl {})      -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
-  TyClD d@(ClassDecl {})    -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
-  SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
+  TyClD (FamDecl d)            -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
+  TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
+  TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
+  TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+  SigD (TypeSig lnames lty)    -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
                                          (hsSigWcType lty) fixities splice unicode qual
-  SigD (PatSynSig lname ty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname
+  SigD (PatSynSig lnames ty)   -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
                                          ty fixities splice unicode qual
-  ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
-  InstD _                        -> noHtml
-  DerivD _                       -> noHtml
-  _                              -> error "declaration not supported by ppDecl"
+  ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
+  InstD _                      -> noHtml
+  DerivD _                     -> noHtml
+  _                            -> error "declaration not supported by ppDecl"
 
 
 ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
@@ -75,22 +75,20 @@ ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
     pp_typ = ppLType unicode qual typ
 
 ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-             Located DocName -> LHsSigType DocName ->
+             [Located DocName] -> LHsSigType DocName ->
              [(DocName, Fixity)] ->
              Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc (doc, _argDocs) (L _ name) typ fixities splice unicode qual
+ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode qual
   | summary = pref1
-  | otherwise = topDeclElem links loc splice [name] (pref1 <+> ppFixities fixities qual)
+  | otherwise = topDeclElem links loc splice (map unLoc docnames) (pref1 <+> ppFixities fixities qual)
                 +++ docSection Nothing qual doc
   where
     pref1 = hsep [ keyword "pattern"
-                 , ppBinder summary occname
+                 , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames
                  , dcolon unicode
                  , ppLType unicode qual (hsSigType typ)
                  ]
 
-    occname = nameOccName . getName $ name
-
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
              [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
              Splice -> Unicode -> Qualification -> Html
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 5f3a1e9e..88cedc75 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -101,7 +101,7 @@ tyThingToLHsDecl t = case t of
     (synifySigWcType ImplicitizeForAll (dataConUserType dc)))
 
   AConLike (PatSynCon ps) ->
-    allOK . SigD $ PatSynSig (synifyName ps) (synifyPatSynSigType ps)
+    allOK . SigD $ PatSynSig [synifyName ps] (synifyPatSynSigType ps)
   where
     withErrs e x = return (e, x)
     allOK x = return (mempty, x)
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 3933f8e7..c8e5ea8b 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -104,7 +104,7 @@ sigName (L _ sig) = sigNameNoLoc sig
 sigNameNoLoc :: Sig name -> [name]
 sigNameNoLoc (TypeSig      ns _)       = map unLoc ns
 sigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns
-sigNameNoLoc (PatSynSig    n _)        = [unLoc n]
+sigNameNoLoc (PatSynSig    ns _)       = map unLoc ns
 sigNameNoLoc (SpecSig      n _ _)      = [unLoc n]
 sigNameNoLoc (InlineSig    n _)        = [unLoc n]
 sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index ab23ce3b..d786d0cc 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -470,10 +470,10 @@ renameSig sig = case sig of
     lnames' <- mapM renameL lnames
     ltype' <- renameLSigType sig_ty
     return (ClassOpSig is_default lnames' ltype')
-  PatSynSig lname sig_ty -> do
-    lname' <- renameL lname
+  PatSynSig lnames sig_ty -> do
+    lnames' <- mapM renameL lnames
     sig_ty' <- renameLSigType sig_ty
-    return $ PatSynSig lname' sig_ty'
+    return $ PatSynSig lnames' sig_ty'
   FixSig (FixitySig lnames fixity) -> do
     lnames' <- mapM renameL lnames
     return $ FixSig (FixitySig lnames' fixity)
-- 
cgit v1.2.3


From cdc81a1b73bd4d1b330a32870d4369e1a2af3610 Mon Sep 17 00:00:00 2001
From: Ömer Sinan Ağacan <omeragacan@gmail.com>
Date: Fri, 1 Jul 2016 10:11:48 +0000
Subject: Add support for unboxed sums

---
 haddock-api/src/Haddock/Backends/LaTeX.hs       | 5 +++++
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs  | 4 ++++
 haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 6 +++++-
 haddock-api/src/Haddock/Interface/Rename.hs     | 1 +
 haddock-api/src/Haddock/Interface/Specialize.hs | 1 +
 5 files changed, 16 insertions(+), 1 deletion(-)

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

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 3b0c38c4..ffb4d782 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -885,6 +885,10 @@ tupleParens HsUnboxedTuple = ubxParenList
 tupleParens _              = parenList
 
 
+sumParens :: [LaTeX] -> LaTeX
+sumParens = ubxparens . hsep . punctuate (text " | ")
+
+
 -------------------------------------------------------------------------------
 -- * Rendering of HsType
 --
@@ -948,6 +952,7 @@ ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
 ppr_mono_ty _         (HsTyVar (L _ name)) _ = ppDocName name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
 ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
+ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
 ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index ed9fd964..c6f1100b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -913,6 +913,9 @@ tupleParens HsUnboxedTuple = ubxParenList
 tupleParens _              = parenList
 
 
+sumParens :: [Html] -> Html
+sumParens = ubxSumList
+
 --------------------------------------------------------------------------------
 -- * Rendering of HsType
 --------------------------------------------------------------------------------
@@ -989,6 +992,7 @@ ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q t
 ppr_mono_ty _         (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
 ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
+ppr_mono_ty _         (HsSumTy tys) u q = sumParens (map (ppLType u q) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u q =
     parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
 ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 391bb50c..a8b4a4ec 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -20,7 +20,7 @@ module Haddock.Backends.Xhtml.Utils (
   (<+>), (<=>), char,
   keyword, punctuate,
 
-  braces, brackets, pabrackets, parens, parenList, ubxParenList,
+  braces, brackets, pabrackets, parens, parenList, ubxParenList, ubxSumList,
   arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,
 
   hsep, vcat,
@@ -177,6 +177,10 @@ ubxParenList :: [Html] -> Html
 ubxParenList = ubxparens . hsep . punctuate comma
 
 
+ubxSumList :: [Html]  -> Html
+ubxSumList = ubxparens . hsep . punctuate (toHtml " | ")
+
+
 ubxparens :: Html -> Html
 ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
 
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index d786d0cc..cf3b72ac 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -238,6 +238,7 @@ renameType t = case t of
   HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
 
   HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
+  HsSumTy ts -> HsSumTy <$> mapM renameLType ts
 
   HsOpTy a (L loc op) b -> do
     op' <- rename op
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 198bc4ff..3e0df4e1 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -273,6 +273,7 @@ renameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr
 renameType (HsListTy lt) = HsListTy <$> renameLType lt
 renameType (HsPArrTy lt) = HsPArrTy <$> renameLType lt
 renameType (HsTupleTy srt lt) = HsTupleTy srt <$> mapM renameLType lt
+renameType (HsSumTy lt) = HsSumTy <$> mapM renameLType lt
 renameType (HsOpTy la lop lb) =
     HsOpTy <$> renameLType la <*> located renameName lop <*> renameLType lb
 renameType (HsParTy lt) = HsParTy <$> renameLType lt
-- 
cgit v1.2.3


From d73b286cb39ad9d02bee4b1a104e817783ceb195 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sun, 29 May 2016 23:30:27 -0400
Subject: Haddock changes for T10598

See https://ghc.haskell.org/trac/ghc/ticket/10598
---
 haddock-api/src/Haddock/Backends/Hoogle.hs  | 2 +-
 haddock-api/src/Haddock/Convert.hs          | 4 ++--
 haddock-api/src/Haddock/Interface/Create.hs | 5 +++--
 haddock-api/src/Haddock/Interface/Rename.hs | 5 ++++-
 4 files changed, 10 insertions(+), 6 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 1c3dea7c..48b97445 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -204,7 +204,7 @@ ppSynonym dflags x = [out dflags x]
 
 ppData :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
 ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
-    = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=Nothing }} :
+    = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=noLoc [] }} :
       concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
     where
 
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 41e98c6f..4e2ee05c 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -153,7 +153,7 @@ synifyTyCon _coax tc
                                       , dd_kindSig = Just (synifyKindSig (tyConKind tc))
                                                -- we have their kind accurately:
                                       , dd_cons = []  -- No constructors
-                                      , dd_derivs = Nothing }
+                                      , dd_derivs = noLoc [] }
            , tcdDataCusk = False
            , tcdFVs = placeHolderNamesTc }
 
@@ -224,7 +224,7 @@ synifyTyCon coax tc
   consRaw = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc)
   cons = rights consRaw
   -- "deriving" doesn't affect the signature, no need to specify any.
-  alg_deriv = Nothing
+  alg_deriv = noLoc []
   defn = HsDataDefn { dd_ND      = alg_nd
                     , dd_ctxt    = alg_ctx
                     , dd_cType   = Nothing
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 2c8b0b7e..2cdc6f8b 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -349,8 +349,9 @@ subordinates instMap decl = case decl of
                   , L _ (ConDeclField ns _ doc) <- (unLoc flds)
                   , L _ n <- ns ]
         derivs  = [ (instName, [unL doc], M.empty)
-                  | Just (L _ tys) <- [dd_derivs dd]
-                  , HsIB { hsib_body = L l (HsDocTy _ doc) } <- tys
+                  | HsIB { hsib_body = L l (HsDocTy _ doc) }
+                      <- concatMap (unLoc . deriv_clause_tys . unLoc) $
+                           unLoc $ dd_derivs dd
                   , Just instName <- [M.lookup l instMap] ]
 
 -- | Extract function argument docs from inside types.
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index cf3b72ac..fa85ba64 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -416,7 +416,8 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
     cons'     <- mapM (mapM renameCon) cons
     -- I don't think we need the derivings, so we return Nothing
     return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
-                       , dd_kindSig = k', dd_cons = cons', dd_derivs = Nothing })
+                       , dd_kindSig = k', dd_cons = cons'
+                       , dd_derivs = noLoc [] })
 
 renameCon :: ConDecl Name -> RnM (ConDecl DocName)
 renameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars
@@ -509,9 +510,11 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do
 
 renameDerivD :: DerivDecl Name -> RnM (DerivDecl DocName)
 renameDerivD (DerivDecl { deriv_type = ty
+                        , deriv_strategy = strat
                         , deriv_overlap_mode = omode }) = do
   ty' <- renameLSigType ty
   return (DerivDecl { deriv_type = ty'
+                    , deriv_strategy = strat
                     , deriv_overlap_mode = omode })
 
 renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
-- 
cgit v1.2.3


From 1dcefaddc52d968b20bb6107d620e1e0c6839970 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 3 Nov 2016 14:08:10 +0200
Subject: Match changes in GHC wip/T3384 branch

---
 haddock-api/src/Haddock/Backends/Hoogle.hs          |  8 ++++----
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs |  2 +-
 haddock-api/src/Haddock/Backends/LaTeX.hs           |  6 ++++--
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs      |  7 ++++---
 haddock-api/src/Haddock/Convert.hs                  | 16 ++++++++--------
 haddock-api/src/Haddock/Interface/Create.hs         | 10 +++++-----
 haddock-api/src/Haddock/Interface/Rename.hs         |  4 ++--
 haddock-api/src/Haddock/Interface/Specialize.hs     | 16 ++++++++--------
 haddock-api/src/Haddock/Types.hs                    |  6 +++---
 haddock-api/src/Haddock/Utils.hs                    |  2 +-
 10 files changed, 40 insertions(+), 37 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 48b97445..40106491 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -16,7 +16,7 @@ module Haddock.Backends.Hoogle (
     ppHoogle
   ) where
 
-import BasicTypes (OverlapFlag(..), OverlapMode(..))
+import BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..))
 import InstEnv (ClsInst(..))
 import Haddock.GhcUtils
 import Haddock.Types hiding (Version)
@@ -85,7 +85,7 @@ dropHsDocTy = f
         f (HsDocTy a _) = f $ unL a
         f x = x
 
-outHsType :: (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+outHsType :: (OutputableBndrId a, HasOccNameId a)
           => DynFlags -> HsType a -> String
 outHsType dflags = out dflags . dropHsDocTy
 
@@ -196,7 +196,7 @@ ppInstance dflags x =
     -- safety information to a state where the Outputable instance
     -- produces no output which means no overlap and unsafe (or [safe]
     -- is generated).
-    cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap mempty
+    cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap NoSourceText
                                     , isSafeOverlap = False } }
 
 ppSynonym :: DynFlags -> TyClDecl Name -> [String]
@@ -244,7 +244,7 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         -- docs for con_names on why it is a list to begin with.
         name = commaSeparate dflags . map unL $ getConNames con
 
-        resType = apps $ map (reL . HsTyVar . reL) $
+        resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
                         (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
 
 ppCtor dflags _dat subdocs con@ConDeclGADT {}
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index be17cb8b..1d9fbe20 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -72,7 +72,7 @@ types =
     everything (<|>) ty
   where
     ty term = case cast term of
-        (Just (GHC.L sspan (GHC.HsTyVar name))) ->
+        (Just (GHC.L sspan (GHC.HsTyVar _ name))) ->
             pure (sspan, RtkType (GHC.unLoc name))
         _ -> empty
 
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index ffb4d782..36a859e6 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -949,7 +949,8 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode
         , ppr_mono_lty pREC_TOP ty unicode ]
 
 ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _         (HsTyVar (L _ name)) _ = ppDocName name
+ppr_mono_ty _         (HsTyVar NotPromoted (L _ name)) _ = ppDocName name
+ppr_mono_ty _         (HsTyVar Promoted    (L _ name)) _ = char '\'' <> ppDocName name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
 ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
 ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)
@@ -960,7 +961,8 @@ ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppIPName n <+> dcolon u
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index c6f1100b..499d9e11 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -984,12 +984,12 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual
     ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual
 
 -- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar (L _ name)) True _
+ppr_mono_ty _ (HsTyVar _ (L _ name)) True _
   | getOccString (getName name) == "*"    = toHtml "★"
   | getOccString (getName name) == "(->)" = toHtml "(→)"
 
 ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q ty
-ppr_mono_ty _         (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name
+ppr_mono_ty _         (HsTyVar _ (L _ name)) _ q = ppDocName q Prefix True name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
 ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
 ppr_mono_ty _         (HsSumTy tys) u q = sumParens (map (ppLType u q) tys)
@@ -1005,7 +1005,8 @@ ppr_mono_ty _         (HsRecTy {})        _ _ = toHtml "{..}"
        -- placeholder in the signature, which is followed by the field
        -- declarations.
 ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q = brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = promoQuote $ parenList $ map (ppLType u q) tys
 ppr_mono_ty _         (HsAppsTy {})       _ _ = error "ppr_mono_ty HsAppsTy"
 
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 4e2ee05c..a99c5886 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(..) )
+import BasicTypes ( TupleSort(..), SourceText(..) )
 import Class
 import CoAxiom
 import ConLike
@@ -80,7 +80,7 @@ tyThingToLHsDecl t = case t of
          , tcdFDs = map (\ (l,r) -> noLoc
                         (map (noLoc . getName) l, map (noLoc . getName) r) ) $
                          snd $ classTvsFds cl
-         , tcdSigs = noLoc (MinimalSig mempty . noLoc . fmap noLoc $ classMinimalDef cl) :
+         , tcdSigs = noLoc (MinimalSig NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) :
                       map (noLoc . synifyTcIdSig DeleteTopLevelQuantification)
                         (classMethods cl)
          , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
@@ -366,17 +366,17 @@ synifyPatSynSigType :: PatSyn -> LHsSigType Name
 synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps)
 
 synifyType :: SynifyTypeState -> Type -> LHsType Name
-synifyType _ (TyVarTy tv) = noLoc $ HsTyVar $ noLoc (getName tv)
+synifyType _ (TyVarTy tv) = noLoc $ HsTyVar NotPromoted $ noLoc (getName tv)
 synifyType _ (TyConApp tc tys)
   -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473)
   | tc `hasKey` tYPETyConKey
   , [TyConApp lev []] <- tys
   , lev `hasKey` ptrRepLiftedDataConKey
-  = noLoc (HsTyVar (noLoc starKindTyConName))
+  = noLoc (HsTyVar NotPromoted (noLoc starKindTyConName))
   | tc `hasKey` tYPETyConKey
   , [TyConApp lev []] <- tys
   , lev `hasKey` ptrRepUnliftedDataConKey
-  = noLoc (HsTyVar (noLoc unliftedTypeKindTyConName))
+  = noLoc (HsTyVar NotPromoted (noLoc unliftedTypeKindTyConName))
   -- Use non-prefix tuple syntax where possible, because it looks nicer.
   | Just sort <- tyConTuple_maybe tc
   , tyConArity tc == length tys
@@ -400,7 +400,7 @@ synifyType _ (TyConApp tc tys)
   -- Most TyCons:
   | otherwise =
     foldl (\t1 t2 -> noLoc (HsAppTy t1 t2))
-      (noLoc $ HsTyVar $ noLoc (getName tc))
+      (noLoc $ HsTyVar NotPromoted $ noLoc (getName tc))
       (map (synifyType WithinType) $
        filterOut isCoercionTy tys)
 synifyType s (AppTy t1 (CoercionTy {})) = synifyType s t1
@@ -443,8 +443,8 @@ synifyPatSynType ps = let
   in noLoc $ sForAll univ_tvs $ sQual req_theta' $ sForAll ex_tvs $ sQual prov_theta sTau
 
 synifyTyLit :: TyLit -> HsTyLit
-synifyTyLit (NumTyLit n) = HsNumTy mempty n
-synifyTyLit (StrTyLit s) = HsStrTy mempty s
+synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n
+synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s
 
 synifyKindSig :: Kind -> LHsKind Name
 synifyKindSig k = synifyType WithinType k
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 2cdc6f8b..4e1a9b3a 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -48,7 +48,7 @@ import Bag
 import RdrName
 import TcRnTypes
 import FastString (concatFS)
-import BasicTypes ( StringLiteral(..) )
+import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
 import HsDecls ( gadtDeclDetails,getConDetails )
 
@@ -164,7 +164,7 @@ mkAliasMap dflags mRenamedSource =
     Just (_,impDecls,_,_) ->
       M.fromList $
       mapMaybe (\(SrcLoc.L _ impDecl) -> do
-        alias <- ideclAs impDecl
+        SrcLoc.L _ alias <- ideclAs impDecl
         return $
           (lookupModuleDyn dflags
              (fmap Module.fsToUnitId $
@@ -569,7 +569,7 @@ mkExportItems
 
                   L loc (TyClD cl@ClassDecl{}) -> do
                     mdef <- liftGhcToErrMsgGhc $ minimalDef t
-                    let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
+                    let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef
                     return [ mkExportDecl t
                       (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
 
@@ -769,7 +769,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
         expInst decl l name
     mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
       mdef <- liftGhcToErrMsgGhc $ minimalDef name
-      let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
+      let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef
       expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
     mkExportItem decl@(L l d)
       | name:_ <- getMainDeclBinder d = expDecl decl l name
@@ -839,7 +839,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
   data_ty
     -- | ResTyGADT _ ty <- con_res con = ty
     | ConDeclGADT{} <- con = hsib_body $ con_type con
-    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
 
 -- | Keep export items with docs.
 pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index fa85ba64..40a10675 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -219,7 +219,7 @@ renameType t = case t of
     ltype'    <- renameLType ltype
     return (HsQualTy { hst_ctxt = lcontext', hst_body = ltype' })
 
-  HsTyVar (L l n) -> return . HsTyVar . L l =<< rename n
+  HsTyVar ip (L l n) -> return . HsTyVar ip . L l =<< rename n
   HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
 
   HsAppTy a b -> do
@@ -262,7 +262,7 @@ renameType t = case t of
 
   HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a
   HsCoreTy a              -> pure (HsCoreTy a)
-  HsExplicitListTy  a b   -> HsExplicitListTy  a <$> mapM renameLType b
+  HsExplicitListTy i a b  -> HsExplicitListTy i a <$> mapM renameLType b
   HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b
   HsSpliceTy _ _          -> error "renameType: HsSpliceTy"
   HsWildCardTy a          -> HsWildCardTy <$> renameWildCardInfo a
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 3e0df4e1..28bbf305 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -36,7 +36,7 @@ specialize :: (Eq name, Typeable name)
 specialize name details =
     everywhere $ mkT step
   where
-    step (HsTyVar (L _ name')) | name == name' = details
+    step (HsTyVar _ (L _ name')) | name == name' = details
     step typ = typ
 
 
@@ -123,7 +123,7 @@ sugar =
 
 
 sugarLists :: NamedThing name => HsType name -> HsType name
-sugarLists (HsAppTy (L _ (HsTyVar (L _ name))) ltyp)
+sugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp)
     | isBuiltInSyntax name' && strName == "[]" = HsListTy ltyp
   where
     name' = getName name
@@ -137,7 +137,7 @@ sugarTuples typ =
   where
     aux apps (HsAppTy (L _ ftyp) atyp) = aux (atyp:apps) ftyp
     aux apps (HsParTy (L _ typ')) = aux apps typ'
-    aux apps (HsTyVar (L _ name))
+    aux apps (HsTyVar _ (L _ name))
         | isBuiltInSyntax name' && suitable = HsTupleTy HsBoxedTuple apps
       where
         name' = getName name
@@ -149,7 +149,7 @@ sugarTuples typ =
 
 
 sugarOperators :: NamedThing name => HsType name -> HsType name
-sugarOperators (HsAppTy (L _ (HsAppTy (L _ (HsTyVar (L l name))) la)) lb)
+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 la lb
   where
@@ -224,7 +224,7 @@ freeVariables =
     query term ctx = case cast term :: Maybe (HsType name) of
         Just (HsForAllTy bndrs _) ->
             (Set.empty, Set.union ctx (bndrsNames bndrs))
-        Just (HsTyVar (L _ name))
+        Just (HsTyVar _ (L _ name))
             | getName name `Set.member` ctx -> (Set.empty, ctx)
             | otherwise -> (Set.singleton $ getNameRep name, ctx)
         _ -> (Set.empty, ctx)
@@ -267,7 +267,7 @@ renameType (HsQualTy lctxt lt) =
   HsQualTy
         <$> located renameContext lctxt
         <*> renameLType lt
-renameType (HsTyVar name) = HsTyVar <$> located renameName name
+renameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name
 renameType (HsAppTy lf la) = HsAppTy <$> renameLType lf <*> renameLType la
 renameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr
 renameType (HsListTy lt) = HsListTy <$> renameLType lt
@@ -285,8 +285,8 @@ renameType (HsDocTy lt doc) = HsDocTy <$> renameLType lt <*> pure doc
 renameType (HsBangTy bang lt) = HsBangTy bang <$> renameLType lt
 renameType t@(HsRecTy _) = pure t
 renameType t@(HsCoreTy _) = pure t
-renameType (HsExplicitListTy ph ltys) =
-    HsExplicitListTy ph <$> renameLTypes ltys
+renameType (HsExplicitListTy ip ph ltys) =
+    HsExplicitListTy ip ph <$> renameLTypes ltys
 renameType (HsExplicitTupleTy phs ltys) =
     HsExplicitTupleTy phs <$> renameLTypes ltys
 renameType t@(HsTyLit _) = pure t
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 5220e6e9..951faf5b 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 (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+instance (OutputableBndrId a, HasOccNameId a)
          => Outputable (InstType a) where
   ppr (ClassInst { .. }) = text "ClassInst"
       <+> ppr clsiCtx
@@ -380,8 +380,8 @@ mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
     mkType (KindedTyVar (L loc name) lkind) =
         HsKindSig tvar lkind
       where
-        tvar = L loc (HsTyVar (L loc name))
-    mkType (UserTyVar name) = HsTyVar name
+        tvar = L loc (HsTyVar NotPromoted (L loc name))
+    mkType (UserTyVar name) = HsTyVar NotPromoted name
 
 
 -- | An instance head that may have documentation and a source location.
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index da87990c..ba382600 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -151,7 +151,7 @@ addClassContext _ _ sig = sig   -- E.g. a MinimalSig is fine
 
 lHsQTyVarsToTypes :: LHsQTyVars Name -> [LHsType Name]
 lHsQTyVarsToTypes tvs
-  = [ noLoc (HsTyVar (noLoc (hsLTyVarName tv)))
+  = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv)))
     | tv <- hsQTvExplicit tvs ]
 
 --------------------------------------------------------------------------------
-- 
cgit v1.2.3


From f951caf888eabd8742059f26e516e3392658fc88 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 9 Dec 2016 19:56:39 +0200
Subject: Matching changes for GHC wip/T12942

---
 haddock-api/src/Haddock/Backends/Hoogle.hs         |  3 ++-
 .../src/Haddock/Backends/Hyperlinker/Ast.hs        |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml.hs          |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs     |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Names.hs    |  2 +-
 haddock-api/src/Haddock/Convert.hs                 | 11 +++++++--
 haddock-api/src/Haddock/Interface/Rename.hs        | 28 ++++++++++++++--------
 haddock-api/src/Haddock/Types.hs                   |  2 +-
 8 files changed, 34 insertions(+), 18 deletions(-)

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

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


From b19ea3ababeb231157c4a067c43003e09b1f0185 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Tue, 10 Jan 2017 16:59:38 +0200
Subject: HsIParamTy now has a Located name

---
 haddock-api/src/Haddock/Backends/LaTeX.hs      | 2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 2 +-
 haddock-api/src/Haddock/Convert.hs             | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 36a859e6..53cfccff 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -957,7 +957,7 @@ ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
 ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsIParamTy (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index adee2b67..2aec5272 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -997,7 +997,7 @@ ppr_mono_ty _         (HsKindSig ty kind) u q =
     parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
 ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty ctxt_prec (HsIParamTy n ty)   u q =
+ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q =
     maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q
 ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ _ = toHtml "{..}"
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 6cf77de0..87a273b2 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -399,7 +399,7 @@ synifyType _ (TyConApp tc tys)
   | tc `hasKey` ipClassKey
   , [name, ty] <- tys
   , Just x <- isStrLitTy name
-  = noLoc $ HsIParamTy (HsIPName x) (synifyType WithinType ty)
+  = noLoc $ HsIParamTy (noLoc $ HsIPName x) (synifyType WithinType ty)
   -- and equalities
   | tc `hasKey` eqTyConKey
   , [ty1, ty2] <- tys
-- 
cgit v1.2.3


From 7f1987b35eb7bb15ca2fd93321440af519dd8cd5 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Tue, 24 Jan 2017 21:57:56 +0200
Subject: Changes to match #13163 in GHC

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 8 ++++----
 haddock-api/src/Haddock/Interface/Create.hs         | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index aff61cfc..b97f0ead 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -152,11 +152,11 @@ imports src@(_, imps, _, _) =
     everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
-        (Just (GHC.IEVar v)) -> pure $ var v
-        (Just (GHC.IEThingAbs t)) -> pure $ typ t
-        (Just (GHC.IEThingAll t)) -> pure $ typ t
+        (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v
+        (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t
+        (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t
         (Just (GHC.IEThingWith t _ vs _fls)) ->
-          [typ t] ++ map var vs
+          [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs
         _ -> empty
     typ (GHC.L sspan name) = (sspan, RtkType name)
     var (GHC.L sspan name) = (sspan, RtkVar name)
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 4e1a9b3a..4a65fc2a 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -511,10 +511,10 @@ mkExportItems
     Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls
     Just exports -> liftM concat $ mapM lookupExport exports
   where
-    lookupExport (IEVar (L _ x))         = declWith x
-    lookupExport (IEThingAbs (L _ t))    = declWith t
-    lookupExport (IEThingAll (L _ t))    = declWith t
-    lookupExport (IEThingWith (L _ t) _ _ _) = declWith t
+    lookupExport (IEVar (L _ x))         = declWith $ ieWrappedName x
+    lookupExport (IEThingAbs (L _ t))    = declWith $ ieWrappedName t
+    lookupExport (IEThingAll (L _ t))    = declWith $ ieWrappedName t
+    lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t
     lookupExport (IEModuleContents (L _ m)) =
       moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices
     lookupExport (IEGroup lev docStr)  = return $
-- 
cgit v1.2.3