Error positions for FFI related errors (purescript#3276)

garyb · web-flow · commit 80c671e7a0c1 · 2018-03-11T13:49:24.000Z
* Add source span for UnnecessaryFFIModule

* Add source spans for more FFI warnings

* Add error test for MissingFFIImplementations
diff --git a/examples/failing/MissingFFIImplementations.js b/examples/failing/MissingFFIImplementations.js
@@ -0,0 +1 @@
+exports.yes = true;
diff --git a/examples/failing/MissingFFIImplementations.purs b/examples/failing/MissingFFIImplementations.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith MissingFFIImplementations
+module Main where
+
+foreign import yes :: Boolean
+foreign import no :: Boolean
diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
@@ -158,7 +158,7 @@ shushProgress ma _ =
 -- files though)
 shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
 shushCodegen ma MakeActionsEnv{..} =
-  ma { P.codegen = \_ _ _ -> pure () }
+  ma { P.codegen = \_ _ _ _ -> pure () }
 
 -- | Returns a topologically sorted list of dependent ExternsFiles for the given
 -- module. Throws an error if there is a cyclic dependency within the
diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
@@ -108,7 +108,7 @@ data MakeActions m = MakeActions
   , readExterns :: ModuleName -> m (FilePath, Externs)
   -- ^ Read the externs file for a module as a string and also return the actual
   -- path for the file.
-  , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()
+  , codegen :: SourceSpan -> CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()
   -- ^ Run the code generator for the module and write any required output files.
   , progress :: ProgressMessage -> m ()
   -- ^ Respond to a progress update.
@@ -154,7 +154,7 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do
       corefn = CF.moduleToCoreFn env' mod'
       [renamed] = renameInModules [corefn]
       exts = moduleToExternsFile mod' env'
-  evalSupplyT nextVar' . codegen renamed env' . encode $ exts
+  evalSupplyT nextVar' . codegen ss renamed env' . encode $ exts
   return exts
 
 -- | Compiles in "make" mode, compiling each module separately to a @.js@ file and an @externs.json@ file.
@@ -344,16 +344,16 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
     let path = outputDir </> T.unpack (runModuleName mn) </> "externs.json"
     (path, ) <$> readTextFile path
 
-  codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT Make ()
-  codegen m _ exts = do
+  codegen :: SourceSpan -> CF.Module CF.Ann -> Environment -> Externs -> SupplyT Make ()
+  codegen modSS m _ exts = do
     let mn = CF.moduleName m
     foreignInclude <- case mn `M.lookup` foreigns of
       Just path
         | not $ requiresForeign m -> do
-            tell $ errorMessage $ UnnecessaryFFIModule mn path
+            tell $ errorMessage' modSS $ UnnecessaryFFIModule mn path
             return Nothing
         | otherwise -> do
-            checkForeignDecls m path
+            checkForeignDecls modSS m path
             return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign"]
       Nothing | requiresForeign m -> throwError . errorMessage $ MissingFFIModule mn
               | otherwise -> return Nothing
@@ -425,8 +425,8 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
 
 -- | Check that the declarations in a given PureScript module match with those
 -- in its corresponding foreign module.
-checkForeignDecls :: CF.Module ann -> FilePath -> SupplyT Make ()
-checkForeignDecls m path = do
+checkForeignDecls :: SourceSpan -> CF.Module ann -> FilePath -> SupplyT Make ()
+checkForeignDecls modSS m path = do
   jsStr <- lift $ readTextFile path
   js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse (BU8.toString (B.toStrict jsStr)) path
 
@@ -439,12 +439,12 @@ checkForeignDecls m path = do
 
   let unusedFFI = foreignIdents S.\\ importedIdents
   unless (null unusedFFI) $
-    tell . errorMessage . UnusedFFIImplementations mname $
+    tell . errorMessage' modSS . UnusedFFIImplementations mname $
       S.toList unusedFFI
 
   let missingFFI = importedIdents S.\\ foreignIdents
   unless (null missingFFI) $
-    throwError . errorMessage . MissingFFIImplementations mname $
+    throwError . errorMessage' modSS . MissingFFIImplementations mname $
       S.toList missingFFI
 
   where
