fay-0.1.0.0: src/Tests.hs

module Main where

import Language.Fay.Compiler

import Data.List
import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Process
import Test.HUnit

-- | Main test runner.
main :: IO ()
main = runUnitTests >>= print

-- | Run the case-by-case unit tests.
runUnitTests :: IO Counts
runUnitTests = do
  files <- fmap (map ("tests" </>) . sort . filter dotHs) $ getDirectoryContents "tests"
  runTestTT (makeTests files)
  
    where dotHs = isSuffixOf ".hs"
          makeTests files =
            TestList $ flip map files $ \file -> TestLabel file $ TestCase $ do
              let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file
                  out = toJsName file
              outExists <- doesFileExist root
              compileFromTo True file out
              result <- runJavaScriptFile out
              if outExists
                 then do output <- readFile root
                         assertEqual file output (either show id result)
                 else assertEqual file True (either (const True) (const False) result)

-- | Run a JS file.
runJavaScriptFile :: String -> IO (Either String String)
runJavaScriptFile file = readAllFromProcess "node" file

-- | Read all stuff from a process.
readAllFromProcess :: FilePath -> String -> IO (Either String String)
readAllFromProcess program file = do
  (_,out,err,pid) <- runInteractiveProcess program [file] Nothing Nothing
  code <- waitForProcess pid
  case code of
    ExitSuccess -> fmap Right (hGetContents out)
    ExitFailure _ -> fmap Left (hGetContents err)