{-# LANGUAGE NoImplicitPrelude #-} module Main where import BNFC.Prelude import Test.Tasty import Test.Tasty.Silver import BNFC.Main (runBnfcArgs) import Paths_BNFC3 (getDataDir) import Data.Text (pack) import System.FilePath ((), (<.>)) main :: IO () main = do dir <- getDataDir defaultMain (texFile dir) texFile :: FilePath -> TestTree texFile dir = testGroup "Latex" $ map (checkTexFile dir) examples checkTexFile :: FilePath -> (String, String) -> TestTree checkTexFile dir (testName, testPath) = goldenVsAction testName golden action pack where golden :: FilePath golden = dir "test/latex/tex" testName <.> "golden" action :: IO String action = do let filename = dir "examples" testPath <.> "cf" ((Just result, _), _) <- runBnfcArgs [ filename, "latex" ] let (Just file) = lookup (testName <.> "tex") result return file examples :: [(String, String)] examples = [ ("Alfa", "Alfa/Alfa") , ("C", "C/C") , ("C4", "C/C4") , ("Calc", "Calc/Calc") , ("GF", "GF/GF") , ("Java", "Java/Java") , ("JavaletteLight", "Javalette/JavaletteLight") , ("LBNF", "LBNF/LBNF") , ("OCL", "OCL/OCL") , ("Cpp", "Cpp/Cpp") , ("Cubicaltt", "Cubicaltt/Cubicaltt") , ("FstStudio", "FstStudio/FstStudio") , ("Core", "Haskell-core/Core") , ("Prolog", "Prolog/Prolog") ]