Add ffi check for ide rebuild without codegen

wclr · wclr · commit cebed8f676e2 · 2022-07-04T18:03:01.000+05:00
diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
@@ -16,8 +16,10 @@ import qualified Data.Set                        as S
 import qualified Data.Time                       as Time
 import qualified Data.Text                       as Text
 import qualified Language.PureScript             as P
+import           Language.PureScript.Make (ffiCodegen')
 import           Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache)
 import qualified Language.PureScript.CST         as CST
+
 import           Language.PureScript.Ide.Error
 import           Language.PureScript.Ide.Logging
 import           Language.PureScript.Ide.State
@@ -69,10 +71,15 @@ rebuildFile file actualFile codegenTargets runOpenBuild = do
   -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign
   -- modules using their file paths, we need to specify the path in the 'Map'.
   let filePathMap = M.singleton moduleName (Left P.RebuildAlways)
-  let pureRebuild = S.null codegenTargets
-  foreigns <- P.inferForeignModules (M.singleton moduleName (Right file))
+  let pureRebuild = fp == ""
+  let modulePath = if pureRebuild then fp' else file
+  foreigns <- P.inferForeignModules (M.singleton moduleName (Right modulePath))
   let makeEnv = P.buildMakeActions outputDirectory filePathMap foreigns False
         & (if pureRebuild then shushCodegen else identity)
+        & ( if pureRebuild
+              then enableForeignCheck foreigns codegenTargets
+              else identity
+          )
         & shushProgress
   -- Rebuild the single module using the cached externs
   (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $
@@ -184,6 +191,16 @@ shushCodegen ma =
      , P.ffiCodegen = \_ -> pure ()
      }
 
+-- | Enables foreign module check without actual codegen.
+enableForeignCheck
+  :: M.Map P.ModuleName FilePath
+  -> S.Set P.CodegenTarget
+  -> P.MakeActions P.Make
+  -> P.MakeActions P.Make
+enableForeignCheck foreigns codegenTargets ma =
+  ma { P.ffiCodegen = ffiCodegen' foreigns codegenTargets Nothing
+     }
+
 -- | Returns a topologically sorted list of dependent ExternsFiles for the given
 -- module. Throws an error if there is a cyclic dependency within the
 -- ExternsFiles
diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs
@@ -8,6 +8,7 @@ module Language.PureScript.Make.Actions
   , cacheDbFile
   , readCacheDb'
   , writeCacheDb'
+  , ffiCodegen'
   ) where
 
 import           Prelude
@@ -280,23 +281,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
   ffiCodegen :: CF.Module CF.Ann -> Make ()
   ffiCodegen m = do
     codegenTargets <- asks optionsCodegenTargets
-    when (S.member JS codegenTargets) $ do
-      let mn = CF.moduleName m
-      case mn `M.lookup` foreigns of
-        Just path
-          | not $ requiresForeign m ->
-              tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
-          | otherwise -> do
-              checkResult <- checkForeignDecls m path
-              case checkResult of
-                Left _ -> copyFile path (outputFilename mn "foreign.js")
-                Right (ESModule, _) -> copyFile path (outputFilename mn "foreign.js")
-                Right (CJSModule, _) -> do
-                  throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path
-
-        Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
-                | otherwise -> return ()
-
+    ffiCodegen' foreigns codegenTargets (Just outputFilename) m
 
   genSourceMap :: String -> String -> Int -> [SMap] -> Make ()
   genSourceMap dir mapFile extraLines mappings = do
@@ -358,7 +343,7 @@ checkForeignDecls m path = do
   modSS = CF.moduleSourceSpan m
 
   checkFFI :: JS.JSAST -> Make (ForeignModuleType, S.Set Ident)
-  checkFFI js = do 
+  checkFFI js = do
     (foreignModuleType, foreignIdentsStrs) <-
         case (,) <$> getForeignModuleExports js <*> getForeignModuleImports js of
           Left reason -> throwError $ errorParsingModule reason
@@ -438,3 +423,36 @@ checkForeignDecls m path = do
       . CST.runTokenParser CST.parseIdent
       . CST.lex
       $ T.pack str
+
+-- | FFI check and codegen action.
+-- If path maker is supplied copies foreign module to the output.
+ffiCodegen'
+  :: M.Map ModuleName FilePath
+  -> S.Set CodegenTarget
+  -> Maybe (ModuleName -> String -> FilePath)
+  -> CF.Module CF.Ann
+  -> Make ()
+ffiCodegen' foreigns codegenTargets makeOutputPath m = do
+  when (S.member JS codegenTargets) $ do
+    let mn = CF.moduleName m
+    case mn `M.lookup` foreigns of
+      Just path
+        | not $ requiresForeign m ->
+            tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path
+        | otherwise -> do
+            checkResult <- checkForeignDecls m path
+            case checkResult of
+              Left _ -> copyForeign path mn
+              Right (ESModule, _) -> copyForeign path mn
+              Right (CJSModule, _) -> do
+                throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path
+      Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
+              | otherwise -> return ()
+  where
+  requiresForeign = not . null . CF.moduleForeign
+
+  copyForeign path mn =
+    case makeOutputPath of
+        Nothing -> pure ()
+        Just outputFilename ->
+          copyFile path (outputFilename mn "foreign.js")
