{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
-- TODO: cf <http://hpaste.org/76873>
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  System.Posix.IO.ByteString.Lazy
-- Copyright   :  Copyright (c) 2010--2021 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@cpan.org
-- Stability   :  experimental
-- Portability :  non-portable (requires POSIX.1, XPG4.2)
--
-- Provides a lazy-'BL.ByteString' file-descriptor based I\/O
-- API, designed loosely after the @String@ file-descriptor based
-- I\/O API in "System.Posix.IO". The functions here wrap standard
-- C implementations of the functions specified by the ISO\/IEC
-- 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue
-- 4, Version 2 (``XPG4.2'') specifications.
--
-- These functions are provided mainly as a convenience to avoid
-- boilerplate code converting between lazy 'BL.ByteString' and
-- strict @['BS.ByteString']@. It may be depricated in the future.
----------------------------------------------------------------
module System.Posix.IO.ByteString.Lazy
    (
    -- * I\/O with file descriptors
    -- ** Reading
      fdRead
    , fdPread
    -- ** Writing
    , fdWrites
    , fdWritev
    ) where

import qualified Data.ByteString               as BS
import qualified Data.ByteString.Unsafe        as BSU
import qualified System.Posix.IO.ByteString    as PosixBS
import qualified Data.ByteString.Lazy          as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import           System.Posix.Types            (Fd, ByteCount, FileOffset)

----------------------------------------------------------------
-- | Read data from an 'Fd' and convert it to a 'BL.ByteString'.
-- Throws an exception if this is an invalid descriptor, or EOF has
-- been reached. This is a thin wrapper around 'PosixBS.fdRead'.
fdRead
    :: Fd
    -> ByteCount        -- ^ How many bytes to try to read.
    -> IO BL.ByteString -- ^ The bytes read.
fdRead :: Fd -> ByteCount -> IO ByteString
fdRead Fd
fd ByteCount
nbytes
    | ByteCount
nbytes ByteCount -> ByteCount -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCount
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BL.empty
    | Bool
otherwise   = do
        ByteString
s <- Fd -> ByteCount -> IO ByteString
PosixBS.fdRead Fd
fd ByteCount
nbytes
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BLI.chunk ByteString
s ByteString
BL.empty)

----------------------------------------------------------------
-- | Read data from a specified position in the 'Fd' and convert
-- it to a 'BS.ByteString', without altering the position stored
-- in the @Fd@. Throws an exception if this is an invalid descriptor,
-- or EOF has been reached. This is a thin wrapper around
-- 'PosixBS.fdPread'.
--
-- /Since: 0.3.1/
fdPread
    :: Fd
    -> ByteCount        -- ^ How many bytes to try to read.
    -> FileOffset       -- ^ Where to read the data from.
    -> IO BL.ByteString -- ^ The bytes read.
fdPread :: Fd -> ByteCount -> FileOffset -> IO ByteString
fdPread Fd
fd ByteCount
nbytes FileOffset
offset
    | ByteCount
nbytes ByteCount -> ByteCount -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCount
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BL.empty
    | Bool
otherwise   = do
        ByteString
s <- Fd -> ByteCount -> FileOffset -> IO ByteString
PosixBS.fdPread Fd
fd ByteCount
nbytes FileOffset
offset
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BLI.chunk ByteString
s ByteString
BL.empty)


----------------------------------------------------------------
-- | Write a 'BL.ByteString' to an 'Fd'. This function makes one
-- @write(2)@ system call per chunk, as per 'PosixBS.fdWrites'.
fdWrites
    :: Fd
    -> BL.ByteString
        -- ^ The string to write.
    -> IO (ByteCount, BL.ByteString)
        -- ^ How many bytes were actually written, and the remaining
        -- (unwritten) string.
fdWrites :: Fd -> ByteString -> IO (ByteCount, ByteString)
fdWrites Fd
fd = ByteCount -> ByteString -> IO (ByteCount, ByteString)
go ByteCount
0
    where
    -- We want to do a left fold in order to avoid stack overflows,
    -- but we need to have an early exit for incomplete writes
    -- (which normally requires a right fold). Hence this recursion.
    go :: ByteCount -> ByteString -> IO (ByteCount, ByteString)
go ByteCount
acc ByteString
BLI.Empty        = (ByteCount, ByteString) -> IO (ByteCount, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCount
acc, ByteString
BL.empty)
    go ByteCount
acc (BLI.Chunk ByteString
c ByteString
cs) =
        Fd -> ByteString -> IO ByteCount
PosixBS.fdWrite Fd
fd ByteString
c IO ByteCount
-> (ByteCount -> IO (ByteCount, ByteString))
-> IO (ByteCount, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteCount
rc ->
        let acc' :: ByteCount
acc'  = ByteCount
accByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ByteCount
rc          in ByteCount
acc'  ByteCount
-> IO (ByteCount, ByteString) -> IO (ByteCount, ByteString)
`seq`
        let rcInt :: Int
rcInt = ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
rc in Int
rcInt Int -> IO (ByteCount, ByteString) -> IO (ByteCount, ByteString)
`seq`
        if Int
rcInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
c
            then ByteCount -> ByteString -> IO (ByteCount, ByteString)
go ByteCount
acc' ByteString
cs
            else (ByteCount, ByteString) -> IO (ByteCount, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCount
acc', ByteString -> ByteString -> ByteString
BLI.Chunk (Int -> ByteString -> ByteString
BSU.unsafeDrop Int
rcInt ByteString
c) ByteString
cs)
{-
Using 'BSU.unsafeDrop' above is safe, assuming that
'System.Posix.IO.fdWriteBuf' never returns (rc < 0 || rc > BS.length c).
If we are paranoid about that then we should do the following instead:

    go acc ccs =
        case ccs of
        BLI.Empty      -> return (acc, ccs)
        BLI.Chunk c cs -> do
            rc <- PosixBS.fdWrite fd c
            let acc'  = acc+rc          in acc'  `seq` do
            let rcInt = fromIntegral rc in rcInt `seq` do
            case BS.length c of
                len | rcInt == len -> go acc' cs
                    | rcInt >  len -> error _impossibleByteCount
                    | rcInt <  0   -> error _negtiveByteCount
                    | rcInt == 0   -> return (acc', ccs) -- trivial optimizing
                    | otherwise    -> return (acc', BLI.Chunk (BSU.unsafeDrop rcInt c) cs)

_negtiveByteCount =
    "System.Posix.IO.fdWriteBuf: returned a negative byte count"
_impossibleByteCount =
    "System.Posix.IO.fdWriteBuf: returned a byte count greater than the length it was given"
-}


----------------------------------------------------------------
-- | Write a 'BL.ByteString' to an 'Fd'. This function makes a
-- single @writev(2)@ system call, as per 'PosixBS.fdWritev'.
fdWritev
    :: Fd
    -> BL.ByteString -- ^ The string to write.
    -> IO ByteCount  -- ^ How many bytes were actually written.
fdWritev :: Fd -> ByteString -> IO ByteCount
fdWritev Fd
fd ByteString
s = Fd -> [ByteString] -> IO ByteCount
PosixBS.fdWritev Fd
fd (ByteString -> [ByteString]
BL.toChunks ByteString
s)
{-# INLINE fdWritev #-}
-- Hopefully the intermediate list can be fused away...


----------------------------------------------------------------
----------------------------------------------------------- fin.