parser

Main.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}

import Data.Void
import Text.Megaparsec hiding (Token)
import Text.Read (reads)

data Token
  = TokParenL
  | TokParenR
  | TokNumber Int
  | TokPlus
  | TokMult
  deriving (Show, Ord, Eq)

lexer :: String -> [Token]
lexer [] = []
lexer ('(' : toks) = TokParenL : lexer toks
lexer (')' : toks) = TokParenR : lexer toks
lexer ('+' : toks) = TokPlus : lexer toks
lexer ('*' : toks) = TokMult : lexer toks
lexer (' ' : toks) = lexer toks
lexer s = case reads s of
  [(num, s)] -> TokNumber num : lexer s
  _ -> error "invalid source"

data Expr
  = Val Int
  | Plus Expr Expr
  | Mult Expr Expr
  deriving (Show)

type Parser = Parsec Void [Token]

tok :: Char -> Parser Token
tok '(' = single TokParenL
tok ')' = single TokParenR
tok '+' = single TokPlus
tok '*' = single TokMult

number :: Parser Int
number = flip token mempty \case
  TokNumber n -> Just n
  _ -> Nothing

expr, expr1, expr2, expr3, expr4 :: Parser Expr
expr = expr1
expr1 = try (Plus <$> expr2 <* tok '+' <*> expr1) <|> expr2
expr2 = try (Mult <$> expr3 <* tok '*' <*> expr2) <|> expr3
expr3 = try (Val <$> number) <|> expr4
expr4 = between (tok '(') (tok ')') expr1

f :: String -> IO ()
f = print . runParser (expr <* eof) "" . lexer

main = f "1 + 2*3 + 4"

package.yaml

name: haskell-playground

dependencies:
  - base >= 4.12 && < 5
  - megaparsec

executables:
  haskell-playground-exe:
    main: Main.hs
    source-dirs: app