module Streamly.Internal.FileSystem.File.Common
    ( withFile
    , openFile
    ) where

-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

import Control.Exception (mask, onException, try)
import Control.Monad (when)
import GHC.IO (catchException)
import GHC.IO.Exception (IOException(..))
import GHC.IO.Handle.Internals (handleFinalizer)
import Streamly.Internal.FileSystem.Path (Path)
import System.IO (IOMode(..), Handle, hSetBinaryMode, hClose)

import qualified Streamly.Internal.FileSystem.Path as Path

#if MIN_VERSION_base(4,16,0)
import GHC.IO.Handle.Internals (addHandleFinalizer)
#else
import Control.Concurrent.MVar (MVar, addMVarFinalizer)
import GHC.IO.Handle.Types (Handle__, Handle(..))
#endif

-------------------------------------------------------------------------------
-- Utils
-------------------------------------------------------------------------------

#if !(MIN_VERSION_base(4,16,0))
type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()

-- | Add a finalizer to a 'Handle'. Specifically, the finalizer
-- will be added to the 'MVar' of a file handle or the write-side
-- 'MVar' of a duplex handle. See Handle Finalizers for details.
addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()
addHandleFinalizer handle finalizer = do
  addMVarFinalizer mv (finalizer filepath mv)
  where
    !(filepath, !mv) = case handle of
      FileHandle fp m -> (fp, m)
      DuplexHandle fp _ write_m -> (fp, write_m)
#endif

{-# INLINE withOpenFile #-}
withOpenFile
    :: Bool
    -> Bool
    -> (Path -> IOMode -> IO Handle)
    -> Path
    -> IOMode
    -> (Handle -> IO r)
    -> IO r
withOpenFile :: forall r.
Bool
-> Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO r)
-> IO r
withOpenFile Bool
binary Bool
close_finally Path -> IOMode -> IO Handle
f Path
fp IOMode
iomode Handle -> IO r
action =
    ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO r) -> IO r)
-> ((forall a. IO a -> IO a) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
        Handle
h <- Path -> IOMode -> IO Handle
f Path
fp IOMode
iomode
        -- XXX In case of withFile it will be closed anyway, so do we even need
        -- this?
        Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
h HandleFinalizer
handleFinalizer
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
binary (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
        r
r <- IO r -> IO r
forall a. IO a -> IO a
restore (Handle -> IO r
action Handle
h) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`onException` Handle -> IO ()
hClose Handle
h
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
close_finally (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
        r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r

addFilePathToIOError :: String -> Path -> IOException -> IOException
addFilePathToIOError :: String -> Path -> IOException -> IOException
addFilePathToIOError String
fun Path
fp IOException
ioe =
  let !str :: String
str = Path -> String
Path.toString Path
fp
   in IOException
ioe
        { ioe_location = fun
        , ioe_filename = Just str
        }

{-# INLINE catchWith #-}
catchWith :: String -> Path -> IO a -> IO a
catchWith :: forall a. String -> Path -> IO a -> IO a
catchWith String
str Path
path IO a
io =
    IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException IO a
io (IOException -> IO a
forall a. IOException -> IO a
ioError (IOException -> IO a)
-> (IOException -> IOException) -> IOException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path -> IOException -> IOException
addFilePathToIOError String
str Path
path)

{-# INLINE withFile #-}
withFile ::
    Bool
    -> (Path -> IOMode -> IO Handle)
    -> Path
    -> IOMode
    -> (Handle -> IO r)
    -> IO r
withFile :: forall r.
Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO r)
-> IO r
withFile Bool
binary Path -> IOMode -> IO Handle
f Path
path IOMode
iomode Handle -> IO r
act =
     String
-> Path -> IO (Either IOException r) -> IO (Either IOException r)
forall a. String -> Path -> IO a -> IO a
catchWith String
"withFile" Path
path
        (Bool
-> Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO (Either IOException r))
-> IO (Either IOException r)
forall r.
Bool
-> Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO r)
-> IO r
withOpenFile Bool
binary Bool
True Path -> IOMode -> IO Handle
f Path
path IOMode
iomode (IO r -> IO (Either IOException r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOException r))
-> (Handle -> IO r) -> Handle -> IO (Either IOException r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act))
      IO (Either IOException r) -> (Either IOException r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOException -> IO r)
-> (r -> IO r) -> Either IOException r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> IO r
forall a. IOException -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{-# INLINE openFile #-}
openFile ::
    Bool -> (Path -> IOMode -> IO Handle) -> Path -> IOMode -> IO Handle
openFile :: Bool
-> (Path -> IOMode -> IO Handle) -> Path -> IOMode -> IO Handle
openFile Bool
binary Path -> IOMode -> IO Handle
f Path
path IOMode
iomode =
    String -> Path -> IO Handle -> IO Handle
forall a. String -> Path -> IO a -> IO a
catchWith String
"openFile" Path
path
        (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO Handle)
-> IO Handle
forall r.
Bool
-> Bool
-> (Path -> IOMode -> IO Handle)
-> Path
-> IOMode
-> (Handle -> IO r)
-> IO r
withOpenFile Bool
binary Bool
False Path -> IOMode -> IO Handle
f Path
path IOMode
iomode Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure