crafting-interpreters/src/MyLib.hs

module MyLib (runLox) where

import Data.Text (Text, pack, unpack)
import Data.Void (Void)
import GHC.Float (int2Double)
import LoxTypes
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L

type LoxParser = Parsec Void Text

runLox :: (Monad m) => Text -> m [Either (ParseErrorBundle Text Void) [LoxToken]]
runLox loxSource = return $ runLoxParser <$> (pack <$> lines (unpack loxSource))

skipSpaceOrComment :: LoxParser ()
skipSpaceOrComment =
  L.space
    space1
    (L.skipLineComment "//")
    (L.skipBlockComment "/*" "*/")

scanCharToken :: LoxParser LoxToken
scanCharToken = do
  try leftParen
    <|> try rightParen
    <|> try leftBrace
    <|> try rightBrace
    <|> try rightBrace
    <|> try comma
    <|> try dot
    <|> try minus
    <|> try plus
    <|> try semiColon
    <|> try slash
    <|> try star
  where
    leftParen = char '(' >> return (Char LeftParen)
    rightParen = char ')' >> return (Char RightParen)
    leftBrace = char '{' >> return (Char LeftBrace)
    rightBrace = char '}' >> return (Char RightBrace)
    comma = char ',' >> return (Char Comma)
    dot = char '.' >> return (Char Dot)
    minus = char '-' >> return (Char Minus)
    plus = char '+' >> return (Char Plus)
    semiColon = char ';' >> return (Char Semicolon)
    star = char '*' >> return (Char Star)
    slash = char '/' >> return (Char Slash)

scanOperators :: LoxParser LoxToken
scanOperators = do
  try bangEqual
    <|> try bang
    <|> try equalEqual
    <|> try equal
    <|> try greaterEqual
    <|> try greater
    <|> try lessEqual
    <|> try less
  where
    bangEqual = char '!' >> char '=' >> return (Op BangEqual)
    bang = char '!' >> return (Op Bang)
    equalEqual = char '=' >> char '=' >> return (Op EqualEqual)
    equal = char '=' >> return (Op Equal)
    greaterEqual = char '>' >> char '=' >> return (Op GreaterEqual)
    greater = char '>' >> return (Op Greater)
    lessEqual = char '<' >> char '=' >> return (Op LessEqual)
    less = char '<' >> return (Op Less)

scanStringLiteral :: LoxParser LoxToken
scanStringLiteral = do
  s <- char '"' >> manyTill L.charLiteral (char '"')
  return (Lit $ Str s)

scanNumberLiteral :: LoxParser LoxToken
scanNumberLiteral = do
  try tryFloat <|> try tryDecimal
  where
    tryFloat = Lit . Number <$> L.float
    tryDecimal = Lit . Number . int2Double <$> L.decimal

scanIdentifiers :: LoxParser LoxToken
scanIdentifiers =
  iand
    <|> iclass
    <|> ielse
    <|> ifalse
    <|> ifunc
    <|> ifor
    <|> iif
    <|> inil
    <|> ior
    <|> iprint
    <|> ireturn
    <|> isuper
    <|> ithis
    <|> itrue
    <|> ivar
    <|> iwhile
  where
    iand = try (string "and") >> return (Lit $ Identifier And)
    iclass = try (string "class") >> return (Lit $ Identifier Class)
    ielse = try (string "else") >> return (Lit $ Identifier Else)
    ifalse = try (string "false") >> return (Lit $ Identifier LoxTypes.False)
    ifunc = try (string "fun") >> return (Lit $ Identifier Func)
    ifor = try (string "for") >> return (Lit $ Identifier For)
    iif = try (string "if") >> return (Lit $ Identifier If)
    inil = try (string "nil") >> return (Lit $ Identifier Nil)
    ior = try (string "or") >> return (Lit $ Identifier Or)
    iprint = try (string "print") >> return (Lit $ Identifier Print)
    ireturn = try (string "return") >> return (Lit $ Identifier Return)
    isuper = try (string "super") >> return (Lit $ Identifier Super)
    ithis = try (string "this") >> return (Lit $ Identifier This)
    itrue = try (string "true") >> return (Lit $ Identifier LoxTypes.True)
    ivar = try (string "var") >> return (Lit $ Identifier Var)
    iwhile = try (string "while") >> return (Lit $ Identifier While)

scanLiteral :: LoxParser LoxToken
scanLiteral = try scanStringLiteral <|> try scanNumberLiteral <|> try scanIdentifiers

scanTokens :: LoxParser [LoxToken]
scanTokens = manyTill scanLine eof
  where
    scanLine :: LoxParser LoxToken
    scanLine = do
      try skipSpaceOrComment
      loxTokens <- try scanLiteral <|> try scanOperators <|> try scanCharToken
      try skipSpaceOrComment
      return loxTokens

runLoxParser :: Text -> Either (ParseErrorBundle Text Void) [LoxToken]
runLoxParser = runParser scanTokens ""