{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Morley.Michelson.Parser.Lexer
( lexeme
, mSpace
, spaces
, symbol
, symbol'
, symbol1
, symbol1'
, word
, word'
, string'
, parens
, braces
, brackets
, brackets'
, semicolon
, comma
, varID
) where
import Prelude hiding (try)
import Data.Char (isDigit, isLower, toLower)
import Data.Text qualified as T
import Text.Megaparsec (Tokens, between, choice, eof, hidden, lookAhead, satisfy, try)
import Text.Megaparsec.Char (lowerChar, space, space1, string)
import Text.Megaparsec.Char.Lexer qualified as L
import Morley.Michelson.Parser.Types (Parser, Parser')
import Morley.Michelson.Untyped qualified as U
lexeme :: Parser le a -> Parser le a
lexeme :: Parser le a -> Parser le a
lexeme = ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) a
-> ReaderT le (Parsec CustomParserException Text) a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ReaderT le (Parsec CustomParserException Text) ()
forall le. Parser le ()
spaces
mSpace :: Parser le ()
mSpace :: Parser' le ()
mSpace = Parser' le () -> Parser' le () -> Parser' le () -> Parser' le ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
(Tokens Text -> Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"#" Parser' le () -> Parser' le () -> Parser' le ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser' le ()
optionalSemicolon)
(Tokens Text -> Tokens Text -> Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/" Parser' le () -> Parser' le () -> Parser' le ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser' le ()
optionalSemicolon)
where
optionalSemicolon :: Parser' le ()
optionalSemicolon = Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Parser' le () -> Parser' le () -> Parser' le ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT le (Parsec CustomParserException Text) (Maybe ())
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser' le ()
forall le. Parser le ()
semicolon)
spaces :: Parser le ()
spaces :: Parser' le ()
spaces =
(Parser' le ()
mandatorySpaceOrComment Parser' le () -> Parser' le () -> Parser' le ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser' le ()
forall le. Parser le ()
mSpace)
Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tokens Text] -> Parser' le ()
hasFollowingDelimiter [Tokens Text
"}", Tokens Text
"{", Tokens Text
"]", Tokens Text
")", Tokens Text
"|", Tokens Text
",", Tokens Text
";", Tokens Text
":", Tokens Text
"."]
Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
where
mandatorySpaceOrComment :: Parser' le ()
mandatorySpaceOrComment = Parser' le () -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Tokens Text -> Parser' le ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/")
hasFollowingDelimiter :: [Tokens Text] -> Parser' le ()
hasFollowingDelimiter = Parser' le () -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser' le () -> Parser' le ())
-> ([Tokens Text] -> Parser' le ())
-> [Tokens Text]
-> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser' le ()] -> Parser' le ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser' le ()] -> Parser' le ())
-> ([Tokens Text] -> [Parser' le ()])
-> [Tokens Text]
-> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tokens Text -> Parser' le ()) -> [Tokens Text] -> [Parser' le ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ReaderT le (Parsec CustomParserException Text) (Tokens Text)
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT le (Parsec CustomParserException Text) (Tokens Text)
-> Parser' le ())
-> (Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text))
-> Tokens Text
-> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT le (Parsec CustomParserException Text) (Tokens Text)
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ReaderT le (Parsec CustomParserException Text) (Tokens Text)
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text))
-> (Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text))
-> Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string)
symbol :: Tokens Text -> Parser le ()
symbol :: Tokens Text -> Parser le ()
symbol = ReaderT le (Parsec CustomParserException Text) Text
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT le (Parsec CustomParserException Text) Text
-> Parser' le ())
-> (Text -> ReaderT le (Parsec CustomParserException Text) Text)
-> Text
-> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser' le ()
-> Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser' le ()
forall le. Parser le ()
mSpace
symbol' :: Text -> Parser le ()
symbol' :: Text -> Parser le ()
symbol' Text
str = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Text
Tokens Text
str Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol ((Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
str)
symbol1 :: Tokens Text -> Parser le ()
symbol1 :: Tokens Text -> Parser le ()
symbol1 = Parser' le () -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser' le () -> Parser' le ())
-> (Text -> Parser' le ()) -> Text -> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT le (Parsec CustomParserException Text) Text
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT le (Parsec CustomParserException Text) Text
-> Parser' le ())
-> (Text -> ReaderT le (Parsec CustomParserException Text) Text)
-> Text
-> Parser' le ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser' le ()
-> Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser' le ()
forall le. Parser le ()
spaces
symbol1' :: Text -> Parser le ()
symbol1' :: Text -> Parser le ()
symbol1' Text
str = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol1 Text
Tokens Text
str Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol1 ((Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
str)
word :: Tokens Text -> a -> Parser le a
word :: Tokens Text -> a -> Parser le a
word Tokens Text
str a
val = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol1 Tokens Text
str Parser' le ()
-> a -> ReaderT le (Parsec CustomParserException Text) a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
val
word' :: Tokens Text -> a -> Parser le a
word' :: Tokens Text -> a -> Parser le a
word' Tokens Text
str a
val = Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
Tokens Text
str Parser' le ()
-> a -> ReaderT le (Parsec CustomParserException Text) a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
val
string' :: Text -> Parser le Text
string' :: Text -> Parser le Text
string' Text
str = Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
str ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string ((Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
str)
parens :: Parser le a -> Parser le a
parens :: Parser le a -> Parser le a
parens = ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) a
-> ReaderT le (Parsec CustomParserException Text) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"(") (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
")")
braces :: Parser le a -> Parser le a
braces :: Parser le a -> Parser le a
braces = ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) a
-> ReaderT le (Parsec CustomParserException Text) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"{") (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"}")
brackets :: Parser le a -> Parser le a
brackets :: Parser le a -> Parser le a
brackets = ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) a
-> ReaderT le (Parsec CustomParserException Text) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"[") (Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
"]")
brackets' :: Parser le a -> Parser le a
brackets' :: Parser le a -> Parser le a
brackets' = ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) a
-> ReaderT le (Parsec CustomParserException Text) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[") (Tokens Text
-> ReaderT le (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"]")
semicolon :: Parser le ()
semicolon :: Parser' le ()
semicolon = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
";"
comma :: Parser le ()
comma :: Parser' le ()
comma = Tokens Text -> Parser le ()
forall le. Tokens Text -> Parser le ()
symbol Tokens Text
","
varID :: Parser le U.Var
varID :: Parser' le Var
varID = Parser le Var -> Parser le Var
forall le a. Parser le a -> Parser le a
lexeme (Parser le Var -> Parser le Var) -> Parser le Var -> Parser le Var
forall a b. (a -> b) -> a -> b
$ do
Char
v <- ReaderT le (Parsec CustomParserException Text) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
[Char]
vs <- ReaderT le (Parsec CustomParserException Text) Char
-> ReaderT le (Parsec CustomParserException Text) [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ReaderT le (Parsec CustomParserException Text) Char
forall le. Parser' le Char
lowerAlphaNumChar
return $ Text -> Var
U.Var ([Char] -> Text
forall a. ToText a => a -> Text
toText (Char
vChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
vs))
where
lowerAlphaNumChar :: Parser' le Char
lowerAlphaNumChar :: Parser' le Char
lowerAlphaNumChar = (Token Text -> Bool)
-> ReaderT le (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
x -> Char -> Bool
isLower Char
Token Text
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char -> Bool
isDigit Char
Token Text
x)