-- | Simple resource management functions

{-# LANGUAGE RankNTypes, Safe #-}

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

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

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

-- | Acquire a 'IO.Handle' within 'MonadSafe'
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 #-}

{- $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 #-}