@@ -12,40 +12,52 @@
1212--
1313-----------------------------------------------------------------------------
1414
15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
15+{-# LANGUAGE DataKinds #-}
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE RecordWildCards #-}
18+{-# LANGUAGE ScopedTypeVariables #-}
19+{-# LANGUAGE TupleSections #-}
1620
1721module Main where
1822
1923import Control.Applicative
2024import Control.Monad
25+import Control.Monad.Error.Class (MonadError(..))
2126import Control.Monad.Reader
27+import Control.Monad.Supply (evalSupplyT)
2228import Control.Monad.Writer
2329
2430import Data.Maybe (fromMaybe)
31+import Data.Traversable (traverse)
2532import Data.Version (showVersion)
2633
2734import Options.Applicative as Opts
35+
2836import System.Directory (createDirectoryIfMissing)
29−import System.FilePath (takeDirectory)
3037import System.Exit (exitSuccess, exitFailure)
31−import System.IO (hPutStrLn, stderr)
38+import System.FilePath (takeDirectory)
39+import System.IO (hPrint, hPutStrLn, stderr)
3240
41+import qualified Data.Map as M
3342import qualified Language.PureScript as P
43+import qualified Language.PureScript.Constants as C
44+import qualified Language.PureScript.CodeGen.JS as J
3445import qualified Paths_purescript as Paths
3546
3647data PSCOptions = PSCOptions
37− { pscInput :: [FilePath]
38− , pscOpts :: P.Options P.Compile
39− , pscStdIn :: Bool
40− , pscOutput :: Maybe FilePath
41− , pscExterns :: Maybe FilePath
42− , pscUsePrefix :: Bool
48+ { pscInput :: [FilePath]
49+ , pscForeignInput :: [FilePath]
50+ , pscOpts :: P.Options P.Compile
51+ , pscStdIn :: Bool
52+ , pscOutput :: Maybe FilePath
53+ , pscExterns :: Maybe FilePath
54+ , pscUsePrefix :: Bool
4355 }
4456
4557data InputOptions = InputOptions
46− { ioNoPrelude :: Bool
47− , ioUseStdIn :: Bool
48− , ioInputFiles :: [FilePath]
58+ { ioNoPrelude :: Bool
59+ , ioUseStdIn :: Bool
60+ , ioInputFiles :: [FilePath]
4961 }
5062
5163readInput :: InputOptions -> IO [(Maybe FilePath, String)]
@@ -59,19 +71,19 @@ runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.Multiple
5971runPSC opts rwe = runWriterT (runReaderT rwe opts)
6072
6173compile :: PSCOptions -> IO ()
62−compile (PSCOptions input opts stdin output externs usePrefix) = do
74+compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
6375 modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
6476 case modules of
6577 Left err -> do
66− hPutStrLn stderr $ show err
78+ hPrint stderr err
6779 exitFailure
68− Right ms -> do
69− case runPSC opts (P.compile (map snd ms) prefix) of
80+ Right ms ->
81+ case runPSC opts (compileJS (map snd ms) M.empty) of
7082 Left errs -> do
7183 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
7284 exitFailure
73− Right ((js, exts, _), warnings) -> do
74− when (P.nonEmpty warnings) $
85+ Right ((js, exts), warnings) -> do
86+ when (P.nonEmpty warnings) $
7587 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
7688 case output of
7789 Just path -> mkdirp path >> writeFile path js
@@ -85,6 +97,28 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do
8597 then ["Generated by psc version " ++ showVersion Paths.version]
8698 else []
8799
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
121+
88122mkdirp :: FilePath -> IO ()
89123mkdirp = createDirectoryIfMissing True . takeDirectory
90124
@@ -161,6 +195,12 @@ inputFile = strArgument $
161195 metavar "FILE"
162196 <> help "The input .purs file(s)"
163197
198+inputForeignFile :: Parser FilePath
199+inputForeignFile = strOption $
200+ short 'f'
201+ <> long "ffi"
202+ <> help "The input .purs file(s)"
203+
164204outputFile :: Parser (Maybe FilePath)
165205outputFile = optional . strOption $
166206 short 'o'
@@ -196,6 +236,7 @@ options = P.Options <$> noPrelude
196236
197237pscOptions :: Parser PSCOptions
198238pscOptions = PSCOptions <$> many inputFile
239+ <*> many inputForeignFile
199240 <*> options
200241 <*> useStdIn
201242 <*> outputFile
@@ -212,4 +253,3 @@ main = execParser opts >>= compile
212253
213254 version :: Parser (a -> a)
214255 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
215−