{-# options_haddock prune #-}

-- |Description: The parser for the quasiquote body, using "FlatParse".
module Exon.Parse where

import Data.Char (isSpace)
import qualified FlatParse.Stateful as FlatParse
import FlatParse.Stateful (
  Result (Err, Fail, OK),
  anyChar,
  branch,
  char,
  empty,
  eof,
  get,
  inSpan,
  lookahead,
  modify,
  put,
  runParserS,
  satisfy,
  some_,
  string,
  takeRest,
  withSpan,
  (<|>),
  )
import Prelude hiding (empty, span, (<|>))

import Exon.Data.RawSegment (RawSegment (AutoExpSegment, ExpSegment, StringSegment, WsSegment))

type Parser =
  FlatParse.Parser Int Text

span :: Parser () -> Parser String
span :: Parser () -> Parser String
span Parser ()
seek =
  Parser () -> (() -> Span -> Parser String) -> Parser String
forall r e a b.
Parser r e a -> (a -> Span -> Parser r e b) -> Parser r e b
withSpan Parser ()
seek \ ()
_ Span
sp -> Span -> Parser String -> Parser String
forall r e a. Span -> Parser r e a -> Parser r e a
inSpan Span
sp Parser String
forall r e. Parser r e String
takeRest

ws :: Parser Char
ws :: Parser Char
ws =
  (Char -> Bool) -> Parser Char
forall r e. (Char -> Bool) -> Parser r e Char
satisfy Char -> Bool
isSpace

whitespace :: Parser RawSegment
whitespace :: Parser RawSegment
whitespace =
  String -> RawSegment
WsSegment (String -> RawSegment) -> Parser String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span (Parser Char -> Parser ()
forall r e a. Parser r e a -> Parser r e ()
some_ Parser Char
ws)

before ::
  Parser a ->
  Parser () ->
  Parser () ->
  Parser ()
before :: forall a. Parser a -> Parser () -> Parser () -> Parser ()
before =
  Parser Int Text a -> Parser () -> Parser () -> Parser ()
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch (Parser Int Text a -> Parser () -> Parser () -> Parser ())
-> (Parser Int Text a -> Parser Int Text a)
-> Parser Int Text a
-> Parser ()
-> Parser ()
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Int Text a -> Parser Int Text a
forall r e a. Parser r e a -> Parser r e a
lookahead

finishBefore ::
  Parser a ->
  Parser () ->
  Parser ()
finishBefore :: forall a. Parser a -> Parser () -> Parser ()
finishBefore Parser a
cond =
  Parser a -> Parser () -> Parser () -> Parser ()
forall a. Parser a -> Parser () -> Parser () -> Parser ()
before Parser a
cond Parser ()
forall (f :: * -> *). Applicative f => f ()
unit

expr :: Parser ()
expr :: Parser ()
expr =
  Parser () -> Parser () -> Parser () -> Parser ()
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch $(char '{') ((Int -> Int) -> Parser ()
forall r e. (Int -> Int) -> Parser r e ()
modify (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
  Parser () -> Parser () -> Parser () -> Parser ()
forall a. Parser a -> Parser () -> Parser () -> Parser ()
before $(char '}') Parser ()
closing (Parser Char
forall r e. Parser r e Char
anyChar Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr)
  where
    closing :: Parser ()
closing =
      Parser Int Text Int
forall r e. Parser r e Int
get Parser Int Text Int -> (Int -> Parser ()) -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Int
0 -> Parser ()
forall (f :: * -> *). Applicative f => f ()
unit
        Int
cur -> Int -> Parser ()
forall r e. Int -> Parser r e ()
put (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> $(char '}') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr

autoInterpolation :: Parser RawSegment
autoInterpolation :: Parser RawSegment
autoInterpolation =
  $(string "##{") Parser () -> Parser RawSegment -> Parser RawSegment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> RawSegment
AutoExpSegment (String -> RawSegment) -> Parser String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
expr) Parser RawSegment -> Parser () -> Parser RawSegment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '}')

verbatimInterpolation :: Parser RawSegment
verbatimInterpolation :: Parser RawSegment
verbatimInterpolation =
  $(string "#{") Parser () -> Parser RawSegment -> Parser RawSegment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> RawSegment
ExpSegment (String -> RawSegment) -> Parser String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
expr) Parser RawSegment -> Parser () -> Parser RawSegment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '}')

