{-# LANGUAGE Safe #-}

-- | Lifted versions of functions working with files and common IO.
-- All functions are specialized to 'Data.Text.Text'.

module Universum.Lifted.File
       ( appendFile
       , getLine
       , readFile
       , writeFile
       , withFile
       , openFile
       , hClose
       ) where

import Control.Exception.Safe (MonadMask, bracket)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Function ((.))
import Data.Text (Text)
import Prelude (FilePath)
import System.IO (Handle, IOMode)

import qualified Data.Text.IO as XIO
import qualified System.IO as XIO (IO, hClose, openFile)

----------------------------------------------------------------------------
-- Text
----------------------------------------------------------------------------

-- | Lifted version of 'Data.Text.IO.appendFile'.
appendFile :: MonadIO m => FilePath -> Text -> m ()
appendFile :: forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
appendFile FilePath
a Text
b = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Text -> IO ()
XIO.appendFile FilePath
a Text
b)
{-# INLINE appendFile #-}

-- | Lifted version of 'Data.Text.IO.getLine'.
getLine :: MonadIO m => m Text
getLine :: forall (m :: * -> *). MonadIO m => m Text
getLine = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
XIO.getLine
{-# INLINE getLine #-}

-- | Lifted version of 'Data.Text.IO.readFile'.
readFile :: MonadIO m => FilePath -> m Text
readFile :: forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFile FilePath
a = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
XIO.readFile FilePath
a)
{-# INLINE readFile #-}

-- | Lifted version of 'Data.Text.IO.writeFile'.
writeFile :: MonadIO m => FilePath -> Text -> m ()
writeFile :: forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFile FilePath
a Text
b = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Text -> IO ()
XIO.writeFile FilePath
a Text
b)
{-# INLINE writeFile #-}

-- | Lifted version of 'System.IO.openFile'.
--
-- See also 'withFile' for more information.
openFile :: MonadIO m => FilePath -> IOMode -> m Handle
openFile :: forall (m :: * -> *). MonadIO m => FilePath -> IOMode -> m Handle
openFile FilePath
a IOMode
b = IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> IO Handle
XIO.openFile FilePath
a IOMode
b)
{-# INLINE openFile #-}

-- | Close a file handle
--
-- See also 'withFile' for more information.
hClose :: MonadIO m => Handle -> m ()
hClose :: forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
XIO.hClose
{-# INLINE hClose #-}

-- | Opens a file, manipulates it with the provided function and closes the
-- handle before returning. The 'Handle' can be written to using the
-- 'Universum.Print.hPutStr' and 'Universum.Print.hPutStrLn' functions.
--
-- 'withFile' is essentially the 'bracket' pattern, specialized to files. This
-- should be preferred over 'openFile' + 'hClose' as it properly deals with
-- (asynchronous) exceptions. In cases where 'withFile' is insufficient, for
-- instance because the it is not statically known when manipulating the
-- 'Handle' has finished, one should consider other safe paradigms for resource
-- usage, such as the @ResourceT@ transformer from the @resourcet@ package,
-- before resorting to 'openFile' and 'hClose'.
withFile :: (MonadIO m, MonadMask m) => FilePath -> IOMode -> (Handle -> m a) -> m a
withFile :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
filePath IOMode
mode Handle -> m a
f = m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m) =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (FilePath -> IOMode -> m Handle
forall (m :: * -> *). MonadIO m => FilePath -> IOMode -> m Handle
openFile FilePath
filePath IOMode
mode) Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle -> m a
f

{-# SPECIALIZE appendFile :: FilePath -> Text -> XIO.IO () #-}
{-# SPECIALIZE getLine :: XIO.IO Text #-}
{-# SPECIALIZE readFile :: FilePath -> XIO.IO Text #-}
{-# SPECIALIZE writeFile :: FilePath -> Text -> XIO.IO () #-}
{-# SPECIALIZE openFile :: FilePath -> IOMode -> XIO.IO Handle #-}
{-# SPECIALIZE hClose :: Handle -> XIO.IO () #-}
{-# SPECIALIZE withFile :: FilePath -> IOMode -> (Handle -> XIO.IO a) -> XIO.IO a #-}