@@ -26,6 +26,7 @@ module Text.Libyaml
26import qualified Data.ByteString.Internal as B
26import qualified Data.ByteString.Internal as B
27import qualified Data.ByteString.Char8 as B8
27import qualified Data.ByteString.Char8 as B8
28import qualified Data.ByteString
28import qualified Data.ByteString
29+import qualified Data.ByteString.Unsafe as BU
29import Data.ByteString (ByteString, packCStringLen)
30import Data.ByteString (ByteString, packCStringLen)
30import Control.Monad
31import Control.Monad
31import Foreign.C
32import Foreign.C
@@ -376,13 +377,9 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
376 EventDocumentEnd ->
377 EventDocumentEnd ->
377 c_yaml_document_end_event_initialize er 1
378 c_yaml_document_end_event_initialize er 1
378 EventScalar bs thetag style anchor -> do
379 EventScalar bs thetag style anchor -> do
379− let (fvalue, offset, len) = B.toForeignPtr bs
380+ BU.unsafeUseAsCStringLen bs $ \(value, len) -> do
380− withForeignPtr fvalue $ \value -> do
381− let value' = value `plusPtr` offset
381+ let value' = castPtr value :: Ptr CUChar
382− len' = fromIntegral len
382+ len' = fromIntegral len :: CInt
383− value'' = if ptrToIntPtr value' == 0
384− then intPtrToPtr 1 -- c/api.c:827
386 let thetag' = tagToString thetag
383 let thetag' = tagToString thetag
387 withCString thetag' $ \tag' -> do
384 withCString thetag' $ \tag' -> do
388 let style' = toEnum $ fromEnum style
385 let style' = toEnum $ fromEnum style
@@ -394,7 +391,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
395 nullPtr -- anchor
392 nullPtr -- anchor
396 tagP -- tag
393 tagP -- tag
397− value'' -- value
394+ value' -- value
398 len' -- length
395 len' -- length
399 0 -- plain_implicit
396 0 -- plain_implicit
400 qi -- quoted_implicit
397 qi -- quoted_implicit
@@ -406,7 +403,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
407 anchorP -- anchor
404 anchorP -- anchor
408 tagP -- tag
405 tagP -- tag
409− value'' -- value
406+ value' -- value
410 len' -- length
407 len' -- length
411 0 -- plain_implicit
408 0 -- plain_implicit
412 qi -- quoted_implicit
409 qi -- quoted_implicit
@@ -470,7 +467,8 @@ decode bs i = do
470 flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $
467 flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $
471 if (res == 0)
468 if (res == 0)
472 then return $ throwErr $ Err "Yaml out of memory"
469 then return $ throwErr $ Err "Yaml out of memory"
473− else do
470+ else do -- NOTE: can't replace the following with unsafeUseAsCString
471+ -- since it must run in a MonadIO
474 let (fptr, offset, len) = B.toForeignPtr bs
472 let (fptr, offset, len) = B.toForeignPtr bs
475 withForeignPtr' fptr $ \ptr -> do
473 withForeignPtr' fptr $ \ptr -> do
476 let ptr' = castPtr ptr `plusPtr` offset
474 let ptr' = castPtr ptr `plusPtr` offset