{-# LANGUAGE FlexibleInstances #-}
module HSH.Helpers.Instances where

import HSH
import System.Exit
import System.Posix.Process
import System.Posix.Env
instance RunResult (IO (Either String ()) ) where
    run cmd = checkProcessStatus =<< run cmd 

{- | Evaluates result codes and raises an error for any bad ones it finds. -}
checkProcessStatus :: (String, ProcessStatus) -> IO (Either String ())
checkProcessStatus (cmd, ps) =
       case ps of
         Exited (ExitSuccess) -> return $ Right ()
         Exited (ExitFailure x) ->
             return $ Left $ cmd ++ ": exited with code " ++ show x
         Terminated sig ->
             return $ Left $ cmd ++ ": terminated by signal " ++ show sig
         Stopped sig ->
             return $ Left $ cmd ++ ": stopped by signal " ++ show sig

-- Command where Change Working Directory specified at process level
data CWDCommand = CWDCommand {cwdDir :: String,
                              cwdCmd :: String}
  deriving (Read,Show)

instance ShellCommand CWDCommand where
    fdInvoke (CWDCommand dir cmdline) ifd ofd closefd forkfunc =
        do esh <- getEnv "SHELL"
           let sh = case esh of
                      Nothing -> "/bin/sh"
                      Just x -> x
           fdInvoke (sh, ["-c", "cd " ++ dir ++ "; " ++ cmdline]) ifd ofd closefd forkfunc

-- | runCD dir command
-- | useful alternative to bracketCD where bracketCD has the wrong behavior due to lazy IO
-- | note, not a drop in replacement to bracketCD because you specify an actual shell command, not arbitrary IO
runCD :: FilePath -> String -> IO ()
runCD dir cmd = run (CWDCommand dir cmd)

t :: IO ()
t = run (CWDCommand "/tmp" "ls")