@@ -25,7 +25,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25import System.Exit
25import System.Exit
26import System.Process
26import System.Process
27import System.FilePath (pathSeparator)
27import System.FilePath (pathSeparator)
28−import System.Directory (getCurrentDirectory, getDirectoryContents, findExecutable)
28+import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable)
29import Text.Parsec (ParseError)
29import Text.Parsec (ParseError)
30import qualified Paths_purescript as Paths
30import qualified Paths_purescript as Paths
31import qualified System.IO.UTF8 as U
31import qualified System.IO.UTF8 as U
@@ -38,62 +38,66 @@ readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputF
38 text <- U.readFile inputFile
38 text <- U.readFile inputFile
39 return $ P.runIndentParser inputFile P.parseModules text
39 return $ P.runIndentParser inputFile P.parseModules text
41−compile :: P.Options -> [FilePath] -> IO (Either String String)
41+compile :: P.Options -> [FilePath] -> IO (Either String (String, String, P.Environment))
42compile opts inputFiles = do
42compile opts inputFiles = do
43 modules <- readInput inputFiles
43 modules <- readInput inputFiles
44 case modules of
44 case modules of
45 Left parseError ->
45 Left parseError ->
46 return (Left $ show parseError)
46 return (Left $ show parseError)
48− case P.compile opts ms of
47+ Right ms -> return $ P.compile opts ms
50− return (Left typeError)
54−assert :: P.Options -> [FilePath] -> (Either String String -> IO (Maybe String)) -> IO ()
49+assert :: FilePath -> P.Options -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
55−assert opts inputFiles f = do
50+assert preludeExterns opts inputFile f = do
56− e <- compile opts inputFiles
51+ e <- compile opts [preludeExterns, inputFile]
57 maybeErr <- f e
52 maybeErr <- f e
58 case maybeErr of
53 case maybeErr of
59 Just err -> putStrLn err >> exitFailure
54 Just err -> putStrLn err >> exitFailure
60 Nothing -> return ()
55 Nothing -> return ()
62−assertCompiles :: FilePath -> IO ()
57+assertCompiles :: FilePath -> FilePath -> FilePath -> IO ()
63−assertCompiles inputFile = do
58+assertCompiles preludeJs preludeExterns inputFile = do
64− putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
59+ putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"
65− prelude <- preludeFilename
66− assert (P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"] }) [prelude, inputFile] $ either (return . Just) $ \js -> do
60+ let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"] }
61+ assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do
67 process <- findNodeProcess
62 process <- findNodeProcess
68− result <- traverse (\node -> readProcessWithExitCode node [] js) process
63+ result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process
69 case result of
64 case result of
70 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing
65 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing
71 Just (ExitFailure _, _, err) -> return $ Just err
66 Just (ExitFailure _, _, err) -> return $ Just err
72 Nothing -> return $ Just "Couldn't find node.js executable"
67 Nothing -> return $ Just "Couldn't find node.js executable"
74−findNodeProcess :: IO (Maybe String)
69+assertDoesNotCompile :: FilePath -> FilePath -> IO ()
75−findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
76− where names = ["nodejs", "node"]
78−assertDoesNotCompile :: FilePath -> IO ()
79−assertDoesNotCompile inputFile = do
70+assertDoesNotCompile preludeExterns inputFile = do
80− putStrLn $ "assert " ++ inputFile ++ " does not compile"
71+ putStrLn $ "Assert " ++ inputFile ++ " does not compile"
81− assert P.defaultOptions [inputFile] $ \e ->
72+ assert preludeExterns P.defaultOptions inputFile $ \e ->
83 Left _ -> return Nothing
74 Left _ -> return Nothing
84 Right _ -> return $ Just "Should not have compiled"
75 Right _ -> return $ Just "Should not have compiled"
77+findNodeProcess :: IO (Maybe String)
78+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
79+ where names = ["nodejs", "node"]
86main :: IO ()
81main :: IO ()
83+ prelude <- preludeFilename
84+ putStrLn "Compiling Prelude"
85+ preludeResult <- compile P.defaultOptions [prelude]
86+ case preludeResult of
87+ Left err -> putStrLn err >> exitFailure
88+ Right (preludeJs, exts, _) -> do
89+ tmp <- getTemporaryDirectory
90+ let preludeExterns = tmp ++ pathSeparator : "prelude.externs"
91+ writeFile preludeExterns exts
92+ putStrLn $ "Wrote " ++ preludeExterns
88− cd <- getCurrentDirectory
93+ cd <- getCurrentDirectory
90− let examples = cd ++ pathSeparator : "examples"
94+ let examples = cd ++ pathSeparator : "examples"
91− let passing = examples ++ pathSeparator : "passing"
95+ let passing = examples ++ pathSeparator : "passing"
92− passingTestCases <- getDirectoryContents passing
96+ passingTestCases <- getDirectoryContents passing
93− forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
97+ forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
94− assertCompiles (passing ++ pathSeparator : inputFile)
98+ assertCompiles preludeJs preludeExterns (passing ++ pathSeparator : inputFile)
95− let failing = examples ++ pathSeparator : "failing"
99+ let failing = examples ++ pathSeparator : "failing"
96− failingTestCases <- getDirectoryContents failing
100+ failingTestCases <- getDirectoryContents failing
97− forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
101+ forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
98− assertDoesNotCompile (failing ++ pathSeparator : inputFile)
102+ assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)
99− exitSuccess
103+ exitSuccess