git.iko.soy/typeable/yaml
on master help sign in
Recent attempt changes
88482b5Michael Snoyman
Text/Libyaml.hs+4−7
compare with master
unifiedsplit
@@ -46,8 +46,7 @@ foreign import ccall unsafe "yaml_parser_set_input_string"
46 -> IO ()
46 -> IO ()
47
47
48withParser :: B.ByteString -> (Parser -> IO a) -> IO a
48withParser :: B.ByteString -> (Parser -> IO a) -> IO a
49−withParser bs f = do
50− allocaBytes parserSize $ \p ->
49+withParser bs f = allocaBytes parserSize $ \p ->
51 do
50 do
52 _res <- c_yaml_parser_initialize p
51 _res <- c_yaml_parser_initialize p
53 -- FIXME check res
52 -- FIXME check res
@@ -62,7 +61,7 @@ withParser bs f = do
62 return ret
61 return ret
63
62
64withEventRaw :: (EventRaw -> IO a) -> IO a
63withEventRaw :: (EventRaw -> IO a) -> IO a
65−withEventRaw f = allocaBytes eventSize $ f
64+withEventRaw = allocaBytes eventSize
66
65
67foreign import ccall unsafe "yaml_parser_parse"
66foreign import ccall unsafe "yaml_parser_parse"
68 c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt
67 c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt
@@ -184,8 +183,7 @@ foreign import ccall unsafe "get_buffer_used"
184 c_get_buffer_used :: Buffer -> IO CULong
183 c_get_buffer_used :: Buffer -> IO CULong
185
184
186withBuffer :: (Buffer -> IO (Attempt ())) -> IO (Attempt B.ByteString)
185withBuffer :: (Buffer -> IO (Attempt ())) -> IO (Attempt B.ByteString)
187−withBuffer f = do
188− allocaBytes bufferSize $ \b -> do
186+withBuffer f = allocaBytes bufferSize $ \b -> do
189 c_buffer_init b
187 c_buffer_init b
190 aRes <- f b
188 aRes <- f b
191 case aRes of
189 case aRes of
@@ -200,8 +198,7 @@ foreign import ccall unsafe "my_emitter_set_output"
200 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
198 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
201
199
202withEmitter :: (Emitter -> IO (Attempt ())) -> IO (Attempt B.ByteString)
200withEmitter :: (Emitter -> IO (Attempt ())) -> IO (Attempt B.ByteString)
203−withEmitter f = do
204− allocaBytes emitterSize $ \e -> do
201+withEmitter f = allocaBytes emitterSize $ \e -> do
205 _res <- c_yaml_emitter_initialize e
202 _res <- c_yaml_emitter_initialize e
206 -- FIXME check res
203 -- FIXME check res
207 bs <- withBuffer $ \b -> do
204 bs <- withBuffer $ \b -> do
Text/Yaml.hs+8−5
@@ -32,8 +32,7 @@ import Data.Object
32import Data.Object.Raw
32import Data.Object.Raw
33import System.IO.Unsafe
33import System.IO.Unsafe
34import Control.Arrow (first, (***))
34import Control.Arrow (first, (***))
35−import Control.Monad (replicateM)
35+import Control.Monad (replicateM, liftM)
36−import Data.Attempt
37import qualified Data.Attempt.Helper as A
36import qualified Data.Attempt.Helper as A
38import Control.Monad.Trans
37import Control.Monad.Trans
39import Control.Monad.Attempt
38import Control.Monad.Attempt
@@ -68,7 +67,7 @@ decodeFile path = liftIO (B.readFile path) >>= decode'
68encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
67encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
69encode' o =
68encode' o =
70 let events = objectToEvents $ toObject o
69 let events = objectToEvents $ toObject o
71− result = withEmitter $ flip emitEvents $ events
70+ result = withEmitter $ flip emitEvents events
72 in fromStrictByteString `fmap` A.join result
71 in fromStrictByteString `fmap` A.join result
73
72
74decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
73decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
@@ -77,7 +76,11 @@ decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
77 -> m o
76 -> m o
78decode' bs = do
77decode' bs = do
79 events <- liftIO $ withParser (toStrictByteString bs) parserParse
78 events <- liftIO $ withParser (toStrictByteString bs) parserParse
80− attempt failure (fromObject . eventsToRawObject) events
79+ attempt failure (myFA . fromObject . eventsToRawObject) events
80+ where
81+ myFA :: MonadAttempt m => Attempt v -> m v
82+ myFA (Success v) = return v
83+ myFA (Failure e) = failure e
81
84
82objectToEvents :: RawObject -> [Event]
85objectToEvents :: RawObject -> [Event]
83objectToEvents y = concat
86objectToEvents y = concat
@@ -132,7 +135,7 @@ newtype MyString = MyString String
132instance ToScalar MyString Raw where
135instance ToScalar MyString Raw where
133 toScalar (MyString s) = toScalar s
136 toScalar (MyString s) = toScalar s
134instance FromScalar MyString Raw where
137instance FromScalar MyString Raw where
135− fromScalar raw = MyString `fmap` fromScalar raw
138+ fromScalar raw = MyString `liftM` fromScalar raw
136
139
137propEncodeDecode :: Object MyString MyString -> Bool
140propEncodeDecode :: Object MyString MyString -> Bool
138propEncodeDecode o = fromAttempt (decode (encode o :: B.ByteString))
141propEncodeDecode o = fromAttempt (decode (encode o :: B.ByteString))