{-
  Shell processes implementation.
  Copyright (C) 2005, 2008 Luis Francisco Araujo
-}

module Process
    where

import Parse

import Data.Char
import System.Exit
import System.IO
import System.Posix.Files (fileExist)
import System.Posix.IO
import System.Process
import Text.Regex

{-
   | Basic standard input (<) , output (>)
   redirection operations.
-}
----------------------------------------------------------------------------------
-- | Openfile and choose the type of redirection.
redirect :: String -> String -> IO ExitCode
redirect expr red
    | (red == ">" || red == "1>") = openFile filep WriteMode >>=
                                    (\ f -> chooseRedirect cmd Nothing (Just f) Nothing) >>
                                    return ExitSuccess
    | (red == "<" || red == "0>") = do
                                    v <- fileExist filep
                                    if v == True
                                       then openFile filep ReadMode >>=
                                            ( \ f -> chooseRedirect cmd (Just f) Nothing Nothing) >>
                                            return ExitSuccess
                                       else  putStrLn "File does not exist." >>
                                             return (ExitFailure 1)
    | (red == ">>") = openFile filep AppendMode >>=
                      ( \ f -> chooseRedirect cmd Nothing (Just f) Nothing) >>
                      return ExitSuccess
    | (red == "2>") = openFile filep WriteMode >>=
                      ( \ f -> chooseRedirect cmd Nothing Nothing (Just f)) >>
                      return ExitSuccess
    | otherwise = return (ExitFailure 1) -- Not asked to do anything sensible. Try again.
    where
      redtokens = [ x | x <- splitRegex (mkRegex red) expr , isAlpha `any` x]
      filep = if length redtokens > 1
              then (!! 0) $ hParse (redtokens !! 1)
              else ""
      cmd = redtokens !! 0

chooseRedirect :: String
               -> Maybe Handle
               -> Maybe Handle
               -> Maybe Handle
               -> IO ExitCode
chooseRedirect cmdl inh outh errh = runProcess (getCmd cmdl) (getArg cmdl)
                                       Nothing Nothing inh outh errh >>=
                                    waitForProcess

{-
   | Basic pipe.
-}
----------------------------------------------------------------------------------
-- | Split into '|' and processes get connected through pipes.
pipe :: String -> IO ExitCode
pipe cmd = newPipe pipetokens Nothing
           where
           pipetokens = splitInto '|' cmd

-- | Iteratively process and connect each command with
-- standard unix pipes through filedescriptors.
newPipe :: [String] -> Maybe Handle -> IO ExitCode
newPipe (x:[]) (Just h) = runProcess (getCmd x) (getArg x)
                                     Nothing Nothing (Just h)
                                     Nothing Nothing >>= waitForProcess
newPipe (x:xs) (Just h) = do
                         (hrf,hwt) <- initHandle
                         runProcess (getCmd x) (getArg x)
                                    Nothing Nothing (Just h)
                                    (Just hwt) Nothing >>= waitForProcess
                         newPipe xs (Just hrf)
newPipe (x:xs) Nothing = do
                         (hrf, hwt) <- initHandle
                         runProcess (getCmd x) (getArg x)
                                    Nothing Nothing Nothing
                                    (Just hwt) Nothing >>= waitForProcess
                         newPipe xs (Just hrf)
newPipe _ _ = return ExitSuccess -- If not asked to do anything, we can do that easily.

-- | Create new pipes and connect them
-- to output and input filedescriptors.
initHandle :: IO (Handle,Handle)
initHandle = do
             (rf,wt) <- createPipe
             hrf <- fdToHandle rf
             hwt <- fdToHandle wt
             return (hrf,hwt)

----------------------------------------------------------------------------------
-- | Concatenate a string with the first element
-- of a list.
addAtFirst :: [String] -> String -> [String]
addAtFirst (x:xs) a = (x ++ " " ++ a) : xs
addAtFirst [] _ = [""]