git.iko.soy/elk
on 37e4dfe help sign in
elk/tests/Test/Compiler.hs
77 lines 2.0 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Test.Compiler (compilerTests) where
4import qualified Data.Map as Map
5import Data.Traversable (traverse)
6import Data.Bifunctor (first, second)
8import System.FilePath ((</>))
9import System.FilePath.Find (find, (==?), extension)
11import Test.Framework
12import Test.Framework.Providers.HUnit (testCase)
13import Test.HUnit (Assertion, assertFailure, assertBool)
15import qualified Elm.Compiler as Compiler
16import qualified Elm.Compiler.Module as Module
18type ErrorMessage = String
20compilerTests :: Test
21compilerTests =
22 buildTest $ do
23 goods <- testIf isSuccess =<< getElms "good"
24 bads <- testIf isFailure =<< getElms "bad"
25 return $
26 testGroup "Compile Tests"
27 [ testGroup "Good Tests" goods
28 , testGroup "Bad Tests" bads
29 ]
32-- GATHER ELM FILES
34getElms :: FilePath -> IO [FilePath]
35getElms filePath =
36 find
37 (return True)
38 (extension ==? ".elm")
39 (testsDir </> filePath)
42testsDir :: FilePath
43testsDir =
44 "tests" </> "test-files"
47-- RUN COMPILER
49testIf
50 :: (([Compiler.Warning], Either [ErrorMessage] (Module.Interface, String)) -> Assertion)
51 -> [FilePath]
52 -> IO [Test]
53testIf handleResult filePaths =
54 traverse setupTest filePaths
55 where
56 setupTest filePath = do
57 source <- readFile filePath
59 let result = Compiler.compile "elm-lang" "core" True source Map.empty
60 let errorsToStrings = second (first $ map (Compiler.errorToString filePath source))
62 return $ testCase filePath (handleResult . errorsToStrings $ result)
64-- CHECK RESULTS
66isSuccess :: ([Compiler.Warning], Either [ErrorMessage] a) -> Assertion
67isSuccess (_, result) =
68 case result of
69 Right _ -> assertBool "" True
70 Left errorMessages -> assertFailure $ concat errorMessages
73isFailure :: ([Compiler.Warning], Either a b) -> Assertion
74isFailure (_, result) =
75 case result of
76 Right _ -> assertFailure "Compilation succeeded but should have failed"
77 Left _ -> assertBool "" True