-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Michelson.Parser.Lexer
  ( lexeme
  , mSpace
  , spaces
  , symbol
  , symbol1
  , word
  , parens
  , braces
  , brackets
  , brackets'
  , semicolon
  , comma
  ) where

import Prelude hiding (try)

import Text.Megaparsec (Tokens, between, choice, eof, hidden, lookAhead, try)
import Text.Megaparsec.Char (space, space1, string)
import Text.Megaparsec.Char.Lexer qualified as L

import Morley.Michelson.Parser.Types (Parser)

-- Lexing
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT CustomParserException Text Identity ()
spaces

mSpace :: Parser ()
mSpace :: ParsecT CustomParserException Text Identity ()
mSpace = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
  (Tokens Text -> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"#" ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomParserException Text Identity ()
optionalSemicolon)
  (Tokens Text
-> Tokens Text -> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/" ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomParserException Text Identity ()
optionalSemicolon)
  where
    optionalSemicolon :: ParsecT CustomParserException Text Identity ()
optionalSemicolon = ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomParserException Text Identity (Maybe ())
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomParserException Text Identity ()
semicolon)

spaces :: Parser ()
spaces :: ParsecT CustomParserException Text Identity ()
spaces =
  (ParsecT CustomParserException Text Identity ()
mandatorySpaceOrComment ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomParserException Text Identity ()
mSpace)
  ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tokens Text] -> ParsecT CustomParserException Text Identity ()
hasFollowingDelimiter [Tokens Text
"}", Tokens Text
"{", Tokens Text
"]", Tokens Text
")", Tokens Text
"|", Tokens Text
",", Tokens Text
";", Tokens Text
":", Tokens Text
"."]
  ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  where
    mandatorySpaceOrComment :: ParsecT CustomParserException Text Identity ()
mandatorySpaceOrComment = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> Tokens Text -> ParsecT CustomParserException Text Identity ()
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] -> ParsecT CustomParserException Text Identity ()
hasFollowingDelimiter = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT CustomParserException Text Identity ()
 -> ParsecT CustomParserException Text Identity ())
-> ([Tokens Text]
    -> ParsecT CustomParserException Text Identity ())
-> [Tokens Text]
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT CustomParserException Text Identity ()]
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT CustomParserException Text Identity ()]
 -> ParsecT CustomParserException Text Identity ())
-> ([Tokens Text]
    -> [ParsecT CustomParserException Text Identity ()])
-> [Tokens Text]
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tokens Text -> ParsecT CustomParserException Text Identity ())
-> [Tokens Text]
-> [ParsecT CustomParserException Text Identity ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomParserException Text Identity (Tokens Text)
 -> ParsecT CustomParserException Text Identity ())
-> (Tokens Text
    -> ParsecT CustomParserException Text Identity (Tokens Text))
-> Tokens Text
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT CustomParserException Text Identity (Tokens Text)
 -> ParsecT CustomParserException Text Identity (Tokens Text))
-> (Tokens Text
    -> ParsecT CustomParserException Text Identity (Tokens Text))
-> Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string)

symbol :: Tokens Text -> Parser ()
symbol :: Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol = ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomParserException Text Identity Text
 -> ParsecT CustomParserException Text Identity ())
-> (Text -> ParsecT CustomParserException Text Identity Text)
-> Text
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomParserException Text Identity ()
-> Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT CustomParserException Text Identity ()
mSpace

symbol1 :: Tokens Text -> Parser ()
symbol1 :: Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol1 = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity ()
 -> ParsecT CustomParserException Text Identity ())
-> (Text -> ParsecT CustomParserException Text Identity ())
-> Text
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomParserException Text Identity Text
 -> ParsecT CustomParserException Text Identity ())
-> (Text -> ParsecT CustomParserException Text Identity Text)
-> Text
-> ParsecT CustomParserException Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT CustomParserException Text Identity ()
-> Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT CustomParserException Text Identity ()
spaces

word :: Tokens Text -> a -> Parser a
word :: forall a. Tokens Text -> a -> Parser a
word Tokens Text
str a
val = Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol1 Tokens Text
str ParsecT CustomParserException Text Identity ()
-> a -> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
val

parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
"(") (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
")")

braces :: Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
"{") (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
"}")

brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
"[") (Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
"]")

brackets' :: Parser a -> Parser a
brackets' :: forall a. Parser a -> Parser a
brackets' = ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[") (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"]")

semicolon :: Parser ()
semicolon :: ParsecT CustomParserException Text Identity ()
semicolon = Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
";"

comma :: Parser ()
comma :: ParsecT CustomParserException Text Identity ()
comma = Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol Tokens Text
","