{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Test.Hspec.Megaparsec
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Utility functions for testing Megaparsec parsers with Hspec.
module Test.Hspec.Megaparsec
  ( -- * Basic expectations
    shouldParse,
    parseSatisfies,
    shouldSucceedOn,
    shouldFailOn,

    -- * Testing of error messages
    shouldFailWith,
    shouldFailWithM,

    -- * Incremental parsing
    failsLeaving,
    succeedsLeaving,
    initialState,
    initialPosState,

    -- * Re-exports
    module Text.Megaparsec.Error.Builder,
  )
where

import Control.Monad (unless)
import Data.List.NonEmpty qualified as NE
import Test.Hspec.Expectations
import Text.Megaparsec
import Text.Megaparsec.Error.Builder

----------------------------------------------------------------------------
-- Basic expectations

-- | Create an expectation by saying what the result should be.
--
-- > parse letterChar "" "x" `shouldParse` 'x'
shouldParse ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a,
    Eq a
  ) =>
  -- | Result of parsing as returned by function like 'parse'
  Either (ParseErrorBundle s e) a ->
  -- | Desired result
  a ->
  Expectation
Either (ParseErrorBundle s e) a
r shouldParse :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq a) =>
Either (ParseErrorBundle s e) a -> a -> Expectation
`shouldParse` a
v = case Either (ParseErrorBundle s e) a
r of
  Left ParseErrorBundle s e
e ->
    HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"expected: "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v
        forall a. [a] -> [a] -> [a]
++ String
"\nbut parsing failed with error:\n"
        forall a. [a] -> [a] -> [a]
++ forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle ParseErrorBundle s e
e
  Right a
x -> a
x forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
v

-- | Create an expectation by saying that the parser should successfully
-- parse a value and that the value should satisfy some predicate.
--
-- > parse (many punctuationChar) "" "?!!" `parseSatisfies` ((== 3) . length)
parseSatisfies ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a,
    Eq a
  ) =>
  -- | Result of parsing as returned by function like 'parse'
  Either (ParseErrorBundle s e) a ->
  -- | Predicate
  (a -> Bool) ->
  Expectation
Either (ParseErrorBundle s e) a
r parseSatisfies :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq a) =>
Either (ParseErrorBundle s e) a -> (a -> Bool) -> Expectation
`parseSatisfies` a -> Bool
p = case Either (ParseErrorBundle s e) a
r of
  Left ParseErrorBundle s e
e ->
    HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"expected a parsed value to check against the predicate"
        forall a. [a] -> [a] -> [a]
++ String
"\nbut parsing failed with error:\n"
        forall a. [a] -> [a] -> [a]
++ forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle ParseErrorBundle s e
e
  Right a
x ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"the value did not satisfy the predicate: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x

-- | Check that a parser fails on a given input.
--
-- > parse (char 'x') "" `shouldFailOn` "a"
shouldFailOn ::
  (HasCallStack, Show a) =>
  -- | Parser that takes stream and produces result or error message
  (s -> Either (ParseErrorBundle s e) a) ->
  -- | Input that the parser should fail on
  s ->
  Expectation
s -> Either (ParseErrorBundle s e) a
p shouldFailOn :: forall a s e.
(HasCallStack, Show a) =>
(s -> Either (ParseErrorBundle s e) a) -> s -> Expectation
`shouldFailOn` s
s = forall a s e.
(HasCallStack, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldFail (s -> Either (ParseErrorBundle s e) a
p s
s)

-- | Check that a parser succeeds on a given input.
--
-- > parse (char 'x') "" `shouldSucceedOn` "x"
shouldSucceedOn ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a
  ) =>
  -- | Parser that takes stream and produces result or error message
  (s -> Either (ParseErrorBundle s e) a) ->
  -- | Input that the parser should succeed on
  s ->
  Expectation
s -> Either (ParseErrorBundle s e) a
p shouldSucceedOn :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a) =>
(s -> Either (ParseErrorBundle s e) a) -> s -> Expectation
`shouldSucceedOn` s
s = forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldSucceed (s -> Either (ParseErrorBundle s e) a
p s
s)

----------------------------------------------------------------------------
-- Testing of error messages

