-- | 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 <- forall (m :: * -> *). Monad m => ResourceT m InternalState
getInternalState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ProcessID
_ <- IO () -> IO ProcessID
forkProcess forall a b. (a -> b) -> a -> b
$ forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      a
_ <- forall a. IO a -> IO a
restore (forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
res InternalState
istate) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
        Maybe SomeException -> InternalState -> IO ()
stateCleanupChecked (forall a. a -> Maybe a
Just SomeException
e) InternalState
istate
        forall e a. Exception e => e -> IO a
throwIO SomeException
e
      Maybe SomeException -> InternalState -> IO ()
stateCleanupChecked 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@
    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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (forall a. Int -> IO (Ptr a)
callocBytes Int
n) 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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (forall a. Int -> IO (Ptr a)
mallocBytes Int
n) 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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (forall a. Storable a => a -> IO (Ptr a)
new a
a) 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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (String -> IO CString
newCString String
s) 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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (String -> IO CString
newFilePath String
path) 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 = forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
as) forall a. Ptr a -> IO ()
free