Lexer.hs

-- 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 = L.lexeme spaces

mSpace :: Parser ()
mSpace = L.space space1
  (L.skipLineComment "#" >> optionalSemicolon)
  (L.skipBlockComment "/*" "*/" >> optionalSemicolon)
  where
    optionalSemicolon = space >> void (optional semicolon)

spaces :: Parser ()
spaces =
  (mandatorySpaceOrComment >> mSpace)
  <|> hasFollowingDelimiter ["}", "{", "]", ")", "|", ",", ";", ":", "."]
  <|> eof
  where
    mandatorySpaceOrComment = hidden (space1 <|> L.skipBlockComment "/*" "*/")
    hasFollowingDelimiter = hidden . choice . map (void . lookAhead . string)

symbol :: Tokens Text -> Parser ()
symbol = void . L.symbol mSpace

symbol1 :: Tokens Text -> Parser ()
symbol1 = try . void . L.symbol spaces

word :: Tokens Text -> a -> Parser a
word str val = symbol1 str $> val

parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")

braces :: Parser a -> Parser a
braces = between (symbol "{") (symbol "}")

brackets :: Parser a -> Parser a
brackets = between (symbol "[") (symbol "]")

brackets' :: Parser a -> Parser a
brackets' = between (string "[") (string "]")

semicolon :: Parser ()
semicolon = symbol ";"

comma :: Parser ()
comma = symbol ","