{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |

--

-- Pour handles into folds,

-- write to handles using folds. 

module Control.Foldl.Transduce.ByteString (
        -- * Reading from handles

        drainHandle
    ,   ChunkSize
    ,   chunkSize
    ,   chunkSizeDefault
        -- * Writing to handles

    ,   toHandle
    ,   toHandleBuilder  
    ) where

import qualified Control.Foldl as L
import Control.Foldl.Transduce 
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import Control.Monad.IO.Class
import System.IO
import Data.ByteString.Lazy.Internal (defaultChunkSize)

{-| Feed a fold with bytes read from a 'Handle'.

-}
drainHandle 
    :: (MonadIO m,ToFoldM m f) 
    => f B.ByteString r 
    -> ChunkSize 
    -> Handle 
    -> m r 
drainHandle :: f ByteString r -> ChunkSize -> Handle -> m r
drainHandle f ByteString r
f (ChunkSize Int
csize) Handle
h = f ByteString r -> Int -> Handle -> m r
forall (m :: * -> *) (f :: * -> * -> *) r.
(MonadIO m, ToFoldM m f) =>
f ByteString r -> Int -> Handle -> m r
driveHandle f ByteString r
f Int
csize Handle
h

{-| Maximum chunk size		

-}
newtype ChunkSize = ChunkSize Int deriving (Int -> ChunkSize -> ShowS
[ChunkSize] -> ShowS
ChunkSize -> String
(Int -> ChunkSize -> ShowS)
-> (ChunkSize -> String)
-> ([ChunkSize] -> ShowS)
-> Show ChunkSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkSize] -> ShowS
$cshowList :: [ChunkSize] -> ShowS
show :: ChunkSize -> String
$cshow :: ChunkSize -> String
showsPrec :: Int -> ChunkSize -> ShowS
$cshowsPrec :: Int -> ChunkSize -> ShowS
Show,ChunkSize -> ChunkSize -> Bool
(ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool) -> Eq ChunkSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChunkSize -> ChunkSize -> Bool
$c/= :: ChunkSize -> ChunkSize -> Bool
== :: ChunkSize -> ChunkSize -> Bool
$c== :: ChunkSize -> ChunkSize -> Bool
Eq,Eq ChunkSize
Eq ChunkSize
-> (ChunkSize -> ChunkSize -> Ordering)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> Ord ChunkSize
ChunkSize -> ChunkSize -> Bool
ChunkSize -> ChunkSize -> Ordering
ChunkSize -> ChunkSize -> ChunkSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChunkSize -> ChunkSize -> ChunkSize
$cmin :: ChunkSize -> ChunkSize -> ChunkSize
max :: ChunkSize -> ChunkSize -> ChunkSize
$cmax :: ChunkSize -> ChunkSize -> ChunkSize
>= :: ChunkSize -> ChunkSize -> Bool
$c>= :: ChunkSize -> ChunkSize -> Bool
> :: ChunkSize -> ChunkSize -> Bool
$c> :: ChunkSize -> ChunkSize -> Bool
<= :: ChunkSize -> ChunkSize -> Bool
$c<= :: ChunkSize -> ChunkSize -> Bool
< :: ChunkSize -> ChunkSize -> Bool
$c< :: ChunkSize -> ChunkSize -> Bool
compare :: ChunkSize -> ChunkSize -> Ordering
$ccompare :: ChunkSize -> ChunkSize -> Ordering
$cp1Ord :: Eq ChunkSize
Ord,Integer -> ChunkSize
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> ChunkSize
(ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (Integer -> ChunkSize)
-> Num ChunkSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ChunkSize
$cfromInteger :: Integer -> ChunkSize
signum :: ChunkSize -> ChunkSize
$csignum :: ChunkSize -> ChunkSize
abs :: ChunkSize -> ChunkSize
$cabs :: ChunkSize -> ChunkSize
negate :: ChunkSize -> ChunkSize
$cnegate :: ChunkSize -> ChunkSize
* :: ChunkSize -> ChunkSize -> ChunkSize
$c* :: ChunkSize -> ChunkSize -> ChunkSize
- :: ChunkSize -> ChunkSize -> ChunkSize
$c- :: ChunkSize -> ChunkSize -> ChunkSize
+ :: ChunkSize -> ChunkSize -> ChunkSize
$c+ :: ChunkSize -> ChunkSize -> ChunkSize
Num)

chunkSize :: Int -> ChunkSize
chunkSize :: Int -> ChunkSize
chunkSize = Int -> ChunkSize
ChunkSize

chunkSizeDefault :: ChunkSize
chunkSizeDefault :: ChunkSize
chunkSizeDefault = Int -> ChunkSize
chunkSize Int
defaultChunkSize

driveHandle :: (MonadIO m,ToFoldM m f) 
            => f B.ByteString r 
            -> Int -- ^ max chunk size

            -> Handle 
            -> m r 
driveHandle :: f ByteString r -> Int -> Handle -> m r
driveHandle (f ByteString r -> FoldM m ByteString r
forall (m :: * -> *) (t :: * -> * -> *) i r.
ToFoldM m t =>
t i r -> FoldM m i r
toFoldM -> FoldM m ByteString r
f) Int
chunkSize Handle
handle = 
    (forall x.
 (x -> ByteString -> m x)
 -> m x -> (x -> m r) -> (IO ByteString, IO Bool) -> m r)
-> FoldM m ByteString r -> (IO ByteString, IO Bool) -> m r
forall a (m :: * -> *) b r.
(forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b -> r
L.impurely forall x.
(x -> ByteString -> m x)
-> m x -> (x -> m r) -> (IO ByteString, IO Bool) -> m r
forall (m :: * -> *) a t b.
MonadIO m =>
(a -> t -> m a) -> m a -> (a -> m b) -> (IO t, IO Bool) -> m b
consumeFunc FoldM m ByteString r
f (Handle -> Int -> IO ByteString
B.hGetSome Handle
handle Int
chunkSize,Handle -> IO Bool
hIsEOF Handle
handle)
    where
        -- adapted from foldM in Pipes.Prelude

        consumeFunc :: (a -> t -> m a) -> m a -> (a -> m b) -> (IO t, IO Bool) -> m b
consumeFunc a -> t -> m a
step m a
begin a -> m b
done (IO t
readChunk,IO Bool
checkEOF) = do
            a
x0 <- m a
begin
            a -> m b
loop a
x0
              where
                loop :: a -> m b
loop a
x = do
                    Bool
atEOF <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
checkEOF
                    if Bool
atEOF 
                       then a -> m b
done a
x 
                       else do
                           t
chunk <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO t
readChunk
                           a
x' <- a -> t -> m a
step a
x t
chunk
                           a -> m b
loop (a -> m b) -> a -> m b
forall a b. (a -> b) -> a -> b
$! a
x'


toHandle :: (MonadIO m) => Handle -> L.FoldM m B.ByteString ()
toHandle :: Handle -> FoldM m ByteString ()
toHandle Handle
handle = 
    (() -> ByteString -> m ())
-> m () -> (() -> m ()) -> FoldM m ByteString ()
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
L.FoldM 
    (\()
_ ByteString
b -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
B.hPut Handle
handle ByteString
b))  
    (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) 
    (\()
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())


toHandleBuilder :: (MonadIO m) => Handle -> L.FoldM m B.Builder ()
toHandleBuilder :: Handle -> FoldM m Builder ()
toHandleBuilder Handle
handle = 
    (() -> Builder -> m ())
-> m () -> (() -> m ()) -> FoldM m Builder ()
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
L.FoldM
    (\()
_ Builder
b -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Builder -> IO ()
B.hPutBuilder Handle
handle Builder
b)) 
    (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) 
    (\()
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())