{-
  Command/Expression main entry execution fuctions.
  Copyright (C) 2005, 2008 Luis Francisco Araujo
-}

module Exec (mainExec)
    where

import Process (pipe, redirect)
import Eval (hEval, funcProcess)
import Parse (findSubStr, esc, getArg, getCmd, restoreWhiteSpace)
import Environment (ExecutionEnv(), setEnvVar, getEnvVariable, command, newcommand, getVariables, Alias())

import Data.Char (isAlpha, isSpace)
import Data.List (isPrefixOf)
import Data.Maybe (fromJust)
import System.Cmd (rawSystem)
import System.Console.Readline (addHistory, readline)
import System.Exit -- (ExitCode, ExitSuccess, ExitSuccess, ExitFailure)
import System.IO (hPutStr, stderr, hPutStrLn)
import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Env (putEnv)
import System.Posix.Files (fileExist, getFileStatus, isDirectory)
import Text.Regex (mkRegex, splitRegex)
import qualified Control.Exception as E (catch)

----------------------------------------------------------------------------------
-- | Basic command execution.
exec :: String -> IO ExitCode
exec e = rawSystem (getCmd e) (getArg e)

execA :: String -> [Alias] -> IO ExitCode
execA e [] = exec e
execA e (x:xs)
    | (command x) == (getCmd e) = exec $ (newcommand x) ++ (snd $ break (== ' ') e)
    | null xs = exec e
execA e (_:xs) = execA e xs

{-
   | Exec combination.
   These functions combine computations between each other
   to produce Haskell -> Process -> Haskell ... effects.
-}
----------------------------------------------------------------------------------
-- | Execute a Haskell expression.
execH :: String -> IO String
execH s = hEval s >>=
          (\ n -> case n of
                    Just r
                      -> return r
                    Nothing
                      -> ioError $ userError "hEval (execH): nothing.")

-- | Execute a process composed of sub-processes.
execP:: String -> IO String
execP es = if (length splitpexpr > 1)
           then
           hPComposition (reverse splitpexpr)
           else
           funcProcess es
    where
    splitpexpr = splitRegex (mkRegex " && ") es

-- | Iterates over a list of sub-processes.
-- Return the result of all the combinations as string.
hPComposition :: [String] -> IO String
hPComposition [] = return []
hPComposition (x:xs) = do
                       s <- funcProcess x
                       iterateProcess xs s
    where
    iterateProcess [] _ = return ""
    iterateProcess (y:[]) hr = funcProcess ((restoreWhiteSpace y) ++ hr)
    iterateProcess (y:ys) hr = do
                               s' <- funcProcess ((restoreWhiteSpace y) ++ hr)
                               iterateProcess ys s'

