git.iko.soy/rowtype-yoga/purescript-native
on 8030607 help sign in
rowtype-yoga/purescript-native/tests/Main.hs
103 lines 4.1 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Main
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DoAndIfThenElse #-}
17module Main (main) where
19import qualified Language.PureScript as P
21import Data.List (isSuffixOf)
22import Data.Traversable (traverse)
23import Control.Monad
24import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25import System.Exit
26import System.Process
27import System.FilePath (pathSeparator)
28import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable)
29import Text.Parsec (ParseError)
30import qualified Paths_purescript as Paths
31import qualified System.IO.UTF8 as U
33preludeFilename :: IO FilePath
34preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
36readInput :: [FilePath] -> IO (Either ParseError [P.Module])
37readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
38 text <- U.readFile inputFile
39 return $ P.runIndentParser inputFile P.parseModules text
41compile :: P.Options -> [FilePath] -> IO (Either String (String, String, P.Environment))
42compile opts inputFiles = do
43 modules <- readInput inputFiles
44 case modules of
45 Left parseError ->
46 return (Left $ show parseError)
47 Right ms -> return $ P.compile opts ms
49assert :: FilePath -> P.Options -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
50assert preludeExterns opts inputFile f = do
51 e <- compile opts [preludeExterns, inputFile]
52 maybeErr <- f e
53 case maybeErr of
54 Just err -> putStrLn err >> exitFailure
55 Nothing -> return ()
57assertCompiles :: FilePath -> FilePath -> FilePath -> IO ()
58assertCompiles preludeJs preludeExterns inputFile = do
59 putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"
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
62 process <- findNodeProcess
63 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process
64 case result of
65 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing
66 Just (ExitFailure _, _, err) -> return $ Just err
67 Nothing -> return $ Just "Couldn't find node.js executable"
69assertDoesNotCompile :: FilePath -> FilePath -> IO ()
70assertDoesNotCompile preludeExterns inputFile = do
71 putStrLn $ "Assert " ++ inputFile ++ " does not compile"
72 assert preludeExterns P.defaultOptions inputFile $ \e ->
73 case e of
74 Left _ -> return Nothing
75 Right _ -> return $ Just "Should not have compiled"
77findNodeProcess :: IO (Maybe String)
78findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
79 where names = ["nodejs", "node"]
81main :: IO ()
82main = do
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
93 cd <- getCurrentDirectory
94 let examples = cd ++ pathSeparator : "examples"
95 let passing = examples ++ pathSeparator : "passing"
96 passingTestCases <- getDirectoryContents passing
97 forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
98 assertCompiles preludeJs preludeExterns (passing ++ pathSeparator : inputFile)
99 let failing = examples ++ pathSeparator : "failing"
100 failingTestCases <- getDirectoryContents failing
101 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
102 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)
103 exitSuccess