Test.hs

{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-}
module Parsley.Fold.Test where
import Test.Tasty
import Test.Tasty.HUnit
import TestUtils
import qualified Parsley.Fold.Parsers as Parsers

import Prelude hiding ()
import Parsley (runParser)

tests :: TestTree
tests = testGroup "Fold" [ chainPreTests
                         , chainPostTests
                         , pfoldrTests
                         , pfoldlTests
                         , chainlTests
                         , chainrTests
                         , manyTests
                         , skipManyTests
                         , sepByTests
                         , endByTests
                         , sepEndByTests]

plusOne :: String -> Maybe Int
plusOne = $$(runParserMocked Parsers.plusOne [||Parsers.plusOne||])

plusOne' :: String -> Maybe Int
plusOne' = $$(runParserMocked Parsers.plusOne' [||Parsers.plusOne'||])

plusOnePure :: String -> Maybe Int
plusOnePure = $$(runParserMocked Parsers.plusOnePure [||Parsers.plusOnePure||])

chainPreTests :: TestTree
chainPreTests = testGroup "chainPre should"
  [ testCase "parse an operatorless value" $ do
      plusOne "1" @?= Just 1
      plusOne "" @?= Nothing
      plusOnePure "" @?= Just 1
  , testCase "parser all operators that precede" $ do
      plusOne "++++1" @?= Just 3
      plusOne' "++++1" @?= Just 3
      plusOnePure "+" @?= Just 0
  , testCase "fail if an operator fails after consuming input" $ plusOne "+++1" @?= Nothing
  ]

onePlus :: String -> Maybe Int
onePlus = $$(runParserMocked Parsers.onePlus [||Parsers.onePlus||])

onePlus' :: String -> Maybe Int
onePlus' = $$(runParserMocked Parsers.onePlus' [||Parsers.onePlus'||])

chainPostTests :: TestTree
chainPostTests = testGroup "chainPost should"
  [ testCase "require an initial value" $ do
      onePlus "1" @?= Just 1
      onePlus "" @?= Nothing
  , testCase "parser all operators that follow" $ onePlus "1++++" @?= Just 3
  , testCase "fail if an operator fails after consuming input" $ onePlus "1+++" @?= Nothing
  , testCase "not fail if the operator fails with try" $ onePlus' "1+++" @?= Just 2
  ]

pfoldrTests :: TestTree
pfoldrTests = testGroup "pfoldr should" [] -- pfoldr pfoldr1

pfoldlTests :: TestTree
pfoldlTests = testGroup "pfoldl should" [] -- pfoldl pfoldl1

chainlTests :: TestTree
chainlTests = testGroup "chainl should" [] -- chainl1' chainl1 chainl

chainrTests :: TestTree
chainrTests = testGroup "chainr should" [] -- chainr1' chainr1 chainr

manyAA :: String -> Maybe [String]
manyAA = $$(runParserMocked Parsers.manyAA [||Parsers.manyAA||])

someA :: String -> Maybe String
someA = $$(runParserMocked Parsers.someA [||Parsers.someA||])

many2A :: String -> Maybe String
many2A = $$(runParserMocked Parsers.many2A [||Parsers.many2A||])

manyTests :: TestTree
manyTests = testGroup "many should"
  [ testCase "succeed on empty input" $ do
      manyAA "" @?= Just []
      someA "" @?= Nothing
      many2A "" @?= Nothing
      many2A "a" @?= Nothing
  , testCase "succeed when given an input" $ do
      manyAA "aa" @?= Just ["aa"]
      someA "aa" @?= Just "aa"
      many2A "aaa" @?= Just "aaa"
  , testCase "fail when partial" $ manyAA "a" @?= Nothing
  ]

skipManyTests :: TestTree
skipManyTests = testGroup "skipMany should" [] -- skipMany skipManyN skipSome

sepByTests :: TestTree
sepByTests = testGroup "sepBy should" [] -- sepBy sepBy1

endByTests :: TestTree
endByTests = testGroup "endBy should" [] -- endBy endBy1

sepEndByTests :: TestTree
sepEndByTests = testGroup "sepEndBy should" [] -- sepEndBy sepEndBy1