{-# 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 () tests :: TestTree tests = testGroup "Fold" [ prefixTests , postfixTests , manyrTests , somerTests , manylTests , somelTests , chainlTests , chainrTests , infixl1Tests , infixr1Tests , 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||]) prefixTests :: TestTree prefixTests = testGroup "prefix should" [ testCase "parse an operatorless value" $ do plusOne "1" @?= Just 1 plusOne "" @?= Nothing plusOnePure "" @?= Just 1 , testCase "parse 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'||]) postfixTests :: TestTree postfixTests = testGroup "postfix 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 ] manyrTests :: TestTree manyrTests = testGroup "manyr should" [] somerTests :: TestTree somerTests = testGroup "somer should" [] manylTests :: TestTree manylTests = testGroup "manyl should" [] somelTests :: TestTree somelTests = testGroup "somel should" [] chainlTests :: TestTree chainlTests = testGroup "chainl should" [] -- chainl1 chainl chainrTests :: TestTree chainrTests = testGroup "chainr should" [] -- chainr1 chainr infixl1Tests :: TestTree infixl1Tests = testGroup "infixl1 should" [] infixr1Tests :: TestTree infixr1Tests = testGroup "infixr1 should" [] 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