FFI exts - previous tests pass

Author: noisyscanner

app/Command/Compile.hs

@@ -71,8 +71,8 @@ compile PSCMakeOptions{..} = do
   (makeErrors, makeWarnings) <- runMake pscmOpts $ do
     ms <- CST.parseModulesFromFiles id moduleFiles
     let filePathMap = M.fromList $ map (\(fp, pm) -> (P.getModuleName $ CST.resPartial pm, Right fp)) ms
-    foreigns <- inferForeignModules filePathMap
-    let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
+    foreigns <- inferForeignModules (P.optionsFFIExts pscmOpts) filePathMap
+    let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns (P.optionsFFIExts pscmOpts) pscmUsePrefix
     P.make makeActions (map snd ms)
   printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors moduleFiles makeWarnings makeErrors
   exitSuccess
@@ -131,9 +131,14 @@ targetParser =
       . T.unpack
       . T.strip
 
+ffiExtParser :: Opts.ReadM [String]
+ffiExtParser =
+  Opts.str >>= \s -> 
+    for (T.split (== ',') s)
+      $ pure . T.unpack . T.strip
+
 ffiExtensions :: Opts.Parser [String]
-ffiExtensions = Opts.option targetParser $
-     Opts.long "ffi-exts"
+ffiExtensions = Opts.option ffiExtParser $ Opts.long "ffi-exts"
   <> Opts.value ["js"]
   <> Opts.help
       ( "Specifies comma-separated file extensions to consider for foriegn module implementations. "

src/Language/PureScript/Docs/Collect.hs

@@ -93,9 +93,10 @@ compileForDocs outputDir inputFiles = do
     fmap fst $ P.runMake testOptions $ do
       ms <- P.parseModulesFromFiles identity moduleFiles
       let filePathMap = Map.fromList $ map (\(fp, pm) -> (P.getModuleName $ P.resPartial pm, Right fp)) ms
-      foreigns <- P.inferForeignModules filePathMap
+      ffiExts <- asks P.optionsFFIExts
+      foreigns <- P.inferForeignModules ffiExts filePathMap
       let makeActions =
-            (P.buildMakeActions outputDir filePathMap foreigns False)
+            (P.buildMakeActions outputDir filePathMap foreigns ffiExts False)
               { P.progress = liftIO . TIO.hPutStr stdout . (<> "\n") . P.renderProgressMessage "Compiling documentation for "
               }
       P.make makeActions (map snd ms)

src/Language/PureScript/Ide/Rebuild.hs

@@ -73,13 +73,14 @@ rebuildFile file actualFile codegenTargets runOpenBuild = do
   let filePathMap = M.singleton moduleName (Left P.RebuildAlways)
   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
+  let opts = P.defaultOptions { P.optionsCodegenTargets = codegenTargets }
+  foreigns <- P.inferForeignModules (P.optionsFFIExts opts) (M.singleton moduleName (Right modulePath))
+  let makeEnv = P.buildMakeActions outputDirectory filePathMap foreigns (P.optionsFFIExts opts) False
         & (if pureRebuild then enableForeignCheck foreigns codegenTargets . shushCodegen else identity)
         & shushProgress
   -- Rebuild the single module using the cached externs
   (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $
-    liftIO $ P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets }) do
+    liftIO $ P.runMake opts do
       newExterns <- P.rebuildModule makeEnv externs m
       unless pureRebuild
         $ updateCacheDb codegenTargets outputDirectory file actualFile moduleName
@@ -123,7 +124,8 @@ updateCacheDb codegenTargets outputDirectory file actualFile moduleName = do
 
   foreignCacheInfo <-
     if S.member P.JS codegenTargets then do
