interactive_parser.hs

#!/usr/bin/env runhaskell
{-# LANGUAGE FlexibleInstances #-}

-- Interactive Tiny Parser
-- Run with: runhaskell interactive_parser.hs

import Data.Char (isDigit, isAlpha, isAlphaNum, isSpace)
import Data.List (intercalate)
import System.IO (hFlush, stdout)
import Control.Exception (catch, SomeException)


-- AST Data Types

data Expr
  = Number Int
  | BinOp Op Expr Expr
  | Var String
  deriving (Show, Eq)

data Op = Add | Sub | Mul | Div
  deriving (Show, Eq)

data KVPair = KVPair String String
  deriving (Show, Eq)


-- Tokenizer

data Token
  = TNum Int
  | TOp Char
  | TVar String
  | TLParen
  | TRParen
  | TEq
  | EOF
  deriving (Show, Eq)

tokenize :: String -> [Token]
tokenize [] = [EOF]
tokenize (c:cs)
  | isSpace c = tokenize cs
  | isDigit c = 
      let (num, rest) = span isDigit (c:cs)
      in TNum (read num) : tokenize rest
  | isAlpha c =
      let (var, rest) = span isAlphaNum (c:cs)
      in TVar var : tokenize rest
  | c == '+' || c == '-' || c == '*' || c == '/' = TOp c : tokenize cs
  | c == '(' = TLParen : tokenize cs
  | c == ')' = TRParen : tokenize cs
  | c == '=' = TEq : tokenize cs
  | otherwise = tokenize cs


-- Parser for Arithmetic Expressions

parseExpr :: [Token] -> (Expr, [Token])
parseExpr tokens = parseAddSub tokens

parseAddSub :: [Token] -> (Expr, [Token])
parseAddSub tokens =
  let (left, rest) = parseMulDiv tokens
  in parseAddSub' left rest

parseAddSub' :: Expr -> [Token] -> (Expr, [Token])
parseAddSub' left (TOp '+' : rest) =
  let (right, rest') = parseMulDiv rest
  in parseAddSub' (BinOp Add left right) rest'
parseAddSub' left (TOp '-' : rest) =
  let (right, rest') = parseMulDiv rest
  in parseAddSub' (BinOp Sub left right) rest'
parseAddSub' left rest = (left, rest)

parseMulDiv :: [Token] -> (Expr, [Token])
parseMulDiv tokens =
  let (left, rest) = parsePrimary tokens
  in parseMulDiv' left rest

parseMulDiv' :: Expr -> [Token] -> (Expr, [Token])
parseMulDiv' left (TOp '*' : rest) =
  let (right, rest') = parsePrimary rest
  in parseMulDiv' (BinOp Mul left right) rest'
parseMulDiv' left (TOp '/' : rest) =
  let (right, rest') = parsePrimary rest
  in parseMulDiv' (BinOp Div left right) rest'
parseMulDiv' left rest = (left, rest)

parsePrimary :: [Token] -> (Expr, [Token])
parsePrimary (TNum n : rest) = (Number n, rest)
parsePrimary (TVar v : rest) = (Var v, rest)
parsePrimary (TLParen : rest) =
  let (expr, rest') = parseExpr rest
  in case rest' of
    (TRParen : rest'') -> (expr, rest'')
    _ -> error "Expected closing parenthesis"
parsePrimary _ = error "Expected a number, variable, or opening parenthesis"


-- Parser for Key-Value Pairs

parseKVPair :: [Token] -> (KVPair, [Token])
parseKVPair (TVar key : TEq : TVar value : rest) = (KVPair key value, rest)
parseKVPair (TVar key : TEq : TNum num : rest) = (KVPair key (show num), rest)
parseKVPair _ = error "Invalid key-value pair format (expected: key = value)"


-- Evaluator

evalExpr :: Expr -> Int


-- Token Formatter

formatTokens :: [Token] -> String
formatTokens tokens = "[" ++ intercalate ", " (map show tokens) ++ "]"
evalExpr (Number n) = n
evalExpr (Var _) = error "Variable evaluation not supported"
evalExpr (BinOp op left right) =
  let l = evalExpr left
      r = evalExpr right
  in case op of
    Add -> l + r
    Sub -> l - r
    Mul -> l * r
    Div -> if r == 0 then error "Division by zero" else l `div` r

-- Interactive UI

prompt :: String -> IO String
prompt text = do
  putStr text
  hFlush stdout
  getLine

printHeader :: IO ()
printHeader = do
  putStrLn ""
  putStrLn "╔═══════════════════════════════════════╗"
  putStrLn "║   Tiny Parser - Interactive Mode      ║"
  putStrLn "╚═══════════════════════════════════════╝"
  putStrLn ""

printMenu :: IO ()
printMenu = do
  putStrLn "What would you like to do?"
  putStrLn "  1. Parse arithmetic expression"
  putStrLn "  2. Parse key-value pair"
  putStrLn "  3. Evaluate expression"
  putStrLn "  4. Demo mode (show examples)"
  putStrLn "  5. Exit"
  putStrLn ""

handleArithmetic :: IO ()
handleArithmetic = do
  putStrLn ""
  putStrLn "--- Arithmetic Expression Parser ---"
  input <- prompt "Enter expression (e.g., '2 + 3 * 4'): "
  
  if null input
    then putStrLn "Empty input. Please try again."
    else do
      let tokens = tokenize input
      putStrLn $ "Tokens: " ++ formatTokens tokens
      
      catch
        (do
          let (ast, remaining) = parseExpr tokens
          putStrLn $ "AST: " ++ show ast
          if not (null remaining) && remaining /= [EOF]
            then putStrLn $ "Warning: unparsed tokens: " ++ show remaining
            else return ()
        )
        (\e -> putStrLn $ "Parse error: " ++ show (e :: SomeException))

handleEvaluation :: IO ()
handleEvaluation = do
  putStrLn ""
  putStrLn "--- Evaluate Expression ---"
  input <- prompt "Enter expression (e.g., '2 + 3 * 4'): "
  
  if null input
    then putStrLn "Empty input. Please try again."
    else do
      let tokens = tokenize input
      putStrLn $ "Tokens: " ++ formatTokens tokens
      
      catch
        (do
          let (ast, remaining) = parseExpr tokens
          putStrLn $ "AST: " ++ show ast
          if remaining /= [EOF]
            then putStrLn $ "Warning: unparsed tokens: " ++ show remaining
            else return ()
          
          let result = evalExpr ast
          putStrLn ""
          putStrLn $ "Result: " ++ show result
        )
        (\e -> putStrLn $ "Error: " ++ show (e :: SomeException))

handleKeyValue :: IO ()
handleKeyValue = do
  putStrLn ""
  putStrLn "--- Key-Value Pair Parser ---"
  input <- prompt "Enter key-value pair (e.g., 'name = alice'): "
  
  if null input
    then putStrLn "Empty input. Please try again."
    else do
      let tokens = tokenize input
      putStrLn $ "Tokens: " ++ formatTokens tokens
      
      catch
        (do
          let (kvpair, remaining) = parseKVPair tokens
          putStrLn $ "Parsed: " ++ show kvpair
          if remaining /= [EOF]
            then putStrLn $ "Warning: unparsed tokens: " ++ show remaining
            else return ()
        )
        (\e -> putStrLn $ "Parse error: " ++ show (e :: SomeException))

handleDemo :: IO ()
handleDemo = do
  putStrLn ""
  putStrLn "--- Demo Mode ---"
  putStrLn ""
  
  putStrLn "Example 1: Simple addition"
  let ex1 = "2 + 3"
  putStrLn $ "  Input: " ++ ex1
  let tokens1 = tokenize ex1
  let (ast1, _) = parseExpr tokens1
  let result1 = evalExpr ast1
  putStrLn $ "  Result: " ++ show result1
  putStrLn ""
  
  putStrLn "Example 2: With precedence"
  let ex2 = "1 + 5 * 4"
  putStrLn $ "  Input: " ++ ex2
  let tokens2 = tokenize ex2
  let (ast2, _) = parseExpr tokens2
  let result2 = evalExpr ast2
  putStrLn $ "  Result: " ++ show result2
  putStrLn ""
  
  putStrLn "Example 3: With parentheses"
  let ex3 = "(7 + 9) * 3"
  putStrLn $ "  Input: " ++ ex3
  let tokens3 = tokenize ex3
  let (ast3, _) = parseExpr tokens3
  let result3 = evalExpr ast3
  putStrLn $ "  Result: " ++ show result3
  putStrLn ""
  
  putStrLn "Example 4: Key-value pair"
  let ex4 = "name = alice"
  putStrLn $ "  Input: " ++ ex4
  let tokens4 = tokenize ex4
  let (kvpair, _) = parseKVPair tokens4
  putStrLn $ "  Parsed: " ++ show kvpair
  putStrLn ""


-- Main Loop

mainLoop :: IO ()
mainLoop = do
  printMenu
  choice <- prompt "Enter your choice (1-5): "
  
  case choice of
    "1" -> do
      handleArithmetic
      putStrLn ""
      mainLoop
    
    "2" -> do
      handleKeyValue
      putStrLn ""
      mainLoop
    
    "3" -> do
      handleEvaluation
      putStrLn ""
      mainLoop
    
    "4" -> do
      handleDemo
      mainLoop
    
    "5" -> do
      putStrLn ""
      putStrLn "Goodbye! 👋"
      putStrLn ""
    
    _ -> do
      putStrLn "Invalid choice. Please enter 1-5."
      putStrLn ""
      mainLoop

main :: IO ()
main = do
  printHeader
  putStrLn "Welcome to the Tiny Parser!"
  putStrLn "Parse arithmetic expressions and key-value pairs interactively."
  putStrLn ""
  mainLoop