{-# LANGUAGE BangPatterns, CPP #-}
module System.Log.FastLogger.IO where
#if MIN_VERSION_bytestring(0,10,2)
import Data.ByteString.Builder.Extra (Next(..))
import qualified Data.ByteString.Builder.Extra as BBE
#else
import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep)
import Foreign.Ptr (minusPtr)
#endif
import Data.ByteString.Internal (ByteString(..))
import Data.Word (Word8)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (mallocBytes, free)
import Foreign.Ptr (Ptr, plusPtr)
import System.Log.FastLogger.LogStr
type Buffer = Ptr Word8
type BufSize = Int
defaultBufSize :: BufSize
defaultBufSize = 4096
getBuffer :: BufSize -> IO Buffer
getBuffer = mallocBytes
freeBuffer :: Buffer -> IO ()
freeBuffer = free
#if MIN_VERSION_bytestring(0,10,2)
toBufIOWith :: Buffer -> BufSize -> (Buffer -> Int -> IO ()) -> Builder -> IO ()
toBufIOWith buf !size io builder = loop $ BBE.runBuilder builder
where
loop writer = do
(len, next) <- writer buf size
io buf len
case next of
Done -> return ()
More minSize writer'
| size < minSize -> error "toBufIOWith: More: minSize"
| otherwise -> loop writer'
Chunk (PS fptr off siz) writer'
| len == 0 -> loop writer'
| otherwise -> withForeignPtr fptr $ \ptr -> io (ptr `plusPtr` off) siz
#else
toBufIOWith :: Buffer -> BufSize -> (Buffer -> Int -> 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)
loop step = do
signal <- runBuildStep step bufRange
case signal of
Done ptr _ -> io buf (ptr `minusPtr` buf)
BufferFull minSize ptr next
| size < minSize -> error "toBufIOWith: BufferFull: minSize"
| otherwise -> do
io buf (ptr `minusPtr` buf)
loop next
InsertByteString ptr (PS fptr off siz) next -> do
io buf (ptr `minusPtr` buf)
withForeignPtr fptr $ \p -> io (p `plusPtr` off) siz
loop next
#endif