-- | Simple resource management functions

{-# LANGUAGE RankNTypes, Safe #-}

module Pipes.Safe.Prelude (
    -- * Handle management
    withFile,
    withBinaryFile,
    openFile,
    openBinaryFile,

    -- * String I/O
    -- $strings
    readFile,
    writeFile,

    -- * Registering/releasing
    allocate,
    allocate_
    ) where

import Control.Monad.Catch (mask_)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Pipes (Producer', Consumer')
import Pipes.Safe (bracket, liftBase, register, Base, MonadSafe, ReleaseKey)
import qualified Pipes.Prelude as P
import qualified System.IO as IO
import Prelude hiding (readFile, writeFile)

{- | Acquire a 'IO.Handle' within 'MonadSafe'

     The file is opened in text mode. See also: 'withBinaryFile'
-}
withFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r
withFile :: FilePath -> IOMode -> (Handle -> m r) -> m r
withFile FilePath
file IOMode
ioMode = Base m Handle -> (Handle -> Base m ()) -> (Handle -> m r) -> m r
forall (m :: * -> *) a b c.
MonadSafe m =>
Base m a -> (a -> Base m b) -> (a -> m c) -> m c
bracket (IO Handle -> Base m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> Base m Handle) -> IO Handle -> Base m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
file IOMode
ioMode) (IO () -> Base m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Base m ()) -> (Handle -> IO ()) -> Handle -> Base m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)
{-# INLINABLE withFile #-}

{- | Like 'withFile', but open the file in binary mode

     See 'System.IO.hSetBinaryMode' for the differences between binary and text mode.
-}
withBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r
withBinaryFile :: FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile FilePath
file IOMode
ioMode = Base m Handle -> (Handle -> Base m ()) -> (Handle -> m r) -> m r
forall (m :: * -> *) a b c.
MonadSafe m =>
Base m a -> (a -> Base m b) -> (a -> m c) -> m c
bracket (IO Handle -> Base m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> Base m Handle) -> IO Handle -> Base m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
file IOMode
ioMode) (IO () -> Base m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Base m ()) -> (Handle -> IO ()) -> Handle -> Base m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)
{-# INLINABLE withBinaryFile #-}

{- | Acquire a 'IO.Handle' within 'MonadSafe'

     The 'ReleaseKey' can be used to close the handle with 'Pipes.Safe.release';
     otherwise the handle will be closed automatically at the conclusion of the
     'MonadSafe' block.

     The file is opened in text mode. See also: 'openBinaryFile'
-}
openFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle)
openFile :: FilePath -> IOMode -> m (ReleaseKey, Handle)
openFile FilePath
file IOMode
ioMode = Base m Handle -> (Handle -> Base m ()) -> m (ReleaseKey, Handle)
forall (m :: * -> *) a.
MonadSafe m =>
Base m a -> (a -> Base m ()) -> m (ReleaseKey, a)
allocate (IO Handle -> Base m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> Base m Handle) -> IO Handle -> Base m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
file IOMode
ioMode) (IO () -> Base m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Base m ()) -> (Handle -> IO ()) -> Handle -> Base m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)
{-# INLINABLE openFile #-}

{- | Like 'openFile', but open the file in binary mode

     See 'System.IO.hSetBinaryMode' for the differences between binary and text mode.
-}
openBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle)
openBinaryFile :: FilePath -> IOMode -> m (ReleaseKey, Handle)
openBinaryFile FilePath
file IOMode
ioMode = Base m Handle -> (Handle -> Base m ()) -> m (ReleaseKey, Handle)
forall (m :: * -> *) a.
MonadSafe m =>
Base m a -> (a -> Base m ()) -> m (ReleaseKey, a)
allocate (IO Handle -> Base m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> Base m Handle) -> IO Handle -> Base m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
file IOMode
ioMode) (IO () -> Base m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Base m ()) -> (Handle -> IO ()) -> Handle -> Base m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)
{-# INLINABLE openBinaryFile #-}

{- $strings
    Note that 'String's are very inefficient, and I will release future separate
    packages with 'Data.ByteString.ByteString' and 'Data.Text.Text' operations.
    I only provide these to allow users to test simple I/O without requiring any
    additional library dependencies.
-}

{-| Read lines from a file, automatically opening and closing the file as
    necessary
-}
readFile :: MonadSafe m => FilePath -> Producer' String m ()
readFile :: FilePath -> Producer' FilePath m ()
readFile FilePath
file = FilePath
-> IOMode
-> (Handle -> Proxy x' x () FilePath m ())
-> Proxy x' x () FilePath m ()
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
withFile FilePath
file IOMode
IO.ReadMode Handle -> Proxy x' x () FilePath m ()
forall (m :: * -> *) x' x.
MonadIO m =>
Handle -> Proxy x' x () FilePath m ()
P.fromHandle
{-# INLINABLE readFile #-}

{-| Write lines to a file, automatically opening and closing the file as
    necessary
-}
writeFile :: MonadSafe m => FilePath -> Consumer' String m r
writeFile :: FilePath -> Consumer' FilePath m r
writeFile FilePath
file = FilePath
-> IOMode
-> (Handle -> Proxy () FilePath y' y m r)
-> Proxy () FilePath y' y m r
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
withFile FilePath
file IOMode
IO.WriteMode ((Handle -> Proxy () FilePath y' y m r)
 -> Proxy () FilePath y' y m r)
-> (Handle -> Proxy () FilePath y' y m r)
-> Proxy () FilePath y' y m r
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Consumer' FilePath m r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> Consumer' FilePath m r
P.toHandle Handle
h
{-# INLINABLE writeFile #-}

{- | Acquire some resource with a guarantee that it will eventually be released

     The 'ReleaseKey' can be passed to 'Pipes.Safe.release' to
     release the resource manually. If this has not been done by the end
     of the 'MonadSafe' block, the resource will be released automatically.
-}
allocate :: MonadSafe m =>
    Base m a             -- ^ Acquire
    -> (a -> Base m ())  -- ^ Release
    -> m (ReleaseKey, a)
allocate :: Base m a -> (a -> Base m ()) -> m (ReleaseKey, a)
allocate Base m a
acq a -> Base m ()
rel = m (ReleaseKey, a) -> m (ReleaseKey, a)
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m (ReleaseKey, a) -> m (ReleaseKey, a))
-> m (ReleaseKey, a) -> m (ReleaseKey, a)
forall a b. (a -> b) -> a -> b
$ do
    a
a <- Base m a -> m a
forall (m :: * -> *) r. MonadSafe m => Base m r -> m r
liftBase Base m a
acq
    ReleaseKey
key <- Base m () -> m ReleaseKey
forall (m :: * -> *). MonadSafe m => Base m () -> m ReleaseKey
register (a -> Base m ()
rel a
a)
    (ReleaseKey, a) -> m (ReleaseKey, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReleaseKey
key, a
a)

{- | Like 'allocate', but for when the resource itself is not needed

     The acquire  action runs immediately. The 'ReleaseKey' can be passed
     to 'Pipes.Safe.release' to run the release action. If this has not been
     done by the end of the 'MonadSafe' block, the release action will be
     run automatically.
-}
allocate_ :: MonadSafe m =>
    Base m a        -- ^ Acquire
    -> (Base m ())  -- ^ Release
    -> m ReleaseKey
allocate_ :: Base m a -> Base m () -> m ReleaseKey
allocate_ Base m a
acq Base m ()
rel = ((ReleaseKey, a) -> ReleaseKey)
-> m (ReleaseKey, a) -> m ReleaseKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, a) -> ReleaseKey
forall a b. (a, b) -> a
fst (Base m a -> (a -> Base m ()) -> m (ReleaseKey, a)
forall (m :: * -> *) a.
MonadSafe m =>
Base m a -> (a -> Base m ()) -> m (ReleaseKey, a)
allocate Base m a
acq (Base m () -> a -> Base m ()
forall a b. a -> b -> a
const Base m ()
rel))