{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.ByteString.Lazy
  ( ToLazyByteString(..)
  , resegment
  , resegmentPadded
  , rechunk
  , rechunkPadded
  , hGetContentsChunkedBy
  ) where

import Data.Word
import HaskellWorks.Data.ByteString (ToByteString (..))

import qualified Data.ByteString               as BS
import qualified Data.ByteString.Internal      as BS
import qualified Data.ByteString.Lazy          as LBS
import qualified Data.ByteString.Lazy.Internal as LBS
import qualified Data.Vector.Storable          as DVS
import qualified HaskellWorks.Data.ByteString  as BS
import qualified System.IO                     as IO
import qualified System.IO.Unsafe              as IO

class ToLazyByteString a where
  toLazyByteString :: a -> LBS.ByteString

instance ToLazyByteString LBS.ByteString where
  toLazyByteString :: ByteString -> ByteString
toLazyByteString = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString (DVS.Vector Word8) where
  toLazyByteString :: Vector Word8 -> ByteString
toLazyByteString = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Vector Word8 -> ByteString) -> Vector Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString (DVS.Vector Word16) where
  toLazyByteString :: Vector Word16 -> ByteString
toLazyByteString = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Vector Word16 -> ByteString) -> Vector Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString (DVS.Vector Word32) where
  toLazyByteString :: Vector Word32 -> ByteString
toLazyByteString = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word32 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString (DVS.Vector Word64) where
  toLazyByteString :: Vector Word64 -> ByteString
toLazyByteString = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Vector Word64 -> ByteString) -> Vector Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString [DVS.Vector Word8] where
  toLazyByteString :: [Vector Word8] -> ByteString
toLazyByteString [Vector Word8]
vs = [ByteString] -> ByteString
LBS.fromChunks (Vector Word8 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Vector Word8 -> ByteString) -> [Vector Word8] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector Word8]
vs)
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString [DVS.Vector Word16] where
  toLazyByteString :: [Vector Word16] -> ByteString
toLazyByteString [Vector Word16]
vs = [ByteString] -> ByteString
LBS.fromChunks (Vector Word16 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Vector Word16 -> ByteString) -> [Vector Word16] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector Word16]
vs)
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString [DVS.Vector Word32] where
  toLazyByteString :: [Vector Word32] -> ByteString
toLazyByteString [Vector Word32]
vs = [ByteString] -> ByteString
LBS.fromChunks (Vector Word32 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Vector Word32 -> ByteString) -> [Vector Word32] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector Word32]
vs)
  {-# INLINE toLazyByteString #-}

instance ToLazyByteString [DVS.Vector Word64] where
  toLazyByteString :: [Vector Word64] -> ByteString
toLazyByteString [Vector Word64]
vs = [ByteString] -> ByteString
LBS.fromChunks (Vector Word64 -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Vector Word64 -> ByteString) -> [Vector Word64] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector Word64]
vs)
  {-# INLINE toLazyByteString #-}

resegment :: Int -> LBS.ByteString -> LBS.ByteString
resegment :: Int -> ByteString -> ByteString
resegment Int
multiple = [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
BS.resegment Int
multiple ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks

resegmentPadded :: Int -> LBS.ByteString -> LBS.ByteString
resegmentPadded :: Int -> ByteString -> ByteString
resegmentPadded Int
multiple = [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
BS.resegmentPadded Int
multiple ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks

rechunk :: Int -> LBS.ByteString -> LBS.ByteString
rechunk :: Int -> ByteString -> ByteString
rechunk Int
multiple = [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
BS.rechunk Int
multiple ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks

rechunkPadded :: Int -> LBS.ByteString -> LBS.ByteString
rechunkPadded :: Int -> ByteString -> ByteString
rechunkPadded Int
multiple = [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
BS.rechunkPadded Int
multiple ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks

hGetContentsChunkedBy :: Int -> IO.Handle -> IO LBS.ByteString
hGetContentsChunkedBy :: Int -> Handle -> IO ByteString
hGetContentsChunkedBy Int
k Handle
h = IO ByteString
lazyRead
  where lazyRead :: IO ByteString
lazyRead = IO ByteString -> IO ByteString
forall a. IO a -> IO a
IO.unsafeInterleaveIO IO ByteString
loop
        loop :: IO ByteString
loop = do
            ByteString
c <- Int -> (Ptr Word8 -> IO Int) -> IO ByteString
BS.createAndTrim Int
k ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
IO.hGetBuf Handle
h Ptr Word8
p Int
k
            if ByteString -> Bool
BS.null ByteString
c
              then Handle -> IO ()
IO.hClose Handle
h IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LBS.Empty
              else ByteString -> ByteString -> ByteString
LBS.Chunk ByteString
c (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
lazyRead