-- | Create an expectation that parser should fail producing certain
-- 'ParseError'. Use the 'err' function from this module to construct a
-- 'ParseError' to compare with.
--
-- > parse (char 'x') "" "b" `shouldFailWith` err posI (utok 'b' <> etok 'x')
shouldFailWith ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a,
    Eq e
  ) =>
  -- | The result of parsing
  Either (ParseErrorBundle s e) a ->
  -- | Expected parse errors
  ParseError s e ->
  Expectation
Either (ParseErrorBundle s e) a
r shouldFailWith :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq e) =>
Either (ParseErrorBundle s e) a -> ParseError s e -> Expectation
`shouldFailWith` ParseError s e
perr1 = Either (ParseErrorBundle s e) a
r forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq e) =>
Either (ParseErrorBundle s e) a -> [ParseError s e] -> Expectation
`shouldFailWithM` [ParseError s e
perr1]

-- | Similar to 'shouldFailWith', but allows us to check parsers that can
-- report more than one parse error at a time.
--
-- @since 2.0.0
shouldFailWithM ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a,
    Eq e
  ) =>
  -- | The result of parsing
  Either (ParseErrorBundle s e) a ->
  -- | Expected parse errors, the argument is a normal linked list (as
  -- opposed to the more correct 'NonEmpty' list) as a syntactical
  -- convenience for the user, passing empty list here will result in an
  -- error
  [ParseError s e] ->
  Expectation
Either (ParseErrorBundle s e) a
r shouldFailWithM :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a, Eq e) =>
Either (ParseErrorBundle s e) a -> [ParseError s e] -> Expectation
`shouldFailWithM` [ParseError s e]
perrs1' = case Either (ParseErrorBundle s e) a
r of
  Left ParseErrorBundle s e
e0 ->
    let e1 :: ParseErrorBundle s e
e1 = ParseErrorBundle s e
e0 {bundleErrors :: NonEmpty (ParseError s e)
bundleErrors = NonEmpty (ParseError s e)
perrs1}
        perrs0 :: NonEmpty (ParseError s e)
perrs0 = forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors ParseErrorBundle s e
e0
        perrs1 :: NonEmpty (ParseError s e)
