diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index ac06b6e1e3..02ae48d51b 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/src/Language/PureScript/Ide/Rebuild.hs @@ -14,9 +14,12 @@ import qualified Data.Map.Lazy as M import Data.Maybe (fromJust) 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 @@ -51,7 +54,10 @@ rebuildFile -- ^ A runner for the second build with open exports -> m Success rebuildFile file actualFile codegenTargets runOpenBuild = do - (fp, input) <- ideReadFile file + (fp, input) <- + case List.stripPrefix "data:" file of + Just source -> pure ("", Text.pack source) + _ -> ideReadFile file let fp' = fromMaybe fp actualFile (pwarnings, m) <- case sequence $ CST.parseFromFile fp' input of Left parseError -> @@ -65,13 +71,22 @@ 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) - 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") $ liftIO $ P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets }) do - newExterns <- P.rebuildModule (shushProgress makeEnv) externs m - updateCacheDb codegenTargets outputDirectory file actualFile moduleName + newExterns <- P.rebuildModule makeEnv externs m + unless pureRebuild + $ updateCacheDb codegenTargets outputDirectory file actualFile moduleName pure newExterns case result of Left errors -> @@ -176,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 index ff50ba1d0c..56900d3b1e 100644 --- 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")