git.iko.soy/typeable/yaml
on master help sign in
Replaced some error calls with Attempt
278ba7dMichael Snoyman
Text/Libyaml.hs+35−25
compare with master
unifiedsplit
@@ -20,6 +20,9 @@ import Foreign.Ptr
20import Foreign.ForeignPtr
20import Foreign.ForeignPtr
21import Foreign.Marshal.Alloc
21import Foreign.Marshal.Alloc
22
22
23+import Data.Attempt
24+import Control.Monad.Attempt.Class
25+
23data ParserStruct
26data ParserStruct
24type Parser = Ptr ParserStruct
27type Parser = Ptr ParserStruct
25parserSize :: Int
28parserSize :: Int
@@ -70,13 +73,13 @@ foreign import ccall unsafe "yaml_event_delete"
70foreign import ccall "print_parser_error"
73foreign import ccall "print_parser_error"
71 c_print_parser_error :: Parser -> IO ()
74 c_print_parser_error :: Parser -> IO ()
72
75
73−-- FIXME more grace error handling
74−parserParseOne :: Parser -> IO Event
76+parserParseOne :: Parser -> IO (Attempt Event)
75parserParseOne parser = withEventRaw $ \er -> do
77parserParseOne parser = withEventRaw $ \er -> do
76 res <- c_yaml_parser_parse parser er
78 res <- c_yaml_parser_parse parser er
79+ event <-
77− when (res == 0) $
80+ if res == 0
78− c_print_parser_error parser >> fail "yaml_parser_parse failed"
81+ then c_print_parser_error parser >> return (failureString "yaml_parser_parse failed") -- FIXME get the actual error message
79− event <- getEvent er
82+ else return `fmap` getEvent er
80 c_yaml_event_delete er
83 c_yaml_event_delete er
81 return event
84 return event
82
85
@@ -139,14 +142,19 @@ getEvent er = do
139 YamlMappingStartEvent -> return EventMappingStart
142 YamlMappingStartEvent -> return EventMappingStart
140 YamlMappingEndEvent -> return EventMappingEnd
143 YamlMappingEndEvent -> return EventMappingEnd
141
144
142−parserParse :: Parser -> IO [Event]
145+parserParse :: Parser -> IO (Attempt [Event])
143parserParse parser = do
146parserParse parser = do
144− event <- parserParseOne parser
147+ event' <- parserParseOne parser
145− case event of
148+ case event' of
149+ Failure e -> return $ Failure e
150+ Success event ->
151+ case event of
146− EventStreamEnd -> return [event]
152+ EventStreamEnd -> return $ Success [event]
147− _ -> do
153+ _ -> do
148− rest <- parserParse parser
154+ rest <- parserParse parser
155+ case rest of
156+ Failure e -> return $ Failure e
149− return $! event : rest
157+ Success rest' -> return $ Success $ event : rest'
150
158
151-- Emitter
159-- Emitter
152
160
@@ -175,20 +183,23 @@ foreign import ccall unsafe "get_buffer_buff"
175foreign import ccall unsafe "get_buffer_used"
183foreign import ccall unsafe "get_buffer_used"
176 c_get_buffer_used :: Buffer -> IO CULong
184 c_get_buffer_used :: Buffer -> IO CULong
177
185
178−withBuffer :: (Buffer -> IO ()) -> IO B.ByteString
186+withBuffer :: (Buffer -> IO (Attempt ())) -> IO (Attempt B.ByteString)
179withBuffer f = do
187withBuffer f = do
180 allocaBytes bufferSize $ \b -> do
188 allocaBytes bufferSize $ \b -> do
181 c_buffer_init b
189 c_buffer_init b
182− f b
190+ aRes <- f b
191+ case aRes of
192+ Failure e -> return $ Failure e
193+ Success () -> do
183− ptr' <- c_get_buffer_buff b
194+ ptr' <- c_get_buffer_buff b
184− len <- c_get_buffer_used b
195+ len <- c_get_buffer_used b
185− fptr <- newForeignPtr_ $ castPtr ptr'
196+ fptr <- newForeignPtr_ $ castPtr ptr'
186− return $! B.fromForeignPtr fptr 0 $ fromIntegral len
197+ return $ Success $ B.fromForeignPtr fptr 0 $ fromIntegral len
187
198
188foreign import ccall unsafe "my_emitter_set_output"
199foreign import ccall unsafe "my_emitter_set_output"
189 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
200 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
190
201
191−withEmitter :: (Emitter -> IO ()) -> IO B.ByteString
202+withEmitter :: (Emitter -> IO (Attempt ())) -> IO (Attempt B.ByteString)
192withEmitter f = do
203withEmitter f = do
193 allocaBytes emitterSize $ \e -> do
204 allocaBytes emitterSize $ \e -> do
194 _res <- c_yaml_emitter_initialize e
205 _res <- c_yaml_emitter_initialize e
@@ -205,14 +216,13 @@ foreign import ccall unsafe "yaml_emitter_emit"
205foreign import ccall unsafe "print_emitter_error"
216foreign import ccall unsafe "print_emitter_error"
206 c_print_emitter_error :: Emitter -> IO ()
217 c_print_emitter_error :: Emitter -> IO ()
207
218
208−-- FIXME more graceful error handling
209−emitEvents :: Emitter -> [Event] -> IO ()
219+emitEvents :: Emitter -> [Event] -> IO (Attempt ())
210−emitEvents _ [] = return ()
220+emitEvents _ [] = return $ Success ()
211emitEvents emitter (e:rest) = do
221emitEvents emitter (e:rest) = do
212 res <- toEventRaw e $ c_yaml_emitter_emit emitter
222 res <- toEventRaw e $ c_yaml_emitter_emit emitter
213− when (res == 0) $
223+ if res == 0
214− c_print_emitter_error emitter >> fail "yaml_emitter_emit failed"
224+ then c_print_emitter_error emitter >> return (failureString "yaml_emitter_emit failed") -- FIXME get the actual error message
215− emitEvents emitter rest
225+ else emitEvents emitter rest
216
226
217foreign import ccall unsafe "yaml_stream_start_event_initialize"
227foreign import ccall unsafe "yaml_stream_start_event_initialize"
218 c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt
228 c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt
Text/Yaml.hs+4−5
@@ -34,6 +34,7 @@ import System.IO.Unsafe
34import Control.Arrow (first, (***))
34import Control.Arrow (first, (***))
35import Control.Monad (replicateM)
35import Control.Monad (replicateM)
36import Data.Attempt
36import Data.Attempt
37+import qualified Data.Attempt.Helper as A
37import Control.Monad.Trans
38import Control.Monad.Trans
38import Control.Monad.Attempt
39import Control.Monad.Attempt
39import Control.Monad.Attempt.Class
40import Control.Monad.Attempt.Class
@@ -53,7 +54,7 @@ decode :: (StrictByteString bs, FromObject o Raw Raw, MonadAttempt m)
53decode bs = unsafePerformIO $ do
54decode bs = unsafePerformIO $ do
54 a <- runAttemptT $ decode' bs -- FIXME
55 a <- runAttemptT $ decode' bs -- FIXME
55 case a of
56 case a of
56− Success s -> return $ success s
57+ Success s -> return $ return s
57 Failure e -> return $ failure e
58 Failure e -> return $ failure e
58
59
59encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
60encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
@@ -68,7 +69,7 @@ encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
68encode' o =
69encode' o =
69 let events = objectToEvents $ toObject o
70 let events = objectToEvents $ toObject o
70 result = withEmitter $ flip emitEvents $ events
71 result = withEmitter $ flip emitEvents $ events
71− in fromStrictByteString `fmap` result
72+ in fromStrictByteString `fmap` A.join result
72
73
73decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
74decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
74 MonadAttempt m)
75 MonadAttempt m)
@@ -76,9 +77,7 @@ decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
76 -> m o
77 -> m o
77decode' bs = do
78decode' bs = do
78 events <- liftIO $ withParser (toStrictByteString bs) parserParse
79 events <- liftIO $ withParser (toStrictByteString bs) parserParse
79− case fromObject $ eventsToRawObject events of -- FIXME something better in attempt
80+ attempt failure (fromObject . eventsToRawObject) events
80− Failure e -> failure e
81− Success s -> success s
82
81
83objectToEvents :: RawObject -> [Event]
82objectToEvents :: RawObject -> [Event]
84objectToEvents y = concat
83objectToEvents y = concat