@@ -36,14 +36,16 @@ import Options.Applicative as Opts
3636import System.Directory (createDirectoryIfMissing)
3737import System.Exit (exitSuccess, exitFailure)
3838import System.FilePath (takeDirectory)
39−import System.IO (hPrint, hPutStrLn, stderr)
39+import System.IO (hPutStrLn, stderr)
4040
4141import qualified Data.Map as M
4242import qualified Language.PureScript as P
43−import qualified Language.PureScript.Constants as C
4443import qualified Language.PureScript.CodeGen.JS as J
44+import qualified Language.PureScript.Constants as C
4545import qualified Paths_purescript as Paths
4646
47+import Foreign
48+
4749data PSCOptions = PSCOptions
4850 { pscInput :: [FilePath]
4951 , pscForeignInput :: [FilePath]
@@ -72,13 +74,15 @@ runPSC opts rwe = runWriterT (runReaderT rwe opts)
7274
7375compile :: PSCOptions -> IO ()
7476compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
75− modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
76− case modules of
77+ let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
78+ moduleFiles <- readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
79+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
80+ case parseInputs moduleFiles foreignFiles of
7781 Left err -> do
78− hPrint stderr err
82+ hPutStrLn stderr err
7983 exitFailure
80− Right ms ->
81− case runPSC opts (compileJS (map snd ms) M.empty) of
84+ Right (ms, foreigns) ->
85+ case runPSC opts (compileJS (map snd ms) M.empty prefix) of
8286 Left errs -> do
8387 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
8488 exitFailure
@@ -92,32 +96,33 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
9296 Just path -> mkdirp path >> writeFile path exts
9397 Nothing -> return ()
9498 exitSuccess
99+
100+parseInputs :: [(Maybe FilePath, String)] -> [(FilePath, String)] -> Either String ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)
101+parseInputs modules foreigns =
102+ (,) <$> either (Left . show) Right (P.parseModulesFromFiles (fromMaybe "") modules)
103+ <*> parseForeignModulesFromFiles foreigns
104+
105+compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
106+ => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)
107+compileJS ms foreigns prefix = do
108+ (modulesToCodeGen, exts, env, nextVar) <- P.compile ms
109+ js <- concat <$> evalSupplyT nextVar (traverse J.moduleToJs modulesToCodeGen)
110+ js' <- generateMain env js
111+ let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
112+ return (pjs, exts)
113+
95114 where
96− prefix = if usePrefix
97− then ["Generated by psc version " ++ showVersion Paths.version]
98− else []
99−
100− compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
101− => [P.Module] -> M.Map P.ModuleName String -> m (String, String)
102− compileJS ms foreigns = do
103− (modulesToCodeGen, exts, env, nextVar) <- P.compile ms
104− js <- concat <$> evalSupplyT nextVar (traverse J.moduleToJs modulesToCodeGen)
105− js' <- generateMain env js
106− let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
107− return (pjs, exts)
108−
109− where
110−
111− generateMain :: P.Environment -> [J.JS] -> m [J.JS]
112− generateMain env js = do
113− mainName <- asks P.optionsMain
114− additional <- asks P.optionsAdditional
115− case P.moduleNameFromString <$> mainName of
116− Just mmi -> do
117− when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
118− throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
119− return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
120− _ -> return js
115+
116+ generateMain :: P.Environment -> [J.JS] -> m [J.JS]
117+ generateMain env js = do
118+ mainName <- asks P.optionsMain
119+ additional <- asks P.optionsAdditional
120+ case P.moduleNameFromString <$> mainName of
121+ Just mmi -> do
122+ when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
123+ throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
124+ return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
125+ _ -> return js
121126
122127mkdirp :: FilePath -> IO ()
123128mkdirp = createDirectoryIfMissing True . takeDirectory
@@ -199,7 +204,7 @@ inputForeignFile :: Parser FilePath
199204inputForeignFile = strOption $
200205 short 'f'
201206 <> long "ffi"
202− <> help "The input .purs file(s)"
207+ <> help "The input .js file(s) providing foreign import implementations"
203208
204209outputFile :: Parser (Maybe FilePath)
205210outputFile = optional . strOption $