git.iko.soy/typeable/yaml
on master help sign in
Open files through GHC intl-safe API (#90)
e2109cdPaolo G. Giarrusso
Text/Libyaml.hs+26−11
compare with master
unifiedsplit
@@ -29,6 +29,7 @@ module Text.Libyaml
29
29
30import Prelude hiding (pi)
30import Prelude hiding (pi)
31
31
32+import Data.Bits ((.|.))
32import Foreign.C
33import Foreign.C
33import Foreign.Ptr
34import Foreign.Ptr
34import Foreign.ForeignPtr
35import Foreign.ForeignPtr
@@ -36,6 +37,7 @@ import Foreign.ForeignPtr
36import Foreign.ForeignPtr.Unsafe
37import Foreign.ForeignPtr.Unsafe
37#endif
38#endif
38import Foreign.Marshal.Alloc
39import Foreign.Marshal.Alloc
40+import qualified System.Posix.Internals as Posix
39
41
40#if !MIN_VERSION_base(4,8,0)
42#if !MIN_VERSION_base(4,8,0)
41import Control.Applicative
43import Control.Applicative
@@ -147,11 +149,10 @@ foreign import ccall unsafe "yaml_parser_set_input_file"
147data FileStruct
149data FileStruct
148type File = Ptr FileStruct
150type File = Ptr FileStruct
149
151
150−foreign import ccall unsafe "fopen"
152+foreign import ccall unsafe "fdopen"
151− c_fopen :: Ptr CChar
153+ c_fdopen :: CInt
152− -> Ptr CChar
154+ -> Ptr CChar
153− -> IO File
155+ -> IO File
154−
155foreign import ccall unsafe "fclose"
156foreign import ccall unsafe "fclose"
156 c_fclose :: File
157 c_fclose :: File
157 -> IO ()
158 -> IO ()
@@ -503,6 +504,24 @@ decode bs =
503 c_yaml_parser_delete ptr
504 c_yaml_parser_delete ptr
504 free ptr
505 free ptr
505
506
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+
506decodeFile :: MonadResource m => FilePath
525decodeFile :: MonadResource m => FilePath
507#if MIN_VERSION_conduit(1, 0, 0)
526#if MIN_VERSION_conduit(1, 0, 0)
508 -> Producer m Event
527 -> Producer m Event
@@ -521,9 +540,7 @@ decodeFile file =
521 free ptr
540 free ptr
522 throwIO $ YamlException "Yaml out of memory"
541 throwIO $ YamlException "Yaml out of memory"
523 else do
542 else do
524− file' <- liftIO
543+ file' <- openFile file read_flags "r"
525− $ withCString file $ \file' -> withCString "r" $ \r' ->
526− c_fopen file' r'
527 if file' == nullPtr
544 if file' == nullPtr
528 then do
545 then do
529 c_fclose_helper file'
546 c_fclose_helper file'
@@ -599,9 +616,7 @@ encodeFile filePath =
599 bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)
616 bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)
600 where
617 where
601 getFile = do
618 getFile = do
602− file <- withCString filePath $
619+ file <- openFile filePath write_flags "w"
603− \filePath' -> withCString "w" $
604− \w' -> c_fopen filePath' w'
605 if file == nullPtr
620 if file == nullPtr
606 then throwIO $ YamlException $ "could not open file for write: " ++ filePath
621 then throwIO $ YamlException $ "could not open file for write: " ++ filePath
607 else return file
622 else return file