module Lazy.Scope.GetContents where

import Control.Exception (ioError)
import Data.ByteString qualified as S
import Data.ByteString.Lazy.Internal (ByteString(Chunk, Empty), defaultChunkSize)
import Lazy.Scope.Type (LazyT, Handle(..), Bs, Scoped(Scoped))
import Lazy.Scope.Scoped (toBs)
import Relude hiding (Handle)
import System.IO.Error (mkIOError, illegalOperationErrorType)
import System.IO.Unsafe (unsafeInterleaveIO)
import Text.Show (showsPrec)

hGetContentsOnlyN :: Int -> Handle s -> IO LByteString
hGetContentsOnlyN :: forall {k} (s :: k). Int -> Handle s -> IO LByteString
hGetContentsOnlyN Int
k (Handle Handle
h) = IO LByteString
lazyRead
  where
    lazyRead :: IO LByteString
lazyRead = IO LByteString -> IO LByteString
forall a. IO a -> IO a
unsafeInterleaveIO IO LByteString
loop

    loop :: IO LByteString
loop = do
        c <- Handle -> Int -> IO ByteString
S.hGetSome Handle
h Int
k
        if S.null c
          then return Empty
          else Chunk c <$> lazyRead

hGetContents :: MonadIO m => Handle s -> LazyT s m (Bs s)
hGetContents :: forall {k} (m :: * -> *) (s :: k).
MonadIO m =>
Handle s -> LazyT s m (Bs s)
hGetContents Handle s
h = m (Bs s) -> LazyT s m (Bs s)
forall (m :: * -> *) a. Monad m => m a -> LazyT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Bs s) -> LazyT s m (Bs s)) -> m (Bs s) -> LazyT s m (Bs s)
forall a b. (a -> b) -> a -> b
$ IO (Bs s) -> m (Bs s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LByteString -> Bs s
forall {k} (s :: k) a. a -> Scoped s a
Scoped (LByteString -> Bs s) -> IO LByteString -> IO (Bs s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Handle s -> IO LByteString
forall {k} (s :: k). Int -> Handle s -> IO LByteString
hGetContentsOnlyN Int
defaultChunkSize Handle s
h)

hGetNonBlockingN :: Int -> Handle s -> Int -> IO LByteString
hGetNonBlockingN :: forall {k} (s :: k). Int -> Handle s -> Int -> IO LByteString
hGetNonBlockingN Int
k (Handle Handle
h) Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0= Int -> IO LByteString
readChunks Int
n
  where
    readChunks :: Int -> IO LByteString
readChunks !Int
i = do
        c <- Handle -> Int -> IO ByteString
S.hGetNonBlocking Handle
h (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
k Int
i)
        case S.length c of
            Int
0 -> LByteString -> IO LByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LByteString
Empty
            Int
m -> do cs <- Int -> IO LByteString
readChunks (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)
                    return (Chunk c cs)

hGetNonBlockingN Int
_ Handle s
_ Int
0 = LByteString -> IO LByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LByteString
Empty
hGetNonBlockingN Int
_ Handle s
h Int
n = Handle s -> String -> Int -> IO LByteString
forall {k} (s :: k) a. Handle s -> String -> Int -> IO a
illegalBufferSize Handle s
h String
"hGetNonBlocking" Int
n

illegalBufferSize :: Handle s -> String -> Int -> IO a
illegalBufferSize :: forall {k} (s :: k) a. Handle s -> String -> Int -> IO a
illegalBufferSize (Handle Handle
handle) String
fn Int
sz =
    IOError -> IO a
forall a. HasCallStack => IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
illegalOperationErrorType String
msg (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing)
    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
    where
      msg :: String
msg = String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": illegal ByteString size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
9 Int
sz []


hGetNonBlocking :: MonadIO m => Handle s -> Int -> LazyT s m (Bs s)
hGetNonBlocking :: forall {k} (m :: * -> *) (s :: k).
MonadIO m =>
Handle s -> Int -> LazyT s m (Bs s)
hGetNonBlocking Handle s
h Int
n = m (Bs s) -> LazyT s m (Bs s)
forall (m :: * -> *) a. Monad m => m a -> LazyT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Bs s) -> m (Bs s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bs s) -> m (Bs s)) -> IO (Bs s) -> m (Bs s)
forall a b. (a -> b) -> a -> b
$ LByteString -> Bs s
forall {k} (s :: k). LByteString -> Bs s
toBs (LByteString -> Bs s) -> IO LByteString -> IO (Bs s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Handle s -> Int -> IO LByteString
forall {k} (s :: k). Int -> Handle s -> Int -> IO LByteString
hGetNonBlockingN Int
defaultChunkSize Handle s
h Int
n)

hPutNonBlocking :: MonadIO m => Handle s -> Bs s -> LazyT s m (Bs s)
hPutNonBlocking :: forall {k} (m :: * -> *) (s :: k).
MonadIO m =>
Handle s -> Bs s -> LazyT s m (Bs s)
hPutNonBlocking Handle s
_ (Scoped LByteString
Empty)           = Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LByteString -> Scoped s LByteString
forall {k} (s :: k) a. a -> Scoped s a
Scoped LByteString
Empty)
hPutNonBlocking bh :: Handle s
bh@(Handle Handle
h) (Scoped bs :: LByteString
bs@(Chunk ByteString
c LByteString
cs)) = do
  c' <- m ByteString -> LazyT s m ByteString
forall (m :: * -> *) a. Monad m => m a -> LazyT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ByteString
S.hPutNonBlocking Handle
h ByteString
c)
  case S.length c' of
    Int
l' | Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
S.length ByteString
c -> Handle s
-> Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall {k} (m :: * -> *) (s :: k).
MonadIO m =>
Handle s -> Bs s -> LazyT s m (Bs s)
hPutNonBlocking Handle s
bh (LByteString -> Scoped s LByteString
forall {k} (s :: k) a. a -> Scoped s a
Scoped LByteString
cs)
    Int
0                     -> Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall a. a -> LazyT s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scoped s LByteString -> LazyT s m (Scoped s LByteString))
-> Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall a b. (a -> b) -> a -> b
$ LByteString -> Scoped s LByteString
forall {k} (s :: k) a. a -> Scoped s a
Scoped LByteString
bs
    Int
_                     -> Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall a. a -> LazyT s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scoped s LByteString -> LazyT s m (Scoped s LByteString))
-> Scoped s LByteString -> LazyT s m (Scoped s LByteString)
forall a b. (a -> b) -> a -> b
$ LByteString -> Scoped s LByteString
forall {k} (s :: k) a. a -> Scoped s a
Scoped (ByteString -> LByteString -> LByteString
Chunk ByteString
c' LByteString
cs)