module System.Touched.Procedure ( Procedure(..)
                                , AsyncIO
                                , async
                                , AsyncCmd
                                , cmd
                                ) where

import Control.Concurrent ( forkIO
                          , killThread
                          , ThreadId
                          )
import System.Process
import System.IO (Handle)

-- | A process defined by three values:
-- exec - the "process" type
-- kill - takes a launched process and stops it
-- fork - takes an 'exec' and launches it into the background
data Procedure a b = Procedure { fork :: a -> IO b
                               , kill :: b -> IO ()
                               , exec :: a
                               }

instance Show (Procedure a b) where
  show = const "{Procedure Type}"

-- | A type synonym for a Haskell native process.
type AsyncIO = Procedure (IO ()) ThreadId

-- | A "smart constructor" for Haskell native processes
async :: IO () -> AsyncIO
async io = Procedure { fork = forkIO
                     , kill = killThread
                     , exec = io
                     }

-- | A type synonym for the tuple returned by 'System.Process.createProcess'
-- Corresponds to stdin, stdout, stderr, and a PID
type CmdHandles = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
                  
-- | Fetches the PID from a 'CmdHandles' tuple.
procId :: CmdHandles -> ProcessHandle
procId (_,_,_,id) = id       

-- | A type synonym for shell commands in the 'System.Process' module
type AsyncCmd = Procedure CreateProcess CmdHandles

-- | A smart constructor for shell processes.
-- Takes a string to launch in the shell and returns the process
cmd :: String -> AsyncCmd
cmd cmdString = Procedure { fork = createProcess
                          , kill = terminateProcess . procId
                          , exec = shell cmdString
                          }