-      foreigns' <- P.inferForeignModules (M.singleton moduleName (Right (fromMaybe file actualFile)))
+      let opts = P.defaultOptions { P.optionsCodegenTargets = codegenTargets }
+      foreigns' <- P.inferForeignModules (P.optionsFFIExts opts) (M.singleton moduleName (Right (fromMaybe file actualFile)))
       for (M.lookup moduleName foreigns') \foreignPath -> do
         foreignHash <- P.hashFile foreignPath
         pure (normaliseForCache cwd foreignPath, (dayZero, foreignHash))

src/Language/PureScript/Interactive.hs

@@ -68,6 +68,7 @@ rebuild loadedExterns m = do
       (P.buildMakeActions modulesDir
                           filePathMap
                           M.empty
+                          mempty
                           False) { P.progress = const (return ()) }
 
     filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
@@ -78,15 +79,17 @@ make
   :: [(FilePath, CST.PartialResult P.Module)]
   -> P.Make ([P.ExternsFile], P.Environment)
 make ms = do
-    foreignFiles <- P.inferForeignModules filePathMap
-    externs <- P.make (buildActions foreignFiles) (map snd ms)
+    ffiExts <- asks P.optionsFFIExts
+    foreignFiles <- P.inferForeignModules ffiExts filePathMap
+    externs <- P.make (buildActions ffiExts foreignFiles) (map snd ms)
     return (externs, foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs)
   where
-    buildActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make
-    buildActions foreignFiles =
+    buildActions :: S.Set String -> M.Map P.ModuleName FilePath -> P.MakeActions P.Make
+    buildActions ffiExts foreignFiles =
       P.buildMakeActions modulesDir
                          filePathMap
                          foreignFiles
+                         ffiExts
                          False
 
     filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

src/Language/PureScript/Make.hs

@@ -283,28 +283,30 @@ make ma@MakeActions{..} ms = do
     BuildPlan.markComplete buildPlan moduleName result
 
 -- | Infer the module name for a module by looking for the same filename with
--- a .js or .ts extension.
+-- an FFI extension (e.g., .js, .ts, or other configured extensions).
 inferForeignModules
   :: forall m
    . MonadIO m
-  => M.Map ModuleName (Either RebuildPolicy FilePath)
+  => S.Set String
+  -- ^ Set of FFI extensions to check (e.g., {"js", "ts"})
+  -> M.Map ModuleName (Either RebuildPolicy FilePath)
   -> m (M.Map ModuleName FilePath)
-inferForeignModules =
+inferForeignModules exts =
     fmap (M.mapMaybe id) . traverse inferForeignModule
   where
     inferForeignModule :: Either RebuildPolicy FilePath -> m (Maybe FilePath)
     inferForeignModule (Left _) = return Nothing
     inferForeignModule (Right path) = do
-      let 
-        jsFile = replaceExtension path "js"
-        tsFile = replaceExtension path "ts"
-      existsJs <- liftIO $ doesFileExist jsFile
-
-      if existsJs
-        then return (Just jsFile)
-        else do
-        existsTs <- liftIO $ doesFileExist tsFile
-        if existsTs
-          then return (Just tsFile)
-          else return Nothing
+      -- Try each extension in order
+      let extList = S.toList exts
+          candidates = map (replaceExtension path) extList
+      findFirst candidates
+
+    findFirst :: [FilePath] -> m (Maybe FilePath)
+    findFirst [] = return Nothing
+    findFirst (fp:fps) = do
+      exists <- liftIO $ doesFileExist fp
+      if exists
+        then return (Just fp)
+        else findFirst fps
 

src/Language/PureScript/Make/Actions.hs

@@ -171,10 +171,12 @@ buildMakeActions
   -- ^ a map between module names and paths to the file containing the PureScript module
   -> M.Map ModuleName FilePath
   -- ^ a map between module name and the file containing the foreign javascript for the module
+  -> S.Set String
+  -- ^ the set of FFI file extensions
   -> Bool
   -- ^ Generate a prefix comment?
   -> MakeActions Make
-buildMakeActions outputDir filePathMap foreigns usePrefix =
+buildMakeActions outputDir filePathMap foreigns _ffiExts usePrefix =
     MakeActions getInputTimestampsAndHashes getOutputTimestamp readExterns codegen ffiCodegen progress readCacheDb writeCacheDb writePackageJson outputPrimDocs
   where
 
@@ -261,7 +263,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
           | not $ requiresForeign m -> do
               return Nothing
           | otherwise -> do
-              let ext = if takeExtension path == ".ts" then ".ts" else ".js"
+              let ext = takeExtension path
               return $ Just (mkString $ T.pack $ "./foreign" ++ ext)
         Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
                 | otherwise -> return Nothing

src/Language/PureScript/Options.hs

@@ -14,11 +14,12 @@ data Options = Options
   -- ^ Remove the comments from the generated js
   , optionsCodegenTargets :: S.Set CodegenTarget
   -- ^ Codegen targets (JS, CoreFn, etc.)
+  , optionsFFIExts :: S.Set String
   } deriving Show
 
 -- Default make options
 defaultOptions :: Options
-defaultOptions = Options False False (S.singleton JS)
+defaultOptions = Options False False (S.singleton JS) (S.singleton "js")
 
 data CodegenTarget = JS | JSSourceMap | CoreFn | Docs
   deriving (Eq, Ord, Show)
@@ -30,3 +31,4 @@ codegenTargets = Map.fromList
   , ("corefn", CoreFn)
   , ("docs", Docs)
   ]
+

tests/TestMake.hs

@@ -10,6 +10,7 @@ import Language.PureScript.CST qualified as CST
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (guard, void)
+import Control.Monad.Reader (asks)
 import Control.Exception (tryJust)
 import Control.Monad.IO.Class (liftIO)
 import Control.Concurrent.MVar (readMVar, newMVar, modifyMVar_)
@@ -229,9 +230,10 @@ compileWithOptions opts input = do
   (makeResult, _) <- P.runMake opts $ do
     ms <- CST.parseModulesFromFiles id moduleFiles
     let filePathMap = M.fromList $ map (\(fp, pm) -> (P.getModuleName $ CST.resPartial pm, Right fp)) ms
-    foreigns <- P.inferForeignModules filePathMap
+    ffiExts <- asks P.optionsFFIExts
+    foreigns <- P.inferForeignModules ffiExts filePathMap
     let makeActions =
-          (P.buildMakeActions modulesDir filePathMap foreigns True)
+          (P.buildMakeActions modulesDir filePathMap foreigns ffiExts True)
             { P.progress = \(P.CompilingModule mn _) ->
                 liftIO $ modifyMVar_ recompiled (return . Set.insert mn)
             }

tests/TestUtils.hs

@@ -238,7 +238,7 @@ getPsModuleName psModule = case snd psModule of
   AST.Module _ _ (N.ModuleName t) _ _ -> t
 
 makeActions :: [P.Module] -> M.Map P.ModuleName FilePath -> P.MakeActions P.Make
-makeActions modules foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns False)
+makeActions modules foreigns = (P.buildMakeActions modulesDir (P.internalError "makeActions: input file map was read.") foreigns mempty False)
                                { P.getInputTimestampsAndHashes = getInputTimestampsAndHashes
                                , P.getOutputTimestamp = getOutputTimestamp
                                , P.progress = const (pure ())
@@ -265,7 +265,7 @@ inferForeignModules
   :: MonadIO m
   => [(FilePath, P.Module)]
   -> m (M.Map P.ModuleName FilePath)
-inferForeignModules = P.inferForeignModules . fromList
+inferForeignModules = P.inferForeignModules (P.optionsFFIExts P.defaultOptions) . fromList
   where
     fromList :: [(FilePath, P.Module)] -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
     fromList = M.fromList . map ((P.getModuleName *** Right) . swap)