packages feed

heist-aeson-0.2: tests/runTests.hs

module Main ( main ) where

import Text.Templating.Heist.Aeson
import Text.Templating.Heist
import System.Directory
import System.FilePath
import System.Exit
import System.IO
import Data.Aeson
import Data.Attoparsec
import Blaze.ByteString.Builder
import Control.Monad
import qualified Data.ByteString.Char8 as Strict

main :: IO ()
main = runTests

runTests :: IO ()
runTests
    = do tests <- findTests
         ets <- loadTemplates "." $ addHeistAeson $ emptyTemplateState "."
         let ts = either error id ets
         results <- mapM (executeTest ts) tests
         unless (and results) $ exitWith (ExitFailure 1)

data Test = Test { testName :: String
                 , testJson :: FilePath
                 , testTemplate :: FilePath
                 , testExpected :: FilePath }

-- Find all tests (.tpl, .json, .expected triplets) in the current directory.
findTests :: IO [Test]
findTests = do files <- getDirectoryContents "."
               return [ Test { testName = takeBaseName file
                             , testJson = json
                             , testTemplate = file
                             , testExpected = expected }
                        | file <- files
                      , takeExtension file == ".tpl"
                      , json <- filter (== replaceExtension file "json") files
                      , expected <- filter (== replaceExtension file "expected") files ]


executeTest :: JsonState IO -> Test -> IO Bool
executeTest state test = do
    putStr (testName test ++ ": ")
    hFlush stdout
    jsonTxt <- Strict.readFile (testJson test)
    case eitherResult (parse json jsonTxt) of
      Left errMsg     -> do putStrLn "FAILED"
                            hPutStrLn stderr $ "Failed to parse json: " ++ errMsg
                            return False
      Right jsonValue -> do
        result  <- renderJsonTemplate state (Strict.pack $ testName test) jsonValue
        case result of
          Nothing -> do putStrLn "FAILED"
                        hPutStrLn stderr $ "Failed to parse template"
                        return False
          Just (t, mime) -> do
            expected <- Strict.readFile (testExpected test)
            if expected == toByteString t
               then do putStrLn "OK"
                       return True
               else do putStrLn "FAILED"
                       let outFile = addExtension (testName test) "out"
                       hPutStrLn stderr $ "Generated data doesn't match expected result. Data written to " ++ outFile
                       Strict.writeFile outFile (toByteString t)
                       return False