started implementing mandatory kinds. compiles but very broken atm, n…

…eed to distinguish between free and bound tyvars and only require annotations only in tyvar binders & free tyvars

src/Language/PureScript/AST/Declarations.hs

@@ -394,15 +394,15 @@ data Declaration
   -- |
   -- A data type declaration (data or newtype, name, arguments, data constructors)
   --
-  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceType)] [DataConstructorDeclaration]
+  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, SourceType)] [DataConstructorDeclaration]
   -- |
   -- A minimal mutually recursive set of data type declarations
   --
   | DataBindingGroupDeclaration (NEL.NonEmpty Declaration)
   -- |
   -- A type synonym declaration (name, arguments, type)
   --
-  | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe SourceType)] SourceType
+  | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text,  SourceType)] SourceType
   -- |
   -- A kind signature declaration
   --
@@ -445,7 +445,7 @@ data Declaration
   -- |
   -- A type class declaration (name, argument, implies, member declarations)
   --
-  | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe SourceType)] [SourceConstraint] [FunctionalDependency] [Declaration]
+  | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, SourceType)] [SourceConstraint] [FunctionalDependency] [Declaration]
   -- |
   -- A type instance declaration (instance chain, chain index, name,
   -- dependencies, class name, instance types, member declarations)

src/Language/PureScript/AST/Traversals.hs

@@ -677,17 +677,17 @@ accumTypes
 accumTypes f = everythingOnValues mappend forDecls forValues forBinders (const mempty) (const mempty)
   where
   forDecls (DataDeclaration _ _ _ args dctors) =
-    foldMap (foldMap f . snd) args <>
+    foldMap ( f . snd) args <>
     foldMap (foldMap (f . snd) . dataCtorFields) dctors
   forDecls (ExternDataDeclaration _ _ ty) = f ty
   forDecls (ExternDeclaration _ _ ty) = f ty
   forDecls (TypeClassDeclaration _ _ args implies _ _) =
-    foldMap (foldMap (foldMap f)) args <>
+    foldMap (foldMap f) args <>
     foldMap (foldMap f . constraintArgs) implies
   forDecls (TypeInstanceDeclaration _ _ _ _ _ cs _ tys _) =
     foldMap (foldMap f . constraintArgs) cs <> foldMap f tys
   forDecls (TypeSynonymDeclaration _ _ args ty) =
-    foldMap (foldMap f . snd) args <>
+    foldMap (f . snd) args <>
     f ty
   forDecls (KindDeclaration _ _ _ ty) = f ty
   forDecls (TypeDeclaration td) = f (tydeclType td)

src/Language/PureScript/CST/Convert.hs

@@ -121,8 +121,12 @@ convertType' withinVta fileName = go
         rowTail
 
   go = \case
-    TypeVar _ a ->
-      T.TypeVar (sourceName fileName a) . getIdent $ nameValue a
+    TypeKinded _ (TypeVar _ a) _ kd ->
+      T.TypeVar (sourceName fileName a) (getIdent $ nameValue a) (go kd)
+    TypeVar _ a  -> error $ "tyvar "
+                    <> Text.unpack (getIdent $ nameValue a)
+                    <> " lacks kind annotation (TODO: better error)"
+      -- T.TypeVar (sourceName fileName a) (getIdent $ nameValue a) (go ki)
     TypeConstructor _ a ->
       T.TypeConstructor (sourceQualName fileName a) $ qualified a
     TypeWildcard _ a ->
@@ -145,8 +149,9 @@ convertType' withinVta fileName = go
         mkForAll a b v t = do
           let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t
           T.ForAll ann' (maybe T.TypeVarInvisible (const T.TypeVarVisible) v) (getIdent $ nameValue a) b t Nothing
-        k (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = mkForAll a (Just (go b)) v
-        k (TypeVarName (v, a)) = mkForAll a Nothing v
+        k (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = mkForAll a ( (go b)) v
+        -- TODO: Fix this better
+        k (TypeVarName (v, a)) = error "forall w/o kind annotation" -- mkForAll a Nothing v
         ty' = foldr k (go ty) bindings
         ann = widenLeft (tokAnn kw) $ T.getAnnForType ty'
       T.setAnnForType ann ty'
@@ -602,8 +607,8 @@ convertDeclaration fileName decl = case decl of
         TypeUnaryRow{} -> "Row"
 
   goTypeVar = \case
-    TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x, Just $ convertType fileName y)
-    TypeVarName (_, x) -> (getIdent $ nameValue x, Nothing)
+    TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x, convertType fileName y)
+    TypeVarName (_, x) -> error $ "Missing kind annotation for type variable: " <> Text.unpack (getIdent $ nameValue x) -- , Nothing)
 
   goInstanceBinding = \case
     InstanceBindingSignature _ lbl ->

src/Language/PureScript/CST/Flatten.hs

@@ -278,7 +278,7 @@ flattenLabeled ka kc (Labeled a b c) = ka a <> pure b <> kc c
 
 flattenType :: Type a -> DList SourceToken
 flattenType = \case
-  TypeVar _ a -> pure $ nameTok a
+  TypeVar _ a  -> pure (nameTok a)
   TypeConstructor _ a -> pure $ qualTok a
   TypeWildcard _ a -> pure a
   TypeHole _ a -> pure $ nameTok a