{-# options_haddock prune #-}
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_,
withSpan,
string,
takeRest,
(<|>),
)
import Prelude hiding (empty, span, (<|>))
import Exon.Data.RawSegment (RawSegment (ExpSegment, StringSegment, WsSegment))
type Parser =
FlatParse.Parser Int Text
span :: Parser () -> Parser String
span :: Parser () -> Parser String
span Parser ()
seek =
forall r e a b.
Parser r e a -> (a -> Span -> Parser r e b) -> Parser r e b
withSpan Parser ()
seek \ ()
_ Span
sp -> forall r e a. Span -> Parser r e a -> Parser r e a
inSpan Span
sp forall r e. Parser r e String
takeRest
ws :: Parser Char
ws :: Parser Char
ws =
forall r e. (Char -> Bool) -> Parser r e Char
satisfy Char -> Bool
isSpace
whitespace :: Parser RawSegment
whitespace :: Parser RawSegment
whitespace =
String -> RawSegment
WsSegment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span (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 =
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a. Parser a -> Parser () -> Parser () -> Parser ()
before Parser a
cond forall (f :: * -> *). Applicative f => f ()
unit
expr :: Parser ()
expr :: Parser ()
expr =
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch $(char '{') (forall r e. (Int -> Int) -> Parser r e ()
modify (Int
1 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr) forall a b. (a -> b) -> a -> b
$
forall a. Parser a -> Parser () -> Parser () -> Parser ()
before $(char '}') Parser ()
closing (forall r e. Parser r e Char
anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr)
where
closing :: Parser ()
closing =
forall r e. Parser r e Int
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
0 -> forall (f :: * -> *). Applicative f => f ()
unit
Int
cur -> forall r e. Int -> Parser r e ()
put (Int
cur forall a. Num a => a -> a -> a
- Int
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> $(char '}') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
expr
interpolation :: Parser RawSegment
interpolation :: Parser RawSegment
interpolation =
$(string "#{") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> RawSegment
ExpSegment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
expr) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '}')
untilTokenEnd :: Parser ()
untilTokenEnd :: Parser ()
untilTokenEnd =
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch $(char '\\') (forall r e. Parser r e Char
anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
untilTokenEnd) forall a b. (a -> b) -> a -> b
$
forall a. Parser a -> Parser () -> Parser ()
finishBefore ($(string "#{") forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
ws) forall a b. (a -> b) -> a -> b
$
forall r e. Parser r e ()
eof forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> (forall r e. Parser r e Char
anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
untilTokenEnd)
text :: Parser RawSegment
text :: Parser RawSegment
text =
String -> RawSegment
StringSegment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String
span Parser ()
untilTokenEnd
segment :: Parser RawSegment
segment :: Parser RawSegment
segment =
forall r e a b.
Parser r e a -> Parser r e b -> Parser r e b -> Parser r e b
branch forall r e. Parser r e ()
eof forall r e a. Parser r e a
empty (Parser RawSegment
whitespace forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
interpolation forall r e a. Parser r e a -> Parser r e a -> Parser r e a
<|> Parser RawSegment
text)
parser :: Parser [RawSegment]
parser :: Parser [RawSegment]
parser =
forall r e a. Parser r e a -> Parser r e [a]
FlatParse.many Parser RawSegment
segment
parse :: String -> Either Text [RawSegment]
parse :: String -> Either Text [RawSegment]
parse =
forall r e a. Parser r e a -> r -> Int -> String -> Result e a
runParserS Parser [RawSegment]
parser Int
0 Int
0 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
"" -> forall a b. b -> Either a b
Right [RawSegment]
a
OK [RawSegment]
_ Int
_ ByteString
u -> forall a b. a -> Either a b
Left (Text
"unconsumed: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
u)
Result Text [RawSegment]
Fail -> forall a b. a -> Either a b
Left Text
"fail"
Err Text
e -> forall a b. a -> Either a b
Left Text
e