ampersand-3.1.0: src/Test.hs

module Main (main) where

import Database.Design.Ampersand.Misc.Options(getOptions,Options)
import Database.Design.Ampersand.Test.TestScripts (getTestScripts,testAmpersandScripts)
import Database.Design.Ampersand.Test.Parser.ParserTest (parseScripts)
import Database.Design.Ampersand.Test.Parser.QuickChecks (parserQuickChecks)
import System.Exit (ExitCode, exitFailure, exitSuccess)

testFunctions :: Options -> IO [([String], IO Bool)]
testFunctions opts =
    do scr <- getTestScripts
       (parserCheckResult, msg) <- parserQuickChecks
       return [ (["Parsing " ++ show (length scr) ++ " scripts."], parseScripts opts scr)
            --  , ("Executing ampersand chain", ampersand scr)
              , ( if parserCheckResult  
                  then ["Parser & prettyprinter test PASSED."]
                  else (  ["QuickCheck found errors in the roundtrip in parsing/prettyprinting for the following case:"]
                        ++map ("\n   "++) (lines msg)
                       )
                , return parserCheckResult
                )
              ]

main :: IO ExitCode
main = do opts <- getOptions
          funcs <- testFunctions opts
          testAmpersandScripts
          tests funcs
    where tests :: [([String], IO Bool)] -> IO ExitCode
          tests [] = exitSuccess
          tests ((msg,test):xs) =
            do mapM_ putStrLn msg
               success <- test
               if success then tests xs
               else do putStrLn "*** Something went wrong here***" 
                       exitFailure