Allow TS to be used for FFI modules

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,12 +131,27 @@ 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 ffiExtParser $ Opts.long "ffi-exts"
+  <> Opts.value ["js"]
+  <> Opts.help
+      ( "Specifies comma-separated file extensions to consider for foriegn module implementations. "
+      <> "Defaults to js"
+      )
+
 options :: Opts.Parser P.Options
 options =
   P.Options
     <$> verboseErrors
     <*> (not <$> comments)
     <*> (handleTargets <$> codegenTargets)
+    <*> (S.fromList <$> ffiExtensions)
   where
     -- Ensure that the JS target is included if sourcemaps are
     handleTargets :: [P.CodegenTarget] -> S.Set P.CodegenTarget

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,20 +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 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"
-      exists <- liftIO $ doesFileExist jsFile
+      -- 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 jsFile)
-        else return Nothing
+        then return (Just fp)
+        else findFirst fps
+

src/Language/PureScript/Make/Actions.hs

@@ -51,11 +51,12 @@ import Language.PureScript.Make.Cache (CacheDb, ContentHash, normaliseForCache)
 import Language.PureScript.Names (Ident(..), ModuleName, runModuleName)
 import Language.PureScript.Options (CodegenTarget(..), Options(..))
 import Language.PureScript.Pretty.Common (SMap(..))
+import Language.PureScript.PSString (mkString)
 import Paths_purescript qualified as Paths
 import SourceMap (generate)
 import SourceMap.Types (Mapping(..), Pos(..), SourceMapping(..))
 import System.Directory (getCurrentDirectory)
-import System.FilePath ((</>), makeRelative, splitPath, normalise, splitDirectories)
+import System.FilePath ((</>), makeRelative, splitPath, normalise, splitDirectories, takeExtension)
 import System.FilePath.Posix qualified as Posix
 import System.IO (stderr)
 
@@ -170,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
 
@@ -256,11 +259,12 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
       lift $ writeJSONFile coreFnFile json
     when (S.member JS codegenTargets) $ do
       foreignInclude <- case mn `M.lookup` foreigns of
-        Just _
+        Just path
           | not $ requiresForeign m -> do
               return Nothing
           | otherwise -> do
-              return $ Just "./foreign.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
       rawJs <- J.moduleToJs m foreignInclude
@@ -331,12 +335,19 @@ data ForeignModuleType = ESModule | CJSModule deriving (Show)
 -- in its corresponding foreign module.
 checkForeignDecls :: CF.Module ann -> FilePath -> Make (Either MultipleErrors (ForeignModuleType, S.Set Ident))
 checkForeignDecls m path = do
-  jsStr <- T.unpack <$> readTextFile path
-
-  let
-    parseResult :: Either MultipleErrors JS.JSAST
-    parseResult = first (errorParsingModule . Bundle.UnableToParseModule) $ JS.parseModule jsStr path
-  traverse checkFFI parseResult
+  if takeExtension path == ".js"
+    then do
+      jsStr <- T.unpack <$> readTextFile path
+
+      let
+        parseResult :: Either MultipleErrors JS.JSAST
+        parseResult = first (errorParsingModule . Bundle.UnableToParseModule) $ JS.parseModule jsStr path
+      traverse checkFFI parseResult
+    else do
+      -- We cannot parse non-JS files to check for exports
+      -- Instead return a successful ES module result without validation
+      let foreignIdents = S.fromList (CF.moduleForeign m)
+      return $ Right (ESModule, foreignIdents)
 
   where
   mname = CF.moduleName m
@@ -451,5 +462,6 @@ ffiCodegen' foreigns codegenTargets makeOutputPath m = do
   where
   requiresForeign = not . null . CF.moduleForeign
 
-  copyForeign path mn =
-    for_ makeOutputPath (\outputFilename -> copyFile path (outputFilename mn "foreign.js"))
+  copyForeign path mn = do
+    let ext = takeExtension path
+    for_ makeOutputPath (\outputFilename -> copyFile path (outputFilename mn ("foreign" ++ ext)))

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)