content: {-# LANGUAGE NoImplicitPrelude #-}
  module Angel.PidFile ( startMaybeWithPidFile
                       , startWithPidFile
                       , clearPIDFile) where
  
  import Control.Exception.Base ( finally
                                , onException )
  
  import Control.Monad (when)
  import System.Process ( CreateProcess
                        , createProcess
                        , ProcessHandle )
  
  -- Wish I didn't have to do this :(
  import System.Process.Internals ( PHANDLE
                                  , ProcessHandle__(OpenHandle, ClosedHandle)
                                  , withProcessHandle
                                  )
  import System.Posix.Files ( removeLink
                            , fileExist)
  
  import Angel.Prelude
  
  startMaybeWithPidFile :: CreateProcess
                        -> Maybe FilePath
                        -> (ProcessHandle -> IO a)
                        -> (ProcessHandle -> IO a)
                        -> IO a
  startMaybeWithPidFile procSpec (Just pidFile) action onPidError = startWithPidFile procSpec pidFile action onPidError
  startMaybeWithPidFile procSpec Nothing action _ = withPHandle procSpec action
  
  startWithPidFile :: CreateProcess
                   -> FilePath
                   -> (ProcessHandle -> IO a)
                   -> (ProcessHandle -> IO a)
                   -> IO a
  startWithPidFile procSpec pidFile action onPidError =
    withPHandle procSpec $ \pHandle -> do
      mPid               <-  getPID pHandle
      case mPid of
        Just pid -> write pid pHandle
        Nothing  -> proceed pHandle
    where
      write pid pHandle = do
        writePID pidFile pid `onException` onPidError pHandle -- re-raises
        proceed pHandle
      proceed pHandle = action pHandle `finally` clearPIDFile pidFile
  
  withPHandle :: CreateProcess -> (ProcessHandle -> IO a) -> IO a
  withPHandle procSpec action = do
    (_, _, _, pHandle) <- createProcess procSpec
    action pHandle
  
  writePID :: FilePath -> PHANDLE -> IO ()
  writePID pidFile = writeFile pidFile . show
  
  clearPIDFile :: FilePath -> IO ()
  clearPIDFile pidFile = do ex <- fileExist pidFile
                            when ex rm
    where rm = removeLink pidFile
  
  getPID :: ProcessHandle -> IO (Maybe PHANDLE)
  getPID pHandle = withProcessHandle pHandle getPID'
    where getPID' h @ (OpenHandle t) = return (Just t)
          getPID' h @ (ClosedHandle t) = return Nothing
  