fixed a bug in the CST grouper, cleaned up old passing tests

src/Language/PureScript/CST/Convert.hs

@@ -46,6 +46,7 @@ import Data.Bitraversable (Bitraversable(..))
 import Language.PureScript.Names (runProperName, coerceProperName)
 
 import Debug.Trace (trace)
+import Data.List (partition)
 
 type ConvertM a = State (Map Text T.SourceType) a
 
@@ -77,34 +78,42 @@ srcTokenRange = tokRange . tokAnn
 
 -}
 groupSignaturesAndDeclarations :: Show a => [Declaration a] -> [[Declaration a]]
-groupSignaturesAndDeclarations decls = trace ("DECLARATIONS (grouping): " <> concatMap ((<> "\n\n") . show) decls)
-  $ foldr (go kindSigs typeSigs) [] decls'
+groupSignaturesAndDeclarations [] = []
+groupSignaturesAndDeclarations decls = trace ("DECLARATIONS (grouping): \n" <> concatMap ((<> "\n\n") . show) decls)
+  $ go kindSigs typeSigs decls'
   where
-    -- I think this minimizes the # of traversals?
     ((kindSigs,typeSigs),decls') = foldr (\x acc -> case x of
         ksig@(DeclKindSignature _ _ (Labeled (nameValue -> nm) _ ty)) -> first (first $ M.insert nm ksig) acc
         tsig@(DeclSignature _ (Labeled (nameValue -> nm) _ _)) -> first (second (M.insert nm tsig)) acc
         other -> second (other:) acc
       ) ((M.empty,M.empty),[]) decls
 
-    go ksigs tsigs x acc = case x of
+    go ksigs tsigs [] = []
+    go ksigs tsigs (d:ds)  = case d of
       dataDecl@(DeclData _ (DataHead _ (nameValue -> nm) _ ) _) -> case M.lookup nm ksigs of
-        Just sigDecl -> [sigDecl,dataDecl] : acc
-        Nothing -> [dataDecl] : acc
+        Just sigDecl -> [sigDecl,dataDecl] : go ksigs tsigs ds
+        Nothing -> [dataDecl] : go ksigs tsigs ds
       tyDecl@(DeclType _ (DataHead _ (nameValue -> nm) _) _ _) -> case M.lookup nm ksigs of
-        Just sigDecl -> [sigDecl,tyDecl] : acc
-        Nothing -> [tyDecl] : acc
+        Just sigDecl -> [sigDecl,tyDecl] : go ksigs tsigs ds
+        Nothing -> [tyDecl] : go ksigs tsigs ds
       newtypeDecl@(DeclNewtype _ (DataHead _ (nameValue -> nm) _) _ _ _) -> case M.lookup nm ksigs of
-        Just sigDecl -> [sigDecl,newtypeDecl] : acc
-        Nothing -> [newtypeDecl] : acc
+        Just sigDecl -> [sigDecl,newtypeDecl] : go ksigs tsigs ds
+        Nothing -> [newtypeDecl] : go ksigs tsigs ds
       classDecl@(DeclClass _ (clsName -> nm) _) -> case M.lookup (coerceProperName $ nameValue nm) ksigs of
-        Just sigDecl -> [sigDecl,classDecl] : acc
-        Nothing -> [classDecl] : acc
-      valDecl@(DeclValue _ (valName -> nm)) -> case M.lookup (nameValue nm) tsigs of
-        Just sigDecl -> [sigDecl,valDecl] : acc
-        Nothing -> [valDecl] : acc
+        Just sigDecl -> [sigDecl,classDecl] : go ksigs tsigs ds
+        Nothing -> [classDecl] : go ksigs tsigs ds
+      valDecl@(DeclValue _ (valName -> nm)) ->
+        let (valDecls',ds') = partition (valDecWithName nm) ds
+            valDecls = valDecl : valDecls'
+        in case M.lookup (nameValue nm) tsigs of
+             Just sigDecl -> (sigDecl:valDecls) : go ksigs tsigs ds'
+             Nothing -> valDecls : go ksigs tsigs ds'
       -- I don't think anything else can have a type/kind sig but I could be wrong...
-      other -> [other] : acc
+      other -> [other] : go ksigs tsigs ds
+     where
+       valDecWithName :: Name Ident -> Declaration a -> Bool
+       valDecWithName nm (DeclValue _ (valName -> nm')) = nameValue nm == nameValue nm'
+       valDecWithName _ _ = False
 
 
 comment :: Comment a -> Maybe C.Comment

src/Language/PureScript/Sugar/Names.hs

@@ -356,12 +356,51 @@ renameInModule imports (Module modSS coms mn decls exps) =
     updateType (TypeOp ann@(ss, _) name) = TypeOp ann <$> updateTypeOpName name ss
     updateType (TypeConstructor ann@(ss, _) name) = TypeConstructor ann <$> updateTypeName name ss
     updateType (ConstrainedType ann c t) = ConstrainedType ann <$> updateInConstraint c <*> pure t
-    updateType (TypeVar ann nm ki) = TypeVar ann nm <$> updateType ki
+    updateType (TypeVar ann nm ki) = TypeVar ann nm <$> updateType' ki
     updateType t = return t
     updateInConstraint :: SourceConstraint -> m SourceConstraint
     updateInConstraint (Constraint ann@(ss, _) name ks ts info) =
       Constraint ann <$> updateClassName name ss <*> pure ks <*> pure ts <*> pure info
 
+    {- NOTE/REVIEW/HACK:
+
+       Before our 'mandatory kinds' changes, `updateType` ignored TypeApps.
+
+       Our changes add mandatory kind annotations to Type variables. If those annotations mention
+       unqualified type constructors (kind constructors) from `Prim`, we need to qualify them to
+       avoid typechecking errors.
+
+       For example, if we have:
+
+       ```
+       aFunction4 :: forall (r :: Row Type). {a :: Int | r} -> Int
+       ```
+
+       Then `updateType` will ignore the `Row Type` annotation because there isn't a case branch
+       for TypeApps.
+
+       Adding a TypeApp case above breaks everything - afaict it qualifies local names
+       that shouldn't need to be qualified such that they're qualified by the module
+       in which they occur. (Didn't look too closely into why because it broke every single test
+       module).
+
+       We need this helper function to ensure that the above example does not have to be explicitly
+       annotated as
+
+       ```
+       aFunction4 :: forall (r :: Prim.Row Prim.Type). {a :: Int | r} -> Int
+       ```
+
+       THIS MIGHT BREAK SOMETHING. It appears to work with our existing tests, but those
+       are not comprehensive.
+    -}
+    updateType' :: SourceType -> m SourceType
+    updateType' = \case
+      TypeApp ann t1 t2 -> TypeApp ann <$> updateType' t1 <*> updateType' t2
+      other -> updateType other
+
+
+
   updateConstraints :: [SourceConstraint] -> m [SourceConstraint]
   updateConstraints = traverse $ \(Constraint ann@(pos, _) name ks ts info) ->
     Constraint ann

tests/TestPurus.hs

@@ -110,6 +110,7 @@ shouldPass = map (prefix </>) paths
         "ResolvableScopeConflict",
         "ResolvableScopeConflict2",
         "ResolvableScopeConflict3",
+        -- "RowSyntax",
         "ShadowedModuleName",
         "TransitiveImport"
       ]

tests/purus/passing/Misc/Lib.purs

@@ -1,5 +1,7 @@
 module Lib where
 
+import Prim
+
 {- Type Classes -}
 -- Single Param
 class Eq (a :: Type) where