{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.Command
(
  -- * Running sub-processes
  P.createProcess
, P.shell
, P.proc
, P.CreateProcess(..)
, P.CmdSpec(..)
, P.StdStream(..)
, P.ProcessHandle
  -- * Specific variants of createProcess
, readProcessWithExitCode
, P.runCommand
, P.runProcess
, P.runInteractiveCommand
, P.runInteractiveProcess
, P.readProcess
, system
, rawSystem
  -- * Data Type
, ExitCode
  -- * ExitCode combinators
, exitCode
, success
, isSuccess
, isFailure
, exitValue
, exitWith
, exitFailure
, exitSuccess
, (->>)
, (->>>)
, (->->)
, (<<-)
, (<<<-)
, (<-<-)
, runExitCodes
, traverseExitCodes
  -- * Process completion
, waitForProcess
, getProcessExitCode
, P.terminateProcess
  -- * Execution combinators
, inDirectory
, inDirectory'
) where

import qualified System.Exit as E(exitWith, ExitCode(ExitSuccess, ExitFailure))
import qualified System.Process as P(system, rawSystem, ProcessHandle, waitForProcess, getProcessExitCode, readProcessWithExitCode, shell, CreateProcess(..), createProcess, readProcess, terminateProcess, runInteractiveCommand, runInteractiveProcess, runProcess, StdStream(..), CmdSpec(..), runCommand, proc)
import System.Directory(getCurrentDirectory, setCurrentDirectory)
import Data.Bool(Bool, not)
import Data.Data(Data, Typeable)
import Data.Function((.), const, flip)
import Data.Functor(Functor(fmap))
import Data.List((++))
import Data.Maybe(Maybe)
import Data.Monoid(Monoid(mempty, mappend))
import Data.String(String)
import Control.Arrow(first)
import Control.Exception(Exception, toException, fromException, finally)
import Control.Monad(Monad(return), when, void, (>>))
import System.IO(IO)
import System.FilePath(FilePath)
import Prelude(Read(readsPrec), Show(show), Eq((==)), Ord, Int)
import Data.Foldable(Foldable(foldr))

-- | The result of running a process
newtype ExitCode =
  ExitCode Int
  deriving (Eq, Ord, Data, Typeable)

instance Read ExitCode where
  readsPrec n s =
    first exitCode `fmap` readsPrec n s

instance Show ExitCode where
  show (ExitCode n) =
    if n == 0 then "ExitSuccess" else "ExitFailure " ++ show n

instance Exception ExitCode where
  toException =
    toException . toExitCode
  fromException =
    fmap fromExitCode . fromException

instance Monoid ExitCode where
  mempty =
    success
  a `mappend` b =
    if isSuccess a then b else a

-- | Construct a process result.
-- A value of @0@ denotes success, otherwise, failure.
exitCode ::
  Int
  -> ExitCode
exitCode =
  ExitCode

-- | Construct a process result with the value @0@.
success ::
  ExitCode
success =
  exitCode 0

-- | Returns true if the given process result was constructed with the value @0@, otherwise false.
isSuccess ::
  ExitCode
  -> Bool
isSuccess (ExitCode n) =
  n == 0

-- | Returns false if the given process result was constructed with the value @0@, otherwise true.
isFailure ::
  ExitCode
  -> Bool
isFailure =
  not . isSuccess

-- | Returns the value that the given process result was constructed with.
exitValue ::
  ExitCode
  -> Int
exitValue (ExitCode n) =
  n

-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
-- Normally this terminates the program, returning @code@ to the
-- program's caller.  Before the program terminates, any open or
-- semi-closed handles are first closed.
--
-- A program that fails in any other way is treated as if it had
-- called 'exitFailure'.
-- A program that terminates successfully without calling 'exitWith'
-- explicitly is treated as it it had called 'exitWith' 'ExitSuccess'.
--
-- As an 'ExitCode' is not an 'IOError', 'exitWith' bypasses
-- the error handling in the 'IO' monad and cannot be intercepted by
-- 'catch' from the "Prelude".  However it is a 'SomeException', and can
-- be caught using the functions of "Control.Exception".  This means
-- that cleanup computations added with 'Control.Exception.bracket'
-- (from "Control.Exception") are also executed properly on 'exitWith'.
--
-- Note: in GHC, 'exitWith' should be called from the main program
-- thread in order to exit the process.  When called from another
-- thread, 'exitWith' will throw an 'ExitException' as normal, but the
-- exception will not cause the process itself to exit.
exitWith ::
  ExitCode
  -> IO a
exitWith =
  E.exitWith . toExitCode

-- | The computation 'exitFailure' is equivalent to
-- 'exitWith' @(@'exitCode exitfail'@)@,
-- where /exitfail/ is implementation-dependent.
exitFailure ::
  IO a
exitFailure =
  exitWith (exitCode 1)

-- | The computation 'exitSuccess' is equivalent to
-- 'exitWith' 'success', It terminates the program
-- sucessfully.
exitSuccess ::
  IO a
exitSuccess =
  exitWith success

-- | Runs the first action.
--
-- Only if the result is successful, run the second action returning its result.
(->>) ::
  Monad m =>
  m ExitCode
  -> m ExitCode
  -> m ExitCode
a ->> b =
  do a' <- a
     if isSuccess a' then b else return a'

-- | Runs the first action.
--
-- Only if the result is successful, run the second action returning no result.
(->>>) ::
  (Monad m, Functor m) =>
  m ExitCode
  -> m a
  -> m ()
a ->>> b =
  do a' <- a
     when (isSuccess a') (void b) -- if isSuccess a' then b >> return () else return ()

-- | Runs the first action.
--
-- Only if the result is successful, run the second action returning the first action's result.
(->->) ::
  Monad m =>
  m ExitCode
  -> m a
  -> m ExitCode
a ->-> b =
  do a' <- a
     if isSuccess a' then b >> return a' else return a'

-- | Runs the second action.
--
-- Only if the result is successful, run the first action returning its result.
(<<-) ::
  Monad m =>
  m ExitCode
  -> m ExitCode
  -> m ExitCode
(<<-) =
  flip (->>)

-- | Runs the second action.
--
-- Only if the result is successful, run the first action returning no result.
(<<<-) ::
  (Monad m, Functor m) =>
  m a
  -> m ExitCode
  -> m ()
(<<<-) =
  flip (->>>)

-- | Runs the second action.
--
-- Only if the result is successful, run the first action returning the second action's result.
(<-<-) ::
  Monad m =>
  m a
  -> m ExitCode
  -> m ExitCode
(<-<-) =
  flip (->->)

-- | Run the structure of actions stopping at the first failure.
runExitCodes ::
  (Monad m, Foldable f) =>
  f (m ExitCode)
  -> m ExitCode
runExitCodes =
  foldr (->>) (return success)

-- | Traverse the structure of actions stopping at the first failure.
traverseExitCodes ::
  (Monad m, Foldable f, Functor f) =>
  (a -> m ExitCode)
  -> f a
  -> m ExitCode
traverseExitCodes f =
  runExitCodes . fmap f

-- | readProcessWithExitCode creates an external process, reads its
-- standard output and standard error strictly, waits until the process
-- terminates, and then returns the 'ExitCode' of the process,
-- the standard output, and the standard error.
--
-- 'readProcess' and 'readProcessWithExitCode' are fairly simple wrappers
-- around 'createProcess'.  Constructing variants of these functions is
-- quite easy: follow the link to the source code to see how
-- 'readProcess' is implemented.
readProcessWithExitCode ::
  FilePath
  -> [String]
  -> String
  -> IO (ExitCode, String, String)
readProcessWithExitCode p args i =
  fmap (\(e, t, u) -> (fromExitCode e, t, u)) (P.readProcessWithExitCode p args i)

-- | Computation @system cmd@ returns the exit code produced when the
-- operating system runs the shell command @cmd@.
--
-- This computation may fail with
--
--    * @PermissionDenied@: The process has insufficient privileges to
--      perform the operation.
--
--    * @ResourceExhausted@: Insufficient resources are available to
--      perform the operation.
--
--    * @UnsupportedOperation@: The implementation does not support
--      system calls.
--
-- On Windows, 'system' passes the command to the Windows command
-- interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks
-- will not work.
system ::
  String
  -> IO ExitCode
system =
  fmap fromExitCode . P.system

-- | The computation @'rawSystem' cmd args@ runs the operating system command
-- @cmd@ in such a way that it receives as arguments the @args@ strings
-- exactly as given, with no funny escaping or shell meta-syntax expansion.
-- It will therefore behave more portably between operating systems than 'system'.
--
-- The return codes and possible failures are the same as for 'system'.
rawSystem ::
  String
  -> [String]
  -> IO ExitCode
rawSystem z =
  fmap fromExitCode . P.rawSystem z

-- | Waits for the specified process to terminate, and returns its exit code.

-- GHC Note: in order to call @waitForProcess@ without blocking all the
-- other threads in the system, you must compile the program with
-- @-threaded@.
waitForProcess ::
  P.ProcessHandle
  -> IO ExitCode
waitForProcess =
  fmap fromExitCode . P.waitForProcess


-- | This is a non-blocking version of 'waitForProcess'.  If the process is
-- still running, 'Nothing' is returned.  If the process has exited, then
-- @'Just' e@ is returned where @e@ is the exit code of the process.
getProcessExitCode ::
  P.ProcessHandle
  -> IO (Maybe ExitCode)
getProcessExitCode =
  (fmap . fmap) fromExitCode . P.getProcessExitCode

inDirectory ::
  FilePath
  -> (FilePath -> IO a)
  -> IO a
inDirectory d k =
  do c <- getCurrentDirectory
     setCurrentDirectory d
     k c `finally` setCurrentDirectory c

inDirectory' ::
  FilePath
  -> IO a
  -> IO a
inDirectory' p =
  inDirectory p . const
-- not exported

toExitCode ::
  ExitCode
  -> E.ExitCode
toExitCode (ExitCode n) =
  if n == 0 then E.ExitSuccess else E.ExitFailure n

fromExitCode ::
  E.ExitCode
  -> ExitCode
fromExitCode E.ExitSuccess =
  success
fromExitCode (E.ExitFailure n) =
  exitCode n