untilTokenEnd :: Parser ()
untilTokenEnd :: Parser ()
untilTokenEnd =
  Parser () -> Parser () -> Parser ()
forall a. Parser a -> Parser () -> Parser ()
finishBefore ($(string "##{") Parser () -> Parser () -> Parser ()
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> $(string "#{")) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
  Parser ()
forall r e. Parser r e ()
eof Parser () -> Parser () -> Parser ()
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> (Parser Char
forall r e. Parser r e Char
anyChar Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
untilTokenEnd)

untilTokenEndWs :: Parser ()
untilTokenEndWs :: Parser ()
untilTokenEndWs =
  Parser () -> Parser () -> Parser ()
forall a. Parser a -> Parser () -> Parser ()
finishBefore ($(string "##{") Parser () -> Parser () -> Parser ()
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> $(string "#{") Parser () -> Parser () -> Parser ()
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
ws) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
  Parser ()
forall r e. Parser r e ()
eof Parser () -> Parser () -> Parser ()
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> (Parser Char
forall r e. Parser r e Char
anyChar Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
untilTokenEndWs)

text :: Parser RawSegment
text :: Parser RawSegment
text =
  String -> RawSegment
StringSegment (String -> RawSegment) -> Parser String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
untilTokenEnd

textWs :: Parser RawSegment
textWs :: Parser RawSegment
textWs =
  String -> RawSegment
StringSegment (String -> RawSegment) -> Parser String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
untilTokenEndWs

segment :: Parser RawSegment
segment :: Parser RawSegment
segment =
  Parser ()
-> Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch Parser ()
forall r e. Parser r e ()
eof Parser RawSegment
forall r e a. Parser r e a
empty (Parser RawSegment
autoInterpolation Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
verbatimInterpolation Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
text)

segmentWs :: Parser RawSegment
segmentWs :: Parser RawSegment
segmentWs =
  Parser ()
-> Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch Parser ()
forall r e. Parser r e ()
eof Parser RawSegment
forall r e a. Parser r e a
empty (Parser RawSegment
whitespace Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
autoInterpolation Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
verbatimInterpolation Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
textWs)

parser :: Parser [RawSegment]
parser :: Parser [RawSegment]
parser =
  Parser RawSegment -> Parser [RawSegment]
forall r e a. Parser r e a -> Parser r e [a]
FlatParse.many Parser RawSegment
segment

parserWs :: Parser [RawSegment]
parserWs :: Parser [RawSegment]
parserWs =
  Parser RawSegment -> Parser [RawSegment]
forall r e a. Parser r e a -> Parser r e [a]
FlatParse.many Parser RawSegment
segmentWs

parseWith :: Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith :: Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith Parser [RawSegment]
p =
  Parser [RawSegment]
-> Int -> Int -> String -> Result Text [RawSegment]
forall r e a. Parser r e a -> r -> Int -> String -> Result e a
runParserS Parser [RawSegment]
p Int
0 Int
0 (String -> Result Text [RawSegment])
-> (Result Text [RawSegment] -> Either Text [RawSegment])
-> String
-> Either Text [RawSegment]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    OK [RawSegment]
a Int
_ ByteString
"" -> [RawSegment] -> Either Text [RawSegment]
forall a b. b -> Either a b
Right [RawSegment]
a
    OK [RawSegment]
_ Int
_ ByteString
u -> Text -> Either Text [RawSegment]
forall a b. a -> Either a b
Left (Text
"unconsumed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
u)
    Result Text [RawSegment]
Fail -> Text -> Either Text [RawSegment]
forall a b. a -> Either a b
Left Text
"fail"
    Err Text
e -> Text -> Either Text [RawSegment]
forall a b. a -> Either a b
Left Text
e

parse :: String -> Either Text [RawSegment]
parse :: String -> Either Text [RawSegment]
parse =
  Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith Parser [RawSegment]
parser

parseWs :: String -> Either Text [RawSegment]
parseWs :: String -> Either Text [RawSegment]
parseWs =
  Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith Parser [RawSegment]
parserWs