comparse-0.1.0.0: test/Parsing.hs

module Parsing where

import Control.Monad.Parser
import qualified Data.List.NonEmpty as NonEmpty
import Data.Stream.StringLines
import Test.Tasty
import Test.Tasty.HUnit

parse :: StringParser a -> String -> Maybe (a, String)
parse p s =
    case runStringParser p s of
        Parsed v (StringLines rest _) _ -> Just (v, rest)
        _ -> Nothing

parserTests :: [TestTree]
parserTests =
    [ coreParserTests
    , coreCombinatorsTests
    , derivedParserTests
    , derivedCombinatorsTests
    ]

coreParserTests :: TestTree
coreParserTests =
    testGroup
        "Core parsers"
        [ testCase "item returns next char" $
            parse item "hi" @?= Just ('h', "i")
        , testCase "item fails on eof" $
            parse item "" @?= Nothing
        , testCase "eof succeeds on eof" $
            parse eof "" @?= Just ((), "")
        , testCase "eof fails on non-eof" $
            parse eof "hi" @?= Nothing
        , testCase "noParse fails with non-empty input" $
            parse (noParse :: StringParser ()) "hi" @?= Nothing
        , testCase "noParse fails with empty input" $
            parse (noParse :: StringParser ()) "" @?= Nothing
        ]

coreCombinatorsTests :: TestTree
coreCombinatorsTests =
    testGroup
        "Core combinators"
        [ testCase "followedBy fails when parser fails" $
            parse (followedBy $ like 'h') "ello" @?= Nothing
        , testCase "followedBy succeeds without consuming input" $
            parse (followedBy $ like 'h') "hi" @?= Just ((), "hi")
        , testCase "notFollowedBy fails when parser succeeds" $
            parse (notFollowedBy $ like 'h') "hi" @?= Nothing
        , testCase "notFollowedBy succeeds without consuming input" $
            parse (notFollowedBy $ like 'g') "hi" @?= Just ((), "hi")
        , testCase "`a <|> b` returns a when it succeeds" $
            parse (like 'h' <|> like 'g') "hi" @?= Just ('h', "i")
        , testCase "`a <|> b` returns b when a fails" $
            parse (like 'g' <|> like 'h') "hi" @?= Just ('h', "i")
        , testCase "`a <|> b` fails when both fail" $
            parse (like 'g' <|> like 'i') "hi" @?= Nothing
        ]

derivedParserTests :: TestTree
derivedParserTests =
    testGroup
        "Derived parsers"
        [ testCase "like succeeds on matching item" $
            parse (like 'h') "hi" @?= Just ('h', "i")
        , testCase "like fails on non-matching item" $
            parse (like 'h') "pi" @?= Nothing
        , testCase "like fails on eof" $
            parse (like 'h') "" @?= Nothing
        , testCase "unlike succeeds on non-matching item" $
            parse (unlike 'g') "hi" @?= Just ('h', "i")
        , testCase "unlike fails on matching item" $
            parse (unlike 'h') "hi" @?= Nothing
        , testCase "string succeeds on matching string" $
            parse (string "hell") "hello" @?= Just ("hell", "o")
        , testCase "string fails on non-matching string" $
            parse (string "hello") "hi" @?= Nothing
        , testCase "`string \"\"` succeeds on arbitrary input" $
            parse (string "") "hi" @?= Just ("", "hi")
        , testCase "`string \"\"` succeeds on empty input" $
            parse (string "") "" @?= Just ("", "")
        ]

derivedCombinatorsTests :: TestTree
derivedCombinatorsTests =
    testGroup
        "Derived combinators"
        [ testCase "satisfy succeeds on matching char" $
            parse (satisfy item (== 'h')) "hi" @?= Just ('h', "i")
        , testCase "satisfy fails on non-matching char" $
            parse (satisfy item (== 'g')) "hi" @?= Nothing
        , testCase "optional returns Nothing on eof" $
            parse (optional item) "" @?= Just (Nothing, "")
        , testCase "optional returns Nothing on failure" $
            parse (optional $ like 'g') "hi" @?= Just (Nothing, "hi")
        , testCase "optional returns Just on success" $
            parse (optional item) "hi" @?= Just (Just 'h', "i")
        , testCase "many returns empty list on eof" $
            parse (many item) "" @?= Just ([], "")
        , testCase "many returns list of items" $
            parse (many item) "hi" @?= Just ("hi", "")
        , testCase "many1 fails on eof" $
            parse (many1 item) "" @?= Nothing
        , testCase "many1 returns non-empty list of items" $
            parse (many1 item) "hi" @?= Just ("hi", "")
        , testCase "some fails on eof" $
            parse (some item) "" @?= Nothing
        , testCase "some returns NonEmpty list of items" $
            parse (some item) "hi" @?= Just (NonEmpty.fromList "hi", "")
        , testCase "choice takes first successful parser" $
            parse (choice [like 'h', like 'g']) "hi" @?= Just ('h', "i")
        , testCase "choice with empty parser list fails" $
            parse (choice [] :: StringParser ()) "hi" @?= Nothing
        , testCase "choice with no matching parser fails" $
            parse (choice [like 'g', like 'j']) "hi" @?= Nothing
        , testCase "sepBy matches empty list" $
            parse (sepBy item $ like ',') "" @?= Just ([], "")
        , testCase "sepBy matches list of one item" $
            parse (sepBy item $ like ',') "hi" @?= Just ("h", "i")
        , testCase "sepBy matches list of many items" $
            parse (sepBy item $ like ',') "h,e,llo" @?= Just ("hel", "lo")
        , testCase "sepBy doesn't consume trailing separator" $
            parse (sepBy item $ like ',') "h,i," @?= Just ("hi", ",")
        , testCase "sepBy1 doesn't match empty list" $
            parse (sepBy1 item $ like ',') "" @?= Nothing
        , testCase "sepBy1 matches list of one item" $
            parse (sepBy1 item $ like ',') "hi"
                @?= Just (NonEmpty.fromList "h", "i")
        , testCase "sepBy1 matches list of many items" $
            parse (sepBy1 item $ like ',') "h,e,llo"
                @?= Just (NonEmpty.fromList "hel", "lo")
        , testCase "sepBy1 doesn't consume trailing separator" $
            parse (sepBy1 item $ like ',') "h,i,"
                @?= Just (NonEmpty.fromList "hi", ",")
        , testCase "oneOf fails when item doesn't match any" $
            parse (oneOf "gj") "hi" @?= Nothing
        , testCase "oneOf succeeds when item matches one" $
            parse (oneOf "gh") "hi" @?= Just ('h', "i")
        , testCase "oneOf succeeds when item matches many" $
            parse (oneOf "ghh") "hi" @?= Just ('h', "i")
        , testCase "oneOf fails with empty class" $
            parse (oneOf "") "hi" @?= Nothing
        , testCase "noneOf succeeds when item doesn't match any" $
            parse (noneOf "gj") "hi" @?= Just ('h', "i")
        , testCase "noneOf fails when item matches one" $
            parse (noneOf "gh") "hi" @?= Nothing
        , testCase "noneOf fails when item matches many" $
            parse (noneOf "ghh") "hi" @?= Nothing
        , testCase "noneOf succeeds with empty class" $
            parse (noneOf "") "hi" @?= Just ('h', "i")
        ]