{-# LANGUAGE BangPatterns #-} module Network.Wai.Handler.Warp.IO where import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep) import Data.ByteString.Internal (ByteString(..)) import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (plusPtr, minusPtr) import Network.Wai.Handler.Warp.Buffer toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO () toBufIOWith buf !size io (Builder build) = loop firstStep where firstStep = build (buildStep finalStep) finalStep (BufRange p _) = return $ Done p () bufRange = BufRange buf (buf `plusPtr` size) runIO ptr = toBS buf (ptr `minusPtr` buf) >>= io loop step = do signal <- runBuildStep step bufRange case signal of Done ptr _ -> runIO ptr BufferFull minSize ptr next | size < minSize -> error "toBufIOWith: BufferFull: minSize" | otherwise -> do runIO ptr loop next InsertByteString ptr bs next -> do runIO ptr io bs loop next toBS :: Buffer -> Int -> IO ByteString toBS ptr siz = do fptr <- newForeignPtr_ ptr return $ PS fptr 0 siz