-- | Description: Fuzzy pattern matching for doctest output.
-- Copyright: Copyright 2024, Ruifeng Xie
-- License: LGPL-3.0-or-later
-- Maintainer: Ruifeng Xie <ruifengx@outlook.com>
--
-- Fuzzy matching logic used for doctest output text segments.
module Test.DocTest.FuzzyMatch
  ( match
  ) where

import Data.Foldable (traverse_)
import Data.Functor (void)
import Test.DocTest.FuzzySyntax (Pattern, Segment (..))
import Text.ParserCombinators.ReadP (ReadP, readP_to_S)
import Text.ParserCombinators.ReadP qualified as P

-- $setup
-- >>> import Test.DocTest.FuzzySyntax

-- | Match the 'String' with the given 'Pattern'.
--
-- * No wildcard:
--
-- >>> let pat = [Plain "some text\nwithout wildcard"]
-- >>> pat `match` "some text\nwithout wildcard"
-- True
--
-- * Inline wildcard:
--
-- >>> let pat = [Plain "some ", InlineDots, Plain " text"]
-- >>> pat `match` "some single-line text"
-- True
-- >>> pat `match` "some\nmultiline\ntext"
-- False
--
-- * Multiline wildcard:
--
-- >>> let pat = [Plain "some\n", MultilineDots, Plain "\ntext"]
-- >>> pat `match` "some\nmultiline\ntext"
-- True
-- >>> pat `match` "some\n\ntext"
-- True
-- >>> pat `match` "some\nmulti\nline\ntext"
-- True
--
-- * Blank line:
--
-- >>> let pat = [Plain "a blank\n", BlankLine, Plain "\nline"]
-- >>> pat `match` "a blank\n\nline"
-- True
-- >>> pat `match` "a blank\n(not)\nline"
-- False
match :: Pattern -> String -> Bool
match :: Pattern -> String -> Bool
match Pattern
syn String
s
  | [((), String)
_] <- [((), String)]
results = Bool
True
  | Bool
otherwise = Bool
False
  where results :: [((), String)]
results = ReadP () -> ReadS ()
forall a. ReadP a -> ReadS a
readP_to_S (Pattern -> ReadP ()
matcher Pattern
syn) String
s

matcher :: Pattern -> ReadP ()
matcher :: Pattern -> ReadP ()
matcher Pattern
syn = (Segment -> ReadP ()) -> Pattern -> ReadP ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Segment -> ReadP ()
syntax Pattern
syn ReadP () -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
P.optional (Char -> ReadP Char
P.char Char
'\n') ReadP () -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
P.eof

syntax :: Segment -> ReadP ()
syntax :: Segment -> ReadP ()
syntax Segment
BlankLine     = () -> ReadP ()
forall a. a -> ReadP a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
syntax Segment
MultilineDots = (Char -> Bool) -> ReadP String
P.munch (Char
'\n' /=) ReadP String -> ReadP Char -> ReadP ()
forall a sep. ReadP a -> ReadP sep -> ReadP ()
`skipSepBy1` Char -> ReadP Char
P.char Char
'\n'
syntax Segment
InlineDots    = ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
P.skipMany1 ((Char -> Bool) -> ReadP Char
P.satisfy (Char
'\n' /=))
syntax (Plain String
s)     = ReadP String -> ReadP ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (String -> ReadP String
P.string String
s)

skipSepBy1 :: ReadP a -> ReadP sep -> ReadP ()
skipSepBy1 :: forall a sep. ReadP a -> ReadP sep -> ReadP ()
skipSepBy1 ReadP a
p ReadP sep
sep = ReadP a
p ReadP a -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ReadP a -> ReadP ()
forall a. ReadP a -> ReadP ()
P.skipMany (ReadP sep
sep ReadP sep -> ReadP a -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ReadP a
p)