{-# LANGUAGE NoImplicitPrelude #-}

module Main where

import BNFC.Prelude

import Test.Tasty
import Test.Tasty.Silver

import BNFC.Main   (runBnfcArgs, Msgs)
import Paths_BNFC3 (getDataDir)

import Data.Text (pack)

import System.FilePath ((</>), (<.>))

main :: IO ()
main = do
  dir <- getDataDir
  defaultMain $ tests $ dir </> "test/check"

tests :: FilePath -> TestTree
tests dir = testGroup "Tests" [checksSucceed dir, checksFail dir]

checksSucceed :: FilePath -> TestTree
checksSucceed dir = testGroup "Succeed" $ map (checkFile dir) succeedChecks

checksFail :: FilePath -> TestTree
checksFail dir = testGroup "Fail" $ map (checkFile dir) failChecks

checkFile
  :: FilePath  -- ^ Data (= base) directory.
  -> FilePath  -- ^ Path to test file, also serving as test name.
  -> TestTree
checkFile dir file =
  goldenVsAction file golden action (pack . unlines . drop 1)
  where
    golden :: FilePath
    golden = dir </> file <.> "golden"
    action :: IO Msgs
    action = do
      let filename = dir </> file <.> "cf"
      ((_, _), msgs) <- runBnfcArgs [ filename, "check"]
      return msgs

succeedChecks :: [String]
succeedChecks =
    map ("succeed" </>)
    ( [ "CMM"
      , "EmptyToken"
      , "EmptyCommentDelimiter"
      , "IntegerList"
      , "DuplicateRHS"
      , "NonUniformList"
      ]
      ++
      map ("define" </>)
        [ "ParameterShouldBeLowerCase"
        , "ShadowingParameter"
        , "ShadowedByParameter"
        ]
    )
    ++
    map ("examples" </>)
      [ "Alfa"
      , "C"
      , "C4"
      , "Calc"
   -- , "DefinedRules"
      , "GF"
      , "Java"
      , "JavaletteLight"
      , "LBNF"
      , "OCL"
      , "Cpp"
      , "Cubicaltt"
      , "FstStudio"
      , "Core"
      , "Prolog"
      ]

failChecks :: [String]
failChecks = map ("fail" </>) $
  [ "delimiters"
  , "MixingListAndOrdinary"
  , "MixingTokenAndRules"
  , "BothSeparatorAndTerminator"
  , "EmptyGrammar"
  , "EmptyToken"
  , "NullableToken"
  , "IllformedBlockComment"
  , "ConflictingLayoutKeyword"
  , "UndefinedEntryPoint"
  -- , "CoercionsOfBuiltinCat"
  , "CoercionsOfCoerceCat"
  , "CoercionsOfTokenCat"
  , "UnknownCatName"
  , "CoerceBuiltinCat"
  , "CoerceTokenCat"
  , "DuplicateLabel"
  , "DuplicateRHS"
  , "InvalidListRule"
  , "InvalidListDef"
  , "InvalidListLabelNil"
  , "InvalidListLabelCons"
  , "InvalidListLabelSg"
  , "InvalidLabelNil"
  , "InvalidLabelCons"
  , "InvalidLabelSg"
  , "InvalidLabelWild"
  ]
  ++
  map ("define" </>)
    [ "DroppingSpuriousArguments"
    , "DroppingSpuriousParameters"
    , "ExpectedVsInferredType"
    , "IgnoringUndeclaredFunction"
    , "ListsDontInhabitType"
    , "MissingArguments"
    , "NotEnoughParameters"
    , "UndefinedLabel"
    ]