-- | Sample grammars for tests
{-# LANGUAGE QuasiQuotes #-}
module Data.Cfg.TestGrammars (
    -- * Assertion for equality in 'Cfg'
    assertEqCfg,
    -- * Grammars for sanity checks
    g0,
    micro,
    wiki,
    -- * Convenience functions for the REPL
    pretty'
    ) where

import Data.Cfg.Augment
import Data.Cfg.Bnf
import Data.Cfg.Cfg(Cfg(..), V(..), eqCfg)
import Data.Cfg.CPretty
import Data.Cfg.FreeCfg
import Text.PrettyPrint
import Test.HUnit(assertBool)

-- | An assertion for testing equality of 'Cfg'.
assertEqCfg :: (Cfg cfg t nt, CPretty (cfg t nt) ctxt,
		Cfg cfg' t nt, CPretty (cfg' t nt) ctxt',
		Eq t, Eq nt)
		=> ctxt -> ctxt' -> String -> cfg t nt -> cfg' t nt -> IO ()
assertEqCfg ctxt ctxt' msg expected actual =
    assertBool msg' (eqCfg expected actual)
    where
    msg' = show $ vcat [text msg, expected', actual']
    expected' = text "Expected:" <+> cpretty expected ctxt
    actual' = text "Actual:" <+> cpretty actual ctxt'

pretty' :: AugFreeCfg String String -> Doc
pretty' cfg = cpretty cfg ctxt
    where
    ctxt :: AugV String String -> Doc
    ctxt v = text $ case v of
		 NT nt -> case nt of
		     StartSymbol -> "$start"
		     AugNT s -> s
		 T t -> case t of
		     EOF -> "$EOF"
		     AugT s -> s

-- | A test grammar.  Found in Crafting a compiler, by Charles
-- N. Fischer and Richard J. LeBlanc, Jr., (c) 1998, pg. 95.
g0 :: FreeCfg (AugT String) (AugNT String)
g0 = augmentCfg [bnf|
    e ::= prefix LPAREN e RPAREN.
    e ::= V tail.
    prefix ::= F.
    prefix ::= .
    tail ::= PLUS e.
    tail ::= .
   |]

-- | A test grammar.  Found in Fischer and LeBlanc, pg. 111.
micro :: FreeCfg (AugT String) (AugNT String)
micro = augmentCfg [bnf|
    program ::= BEGIN statement_list END.
    statement_list ::= statement statement_tail.
    statement_tail ::= statement statement_tail.
    statement_tail ::=.
    statement ::= ID ASSIGN expression SEMI.
    statement ::= READ LPAREN id_list RPAREN SEMI.
    statement ::= WRITE LPAREN expr_list RPAREN SEMI.
    id_list ::= ID id_tail.
    id_tail ::= COMMA ID id_tail.
    id_tail ::=.
    expr_list ::= expression expr_tail.
    expr_tail ::= COMMA expression expr_tail.
    expr_tail ::=.
    expression ::= primary primary_tail.
    primary_tail ::= add_op primary primary_tail.
    primary_tail ::=.
    primary ::= LPAREN expression RPAREN.
    primary ::= ID.
    primary ::= INT_LITERAL.
    add_op ::= PLUS.
    add_op ::= MINUS.
    |]

-- | A test grammar.  Found at
-- http://en.wikipedia.org/wiki/Useless_rules; retrieved 2015-03-14.
wiki :: Grammar String String
wiki = [bnf|
    s ::= b B | c C | e E.
    b ::= b B | B.
    c ::= c C | C.
    d ::= b D | c D | D.
    e ::= e E.
    |]