perrs1 = forall a. [a] -> NonEmpty a
NE.fromList [ParseError s e]
perrs1'
     in forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (NonEmpty (ParseError s e)
perrs0 forall a. Eq a => a -> a -> Bool
== NonEmpty (ParseError s e)
perrs1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
          String
"the parser is expected to fail with:\n"
            forall a. [a] -> [a] -> [a]
++ forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle ParseErrorBundle s e
e1
            forall a. [a] -> [a] -> [a]
++ String
"but it failed with:\n"
            forall a. [a] -> [a] -> [a]
++ forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle ParseErrorBundle s e
e0
  Right a
v ->
    HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"the parser is expected to fail, but it parsed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v

----------------------------------------------------------------------------
-- Incremental parsing

-- | Check that a parser fails and leaves a certain part of input
-- unconsumed. Use it with functions like 'runParser'' and 'runParserT''
-- that support incremental parsing.
--
-- > runParser' (many (char 'x') <* eof) (initialState "xxa")
-- >   `failsLeaving` "a"
--
-- See also: 'initialState'.
failsLeaving ::
  ( HasCallStack,
    Show a,
    Eq s,
    Show s
  ) =>
  -- | Parser that takes stream and produces result along with actual
  -- state information
  (State s e, Either (ParseErrorBundle s e) a) ->
  -- | Part of input that should be left unconsumed
  s ->
  Expectation
(State s e
st, Either (ParseErrorBundle s e) a
r) failsLeaving :: forall a s e.
(HasCallStack, Show a, Eq s, Show s) =>
(State s e, Either (ParseErrorBundle s e) a) -> s -> Expectation
`failsLeaving` s
s = do
  forall a s e.
(HasCallStack, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldFail Either (ParseErrorBundle s e) a
r
  forall s. (HasCallStack, Eq s, Show s) => s -> s -> Expectation
checkUnconsumed s
s (forall s e. State s e -> s
stateInput State s e
st)

-- | Check that a parser succeeds and leaves certain part of input
-- unconsumed. Use it with functions like 'runParser'' and 'runParserT''
-- that support incremental parsing.
--
-- > runParser' (many (char 'x')) (initialState "xxa")
-- >   `succeedsLeaving` "a"
--
-- See also: 'initialState'.
succeedsLeaving ::
  ( HasCallStack,
    Show a,
    Eq s,
    Show s,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s
  ) =>
  -- | Parser that takes stream and produces result along with actual
  -- state information
  (State s e, Either (ParseErrorBundle s e) a) ->
  -- | Part of input that should be left unconsumed
  s ->
  Expectation
(State s e
st, Either (ParseErrorBundle s e) a
r) succeedsLeaving :: forall a s e.
(HasCallStack, Show a, Eq s, Show s, ShowErrorComponent e,
 Stream s, VisualStream s, TraversableStream s) =>
(State s e, Either (ParseErrorBundle s e) a) -> s -> Expectation
`succeedsLeaving` s
s = do
  forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldSucceed Either (ParseErrorBundle s e) a
r
  forall s. (HasCallStack, Eq s, Show s) => s -> s -> Expectation
checkUnconsumed s
s (forall s e. State s e -> s
stateInput State s e
st)

-- | Given input for parsing, construct initial state for parser.
initialState :: s -> State s e
initialState :: forall s e. s -> State s e
initialState s
s =
  State
    { stateInput :: s
stateInput = s
s,
      stateOffset :: Int
stateOffset = Int
0,
      statePosState :: PosState s
statePosState = forall s. s -> PosState s
initialPosState s
s,
      stateParseErrors :: [ParseError s e]
stateParseErrors = []
    }

-- | Given input for parsing, construct initial positional state.
--
-- @since 2.0.0
initialPosState :: s -> PosState s
initialPosState :: forall s. s -> PosState s
initialPosState s
s =
  PosState
    { pstateInput :: s
pstateInput = s
s,
      pstateOffset :: Int
pstateOffset = Int
0,
      pstateSourcePos :: SourcePos
pstateSourcePos = String -> SourcePos
initialPos String
"",
      pstateTabWidth :: Pos
pstateTabWidth = Pos
defaultTabWidth,
      pstateLinePrefix :: String
pstateLinePrefix = String
""
    }

----------------------------------------------------------------------------
-- Helpers

-- | Expect that the argument is a result of a failed parser.
shouldFail ::
  (HasCallStack, Show a) =>
  Either (ParseErrorBundle s e) a ->
  Expectation
shouldFail :: forall a s e.
(HasCallStack, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldFail Either (ParseErrorBundle s e) a
r = case Either (ParseErrorBundle s e) a
r of
  Left ParseErrorBundle s e
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Right a
v ->
    HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"the parser is expected to fail, but it parsed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v

-- | Expectation that argument is result of a succeeded parser.
shouldSucceed ::
  ( HasCallStack,
    ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s,
    Show a
  ) =>
  Either (ParseErrorBundle s e) a ->
  Expectation
shouldSucceed :: forall e s a.
(HasCallStack, ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s, Show a) =>
Either (ParseErrorBundle s e) a -> Expectation
shouldSucceed Either (ParseErrorBundle s e) a
r = case Either (ParseErrorBundle s e) a
r of
  Left ParseErrorBundle s e
e ->
    HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
      String
"the parser is expected to succeed, but it failed with:\n"
        forall a. [a] -> [a] -> [a]
++ forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle ParseErrorBundle s e
e
  Right a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Compare two streams for equality and in the case of mismatch report it.
checkUnconsumed ::
  ( HasCallStack,
    Eq s,
    Show s
  ) =>
  -- | Expected unconsumed input
  s ->
  -- | Actual unconsumed input
  s ->
  Expectation
checkUnconsumed :: forall s. (HasCallStack, Eq s, Show s) => s -> s -> Expectation
checkUnconsumed s
e s
a =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (s
e forall a. Eq a => a -> a -> Bool
== s
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
    String
"the parser is expected to leave unconsumed input: "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show s
e
      forall a. [a] -> [a] -> [a]
++ String
"\nbut it left this: "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show s
a

-- | Render a parse error bundle in a way that is suitable for inserting it
-- in a test suite report.
showBundle ::
  ( ShowErrorComponent e,
    Stream s,
    VisualStream s,
    TraversableStream s
  ) =>
  ParseErrorBundle s e ->
  String
showBundle :: forall e s.
(ShowErrorComponent e, Stream s, VisualStream s,
 TraversableStream s) =>
ParseErrorBundle s e -> String
showBundle = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty
  where
    indent :: String -> String
indent String
x =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x
        then String
x
        else String
"  " forall a. [a] -> [a] -> [a]
++ String
x