Earley-0.12.0.0: tests/Optional.hs

{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
module Optional where
import Control.Applicative
import Test.Tasty
import Test.Tasty.HUnit as HU

import Text.Earley

tests :: TestTree
tests = testGroup "Optional"
  [ HU.testCase "Nothing" $
      fullParses (parser $ return optional_) "b"
      @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
  , HU.testCase "Just" $
      fullParses (parser $ return optional_) "ab"
      @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
  , HU.testCase "Using rules Nothing" $
      fullParses (parser optionalRule) "b"
      @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
  , HU.testCase "Using rules Just" $
      fullParses (parser optionalRule) "ab"
      @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
  , HU.testCase "Without continuation Nothing" $
      fullParses (parser $ return $ optional $ namedToken 'a') ""
      @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
  , HU.testCase "Without continuation Just" $
      fullParses (parser $ return $ optional $ namedToken 'a') "a"
      @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
  , HU.testCase "Using rules without continuation Nothing" $
      fullParses (parser $ rule $ optional $ namedToken 'a') ""
      @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
  , HU.testCase "Using rules without continuation Just" $
      fullParses (parser $ rule $ optional $ namedToken 'a') "a"
      @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
  , HU.testCase "Generate optional" $
      language (generator (return optional_) "ab")
      @?= [((Nothing, 'b'), "b"), ((Just 'a', 'b'), "ab")]
  , HU.testCase "Generate optional using rules" $
      language (generator optionalRule "ab")
      @?= [((Nothing, 'b'), "b"), ((Just 'a', 'b'), "ab")]
  , HU.testCase "Generate optional without continuation" $
      language (generator (return $ optional $ namedToken 'a') "ab")
      @?= [(Nothing, ""), (Just 'a', "a")]
  , HU.testCase "Generate optional using rules without continuation" $
      language (generator (rule $ optional $ namedToken 'a') "ab")
      @?= [(Nothing, ""), (Just 'a', "a")]
  ]

optional_ :: Prod r Char Char (Maybe Char, Char)
optional_ = (,) <$> optional (namedToken 'a') <*> namedToken 'b'

optionalRule :: Grammar r (Prod r Char Char (Maybe Char, Char))
optionalRule = mdo
  test <- rule $ (,) <$> optional (namedToken 'a') <*> namedToken 'b'
  return test