diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs index d81dd75c07..4584fb2033 100644 --- a/app/Command/Compile.hs +++ b/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 diff --git a/src/Language/PureScript/Docs/Collect.hs b/src/Language/PureScript/Docs/Collect.hs index 0da65d2251..3a108f315a 100644 --- a/src/Language/PureScript/Docs/Collect.hs +++ b/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) diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index ebc34339eb..2eefd7172c 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/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)) diff --git a/src/Language/PureScript/Interactive.hs b/src/Language/PureScript/Interactive.hs index 5f88b079c3..5cc3d9d8c3 100644 --- a/src/Language/PureScript/Interactive.hs +++ b/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) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index 5228dc86e6..40b217d981 100644 --- a/src/Language/PureScript/Make.hs +++ b/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 + diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index f138327c8d..c286c489be 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/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))) diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs index d94d344cf0..141d20dc8b 100644 --- a/src/Language/PureScript/Options.hs +++ b/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) ] + diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 610e8465c8..b2aec6907c 100644 --- a/tests/TestMake.hs +++ b/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) } diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs index 146093c452..ff84034d9f 100644 --- a/tests/TestUtils.hs +++ b/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)