{-# options_haddock prune #-}

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

import Data.Char (isSpace)
import Prelude hiding ((<|>))
import Text.Parsec as Parsec (
  Parsec,
  anyChar,
  char,
  choice,
  getState,
  lookAhead,
  many1,
  modifyState,
  notFollowedBy,
  option,
  putState,
  runParser,
  satisfy,
  string,
  try,
  (<|>),
  )

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

type Parser = Parsec String Int

ws :: Parser Char
ws :: Parser Char
ws =
  (Char -> Bool) -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace

whitespace :: Parser RawSegment
whitespace :: Parser RawSegment
whitespace =
  String -> RawSegment
WsSegment (String -> RawSegment)
-> ParsecT String Int Identity String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT String Int Identity String
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
ws

takeRestUnless :: Parser Char -> Parser String
takeRestUnless :: Parser Char -> ParsecT String Int Identity String
takeRestUnless Parser Char
end =
  Parser Char -> ParsecT String Int Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser Char -> ParsecT String Int Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy Parser Char
end ParsecT String Int Identity () -> Parser Char -> Parser Char
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)

expr :: Parser String
expr :: ParsecT String Int Identity String
expr =
  [ParsecT String Int Identity String]
-> ParsecT String Int Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Int Identity String
opening, ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Int Identity String
closing, Item [ParsecT String Int Identity String]
ParsecT String Int Identity String
anyChars]
  where
    opening :: ParsecT String Int Identity String
opening = do
      Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
      (Int -> Int) -> ParsecT String Int Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (Int
1 +)
      String
e <- ParsecT String Int Identity String
expr
      pure (Char
'{' Char -> String -> String
forall a. a -> [a] -> [a]
: String
e)

    closing :: ParsecT String Int Identity String
closing = do
      Parser Char -> ParsecT String Int Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> ParsecT String Int Identity ())
-> Parser Char -> ParsecT String Int Identity ()
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
      ParsecT String Int Identity Int
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT String Int Identity Int
-> (Int -> ParsecT String Int Identity String)
-> ParsecT String Int Identity String
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Int
0 -> String -> ParsecT String Int Identity String
forall a. a -> ParsecT String Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
        Int
cur -> do
          Int -> ParsecT String Int Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
          String
e <- ParsecT String Int Identity String
expr
          pure (Char
'}' Char -> String -> String
forall a. a -> [a] -> [a]
: String
e)

    anyChars :: ParsecT String Int Identity String
anyChars = do
      Char
c <- Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      String
e <- ParsecT String Int Identity String
expr
      pure (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
e)

autoInterpolation :: Parser RawSegment
autoInterpolation :: Parser RawSegment
autoInterpolation =
  String -> ParsecT String Int Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"##{" ParsecT String Int Identity String
-> Parser RawSegment -> Parser RawSegment
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> RawSegment
AutoExpSegment (String -> RawSegment)
-> ParsecT String Int Identity String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity String
expr) Parser RawSegment -> Parser Char -> Parser RawSegment
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'

verbatimInterpolation :: Parser RawSegment
verbatimInterpolation :: Parser RawSegment
verbatimInterpolation =
  String -> ParsecT String Int Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#{" ParsecT String Int Identity String
-> Parser RawSegment -> Parser RawSegment
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> RawSegment
ExpSegment (String -> RawSegment)
-> ParsecT String Int Identity String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity String
expr) Parser RawSegment -> Parser Char -> Parser RawSegment
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'

interpolations :: Parser RawSegment
interpolations :: Parser RawSegment
interpolations =
  Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser RawSegment
autoInterpolation Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser RawSegment
verbatimInterpolation

stopHerald :: Parser String
stopHerald :: ParsecT String Int Identity String
stopHerald =
  String
"" String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall a b.
a -> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String Int Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"##{") ParsecT String Int Identity String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String Int Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#{"))

hash :: Parser Char
hash :: Parser Char
hash = Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'

verbatimWith :: Parser Char -> Parser String
verbatimWith :: Parser Char -> ParsecT String Int Identity String
verbatimWith Parser Char
end =
  Parser Char -> ParsecT String Int Identity String
takeRestUnless Parser Char
end ParsecT String Int Identity String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall a. Semigroup a => a -> a -> a
<> (ParsecT String Int Identity String
stopHerald ParsecT String Int Identity String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String Int Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#" ParsecT String Int Identity String
-> ParsecT String Int Identity String
-> ParsecT String Int Identity String
forall a. Semigroup a => a -> a -> a
<> ParsecT String Int Identity String
verbatim)))

verbatim :: Parser String
verbatim :: ParsecT String Int Identity String
verbatim =
  Parser Char -> ParsecT String Int Identity String
verbatimWith Parser Char
hash

verbatimWs :: Parser String
verbatimWs :: ParsecT String Int Identity String
verbatimWs =
  Parser Char -> ParsecT String Int Identity String
verbatimWith (Parser Char
ws Parser Char -> Parser Char -> Parser Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char
hash)

text :: Parser RawSegment
text :: Parser RawSegment
text =
  String -> RawSegment
StringSegment (String -> RawSegment)
-> ParsecT String Int Identity String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity String
verbatim

textWs :: Parser RawSegment
textWs :: Parser RawSegment
textWs =
  String -> RawSegment
StringSegment (String -> RawSegment)
-> ParsecT String Int Identity String -> Parser RawSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity String
verbatimWs

segment :: Parser RawSegment
segment :: Parser RawSegment
segment =
  Parser RawSegment
interpolations Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser RawSegment
text

segmentWs :: Parser RawSegment
segmentWs :: Parser RawSegment
segmentWs =
  Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser RawSegment
whitespace Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser RawSegment
interpolations Parser RawSegment -> Parser RawSegment -> Parser RawSegment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser RawSegment
textWs

parser :: Parser [RawSegment]
parser :: Parser [RawSegment]
parser =
  Parser RawSegment -> Parser [RawSegment]
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser RawSegment
segment

parserWs :: Parser [RawSegment]
parserWs :: Parser [RawSegment]
parserWs =
  Parser RawSegment -> Parser [RawSegment]
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser RawSegment
segmentWs

parseWith :: Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith :: Parser [RawSegment] -> String -> Either Text [RawSegment]
parseWith Parser [RawSegment]
p =
  (ParseError -> Text)
-> Either ParseError [RawSegment] -> Either Text [RawSegment]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> Text
forall b a. (Show a, IsString b) => a -> b
show (Either ParseError [RawSegment] -> Either Text [RawSegment])
-> (String -> Either ParseError [RawSegment])
-> String
-> Either Text [RawSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [RawSegment]
-> Int -> String -> String -> Either ParseError [RawSegment]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parser [RawSegment]
p Int
0 String
""

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