{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Various <https://hackage.haskell.org/package/flatparse flatparse> helpers and combinators.
--
-- This module is exposed only for testing via doctest-parallel and is not intended to form part of the stable API.
module MarkupParse.Internal.FlatParse
  ( -- * Parsers
    isWhitespace,
    ws_,
    ws,
    nota,
    isa,
    sq,
    dq,
    wrappedDq,
    wrappedSq,
    wrappedQ,
    wrappedQNoGuard,
    eq,
    bracketed,
    bracketedSB,
    wrapped,
  )
where

import Data.Bool
import Data.ByteString (ByteString)
import Data.Char hiding (isDigit)
import FlatParse.Basic hiding (cut, take)
import Prelude hiding (replicate)

-- $setup
-- >>> :set -XTemplateHaskell
-- >>> :set -XQuasiQuotes
-- >>> :set -XOverloadedStrings
-- >>> import MarkupParse.Internal.FlatParse
-- >>> import FlatParse.Basic

-- | Consume whitespace.
--
-- >>> runParser ws_ " \nx"
-- OK () "x"
--
-- >>> runParser ws_ "x"
-- OK () "x"
ws_ :: Parser e ()
ws_ :: forall e. Parser e ()
ws_ =
  $( switch
       [|
         case _ of
           " " -> ws_
           "\n" -> ws_
           "\t" -> ws_
           "\r" -> ws_
           "\f" -> ws_
           _ -> pure ()
         |]
   )
{-# INLINE ws_ #-}

-- | \\n \\t \\f \\r and space
isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
' ' = Bool
True -- \x20 space
isWhitespace Char
'\x0a' = Bool
True -- \n linefeed
isWhitespace Char
'\x09' = Bool
True -- \t tab
isWhitespace Char
'\x0c' = Bool
True -- \f formfeed
isWhitespace Char
'\x0d' = Bool
True -- \r carriage return
isWhitespace Char
_ = Bool
False
{-# INLINE isWhitespace #-}

-- | single whitespace
--
-- >>> runParser ws " \nx"
-- OK ' ' "\nx"
ws :: Parser e Char
ws :: forall e. Parser e Char
ws = (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy Char -> Bool
isWhitespace

-- | Single quote
--
-- >>> runParser sq "'"
-- OK () ""
sq :: ParserT st e ()
sq :: forall (st :: ZeroBitType) e. ParserT st e ()
sq = $(char '\'')

-- | Double quote
--
-- >>> runParser dq "\""
-- OK () ""
dq :: ParserT st e ()
dq :: forall (st :: ZeroBitType) e. ParserT st e ()
dq = $(char '"')

-- | Parse whilst not a specific character
--
-- >>> runParser (nota 'x') "abcxyz"
-- OK "abc" "xyz"
nota :: Char -> Parser e ByteString
nota :: forall e. Char -> Parser e ByteString
nota Char
c = ParserT PureMode e ()
-> (() -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan (ParserT PureMode e Char -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e ()
skipMany ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c))) (\() Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE nota #-}

-- | Parse whilst satisfying a predicate.
--
-- >>> runParser (isa (=='x')) "xxxabc"
-- OK "xxx" "abc"
isa :: (Char -> Bool) -> Parser e ByteString
isa :: forall e. (Char -> Bool) -> Parser e ByteString
isa Char -> Bool
p = ParserT PureMode e ()
-> (() -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan (ParserT PureMode e Char -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e ()
skipMany ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy Char -> Bool
p)) (\() Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE isa #-}

-- | A single-quoted string.
wrappedSq :: Parser b ByteString
wrappedSq :: forall b. Parser b ByteString
wrappedSq = $(char '\'') ParserT PureMode b ()
-> ParserT PureMode b ByteString -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParserT PureMode b ByteString
forall e. Char -> Parser e ByteString
nota Char
'\'' ParserT PureMode b ByteString
-> ParserT PureMode b () -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '\'')
{-# INLINE wrappedSq #-}

-- | A double-quoted string.
wrappedDq :: Parser b ByteString
wrappedDq :: forall b. Parser b ByteString
wrappedDq = $(char '"') ParserT PureMode b ()
-> ParserT PureMode b ByteString -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParserT PureMode b ByteString
forall e. Char -> Parser e ByteString
nota Char
'"' ParserT PureMode b ByteString
-> ParserT PureMode b () -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '"')
{-# INLINE wrappedDq #-}

-- | A single-quoted or double-quoted string.
--
-- >>> runParser wrappedQ "\"quoted\""
-- OK "quoted" ""
--
-- >>> runParser wrappedQ "'quoted'"
-- OK "quoted" ""
wrappedQ :: Parser e ByteString
wrappedQ :: forall b. Parser b ByteString
wrappedQ =
  Parser e ByteString
forall b. Parser b ByteString
wrappedDq
    Parser e ByteString -> Parser e ByteString -> Parser e ByteString
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> Parser e ByteString
forall b. Parser b ByteString
wrappedSq
{-# INLINE wrappedQ #-}

-- | A single-quoted or double-quoted wrapped parser.
--
-- >>> runParser (wrappedQNoGuard (many $ satisfy (/= '"'))) "\"name\""
-- OK "name" ""
--
-- Will consume quotes if the underlying parser does.
--
-- >>> runParser (wrappedQNoGuard (many anyChar)) "\"name\""
-- Fail
wrappedQNoGuard :: Parser e a -> Parser e a
wrappedQNoGuard :: forall e a. Parser e a -> Parser e a
wrappedQNoGuard Parser e a
p = Parser e () -> Parser e a -> Parser e a
forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
forall (st :: ZeroBitType) e. ParserT st e ()
dq Parser e a
p Parser e a -> Parser e a -> Parser e a
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> Parser e () -> Parser e a -> Parser e a
forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
forall (st :: ZeroBitType) e. ParserT st e ()
sq Parser e a
p

-- | xml production [25]
--
-- >>> runParser eq " = "
-- OK () ""
--
-- >>> runParser eq "="
-- OK () ""
eq :: Parser e ()
eq :: forall e. Parser e ()
eq = Parser e ()
forall e. Parser e ()
ws_ Parser e () -> Parser e () -> Parser e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> $(char '=') Parser e () -> Parser e () -> Parser e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e ()
forall e. Parser e ()
ws_
{-# INLINE eq #-}

-- | Parser bracketed by two other parsers.
--
-- >>> runParser (bracketed ($(char '[')) ($(char ']')) (many (satisfy (/= ']')))) "[bracketed]"
-- OK "bracketed" ""
bracketed :: Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed :: forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed Parser e b
o Parser e b
c Parser e a
p = Parser e b
o Parser e b -> Parser e a -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e a
p Parser e a -> Parser e b -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e b
c
{-# INLINE bracketed #-}

-- | Parser bracketed by square brackets.
--
-- >>> runParser bracketedSB "[bracketed]"
-- OK "bracketed" ""
bracketedSB :: Parser e [Char]
bracketedSB :: forall e. Parser e [Char]
bracketedSB = Parser e () -> Parser e () -> Parser e [Char] -> Parser e [Char]
forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed $(char '[') $(char ']') (ParserT PureMode e Char -> Parser e [Char]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')))

-- | Parser wrapped by another parser.
--
-- >>> runParser (wrapped ($(char '"')) (many (satisfy (/= '"')))) "\"wrapped\""
-- OK "wrapped" ""
wrapped :: Parser e () -> Parser e a -> Parser e a
wrapped :: forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
x Parser e a
p = Parser e () -> Parser e () -> Parser e a -> Parser e a
forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed Parser e ()
x Parser e ()
x Parser e a
p
{-# INLINE wrapped #-}