@@ -36,14 +36,16 @@ import Options.Applicative as Opts
36import System.Directory (createDirectoryIfMissing)
36import System.Directory (createDirectoryIfMissing)
37import System.Exit (exitSuccess, exitFailure)
37import System.Exit (exitSuccess, exitFailure)
38import System.FilePath (takeDirectory)
38import System.FilePath (takeDirectory)
39−import System.IO (hPrint, hPutStrLn, stderr)
39+import System.IO (hPutStrLn, stderr)
41import qualified Data.Map as M
41import qualified Data.Map as M
42import qualified Language.PureScript as P
42import qualified Language.PureScript as P
43−import qualified Language.PureScript.Constants as C
44import qualified Language.PureScript.CodeGen.JS as J
43import qualified Language.PureScript.CodeGen.JS as J
44+import qualified Language.PureScript.Constants as C
45import qualified Paths_purescript as Paths
45import qualified Paths_purescript as Paths
47data PSCOptions = PSCOptions
49data PSCOptions = PSCOptions
48 { pscInput :: [FilePath]
50 { pscInput :: [FilePath]
49 , pscForeignInput :: [FilePath]
51 , pscForeignInput :: [FilePath]
@@ -72,13 +74,15 @@ runPSC opts rwe = runWriterT (runReaderT rwe opts)
73compile :: PSCOptions -> IO ()
75compile :: PSCOptions -> IO ()
74compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
76compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
77+ let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
75− modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
78+ moduleFiles <- readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
76− case modules of
79+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
80+ case parseInputs moduleFiles foreignFiles of
77 Left err -> do
81 Left err -> do
78− hPrint stderr err
82+ hPutStrLn stderr err
79 exitFailure
83 exitFailure
80− Right ms ->
84+ Right (ms, foreigns) ->
81− case runPSC opts (compileJS (map snd ms) M.empty) of
85+ case runPSC opts (compileJS (map snd ms) M.empty prefix) of
82 Left errs -> do
86 Left errs -> do
83 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
87 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
84 exitFailure
88 exitFailure
@@ -92,32 +96,33 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
92 Just path -> mkdirp path >> writeFile path exts
96 Just path -> mkdirp path >> writeFile path exts
93 Nothing -> return ()
97 Nothing -> return ()
94 exitSuccess
98 exitSuccess
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
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']
96− prefix = if usePrefix
115+
97− then ["Generated by psc version " ++ showVersion Paths.version]
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']
111− generateMain :: P.Environment -> [J.JS] -> m [J.JS]
116+ generateMain :: P.Environment -> [J.JS] -> m [J.JS]
112− generateMain env js = do
117+ generateMain env js = do
113− mainName <- asks P.optionsMain
118+ mainName <- asks P.optionsMain
114− additional <- asks P.optionsAdditional
119+ additional <- asks P.optionsAdditional
115− case P.moduleNameFromString <$> mainName of
120+ case P.moduleNameFromString <$> mainName of
116− Just mmi -> do
121+ Just mmi -> do
117− when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
122+ when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
118− throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
123+ throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
119− return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
124+ return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
120− _ -> return js
125+ _ -> return js
122mkdirp :: FilePath -> IO ()
127mkdirp :: FilePath -> IO ()
123mkdirp = createDirectoryIfMissing True . takeDirectory
128mkdirp = createDirectoryIfMissing True . takeDirectory
@@ -199,7 +204,7 @@ inputForeignFile :: Parser FilePath
199inputForeignFile = strOption $
204inputForeignFile = strOption $
200 short 'f'
205 short 'f'
201 <> long "ffi"
206 <> long "ffi"
202− <> help "The input .purs file(s)"
207+ <> help "The input .js file(s) providing foreign import implementations"
204outputFile :: Parser (Maybe FilePath)
209outputFile :: Parser (Maybe FilePath)
205outputFile = optional . strOption $
210outputFile = optional . strOption $