@@ -29,6 +29,7 @@ module Text.Libyaml
2929
3030import Prelude hiding (pi)
3131
32+import Data.Bits ((.|.))
3233import Foreign.C
3334import Foreign.Ptr
3435import Foreign.ForeignPtr
@@ -36,6 +37,7 @@ import Foreign.ForeignPtr
3637import Foreign.ForeignPtr.Unsafe
3738#endif
3839import Foreign.Marshal.Alloc
40+import qualified System.Posix.Internals as Posix
3941
4042#if !MIN_VERSION_base(4,8,0)
4143import Control.Applicative
@@ -147,11 +149,10 @@ foreign import ccall unsafe "yaml_parser_set_input_file"
147149data FileStruct
148150type File = Ptr FileStruct
149151
150−foreign import ccall unsafe "fopen"
151− c_fopen :: Ptr CChar
152− -> Ptr CChar
153− -> IO File
154−
152+foreign import ccall unsafe "fdopen"
153+ c_fdopen :: CInt
154+ -> Ptr CChar
155+ -> IO File
155156foreign import ccall unsafe "fclose"
156157 c_fclose :: File
157158 -> IO ()
@@ -503,6 +504,24 @@ decode bs =
503504 c_yaml_parser_delete ptr
504505 free ptr
505506
507+-- XXX copied from GHC.IO.FD
508+std_flags, read_flags, output_flags, write_flags :: CInt
509+std_flags = Posix.o_NOCTTY
510+output_flags = std_flags .|. Posix.o_CREAT
511+read_flags = std_flags .|. Posix.o_RDONLY
512+write_flags = output_flags .|. Posix.o_WRONLY
513+
514+-- | Open a C FILE* from a file path, using internal GHC API to work correctly
515+-- on all platforms, even on non-ASCII filenames. The opening mode must be
516+-- indicated via both 'rawOpenFlags' and 'openMode'.
517+openFile :: FilePath -> CInt -> String -> IO File
518+openFile file rawOpenFlags openMode = do
519+ fd <- liftIO $ Posix.withFilePath file $ \file' ->
520+ Posix.c_open file' rawOpenFlags 0o666
521+ if fd /= (-1)
522+ then withCString openMode $ \openMode' -> c_fdopen fd openMode'
523+ else return nullPtr
524+
506525decodeFile :: MonadResource m => FilePath
507526#if MIN_VERSION_conduit(1, 0, 0)
508527 -> Producer m Event
@@ -521,12 +540,9 @@ decodeFile file =
521540 free ptr
522541 throwIO $ YamlException "Yaml out of memory"
523542 else do
524− file' <- liftIO
525− $ withCString file $ \file' -> withCString "r" $ \r' ->
526− c_fopen file' r'
543+ file' <- openFile file read_flags "r"
527544 if file' == nullPtr
528545 then do
529− c_fclose_helper file'
530546 c_yaml_parser_delete ptr
531547 free ptr
532548 throwIO $ YamlException
@@ -599,9 +615,7 @@ encodeFile filePath =
599615 bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)
600616 where
601617 getFile = do
602− file <- withCString filePath $
603− \filePath' -> withCString "w" $
604− \w' -> c_fopen filePath' w'
618+ file <- openFile filePath write_flags "w"
605619 if file == nullPtr
606620 then throwIO $ YamlException $ "could not open file for write: " ++ filePath
607621 else return file