+-- Extract the type variables of a list of type parameters.
+--
+-- * Type arguments can be complex type terms (needed for associated type
+-- declarations).
+--
+extractTyVars :: [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
+extractTyVars tvs = collects [] tvs
+ where
+ -- Collect all variables (1st arg serves as an accumulator)
+ collect tvs (L l (HsForAllTy _ _ _ _)) =
+ parseError l "Forall type not allowed as type parameter"
+ collect tvs (L l (HsTyVar tv))
+ | isRdrTyVar tv = return $ L l (UserTyVar tv) : tvs
+ | otherwise = return tvs
+ collect tvs (L l (HsBangTy _ _ )) =
+ parseError l "Bang-style type annotations not allowed as type parameter"
+ collect tvs (L l (HsAppTy t1 t2 )) = do
+ tvs' <- collect tvs t2
+ collect tvs' t1
+ collect tvs (L l (HsFunTy t1 t2 )) = do
+ tvs' <- collect tvs t2
+ collect tvs' t1
+ collect tvs (L l (HsListTy t )) = collect tvs t
+ collect tvs (L l (HsPArrTy t )) = collect tvs t
+ collect tvs (L l (HsTupleTy _ ts )) = collects tvs ts
+ collect tvs (L l (HsOpTy t1 _ t2 )) = do
+ tvs' <- collect tvs t2
+ collect tvs' t1
+ collect tvs (L l (HsParTy t )) = collect tvs t
+ collect tvs (L l (HsNumTy t )) = return tvs
+ collect tvs (L l (HsPredTy t )) =
+ parseError l "Predicate not allowed as type parameter"
+ collect tvs (L l (HsKindSig (L _ (HsTyVar tv)) k))
+ | isRdrTyVar tv =
+ return $ L l (KindedTyVar tv k) : tvs
+ | otherwise =
+ parseError l "Kind signature only allowed for type variables"
+ collect tvs (L l (HsSpliceTy t )) =
+ parseError l "Splice not allowed as type parameter"
+
+ -- Collect all variables of a list of types
+ collects tvs [] = return tvs
+ collects tvs (t:ts) = do
+ tvs' <- collects tvs ts
+ collect tvs' t
+
+-- Wrap a toplevel type or class declaration into 'TyClDecl' after ensuring
+-- that all type parameters are variables only (which is in contrast to
+-- associated type declarations).
+--
+checkTopTyClD :: LTyClDecl RdrName -> P (HsDecl RdrName)
+checkTopTyClD (L _ d@TyData {tcdTyPats = Just typats}) =
+ do
+ checkTyVars typats
+ return $ TyClD d {tcdTyPats = Nothing}
+checkTopTyClD (L _ d) = return $ TyClD d
+