module Main where
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Expr
import Control.Applicative((<$>), (<*>))
import System.Console.Haskeline
import System.Environment (getArgs)

data Op = Add | Sub | Mul | Div | Mod |
          And | Or | Gt | Lt | Le | Ge |
          Eq | SEq | Ne | SNe
  deriving (Show, Eq)

data UOp = Minus | Not deriving (Show, Eq)

data Exp = Unary UOp Exp         {- A unary operation -}
         | Bin Op Exp Exp        {- A binary operation -}
         | K Double              {- Number representation -}
         | B Bool                {- Boolean representation -}
         | Ternary Exp Exp Exp   {- cond ? yes : no -}
         | Undefined             {- undefined -}
  deriving (Eq)

----------------------------------------------------------------
-- YOUR CHANGES BEGIN HERE
----------------------------------------------------------------

-- step function: perform one step of evaluation of the
-- program
step :: Exp -> Exp
step = error "todo"

-- value function: return True iff the argument is a value
value :: Exp -> Bool
value = error "todo"


----------------------------------------------------------------
-- YOUR CHANGES END HERE
----------------------------------------------------------------

-- evaluate an expression given a step function, returning the trace of intermediate terms
trace :: Exp -> [Exp]
trace = takeWhilePlus1 (not . value) . iterate step
  where
    -- like takeWhile, but includes the first element where p is false
    takeWhilePlus1 p xs =
      case span p xs of
        (ys, z:zs) -> ys ++ [z]
        (ys, [])   -> ys

-- evaluate an expression given a step function
eval :: Exp -> Exp
eval e
  | value e   = e
  | otherwise = eval (step e)

-- main and the REPL
main :: IO ()
main = do
  args <- getArgs
  if null args then
    runInputT defaultSettings readEvalPrintLoop
  else do
    input <- readFile $ head args
    case parse expr "input" input of
      Right e -> do
        putStrLn $ show $ eval e
      Left err ->
        putStrLn $ show err

readEvalPrintLoop :: InputT IO ()
readEvalPrintLoop = do
  maybeLine <- getInputLine "> "
  case maybeLine of
    Nothing -> return ()
    Just line ->
      case parse command "input" line of
        Right (Trace e) -> do
          outputStr $ unlines $ map show $ trace e
          readEvalPrintLoop
        Right (Eval e)  -> do
          outputStrLn $ show $ eval e
          readEvalPrintLoop
        Right Quit -> return ()
        Left err -> do
          outputStrLn $ show err
          readEvalPrintLoop

-- REPL commands
data Cmd = Trace Exp | Eval Exp | Quit

-- A simple parser
command :: Parser Cmd
command = (do
    spaces
    c <- (do { char ':'; spaces; (trace <|> quit)}) <|> eval
    spaces
    eof
    return c) <?> "expression, :trace expression, or :quit"
  where
    eval  = do { x <- expr; return (Eval x) }
    trace = do { string "trace"; spaces; x <- expr; return (Trace x) }
    quit  = do { string "quit"; return Quit }

expr :: Parser Exp
expr = do
  c <- binary
  spaces
  option c (do
    char '?'
    spaces
    t <- expr
    spaces
    char ':'
    spaces
    e <- expr
    return $ Ternary c t e)

binary :: Parser Exp
binary = buildExpressionParser table factor <?> "expression" where
  table = [
    [Prefix (do { char '-'; return $ Unary Minus })],
    [Prefix (do { char '!'; return $ Unary Not })],
    [Infix (do { char '*'; return $ Bin Mul }) AssocLeft,
     Infix (do { char '/'; return $ Bin Div }) AssocLeft,
     Infix (do { char '%'; return $ Bin Mod }) AssocLeft],
    [Infix (do { char '+'; return $ Bin Add }) AssocLeft,
     Infix (do { char '-'; return $ Bin Sub }) AssocLeft],
    [Infix (do { try $ string ">="; return $ Bin Ge }) AssocLeft,
     Infix (do { char '>'; return $ Bin Gt }) AssocLeft,
     Infix (do { try $ string "<="; return $ Bin Le }) AssocLeft,
     Infix (do { char '<'; return $ Bin Lt }) AssocLeft],
    [Infix (do { try $ string "==="; return $ Bin SEq }) AssocLeft,
     Infix (do { string "=="; return $ Bin Eq }) AssocLeft,
     Infix (do { try $ string "!=="; return $ Bin SNe }) AssocLeft,
     Infix (do { string "!="; return $ Bin Ne }) AssocLeft],
    [Infix (do { string "&&"; return $ Bin And }) AssocLeft],
    [Infix (do { string "||"; return $ Bin Or }) AssocLeft]
    ]

factor :: Parser Exp
factor =  (do
              spaces
              f <- do { char '(';  x <- expr; char ')'; return x } <|> number <|> boolean <|> undef
              spaces
              return f
              )
          <?> "simple expression"

sign :: Parser Char
sign = char '+' <|> char '-'

makeNumber '+' ds [] = ds
makeNumber '+' ds mds = ds ++ "." ++ mds
makeNumber '-' ds [] = "-" ++ ds
makeNumber '-' ds mds = "-" ++ ds ++ "." ++ mds

-- limitation: does not handle numbers in scientific notation (1e6, etc)
number :: Parser Exp
number = (K . read) <$> (do { s <- option '+' sign;
                              ds <- many1 digit;
                              mds <- option "0" $ do { char '.'; ds' <- many digit; return ds'};
                              return $ makeNumber s ds mds})

undef :: Parser Exp
undef = (\_ -> Undefined) <$> string "undefined"

boolean :: Parser Exp
boolean =  B <$> (do {string "true"; return True} <|> do {string "false"; return False})

-- A simple pretty-printer for Exps
instance Show Exp where
  show (K n) = show n
  show (B True) = "true"
  show (B False) = "false"
  show Undefined = "undefined"
  show (Bin Add e1 e2) = (paren e1) ++ " + " ++ (paren e2)
  show (Bin Sub e1 e2) = (paren e1) ++ " - " ++ (paren e2)
  show (Bin Mul e1 e2) = (paren e1) ++ " * " ++ (paren e2)
  show (Bin Div e1 e2) = (paren e1) ++ " / " ++ (paren e2)
  show (Bin Mod e1 e2) = (paren e1) ++ " % " ++ (paren e2)
  show (Bin And e1 e2) = (paren e1) ++ " && " ++ (paren e2)
  show (Bin Or e1 e2) = (paren e1) ++ " || " ++ (paren e2)
  show (Bin Gt e1 e2) = (paren e1) ++ " > " ++ (paren e2)
  show (Bin Lt e1 e2) = (paren e1) ++ " < " ++ (paren e2)
  show (Bin Ge e1 e2) = (paren e1) ++ " >= " ++ (paren e2)
  show (Bin Le e1 e2) = (paren e1) ++ " <= " ++ (paren e2)
  show (Bin Eq e1 e2) = (paren e1) ++ " == " ++ (paren e2)
  show (Bin Ne e1 e2) = (paren e1) ++ " != " ++ (paren e2)
  show (Bin SEq e1 e2) = (paren e1) ++ " === " ++ (paren e2)
  show (Bin SNe e1 e2) = (paren e1) ++ " !== " ++ (paren e2)
  show (Ternary c t e) = (paren c) ++ " ? " ++ (paren t) ++ " : " ++ (paren e)
  show (Unary Minus e) = "-" ++ (paren e)
  show (Unary Not e) = "!" ++ (paren e)

paren :: Exp -> String
paren e @ (Bin _ _ _) = "(" ++ show e ++ ")"
paren e               = show e