{- CSci 450: Organization of Programming Languages
   Imperative Core Language, REPL
   Fall 2017 
   H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2017-09-14: Prototype with :use command
2017-09-21: Add in help text similar to PrefixExprREPL

TODO: Update how the environment is handled, similar to ExprLang

-}

module ImpCore
where

-- Haskell libraries
import Data.List  ( dropWhileEnd, intercalate )
import Data.Char  ( isSpace )
import Data.Maybe ( fromMaybe )
import System.Console.Haskeline -- leave open for now
import Control.Monad.IO.Class ( liftIO )

-- Imperative core modules
import ParseImpCore ( trimComment, parseMany )
import EvalImpCore  ( DEnv, EvalErr, ActionD(..), Result(..), 
                      newDEnv, showDEnv, evalScript )

{-  Function "main" is the entry point for the interpreter program.
    It uses the Haskeline library to do interactive input/output.
-}

helptext :: String
helptext = intercalate "\n"
    [ "Welcome to the Expression Language REPL."
    , "You may enter or one of the commands"
    , "    :quit          to exit the interpreter"
    , "    :display       to display the bindings in the environment"
    , "    :use filename  to include the filename content"
    , "or any valid Imperative Core language expression."
    ]
 
main :: IO ()
main = do
    putStrLn helptext
    runInputT defaultSettings (repl newDEnv)


{-  Function "repl" is the Read-Evaluate-Print-Loop for the
    interpreter. It reads one or more definitions from the terminal
    parses the input, evaluates the definitions in sequence, updates
    the environment, and prints the result.

    In addition to the definitions/expressions of the language, it
    takes the following commands:
        :quit         -- terminates the interpreter loop
        :display      -- displays the environment
        :use filename -- includes the file contents at that point in
                         sequence of definitions

-}

-- Principal and subsidiary prompts for interactive interpreter
prompt         = "REPL>  "
continuePrompt = "> "

-- Interpreter loop
repl :: DEnv -> InputT IO ()
repl env = do
    line <- getInputLine prompt
    let cmd = trim $ fromMaybe "" line
 
    case words cmd of

        []           -> repl env

        [":quit"]    -> return ()

        [":display"] -> do
            outputStrLn $ showDEnv env
            repl env

        [":use",fn]  -> do
            outputStrLn $ "Including file " ++ fn
            contents <- liftIO $ readFile fn
            let contents' = concat $ map trim $ lines contents
            let defs = parseMany contents'
            case defs of
                Left err -> do
                    outputStrLn $ "Parse Error: " ++ err
                    repl env
                Right theDefs -> do
                    let (res, env') = evalScript theDefs env
                    putEvalResult res
                    repl env'

        _            -> do  -- definition evaluation
            allLines <- getMultiline 0 cmd
            case allLines of
                Nothing -> do
                    outputStrLn $
                        "Unbalenced parentheses in definition near "
                        ++ cmd
                    repl env
                Just fullcmd -> do
                    let defs = parseMany fullcmd 
                    case defs of
                        Left err -> do
                           outputStrLn $ "Parse Error: " ++ err
                           repl env
                        Right theDefs -> do
                            let (res, env') = evalScript theDefs env
                            putEvalResult res
                            repl env'

{-  Function "printEvalResult" takes the return the "evalScript"
    function and prints the result to the standard output.
-}

putEvalResult :: Either EvalErr Result -> InputT IO ()
putEvalResult (Left err) = outputStrLn $ "Eval Error: " ++ err
putEvalResult (Right (Result v act n)) =
    case act of
        ExprD  ->
            outputStrLn $ "Value:    " ++ show v
        ValD   -> do
            outputStrLn $ "Value:    " ++ show v
            outputStrLn $ "Global:   " ++ show n
        FunD   ->
            outputStrLn $ "Function: " ++ show n
--      UseD   ->
--          outputStrLn $ "Use:      " ++ show n
        NoActD ->
            outputStrLn $ "No action"


{-  Function "getMultiline" takes the previous nesting level of
    parentheses (>= 0) and the next line of the input script. It reads
    additional lines, if needed, until the whole script ends with
    properly nested parentheses. It's return is a Just wrapping the
    concatenated input lines (minus comments and some unnecessary
    white space) or a Nothing if the number of left parentheses
    exceeds the number of right.

    It is intended for use with interactive I/O using Haskeline.
-}

getMultiline :: Int -> String -> InputT IO (Maybe String)
getMultiline n cmd1 =
    case checkParenBalance n cmd1 of
        Nothing         -> return Nothing         
        Just m | m == 0 -> return (Just cmd1)
        Just m | m > 0  -> do
            line2 <- getInputLine continuePrompt
            case line2 of
                Nothing   -> return (Just cmd1)
                Just cmd2 -> do
                    rest <- getMultiline m $ trim cmd2
                    return (Just (cmd1 ++ (fromMaybe "" rest)))
        Just m -> return Nothing -- should not occur


{-  Function "checkParenBalance" takes an integer denoting the
    nesting level of parentheses (>= 0) in prevous lines and the
    next line of text to check for balanced parentheses. It returns
    a Just wrapping the updated nesting level after the next line.
    At any point at which there are more left-parentheses than
    right, it returns a Nothing.
-}

checkParenBalance :: Int -> String -> Maybe Int
checkParenBalance n _ | n < 0 = Nothing
checkParenBalance n []        = Just n
checkParenBalance n (x:xs)
    | x == '('  = checkParenBalance (n+1) xs -- increase level
    | x == ')'  = checkParenBalance (n-1) xs -- decrease level
    | otherwise = checkParenBalance n xs     -- no change


{-  Function "trim" takes a line of text, removes any
    beginning-of-line white space, then any end-of-line comment,
    and then any end-of-line white space. It returns the remaining
    text with a newline charcter appended to the end.
-}

trim :: String -> String
trim xs = (trimTrailing . trimComment . trimLeading) xs  ++ "\n"

trimTrailing :: String -> String
trimTrailing = dropWhileEnd isSpace
  
trimLeading :: String -> String
trimLeading = dropWhile isSpace