-- | Recursively combines the output from haskell expressions
-- evaluations and processes output execution.
haskellAndProcess :: [String] -> IO String
haskellAndProcess [] = return []
haskellAndProcess (x:xs) =
    case xs of
        [] -> do h' <- execH h
                 putStr "[]"
                 execP (p ++ h')
        ys | findSubStr "!" x -> do s <- haskellAndProcess ys
                                    h' <- execH (h ++ (show s))
                                    putStr s
                                    execP (p ++ h')
           | otherwise -> do s <- haskellAndProcess ys
                             putStr $ s ++ " s2"
                             execH (x ++ (show s))
    where
      [p, h] = splitRegex (mkRegex "!") x

----------------------------------------------------------------------------------
-- | 'cd' command implementation.
-- Only change to other directory if it exists.
changeWDIfExist :: String -> IO ExitCode
changeWDIfExist path =
    fileExist p >>=
    \ s -> case s of
               True ->
                   do
                   fs <- getFileStatus p
                   case isDirectory fs of
                       True -> changeWorkingDirectory p >>
                               return ExitSuccess
                       False -> putStrLn (p ++ " is not a directory.") >>
                                return (ExitFailure 1)
               False -> do
                        putStrLn $ "File " ++ p ++ " does not exist."
                        return $ ExitFailure 1
    where
    p = filter (/= ' ') path

----------------------------------------------------------------------------------
-- | Evaluate the code for the shell prompt.
setupShellToolBar :: String -> IO [ExitCode]
setupShellToolBar pexpr = mapExec ([], []) pexpr

---------------------------------------------------------------------------------
-- | Add commands to readline history (omit blank lines).
promptHistory :: Maybe String -> IO String
promptHistory Nothing = return ""
promptHistory h =
    let fj = fromJust h in
        case fj of
            a | (words a /= []) -> addHistory a >> return a
              | otherwise -> return a

----------------------------------------------------------------------------------
-- | Entry function from Main.hs
-- It interfaces processing external options to the shell.
mainExec :: [(String, String)] -> IO ExitCode
mainExec cfg = getVariables cfg >> setEnvVar >>= execRoutine

{-
  | Main Hashell process.
  Functions mutually recursives.
  They cooperate to create the main loop of input -> eval -> output.
-}
----------------------------------------------------------------------------------
-- | Execute the shell.
-- Prompt the user for processing input.
execRoutine :: ExecutionEnv -> IO ExitCode
execRoutine execenv = setupShellToolBar (fst execenv) >>
                      readline "$ " >>=
                      promptHistory >>=
                      mapExec execenv >>
                      execRoutine execenv

----------------------------------------------------------------------------------
-- | Map a list of expressions into its execution
-- using the enviromment of the shell.
mapExec :: ExecutionEnv -> String -> IO [ExitCode]
mapExec execenv expr = mapM (execExpr execenv) xs
    where
    xs = map (dropWhile isSpace) (splitRegex (mkRegex ";") expr)

----------------------------------------------------------------------------------
-- | These functions work together to execute built-in commands
-- and evaluate complete hashell expressions, using the
-- shell environment.
execExpr :: ExecutionEnv -> String -> IO ExitCode
execExpr _ [] = return ExitSuccess -- Empty string passed to mapExec
execExpr execenv expr
    | "quit" `isPrefixOf` expr = exitWith ExitSuccess
    | "cd " `isPrefixOf` expr = changeWDIfExist (drop 3 expr)
    | "set " `isPrefixOf` expr = putEnv ((drop 4 expr) `esc` '\\') >>
                                  setEnvVar >>=
                                  execRoutine
    | "get " `isPrefixOf` expr = getEnvVariable (drop 4 expr) >>=
                                  putStrLn >>
                                  return ExitSuccess
    -- If it isn't a built-in, is a Haskell expression and goes to eval Expr
    | otherwise = evalExpr execenv expr

evalExpr :: ExecutionEnv -> String -> IO ExitCode
-- execExpr handles [] already
evalExpr _ (':':ep) -- look for :
    = (hEval ep
         `E.catch` (\err -> hPutStr stderr (show err) >>
                    return Nothing ))
      >> return ExitSuccess
evalExpr execenv e
    -- Anything in "!()" will be evaluated as a Haskell expression.
    | findSubStr "!(" e =
        do let t = splitRegex (mkRegex " #") e
           hakproc <- haskellAndProcess t
                      `E.catch` (\_ -> execRoutine execenv >> return [])
           putStr $ hakproc ++ " hakproc"
           return ExitSuccess
    | findSubStr " | " e && anyAlpha "\\|"
        = pipe e
    | findSubStr " > " e && anyAlpha ">"
        = redirect e ">"
    | findSubStr " 1> " e && anyAlpha "1>"
        = redirect e "1>"
    | findSubStr " < " e  && anyAlpha "<"
        = redirect e "<"
    | findSubStr " 0> " e && anyAlpha "0>"
        = redirect e "0>"
    | findSubStr " >> " e && anyAlpha ">>"
        = redirect e ">>"
    | findSubStr " 2> " e && anyAlpha "2>"
        = redirect e "2>"
    | otherwise = (execA e (snd execenv) >>= execError)
                  `E.catch` (\err -> hPutStrLn stderr (show err) >>
                                      execRoutine execenv)
    where
        anyAlpha s = any isAlpha $ last $ splitRegex (mkRegex s) e

----------------------------------------------------------------------------------
-- | Notify any error for the basic command execution.
execError :: ExitCode -> IO ExitCode
execError (ExitFailure c) = ioError $ userError (show c)
execError _ = return ExitSuccess