{-# OPTIONS -Wall #-}
module Infix where

import Data.Maybe

data TokenInfix = BracketOpen  |
                  BracketClose |
                  Number Int   |
                  Star         |
                  Plus
  deriving (Show)

lexerInfix :: String -> [TokenInfix]
lexerInfix [] = []
lexerInfix (' ':ss) = lexerInfix ss
lexerInfix ('(':ss) = BracketOpen:lexerInfix ss
lexerInfix (')':ss) = BracketClose:lexerInfix ss
lexerInfix ('*':ss) = Star:lexerInfix ss
lexerInfix ('+':ss) = Plus:lexerInfix ss
lexerInfix ss = (Number $ read num):lexerInfix rest
  where
    (num,rest)=number ss

number :: String->(String,String)
number (c:cs)| c <= '9' && '0' <= c = (c:(rest_num),rest_string)
             | otherwise = ([],(c:cs))
  where (rest_num,rest_string) = (number cs)
number [] = ([],[])

data Expr = Add Expr Expr |
            Mul Expr Expr |
            Const Int
  deriving (Show)

try :: [Maybe a] -> Maybe a
try (Just x:_) = Just x
try (Nothing:xs) = try xs
try [] = Nothing


parserInfix :: [TokenInfix] -> Expr
parserInfix = fst . fromJust . parserInfix1
parserInfix1 :: [TokenInfix] -> Maybe ( Expr, [TokenInfix])
parserInfix1 ss = try [firstTry, secondTry]
  where
    firstTry = f =<< parserInfix2 ss
    secondTry = parserInfix2 ss
    f (e, (Plus:rest)) = (combine (Add e) id) <$> parserInfix1 rest
    f _ = Nothing
    combine g h (a,b) = (g a,h b)
parserInfix2 :: [TokenInfix] -> Maybe ( Expr, [TokenInfix])
parserInfix2 ss = try [firstTry, secondTry]
  where
    firstTry = f =<< parserInfix3 ss
    secondTry = parserInfix3 ss
    f (e, (Star:rest)) = (combine (Mul e) id) <$> parserInfix2 rest
    f _ = Nothing
    combine g h (a,b) = (g a,h b)
parserInfix3 :: [TokenInfix] -> Maybe ( Expr, [TokenInfix])
parserInfix3 (BracketOpen:ss) = case parserInfix1 ss of
                                  Just (e,(BracketClose:rest)) -> Just (e,rest)
                                  _ -> Nothing
parserInfix3 (Number i:ss) = Just (Const i,ss)
parserInfix3 _ = Nothing

eval :: Expr -> Int
eval (Add e f) = eval e + eval f
eval (Mul e f) = eval e * eval f
eval (Const i) = i