-- File: Main.hs

module Main (main) where

import TestUtils
import EvalIntExpr (testEvalIntExpr)
import EvalIdExpr (testEvalIdExpr)
import EvalMaybeExpr (testEvalMaybeExpr)
import PostfixExpr (testPostfixExpr)

------------------------ Functions --------------------

-- Implement toSingletonLists using map
toSingletonLists :: [e] -> [[e]]
toSingletonLists xs = map (:[]) xs

-- Implement listMap using list comprehension
listMap :: (a -> b -> c) -> a -> [b] -> [c]
listMap f a xs = [f a x | x <- xs]

-- Implement member using foldl
member :: Eq e => e -> [e] -> Bool
member e xs = foldl (\acc y -> acc || (y == e)) False xs

-- Implement selectNApart using drop
selectNApart :: Int -> [e] -> [e]
selectNApart n [] = []
selectNApart n xs = head part ++ selectNApart n rest
  where
    (part, rest) = splitAt (min n (length xs)) xs

-- Implement postfixExpr parser
parseToken :: String -> Either ParseError Token
parseToken str = case parseString str of
  Left errMsg -> Left (ParseError ("Invalid character in token: " ++ errMsg))
  Right tkn -> Right tkn

data Token = Num Int | Op Operator
  deriving (Show)

data Operator = Plus | Minus | Multiply | UnaryMinus
  deriving (Show)

data ParseError = ParseError String
  deriving (Show)

parseString :: String -> Either ParseError Token
parseString ('+' : rest) = Right (Op Plus)
parseString ('-' : rest) = Right (Op Minus)
parseString ('*' : rest) = Right (Op Multiply)
parseString (('-':rest') & notFollowedBy ('-')) = Right (Op UnaryMinus)
parseString (numChars : rest) =
  case reads numChars of
    [(value, "")] -> Right (Num value)
    [(value, _)] -> Left ("Non-numeric characters present in number.")
    _             -> Left ("Unable to parse.")

-- a PostFixExpr is an expression tree over integers
data PostfixExpr =
  Leaf Int |
  Add PostfixExpr PostfixExpr |
  Sub PostfixExpr PostfixExpr |
  Mul PostfixExpr PostfixExpr |
  Uminus PostfixExpr
  deriving (Eq, Show)

-- Given a string postfix containing a postfix expression involving
-- integers, the usual binary arithmetic operators "+", "-", "*" as
-- well as "uminus", return the corresponding PostfixExpr.
postfixExpr :: String -> PostfixExpr
postfixExpr postfix = eval [] (words postfix)
  where
    eval :: [PostfixExpr] -> [String] -> PostfixExpr
    eval [result] [] = result
    eval stack (token:tokens) = case token of
      "+" -> evalStack (Add) stack tokens
      "-" -> evalStack (Sub) stack tokens
      "*" -> evalStack (Mul) stack tokens
      "uminus" -> evalStack (Uminus) stack tokens
      _ -> eval (Leaf (read token) : stack) tokens

    evalStack :: (PostfixExpr -> PostfixExpr -> PostfixExpr) -> [PostfixExpr] -> [String] -> PostfixExpr
    evalStack op (e2:e1:stack) tokens = eval (op e1 e2 : stack) tokens
    evalStack _ _ _ = error "Invalid postfix expression"

-- Implement the evalIntExpr function
evalIntExpr :: IntExpr -> Int
evalIntExpr (Leaf n) = n
evalIntExpr (Add expr1 expr2) = evalIntExpr expr1 + evalIntExpr expr2
evalIntExpr (Sub expr1 expr2) = evalIntExpr expr1 - evalIntExpr expr2
evalIntExpr (Mul expr1 expr2) = evalIntExpr expr1 * evalIntExpr expr2
evalIntExpr (Uminus expr) = - (evalIntExpr expr)

-- Implement the evalIdExpr function
evalIdExpr :: IdExpr -> Assoc Int -> Int
evalIdExpr (Leaf i) _ = i
evalIdExpr (Id idStr) env = maybe 0 idVal envLookup
  where
    idVal = fromIntegral
    envLookup = findWithDefault 0 idStr env

findWithDefault :: a -> k -> [(k, a)] -> a
findWithDefault dflt key = fromJust . lookup key

-- Implement the evalMaybeExpr function
evalMaybeExpr :: MaybeExpr -> Assoc Int -> Maybe Int
evalMaybeExpr (Leaf i) _ = Just i
evalMaybeExpr (Id idStr) env = findWithDefault Nothing idStr env
evalMaybeExpr (Add m1 m2) env = liftA2 addMaybes (evalMaybeExpr m1 env) (evalMaybeExpr m2 env)
evalMaybeExpr (Sub m1 m2) env = liftA2 subtractMaybes (evalMaybeExpr m1 env) (evalMaybeExpr m2 env)
evalMaybeExpr (Mul m1 m2) env = liftA2 multiplyMaybes (evalMaybeExpr m1 env) (evalMaybeExpr m2 env)
evalMaybeExpr (Uminus m) env = fmap negate (evalMaybeExpr m env)

addMaybes :: Maybe Int -> Maybe Int -> Maybe Int
addMaybes Nothing (Just i) = Just i
addMaybes (Just i) Nothing = Just i
addMaybes (Just i) (Just j) = Just (i+j)

subtractMaybes :: Maybe Int -> Maybe Int -> Maybe Int
subtractMaybes Nothing (Just i) = Just (-i)
subtractMaybes (Just i) Nothing = Just i
subtractMaybes (Just i) (Just j) = Just (i-j)

multiplyMaybes :: Maybe Int -> Maybe Int -> Maybe Int
multiplyMaybes Nothing _ = Nothing
multiplyMaybes _ Nothing = Nothing
multiplyMaybes (Just i) (Just j) = Just (i*j)

-- Implement the test cases for eval functions
testEvalIntExpr :: Test
testEvalIntExpr = TestList [
    -- Add your test cases here
  ]

testEvalIdExpr :: Test
testEvalIdExpr = TestList [
    -- Add your test cases here
  ]

testEvalMaybeExpr :: Test
testEvalMaybeExpr = TestList [
    -- Add your test cases here
  ]

-- Implement the test cases for postfixExpr
testPostfixExpr :: Test
testPostfixExpr = TestList [
    -- Add your test cases here
  ]

------------------------ Main --------------------

main :: IO ()
main = do
    _ <- runTestTT $ TestList [testEvalIntExpr, testEvalIdExpr, testEvalMaybeExpr, testPostfixExpr]
    return ()

allTests = [
    (Run testToSingletonLists),
    (Run testListMap),
    (Run testMember),
    (Run testSelectNApart),
    (Run testEvalIntExpr),
    (Run testEvalIdExpr),
    (Run testEvalMaybeExpr),
    (Run testPostfixExpr)
  ]

main = do
  mapM_ id tests
  where
    only = onlyTests allTests
    tests = if (length only > 0) then only else runTests allTests