module Network.MoHWS.ByteString where

import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified System.IO as IO
import Control.Monad (liftM2, )
import System.IO.Unsafe (unsafeInterleaveIO, )


{- |
Like 'L.hGetContents' but it does not try to close the file when reaching the end.
Since you may abort reading before reaching the end,
or the run-time system reads more than necessary
(you don't know how unsafeInterleaveIO works),
you never know, whether 'L.hGetContents' has already closed the file or not.
With this function however it is always sure,
that the file is not closed and you are responsible for closing it.
-}
hGetContentsN :: Int -> IO.Handle -> IO L.ByteString
hGetContentsN :: Int -> Handle -> IO ByteString
hGetContentsN Int
k Handle
h =
   let loop :: IO ByteString
loop = IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
          Bool
eof <- Handle -> IO Bool
IO.hIsEOF Handle
h
          if Bool
eof
            then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
            else
              do (ByteString -> ByteString -> ByteString)
-> IO ByteString -> IO ByteString -> IO ByteString
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
                    (\ByteString
c -> ByteString -> ByteString -> ByteString
L.append ([ByteString] -> ByteString
L.fromChunks [ByteString
c]))
                    (Handle -> Int -> IO ByteString
S.hGet Handle
h Int
k) IO ByteString
loop
   in  IO ByteString
loop

{- |
Variant of 'hGetContentsN' that may choose smaller chunks
when currently no more data is available.
The chunk size may however become arbitrarily small,
making the whole process inefficient.
But when real-time fetching counts, it is the better choice.
-}
hGetContentsNonBlockingN :: Int -> IO.Handle -> IO L.ByteString
hGetContentsNonBlockingN :: Int -> Handle -> IO ByteString
hGetContentsNonBlockingN Int
k Handle
h =
   let lazyRead :: IO ByteString
lazyRead = IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO IO ByteString
loop

       loop :: IO ByteString
loop = do
          ByteString
c <- Handle -> Int -> IO ByteString
S.hGetNonBlocking Handle
h Int
k
          if ByteString -> Bool
S.null ByteString
c
            then do Bool
eof <- Handle -> IO Bool
IO.hIsEOF Handle
h
                    if Bool
eof
                      then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
                      else Handle -> Int -> IO Bool
IO.hWaitForInput Handle
h (-Int
1) IO Bool -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ByteString
loop
            else (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString -> ByteString
L.append (ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
c]) IO ByteString
lazyRead
   in  IO ByteString
lazyRead

-- | Read the given number of bytes from a Handle
hGetChars :: IO.Handle -> Int -> IO String
hGetChars :: Handle -> Int -> IO String
hGetChars Handle
h Int
n = (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
L.unpack (IO ByteString -> IO String) -> IO ByteString -> IO String
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
L.hGet Handle
h Int
n