purescript · kritzcreek · Sep 24, 2018 · Sep 18, 2018 · Sep 21, 2018 · Sep 24, 2018
diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
@@ -154,11 +154,12 @@ shushProgress :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
 shushProgress ma _ =
   ma { P.progress = \_ -> pure () }
 
--- | Stops any kind of codegen (also silences errors about missing or unused FFI
--- files though)
 . P.rebuildModule (buildMakeActions 
                     >>= shushProgress $ makeEnv) externs $ m 
 . P.rebuildModule (buildMakeActions 
                     >>= shushProgress $ makeEnv) externs $ m 
+-- | Stops any kind of codegen
 shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
 shushCodegen ma MakeActionsEnv{..} =
-  ma { P.codegen = \_ _ _ -> pure () }
+  ma { P.codegen = \_ _ _ -> pure ()
+     , P.ffiCodegen = \_ -> 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
@@ -75,6 +75,7 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do
       optimized = CF.optimizeCoreFn corefn
       [renamed] = renameInModules [optimized]
       exts = moduleToExternsFile mod' env'
+  ffiCodegen renamed
   evalSupplyT nextVar' . codegen renamed env' . encode $ exts
   return exts
 

diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs
@@ -4,6 +4,7 @@ module Language.PureScript.Make.Actions
   , Externs()
   , ProgressMessage(..)
   , buildMakeActions
+  , checkForeignDecls
   ) where
 
 import           Prelude
@@ -95,6 +96,8 @@ data MakeActions m = MakeActions
   -- path for the file.
   , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()
   -- ^ Run the code generator for the module and write any required output files.
+  , ffiCodegen :: CF.Module CF.Ann -> m ()
+  -- ^ Check ffi and print it in the output directory.
   , progress :: ProgressMessage -> m ()
   -- ^ Respond to a progress update.
   }
@@ -111,7 +114,7 @@ buildMakeActions
   -- ^ Generate a prefix comment?
   -> MakeActions Make
 buildMakeActions outputDir filePathMap foreigns usePrefix =
-    MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
+    MakeActions getInputTimestamp getOutputTimestamp readExterns codegen ffiCodegen progress
   where
 
   getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))
@@ -155,30 +158,42 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
       lift $ writeTextFile coreFnFile (encode json)
     when (S.member JS codegenTargets) $ do
       foreignInclude <- case mn `M.lookup` foreigns of
-        Just path
+        Just _
           | not $ requiresForeign m -> do
-              tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
               return Nothing
           | otherwise -> do
-              checkForeignDecls m path
               return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"]
         Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
                 | otherwise -> return Nothing
       rawJs <- J.moduleToJs m foreignInclude
       dir <- lift $ makeIO (const (ErrorMessage [] $ CannotGetFileInfo ".")) getCurrentDirectory
       let sourceMaps = S.member JSSourceMap codegenTargets
           (pjs, mappings) = if sourceMaps then prettyPrintJSWithSourceMaps rawJs else (prettyPrintJS rawJs, [])
-          foreignFile = outputFilename mn "foreign.js"
           jsFile = targetFilename mn JS
           mapFile = targetFilename mn JSSourceMap
           prefix = ["Generated by purs version " <> T.pack (showVersion Paths.version) | usePrefix]
           js = T.unlines $ map ("// " <>) prefix ++ [pjs]
           mapRef = if sourceMaps then "//# sourceMappingURL=index.js.map\n" else ""
       lift $ do
         writeTextFile jsFile (B.fromStrict $ TE.encodeUtf8 $ js <> mapRef)
-        for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)
         when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings
 
+  ffiCodegen :: CF.Module CF.Ann -> Make ()
+  ffiCodegen m = do
+    codegenTargets <- asks optionsCodegenTargets
+    when (S.member JS codegenTargets) $ do
+      let mn = CF.moduleName m
+          foreignFile = outputFilename mn "foreign.js"
+      case mn `M.lookup` foreigns of
+        Just path
+          | not $ requiresForeign m ->
+              tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
+          | otherwise ->
+              checkForeignDecls m path
+        Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
+                | otherwise -> return ()
+      for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)
+
   genSourceMap :: String -> String -> Int -> [SMap] -> Make ()
   genSourceMap dir mapFile extraLines mappings = do
     let pathToDir = iterate (".." </>) ".." !! length (splitPath $ normalise outputDir)
@@ -226,9 +241,9 @@ 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 :: CF.Module ann -> FilePath -> Make ()
 checkForeignDecls m path = do
-  jsStr <- lift $ readTextFile path
+  jsStr <- readTextFile path
   js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse (LBU8.toString jsStr) path
 
   foreignIdentsStrs <- either errorParsingModule pure $ getExps js
@@ -252,13 +267,13 @@ checkForeignDecls m path = do
   mname = CF.moduleName m
   modSS = CF.moduleSourceSpan m
 
-  errorParsingModule :: Bundle.ErrorMessage -> SupplyT Make a
+  errorParsingModule :: Bundle.ErrorMessage -> Make a
   errorParsingModule = throwError . errorMessage' modSS . ErrorParsingFFIModule path . Just
 
   getExps :: JS.JSAST -> Either Bundle.ErrorMessage [String]
   getExps = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname))
 
-  errorInvalidForeignIdentifiers :: [String] -> SupplyT Make a
+  errorInvalidForeignIdentifiers :: [String] -> Make a
   errorInvalidForeignIdentifiers =
     throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack)