{----
 - Old.hs - the old single command line interface for the noodle interpreter
 ----
 - Author: Jesse Rudolph <jesse.rudolph@gmail.com>
 - See LICENSE for licensing details
 ----------------------------------------------------------------- -}

module Main (
    main
) where

import System.Environment
import Data.List
import IO

import qualified Language.Noodle.Banner as Banner
import Language.Noodle.DepTree
import Language.Noodle.Evaluation
import Language.Noodle.Lib.Basic
import Language.Noodle.Syntax
import Language.Noodle.Parsing.String
import Language.Noodle.Parsing.Noodle

-- command line option data type
data Option
    = SupBanner -- suppress banner
    | ShowTree  -- show abstract syntax of input instead of interpreting it
    | StartRepl -- start the repl if a sourcefile is given
    | ShowDeps
      deriving Eq

-- this just helps prettify our type signatures
type Options = [Option]


--  add incomming options to our options value
add osa osb      = osa ++ osb

-- remove incomming options from our options value
remv os (o1:os1) = if o1 `elem` os
                   then remv os os1
                   else o1 : remv os os1
remv [] o  = o
remv o  [] = []

-- check to see if some option is in a set of options
isOpt      = elem


-- the default options the interpreter starts with
startOpts  = []


-- maps from option character recieved on command line to interal
-- representation, aborting the program if passed an unrecognized option
oMap ('q':cs) = SupBanner : oMap cs
oMap ('t':cs) = ShowTree  : oMap cs
oMap ('r':cs) = StartRepl : oMap cs
oMap ('d':cs) = ShowDeps  : oMap cs
oMap (c:cs)   = error $ "Invalid comand line option '" ++ (c : "'")
oMap []       = []

main = do args <- getArgs
          recmain args startOpts


-- toplevel function that recurses over command line input and an interal
-- representation of options currently being used
recmain ::[String] -> Options -> IO ()

recmain (('-':negopts):os) o = let negs = oMap negopts
                               in  recmain os (remv negs o)
recmain (('+':posopts):os) o = let adds = oMap posopts
                               in  recmain os (add adds o)
recmain [filenm] o
    = do if isOpt ShowDeps o
             then do esrc <- parseDeps [] filenm
                     case esrc of
                          Left s    -> error s
                          Right src -> putStrLn $ show src
             else exec filenm o
recmain [] o = repl env o


-- execute a source file
exec :: FilePath -> Options -> IO ()
exec file o
    = do val <- compileFile env file
         case val of
              Module e ->
                do env <- e
                   if isOpt StartRepl o
                      then repl env o
                      else doMain env
              Error err  -> error ("Uncaught Error\n" ++ show err)
              v        -> error $
                file ++ " compiled to something other than a module (bug)"

-- compute the result of the 'main' binding in a program
doMain :: Env -> IO ()
doMain e = do res <- compute e (ExprComp (Lit (Ident "main")))
              -- FIXME: this is very naive. if main is defined in a dependency,
              --        that will be executed
              case res of
                   Error err -> error ("Uncaught Error\n" ++ show err)
                   v       -> return ()


-- not to insult anyones intelligence, but repl stands for Read Eval Print Loop.
-- its allows users to short circuit the normal build cycle by giving them an
-- interactive console in which to directly evaluate expressions in the context
-- of some module.
repl :: Env -> Options -> IO ()

repl e o
    = do if (isOpt SupBanner o)
            then return ()
            else putStrLn Banner.text
         repl' e
    where
        repl' e = do putStr "noodle> "
                     hFlush stdout
                     i <- getLine
                     case (runp comp (startPos,()) i) of
                          Success res _ _     ->
                            do v <- compute e res
                               if isOpt ShowTree o
                                  then putStrLn $ show res
                                  else putStrLn $ " ==>" ++ show v
                          Failure msg ((_,rel,line),_) ->
                           putStrLn $ (show $
                                       Error $ BadParse i line rel msg)
                     putStr "\n"
                     repl' e