From 1e1f85d6513b84bac3ae13470900ac7c23e8640e Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Tue, 23 May 2017 23:16:32 +0200
Subject: Match new AST as per GHC wip/new-tree-one-param

See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs        | 25 +++++++++++-----------
 1 file changed, 13 insertions(+), 12 deletions(-)

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

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index b97f0ead..abdcafcc 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -56,13 +56,13 @@ variables =
     everything (<|>) (var `combine` rec)
   where
     var term = case cast term of
-        (Just (GHC.L sspan (GHC.HsVar name))) ->
+        (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GHCR)) ->
             pure (sspan, RtkVar (GHC.unLoc name))
         (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->
             pure (sspan, RtkVar name)
         _ -> empty
     rec term = case cast term of
-        Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.Name) _) ->
+        Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.GHCR) _) ->
             pure (sspan, RtkVar name)
         _ -> empty
 
@@ -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)) :: GHC.LHsType GHC.GHCR)) ->
             pure (sspan, RtkType (GHC.unLoc name))
         _ -> empty
 
@@ -86,11 +86,11 @@ binds =
     everything (<|>) (fun `combine` pat `combine` tvar)
   where
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) ->
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GHCR)) ->
             pure (sspan, RtkBind name)
         _ -> empty
     pat term = case cast term of
-        (Just (GHC.L sspan (GHC.VarPat name))) ->
+        (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GHCR)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
             [(sspan, RtkVar name)] ++ everything (<|>) rec recs
@@ -98,11 +98,11 @@ binds =
             pure (sspan, RtkBind name)
         _ -> empty
     rec term = case cast term of
-        (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->
+        (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.GHCR) _)) ->
             pure (sspan, RtkVar name)
         _ -> empty
     tvar term = case cast term of
-        (Just (GHC.L sspan (GHC.UserTyVar name))) ->
+        (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GHCR)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
@@ -122,20 +122,21 @@ decls (group, _, _, _) = concatMap ($ group)
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name))
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GHCR))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
     con term = case cast term of
-        (Just cdcl) ->
+        (Just (cdcl :: GHC.ConDecl GHC.GHCR)) ->
             map decl (GHC.getConNames cdcl) ++ everything (<|>) fld cdcl
         Nothing -> empty
     ins term = case cast term of
-        (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst
+        (Just ((GHC.DataFamInstD inst) :: GHC.InstDecl GHC.GHCR))
+          -> pure . tyref $ GHC.dfid_tycon inst
         (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) ->
             pure . tyref $ GHC.tfe_tycon eqn
         _ -> empty
     fld term = case cast term of
-        Just (field :: GHC.ConDeclField GHC.Name)
+        Just (field :: GHC.ConDeclField GHC.GHCR)
           -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
     sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
@@ -152,7 +153,7 @@ imports src@(_, imps, _, _) =
     everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
-        (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v
+        (Just ((GHC.IEVar v) :: GHC.IE GHC.GHCR)) -> 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)) ->
-- 
cgit v1.2.3