git.iko.soy/rowtype-yoga/purescript-native
on 28fa718 help sign in
rowtype-yoga/purescript-native/tests/Main.hs
106 lines 3.8 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.Applicative
24import Control.Monad
25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26import System.Exit
27import System.Process
28import System.FilePath (pathSeparator)
29import System.Directory (getCurrentDirectory, getDirectoryContents, findExecutable)
30import System.Environment (getArgs)
31import Text.Parsec (ParseError)
32import qualified Paths_purescript as Paths
33import qualified System.IO.UTF8 as U
34import qualified Data.Map as M
36preludeFilename :: IO FilePath
37preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
39readInput :: [FilePath] -> IO (Either ParseError [P.Module])
40readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
41 text <- U.readFile inputFile
42 return $ P.runIndentParser inputFile P.parseModules text
44compile :: P.Options -> [FilePath] -> IO (Either String String)
45compile opts inputFiles = do
46 modules <- readInput inputFiles
47 case modules of
48 Left parseError -> do
49 return (Left $ show parseError)
50 Right ms -> do
51 case P.compile opts ms of
52 Left typeError -> do
53 return (Left typeError)
54 Right (js, _, _) -> do
55 return (Right js)
57assert :: P.Options -> [FilePath] -> (Either String String -> IO (Maybe String)) -> IO ()
58assert opts inputFiles f = do
59 e <- compile opts inputFiles
60 maybeErr <- f e
61 case maybeErr of
62 Just err -> putStrLn err >> exitFailure
63 Nothing -> return ()
65assertCompiles :: FilePath -> IO ()
66assertCompiles inputFile = do
67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
68 prelude <- preludeFilename
69 assert (P.defaultOptions { P.optionsMain = Just "Main", P.optionsNoOptimizations = True, P.optionsModules = ["Main"] }) [prelude, inputFile] $ either (return . Just) $ \js -> do
70 args <- getArgs
71 if "--run-js" `elem` args
72 then do
73 process <- findNodeProcess
74 result <- traverse (\node -> readProcessWithExitCode node [] js) process
75 case result of
76 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing
77 Just (ExitFailure _, _, err) -> return $ Just err
78 Nothing -> return $ Just "Couldn't find node.js executable"
79 else return Nothing
81findNodeProcess :: IO (Maybe String)
82findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
83 where names = ["nodejs", "node"]
85assertDoesNotCompile :: FilePath -> IO ()
86assertDoesNotCompile inputFile = do
87 putStrLn $ "assert " ++ inputFile ++ " does not compile"
88 assert P.defaultOptions [inputFile] $ \e ->
89 case e of
90 Left _ -> return Nothing
91 Right _ -> return $ Just "Should not have compiled"
93main :: IO ()
94main = do
95 cd <- getCurrentDirectory
96 putStrLn $ cd
97 let examples = cd ++ pathSeparator : "examples"
98 let passing = examples ++ pathSeparator : "passing"
99 passingTestCases <- getDirectoryContents passing
100 forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
101 assertCompiles (passing ++ pathSeparator : inputFile)
102 let failing = examples ++ pathSeparator : "failing"
103 failingTestCases <- getDirectoryContents failing
104 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
105 assertDoesNotCompile (failing ++ pathSeparator : inputFile)
106 exitSuccess