-- | @since 2.2.0
module Distribution.Utils.IOData
    ( -- * 'IOData' & 'IODataMode' type
      IOData(..)
    , IODataMode(..)
    , null
    , hGetContents
    , hPutContents
    ) where

import qualified Data.ByteString.Lazy as BS
import           Distribution.Compat.Prelude hiding (null)
import qualified Prelude
import qualified System.IO

-- | Represents either textual or binary data passed via I/O functions
-- which support binary/text mode
--
-- @since 2.2.0
data IOData = IODataText    String
              -- ^ How Text gets encoded is usually locale-dependent.
            | IODataBinary  BS.ByteString
              -- ^ Raw binary which gets read/written in binary mode.

-- | Test whether 'IOData' is empty
--
-- @since 2.2.0
null :: IOData -> Bool
null :: IOData -> Bool
null (IODataText String
s) = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null String
s
null (IODataBinary ByteString
b) = ByteString -> Bool
BS.null ByteString
b

instance NFData IOData where
    rnf :: IOData -> ()
rnf (IODataText String
s) = String -> ()
forall a. NFData a => a -> ()
rnf String
s
    rnf (IODataBinary ByteString
bs) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
bs

data IODataMode = IODataModeText | IODataModeBinary

-- | 'IOData' Wrapper for 'System.IO.hGetContents'
--
-- __Note__: This operation uses lazy I/O. Use 'NFData' to force all
-- data to be read and consequently the internal file handle to be
-- closed.
--
-- @since 2.2.0
hGetContents :: System.IO.Handle -> IODataMode -> Prelude.IO IOData
hGetContents :: Handle -> IODataMode -> IO IOData
hGetContents Handle
h IODataMode
IODataModeText = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
False
    String -> IOData
IODataText (String -> IOData) -> IO String -> IO IOData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO String
System.IO.hGetContents Handle
h
hGetContents Handle
h IODataMode
IODataModeBinary = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
True
    ByteString -> IOData
IODataBinary (ByteString -> IOData) -> IO ByteString -> IO IOData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BS.hGetContents Handle
h

-- | 'IOData' Wrapper for 'System.IO.hPutStr' and 'System.IO.hClose'
--
-- This is the dual operation ot 'ioDataHGetContents',
-- and consequently the handle is closed with `hClose`.
--
-- @since 2.2.0
hPutContents :: System.IO.Handle -> IOData -> Prelude.IO ()
hPutContents :: Handle -> IOData -> IO ()
hPutContents Handle
h (IODataText String
c) = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
False
    Handle -> String -> IO ()
System.IO.hPutStr Handle
h String
c
    Handle -> IO ()
System.IO.hClose Handle
h
hPutContents Handle
h (IODataBinary ByteString
c) = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
True
    Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
c
    Handle -> IO ()
System.IO.hClose Handle
h