diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs index 84555a5413..7bd97997c9 100644 --- a/src/Language/PureScript/Ide/Rebuild.hs +++ b/src/Language/PureScript/Ide/Rebuild.hs @@ -154,11 +154,12 @@ shushProgress :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make shushProgress ma _ = ma { P.progress = \_ -> pure () } --- | Stops any kind of codegen (also silences errors about missing or unused FFI --- files though) +-- | Stops any kind of codegen shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make shushCodegen ma MakeActionsEnv{..} = - ma { P.codegen = \_ _ _ -> pure () } + ma { P.codegen = \_ _ _ -> pure () + , P.ffiCodegen = \_ -> pure () + } -- | Returns a topologically sorted list of dependent ExternsFiles for the given -- module. Throws an error if there is a cyclic dependency within the diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index 112ddbdf13..0341ee25da 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -75,6 +75,7 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do optimized = CF.optimizeCoreFn corefn [renamed] = renameInModules [optimized] exts = moduleToExternsFile mod' env' + ffiCodegen renamed evalSupplyT nextVar' . codegen renamed env' . encode $ exts return exts diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs index 13b50b36f6..b5e7743735 100644 --- a/src/Language/PureScript/Make/Actions.hs +++ b/src/Language/PureScript/Make/Actions.hs @@ -4,6 +4,7 @@ module Language.PureScript.Make.Actions , Externs() , ProgressMessage(..) , buildMakeActions + , checkForeignDecls ) where import Prelude @@ -95,6 +96,8 @@ data MakeActions m = MakeActions -- path for the file. , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m () -- ^ Run the code generator for the module and write any required output files. + , ffiCodegen :: CF.Module CF.Ann -> m () + -- ^ Check ffi and print it in the output directory. , progress :: ProgressMessage -> m () -- ^ Respond to a progress update. } @@ -111,7 +114,7 @@ buildMakeActions -- ^ Generate a prefix comment? -> MakeActions Make buildMakeActions outputDir filePathMap foreigns usePrefix = - MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress + MakeActions getInputTimestamp getOutputTimestamp readExterns codegen ffiCodegen progress where getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime)) @@ -155,12 +158,10 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = lift $ writeTextFile coreFnFile (encode json) when (S.member JS codegenTargets) $ do foreignInclude <- case mn `M.lookup` foreigns of - Just path + Just _ | not $ requiresForeign m -> do - tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path return Nothing | otherwise -> do - checkForeignDecls m path return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"] Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn | otherwise -> return Nothing @@ -168,7 +169,6 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = dir <- lift $ makeIO (const (ErrorMessage [] $ CannotGetFileInfo ".")) getCurrentDirectory let sourceMaps = S.member JSSourceMap codegenTargets (pjs, mappings) = if sourceMaps then prettyPrintJSWithSourceMaps rawJs else (prettyPrintJS rawJs, []) - foreignFile = outputFilename mn "foreign.js" jsFile = targetFilename mn JS mapFile = targetFilename mn JSSourceMap prefix = ["Generated by purs version " <> T.pack (showVersion Paths.version) | usePrefix] @@ -176,9 +176,24 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = mapRef = if sourceMaps then "//# sourceMappingURL=index.js.map\n" else "" lift $ do writeTextFile jsFile (B.fromStrict $ TE.encodeUtf8 $ js <> mapRef) - for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile) when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings + ffiCodegen :: CF.Module CF.Ann -> Make () + ffiCodegen m = do + codegenTargets <- asks optionsCodegenTargets + when (S.member JS codegenTargets) $ do + let mn = CF.moduleName m + foreignFile = outputFilename mn "foreign.js" + case mn `M.lookup` foreigns of + Just path + | not $ requiresForeign m -> + tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path + | otherwise -> + checkForeignDecls m path + Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn + | otherwise -> return () + for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile) + genSourceMap :: String -> String -> Int -> [SMap] -> Make () genSourceMap dir mapFile extraLines mappings = do let pathToDir = iterate (".." ) ".." !! length (splitPath $ normalise outputDir) @@ -226,9 +241,9 @@ buildMakeActions outputDir filePathMap foreigns usePrefix = -- | Check that the declarations in a given PureScript module match with those -- in its corresponding foreign module. -checkForeignDecls :: CF.Module ann -> FilePath -> SupplyT Make () +checkForeignDecls :: CF.Module ann -> FilePath -> Make () checkForeignDecls m path = do - jsStr <- lift $ readTextFile path + jsStr <- readTextFile path js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse (LBU8.toString jsStr) path foreignIdentsStrs <- either errorParsingModule pure $ getExps js @@ -252,13 +267,13 @@ checkForeignDecls m path = do mname = CF.moduleName m modSS = CF.moduleSourceSpan m - errorParsingModule :: Bundle.ErrorMessage -> SupplyT Make a + errorParsingModule :: Bundle.ErrorMessage -> Make a errorParsingModule = throwError . errorMessage' modSS . ErrorParsingFFIModule path . Just getExps :: JS.JSAST -> Either Bundle.ErrorMessage [String] getExps = Bundle.getExportedIdentifiers (T.unpack (runModuleName mname)) - errorInvalidForeignIdentifiers :: [String] -> SupplyT Make a + errorInvalidForeignIdentifiers :: [String] -> Make a errorInvalidForeignIdentifiers = throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack)