git.iko.soy/rowtype-yoga/purescript-native
on 33db511 help sign in
rowtype-yoga/purescript-native/tests/Main.hs
103 lines 4.3 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 DataKinds, 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 System.IO.UTF8 as U
32readInput :: [FilePath] -> IO (Either ParseError [P.Module])
33readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
34 text <- U.readFile inputFile
35 return $ P.runIndentParser inputFile P.parseModules text
37compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))
38compile opts inputFiles = do
39 modules <- readInput inputFiles
40 case modules of
41 Left parseError ->
42 return (Left $ show parseError)
43 Right ms -> return $ P.compile opts ms []
45assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
46assert preludeExterns opts inputFile f = do
47 e <- compile opts [preludeExterns, inputFile]
48 maybeErr <- f e
49 case maybeErr of
50 Just err -> putStrLn err >> exitFailure
51 Nothing -> return ()
53assertCompiles :: String -> FilePath -> FilePath -> IO ()
54assertCompiles preludeJs preludeExterns inputFile = do
55 putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"
56 let options = P.defaultCompileOptions
57 { P.optionsMain = Just "Main"
58 , P.optionsAdditional = P.CompileOptions "Tests" ["Main"] ["Main"]
59 }
60 assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do
61 process <- findNodeProcess
62 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process
63 case result of
64 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing
65 Just (ExitFailure _, _, err) -> return $ Just err
66 Nothing -> return $ Just "Couldn't find node.js executable"
68assertDoesNotCompile :: FilePath -> FilePath -> IO ()
69assertDoesNotCompile preludeExterns inputFile = do
70 putStrLn $ "Assert " ++ inputFile ++ " does not compile"
71 assert preludeExterns (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) inputFile $ \e ->
72 case e of
73 Left _ -> return Nothing
74 Right _ -> return $ Just "Should not have compiled"
76findNodeProcess :: IO (Maybe String)
77findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
78 where names = ["nodejs", "node"]
80main :: IO ()
81main = do
82 prelude <- P.preludeFilename
83 putStrLn "Compiling Prelude"
84 preludeResult <- compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) [prelude]
85 case preludeResult of
86 Left err -> putStrLn err >> exitFailure
87 Right (preludeJs, exts, _) -> do
88 tmp <- getTemporaryDirectory
89 let preludeExterns = tmp ++ pathSeparator : "prelude.externs"
90 writeFile preludeExterns exts
91 putStrLn $ "Wrote " ++ preludeExterns
92 cd <- getCurrentDirectory
93 let examples = cd ++ pathSeparator : "examples"
94 let passing = examples ++ pathSeparator : "passing"
95 passingTestCases <- getDirectoryContents passing
96 forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
97 assertCompiles preludeJs preludeExterns (passing ++ pathSeparator : inputFile)
98 let failing = examples ++ pathSeparator : "failing"
99 failingTestCases <- getDirectoryContents failing
100 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
101 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)
102 exitSuccess