@@ -26,6 +26,7 @@ module Text.Libyaml
2626import qualified Data.ByteString.Internal as B
2727import qualified Data.ByteString.Char8 as B8
2828import qualified Data.ByteString
29+import qualified Data.ByteString.Unsafe as BU
2930import Data.ByteString (ByteString, packCStringLen)
3031import Control.Monad
3132import Foreign.C
@@ -376,13 +377,9 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
376377 EventDocumentEnd ->
377378 c_yaml_document_end_event_initialize er 1
378379 EventScalar bs thetag style anchor -> do
379− let (fvalue, offset, len) = B.toForeignPtr bs
380− withForeignPtr fvalue $ \value -> do
381− let value' = value `plusPtr` offset
382− len' = fromIntegral len
383− value'' = if ptrToIntPtr value' == 0
384− then intPtrToPtr 1 -- c/api.c:827
385− else value'
380+ BU.unsafeUseAsCStringLen bs $ \(value, len) -> do
381+ let value' = castPtr value :: Ptr CUChar
382+ len' = fromIntegral len :: CInt
386383 let thetag' = tagToString thetag
387384 withCString thetag' $ \tag' -> do
388385 let style' = toEnum $ fromEnum style
@@ -394,7 +391,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
394391 er
395392 nullPtr -- anchor
396393 tagP -- tag
397− value'' -- value
394+ value' -- value
398395 len' -- length
399396 0 -- plain_implicit
400397 qi -- quoted_implicit
@@ -406,7 +403,7 @@ toEventRaw e f = allocaBytes eventSize $ \er -> do
406403 er
407404 anchorP -- anchor
408405 tagP -- tag
409− value'' -- value
406+ value' -- value
410407 len' -- length
411408 0 -- plain_implicit
412409 qi -- quoted_implicit
@@ -470,7 +467,8 @@ decode bs i = do
470467 flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $
471468 if (res == 0)
472469 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
474472 let (fptr, offset, len) = B.toForeignPtr bs
475473 withForeignPtr' fptr $ \ptr -> do
476474 let ptr' = castPtr ptr `plusPtr` offset