From e6ca100973c496cd98da3385594fa9a81320f7cb Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed, 30 Jan 2019 20:17:29 -0500
Subject: Changes from #14579

We now have a top-level `tyConAppNeedsKindSig` function, which means
that we can delete lots of code in `Convert`.

(cherry picked from commit cfd682c5fd03b099a3d78c44f9279faf56a0ac70)
---
 haddock-api/src/Haddock/Convert.hs | 27 +++++----------------------
 1 file changed, 5 insertions(+), 22 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 5dc3a508..709e20d4 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -28,7 +28,6 @@ import ConLike
 import Data.Either (lefts, rights)
 import DataCon
 import FamInstEnv
-import FV
 import HsSyn
 import Name
 import NameSet ( emptyNameSet )
@@ -45,8 +44,7 @@ import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName
 import PrelNames ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey
                  , liftedRepDataConKey )
 import Unique ( getUnique )
-import Util ( chkAppend, compareLength, dropList, filterByList, filterOut
-            , splitAtList )
+import Util ( chkAppend,dropList, filterByList, filterOut, splitAtList )
 import Var
 import VarSet
 
@@ -547,7 +545,7 @@ synifyType _ vs (TyConApp tc tys)
       = noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName))
       -- Use non-prefix tuple syntax where possible, because it looks nicer.
       | Just sort <- tyConTuple_maybe tc
-      , tyConArity tc == length tys
+      , tyConArity tc == tys_len
       = noLoc $ HsTupleTy noExt
                           (case sort of
                               BoxedTuple      -> HsBoxedTuple
@@ -604,32 +602,17 @@ synifyType _ vs (TyConApp tc tys)
                 (map (synifyType WithinType vs) $
                  filterOut isCoercionTy ty_args)
 
-    vis_tys  = filterOutInvisibleTypes tc tys
-    binders  = tyConBinders tc
-    res_kind = tyConResKind tc
+    tys_len = length tys
+    vis_tys = filterOutInvisibleTypes tc tys
 
     maybe_sig :: LHsType GhcRn -> LHsType GhcRn
     maybe_sig ty'
-      | needs_kind_sig
+      | tyConAppNeedsKindSig False tc tys_len
       = let full_kind  = typeKind (mkTyConApp tc tys)
             full_kind' = synifyType WithinType vs full_kind
         in noLoc $ HsKindSig noExt ty' full_kind'
       | otherwise = ty'
 
-    needs_kind_sig :: Bool
-    needs_kind_sig
-      | GT <- compareLength tys binders
-      = False
-      | otherwise
-      = let (dropped_binders, remaining_binders)
-                  = splitAtList  tys binders
-            result_kind  = mkTyConKind remaining_binders res_kind
-            result_vars  = tyCoVarsOfType result_kind
-            dropped_vars = fvVarSet $
-                           mapUnionFV injectiveVarsOfBinder dropped_binders
-
-        in not (subVarSet result_vars dropped_vars)
-
 synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1
 synifyType _ vs (AppTy t1 t2) = let
   s1 = synifyType WithinType vs t1
-- 
cgit v1.2.3