@@ -0,0 +1,71 @@
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+-----------------------------------------------------------------------------
14+
15+module Main (main) where
16+
17+import PureScript
18+import PureScript.CodeGen.Pretty.Types
19+
20+import Data.List (isSuffixOf)
21+import Control.Applicative
22+import Control.Monad
23+import System.Exit (exitSuccess, exitFailure)
24+import System.FilePath (pathSeparator)
25+import System.Directory (getCurrentDirectory, getDirectoryContents)
26+import qualified System.IO.UTF8 as U
27+import qualified Data.Map as M
28+
29+compile :: FilePath -> IO (Either String Environment)
30+compile inputFile = do
31+ ast <- runIndentParser parseDeclarations <$> U.readFile inputFile
32+ case ast of
33+ Left parseError -> do
34+ return (Left $ show parseError)
35+ Right decls -> do
36+ case check (typeCheckAll decls) of
37+ Left typeError -> do
38+ return (Left typeError)
39+ Right (_, env) -> do
40+ return (Right env)
41+
42+assert :: FilePath -> (Either String Environment -> Maybe String) -> IO ()
43+assert inputFile f = do
44+ e <- compile inputFile
45+ case f e of
46+ Just err -> exitFailure
47+ Nothing -> return ()
48+
49+assertCompiles :: FilePath -> IO ()
50+assertCompiles inputFile = do
51+ putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
52+ assert inputFile $ either Just (const Nothing)
53+
54+assertDoesNotCompile :: FilePath -> IO ()
55+assertDoesNotCompile inputFile = do
56+ putStrLn $ "assert " ++ inputFile ++ " does not compile"
57+ assert inputFile $ either (const Nothing) (const $ Just "Should not have compiled")
58+
59+main :: IO ()
60+main = do
61+ cd <- getCurrentDirectory
62+ let examples = cd ++ pathSeparator : "examples"
63+ let passing = examples ++ pathSeparator : "passing"
64+ passingTestCases <- getDirectoryContents passing
65+ forM_ passingTestCases $ \inputFile -> when (".ps" `isSuffixOf` inputFile) $
66+ assertCompiles (passing ++ pathSeparator : inputFile)
67+ let failing = examples ++ pathSeparator : "failing"
68+ failingTestCases <- getDirectoryContents failing
69+ forM_ failingTestCases $ \inputFile -> when (".ps" `isSuffixOf` inputFile) $
70+ assertDoesNotCompile (failing ++ pathSeparator : inputFile)
71+ exitSuccess