-- | Utils related to @ResourceT@
--
-- This is an internal module. It is exposed to allow fine-tuning and workarounds but its API is not stable.
module System.LibFuse3.Internal.Resource where

import Control.Exception (catch, mask, throwIO)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, allocate, getInternalState, runInternalState)
import Control.Monad.Trans.Resource.Internal (stateCleanupChecked)
import Foreign (Ptr, Storable, callocBytes, free, mallocBytes, new, newArray)
import Foreign.C (CString, newCString)
import System.Exit (ExitCode(ExitSuccess))
import System.Posix.Internals (newFilePath)
import System.Posix.Process (exitImmediately, forkProcess)

-- | Forks a new process and transfers the resources to it.
--
-- The parent process `exitImmediately`.
daemonizeResourceT :: ResourceT IO a -> ResourceT IO b
daemonizeResourceT :: forall a b. ResourceT IO a -> ResourceT IO b
daemonizeResourceT ResourceT IO a
res = do
  -- We don't use resourceForkWith because we don't want to increase refcounts
  InternalState
istate <- ResourceT IO InternalState
forall (m :: * -> *). Monad m => ResourceT m InternalState
getInternalState
  IO b -> ResourceT IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> ResourceT IO b) -> IO b -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ do
    ProcessID
_ <- IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      a
_ <- IO a -> IO a
forall a. IO a -> IO a
restore (ResourceT IO a -> InternalState -> IO a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
res InternalState
istate) IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
        Maybe SomeException -> InternalState -> IO ()
stateCleanupChecked (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) InternalState
istate
        SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
e
      Maybe SomeException -> InternalState -> IO ()
stateCleanupChecked Maybe SomeException
forall a. Maybe a
Nothing InternalState
istate
    -- cleanup actions are discarded because the child will run them
    ()
_ <- ExitCode -> IO ()
exitImmediately ExitCode
ExitSuccess
    -- this @undefined@ is required because in unix<2.8 @exitImmediately@ returns @IO ()@
    -- instead of @IO a@
    IO b
forall a. HasCallStack => a
undefined

-- | `callocBytes` with `free` associated as a cleanup action.
resCallocBytes :: Int -> ResourceT IO (ReleaseKey, Ptr a)
resCallocBytes :: forall a. Int -> ResourceT IO (ReleaseKey, Ptr a)
resCallocBytes Int
n = IO (Ptr a) -> (Ptr a -> IO ()) -> ResourceT IO (ReleaseKey, Ptr a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
callocBytes Int
n) Ptr a -> IO ()
forall a. Ptr a -> IO ()
free

-- | `mallocBytes` with `free` associated as a cleanup action.
resMallocBytes :: Int -> ResourceT IO (ReleaseKey, Ptr a)
resMallocBytes :: forall a. Int -> ResourceT IO (ReleaseKey, Ptr a)
resMallocBytes Int
n = IO (Ptr a) -> (Ptr a -> IO ()) -> ResourceT IO (ReleaseKey, Ptr a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes Int
n) Ptr a -> IO ()
forall a. Ptr a -> IO ()
free

-- | `new` with `free` associated as a cleanup action.
resNew :: Storable a => a -> ResourceT IO (ReleaseKey, Ptr a)
resNew :: forall a. Storable a => a -> ResourceT IO (ReleaseKey, Ptr a)
resNew a
a = IO (Ptr a) -> (Ptr a -> IO ()) -> ResourceT IO (ReleaseKey, Ptr a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (a -> IO (Ptr a)
forall a. Storable a => a -> IO (Ptr a)
new a
a) Ptr a -> IO ()
forall a. Ptr a -> IO ()
free

-- | `newCString` with `free` associated as a cleanup action.
resNewCString :: String -> ResourceT IO (ReleaseKey, CString)
resNewCString :: String -> ResourceT IO (ReleaseKey, CString)
resNewCString String
s = IO CString
-> (CString -> IO ()) -> ResourceT IO (ReleaseKey, CString)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (String -> IO CString
newCString String
s) CString -> IO ()
forall a. Ptr a -> IO ()
free

-- | `newFilePath` with `free` associated as a cleanup action.
resNewFilePath :: FilePath -> ResourceT IO (ReleaseKey, CString)
resNewFilePath :: String -> ResourceT IO (ReleaseKey, CString)
resNewFilePath String
path = IO CString
-> (CString -> IO ()) -> ResourceT IO (ReleaseKey, CString)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (String -> IO CString
newFilePath String
path) CString -> IO ()
forall a. Ptr a -> IO ()
free

-- | `newArray` with `free` associated as a cleanup action.
resNewArray :: Storable a => [a] -> ResourceT IO (ReleaseKey, Ptr a)
resNewArray :: forall a. Storable a => [a] -> ResourceT IO (ReleaseKey, Ptr a)
resNewArray [a]
as = IO (Ptr a) -> (Ptr a -> IO ()) -> ResourceT IO (ReleaseKey, Ptr a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate ([a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
as) Ptr a -> IO ()
forall a. Ptr a -> IO ()
free