module Language.Egison.Parser.Pattern.Prim
(
ParseFixity(..)
, ParseMode(..)
, ExtParser
, Parse
, runParse
, extParser
, space
, lexeme
, name
, varName
, valueExpr
, Errors
, Error(..)
, ErrorItem(..)
, Position(..)
, Location(..)
, Locate(..)
, Source
, Token
, Tokens
, module X
)
where
import Text.Megaparsec as X
( MonadParsec(..)
, (<?>)
, single
, chunk
)
import Control.Monad ( void )
import Control.Monad.Reader ( ask )
import Control.Applicative ( Alternative((<|>))
, empty
)
import qualified Text.Megaparsec as Parsec
( takeWhile1P
, takeWhileP
, manyTill
, chunk
, customFailure
, single
, anySingle
)
import qualified Text.Megaparsec.Char.Lexer as L
( lexeme
, space
)
import qualified Language.Egison.Parser.Pattern.Token
as Token
( isSpace
, comma
, parenLeft
, parenRight
, bracketLeft
, bracketRight
, newline
)
import Language.Egison.Parser.Pattern.Prim.Location
( Position(..)
, Location(..)
, Locate(..)
)
import Language.Egison.Parser.Pattern.Prim.Error
( Error(..)
, ErrorItem(..)
, Errors
, CustomError(..)
)
import Language.Egison.Parser.Pattern.Prim.Source
( Source(..)
, Token
, Tokens
)
import Language.Egison.Parser.Pattern.Prim.ParseMode
( ParseMode(..)
, ParseFixity(..)
, ExtParser
)
import Language.Egison.Parser.Pattern.Prim.Parse
( Parse
, runParse
)
skipBlockComment :: Source s => Tokens s -> Tokens s -> Parse n v e s ()
Tokens s
start Tokens s
end = Parse n v e s (Tokens s)
cs Parse n v e s (Tokens s) -> Parse n v e s () -> Parse n v e s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse n v e s [Token s] -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parse n v e s (Token s)
-> Parse n v e s (Tokens s) -> Parse n v e s [Token s]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
Parsec.manyTill Parse n v e s (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
Parsec.anySingle Parse n v e s (Tokens s)
ce)
where
cs :: Parse n v e s (Tokens s)
cs = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
start
ce :: Parse n v e s (Tokens s)
ce = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
end
skipLineComment :: Source s => Tokens s -> Parse n v e s ()
Tokens s
prefix = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
prefix
Parse n v e s (Tokens s) -> Parse n v e s () -> Parse n v e s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse n v e s (Tokens s) -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"chars") (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.newline))
space :: Source s => Parse n v e s ()
space :: Parse n v e s ()
space = do
ParseMode { Maybe (Tokens s, Tokens s)
$sel:blockComment:ParseMode :: forall n v e s. ParseMode n v e s -> Maybe (Tokens s, Tokens s)
blockComment :: Maybe (Tokens s, Tokens s)
blockComment, Maybe (Tokens s)
$sel:lineComment:ParseMode :: forall n v e s. ParseMode n v e s -> Maybe (Tokens s)
lineComment :: Maybe (Tokens s)
lineComment } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
let block :: Parse n v e s ()
block = ((Tokens s, Tokens s) -> Parse n v e s ())
-> Maybe (Tokens s, Tokens s) -> Parse n v e s ()
forall a a. (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr ((Tokens s -> Tokens s -> Parse n v e s ())
-> (Tokens s, Tokens s) -> Parse n v e s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Tokens s -> Tokens s -> Parse n v e s ()
forall s n v e.
Source s =>
Tokens s -> Tokens s -> Parse n v e s ()
skipBlockComment) Maybe (Tokens s, Tokens s)
blockComment
line :: Parse n v e s ()
line = (Tokens s -> Parse n v e s ())
-> Maybe (Tokens s) -> Parse n v e s ()
forall a a. (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr Tokens s -> Parse n v e s ()
forall s n v e. Source s => Tokens s -> Parse n v e s ()
skipLineComment Maybe (Tokens s)
lineComment
Parse n v e s ()
-> Parse n v e s () -> Parse n v e s () -> Parse n v e s ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parse n v e s ()
space1 Parse n v e s ()
line Parse n v e s ()
block
where
space1 :: Parse n v e s ()
space1 = Parse n v e s (Tokens s) -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parse n v e s (Tokens s) -> Parse n v e s ())
-> Parse n v e s (Tokens s) -> Parse n v e s ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"whitespace") Token s -> Bool
forall c. IsToken c => c -> Bool
Token.isSpace
emptyOr :: (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr = Parse n v e s a
-> (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parse n v e s a
forall (f :: * -> *) a. Alternative f => f a
empty
takeChunk :: forall n v e s . Source s => Parse n v e s (Tokens s)
takeChunk :: Parse n v e s (Tokens s)
takeChunk = Parse n v e s (Tokens s)
withParens Parse n v e s (Tokens s)
-> Parse n v e s (Tokens s) -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (Tokens s)
withBrackets Parse n v e s (Tokens s)
-> Parse n v e s (Tokens s) -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (Tokens s)
withoutParens
where
withParens :: Parse n v e s (Tokens s)
withParens = do
Token s
left <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.parenLeft
Tokens s
ck <- Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk (in parens)")
(Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.parenRight)
Token s
right <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.parenRight
Tokens s -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tokens s -> Parse n v e s (Tokens s))
-> Tokens s -> Parse n v e s (Tokens s)
forall a b. (a -> b) -> a -> b
$ Token s -> Tokens s -> Tokens s
forall s. Source s => Token s -> Tokens s -> Tokens s
consTokens @s Token s
left (Tokens s -> Token s -> Tokens s
forall s. Source s => Tokens s -> Token s -> Tokens s
snocTokens @s Tokens s
ck Token s
right)
withBrackets :: Parse n v e s (Tokens s)
withBrackets = do
Token s
left <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.bracketLeft
Tokens s
ck <- Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk (in brackets)")
(Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.bracketRight)
Token s
right <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.bracketRight
Tokens s -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tokens s -> Parse n v e s (Tokens s))
-> Tokens s -> Parse n v e s (Tokens s)
forall a b. (a -> b) -> a -> b
$ Token s -> Tokens s -> Tokens s
forall s. Source s => Token s -> Tokens s -> Tokens s
consTokens @s Token s
left (Tokens s -> Token s -> Tokens s
forall s. Source s => Tokens s -> Token s -> Tokens s
snocTokens @s Tokens s
ck Token s
right)
withoutParens :: Parse n v e s (Tokens s)
withoutParens = Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk") Token s -> Bool
forall a. (IsToken a, Eq a) => a -> Bool
endOfChunk
endOfChunk :: a -> Bool
endOfChunk a
x = Bool -> Bool
not (a -> Bool
forall a. (IsToken a, Eq a) => a -> Bool
isDelimiter a
x) Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall c. IsToken c => c
Token.parenRight
isDelimiter :: a -> Bool
isDelimiter a
x =
a -> Bool
forall c. IsToken c => c -> Bool
Token.isSpace a
x
Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.comma
a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.parenRight
a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.bracketRight
a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
extParser :: Source s => ExtParser s a -> Parse n v e s a
extParser :: ExtParser s a -> Parse n v e s a
extParser ExtParser s a
p = Parse n v e s a -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parse n v e s a -> Parse n v e s a)
-> Parse n v e s a -> Parse n v e s a
forall a b. (a -> b) -> a -> b
$ do
Tokens s
lchunk <- Parse n v e s (Tokens s)
forall n v e s. Source s => Parse n v e s (Tokens s)
takeChunk
case ExtParser s a
p Tokens s
lchunk of
Left String
err -> CustomError s -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
Parsec.customFailure (Tokens s -> String -> CustomError s
forall s. Tokens s -> String -> CustomError s
ExtParserError Tokens s
lchunk String
err)
Right a
x -> a -> Parse n v e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
lexeme :: Source s => Parse n v e s a -> Parse n v e s a
lexeme :: Parse n v e s a -> Parse n v e s a
lexeme = Parse n v e s () -> Parse n v e s a -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parse n v e s ()
forall s n v e. Source s => Parse n v e s ()
space
name :: Source s => Parse n v e s n
name :: Parse n v e s n
name = do
ParseMode { ExtParser s n
$sel:nameParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s n
nameParser :: ExtParser s n
nameParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
ExtParser s n -> Parse n v e s n
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s n
nameParser
varName :: Source s => Parse n v e s v
varName :: Parse n v e s v
varName = do
ParseMode { ExtParser s v
$sel:varNameParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s v
varNameParser :: ExtParser s v
varNameParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
ExtParser s v -> Parse n v e s v
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s v
varNameParser
valueExpr :: Source s => Parse n v e s e
valueExpr :: Parse n v e s e
valueExpr = do
ParseMode { ExtParser s e
$sel:valueExprParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s e
valueExprParser :: ExtParser s e
valueExprParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
ExtParser s e -> Parse n v e s e
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s e
valueExprParser