{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

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

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

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

-- | Applies a function polymorphic over 'IODataMode' to an 'IOData' value.
withIOData :: IOData -> (forall mode. IODataMode mode -> mode -> r) -> r
withIOData :: forall r.
IOData -> (forall mode. IODataMode mode -> mode -> r) -> r
withIOData (IODataText String
str) forall mode. IODataMode mode -> mode -> r
k = IODataMode String -> String -> r
forall mode. IODataMode mode -> mode -> r
k IODataMode String
IODataModeText String
str
withIOData (IODataBinary ByteString
lbs) forall mode. IODataMode mode -> mode -> r
k = IODataMode ByteString -> ByteString -> r
forall mode. IODataMode mode -> mode -> r
k IODataMode ByteString
IODataModeBinary ByteString
lbs

-- | Test whether 'IOData' is empty
null :: IOData -> Bool
null :: IOData -> Bool
null (IODataText String
s) = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null String
s
null (IODataBinary ByteString
b) = ByteString -> Bool
LBS.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
lbs) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
lbs

-- | @since 2.2
class NFData mode => KnownIODataMode mode where
  -- | '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.
  hGetIODataContents :: System.IO.Handle -> Prelude.IO mode

  toIOData :: mode -> IOData
  iodataMode :: IODataMode mode

-- | Phantom-typed GADT representation of the mode of 'IOData', containing no
-- other data.
--
-- @since 3.2
data IODataMode mode where
  IODataModeText :: IODataMode String
  IODataModeBinary :: IODataMode LBS.ByteString

instance a ~ Char => KnownIODataMode [a] where
  hGetIODataContents :: Handle -> IO [a]
hGetIODataContents Handle
h = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
False
    Handle -> IO String
System.IO.hGetContents Handle
h

  toIOData :: [a] -> IOData
toIOData = [a] -> IOData
String -> IOData
IODataText
  iodataMode :: IODataMode [a]
iodataMode = IODataMode [a]
IODataMode String
IODataModeText

instance KnownIODataMode LBS.ByteString where
  hGetIODataContents :: Handle -> IO ByteString
hGetIODataContents Handle
h = do
    Handle -> Bool -> IO ()
System.IO.hSetBinaryMode Handle
h Bool
True
    Handle -> IO ByteString
LBS.hGetContents Handle
h

  toIOData :: ByteString -> IOData
toIOData = ByteString -> IOData
IODataBinary
  iodataMode :: IODataMode ByteString
iodataMode = IODataMode ByteString
IODataModeBinary

-- | 'IOData' Wrapper for 'System.IO.hPutStr' and 'System.IO.hClose'
--
-- This is the dual operation ot 'hGetIODataContents',
-- and consequently the handle is closed with `hClose`.
--
-- /Note:/ this performs lazy-IO.
--
-- @since 2.2
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 ()
LBS.hPutStr Handle
h ByteString
c
  Handle -> IO ()
System.IO.hClose Handle
h