git.iko.soy/typeable/yaml
on master help sign in
Removed unnecessary code
c4a490cMichael Snoyman
Text/Libyaml.hs+19−132
compare with master
unifiedsplit
@@ -16,25 +16,7 @@ module Text.Libyaml
16 , Tag (..)
16 , Tag (..)
17 , AnchorName
17 , AnchorName
18 , Anchor
18 , Anchor
19− -- * Exceptions
19+ -- * Encoding and decoding
20− , YamlException (..)
21− -- * Enumerator
22− , With (..)
23− -- * Encoder
24− , YamlEncoder
25− , YamlDecoder
26− , Parser
27− , parseEvent
28− , parserParseOne
29− , emitEvent
30− -- ** Combinators
31− , emitStream
32− , emitDocument
33− , emitSequence
34− , emitSequenceWithAnchor
35− , emitMapping
36− , emitMappingWithAnchor
37− -- * Higher level functions
38 , encode
20 , encode
39 , decode
21 , decode
40 , encodeFile
22 , encodeFile
@@ -50,16 +32,14 @@ import Foreign.C
50import Foreign.Ptr
32import Foreign.Ptr
51import Foreign.ForeignPtr
33import Foreign.ForeignPtr
52import Foreign.Marshal.Alloc
34import Foreign.Marshal.Alloc
35+
53#if MIN_VERSION_transformers(0,2,0)
36#if MIN_VERSION_transformers(0,2,0)
54import "transformers" Control.Monad.IO.Class
37import "transformers" Control.Monad.IO.Class
55#else
38#else
56import "transformers" Control.Monad.Trans
39import "transformers" Control.Monad.Trans
57#endif
40#endif
58−import Control.Monad.Failure.Transformers
59−import qualified Control.Monad.Trans.Error as ErrorT
60−import Control.Monad.Trans.Reader
61
41
62−import Control.Exception (throwIO, Exception, SomeException)
42+import Control.Exception (throwIO, Exception)
63import Data.Typeable (Typeable)
43import Data.Typeable (Typeable)
64import Data.Iteratee
44import Data.Iteratee
65import qualified Data.Iteratee.Base.StreamChunk as SC
45import qualified Data.Iteratee.Base.StreamChunk as SC
@@ -131,30 +111,6 @@ stringToTag "tag:yaml.org,2002:map" = MapTag
131stringToTag "" = NoTag
111stringToTag "" = NoTag
132stringToTag s = UriTag s
112stringToTag s = UriTag s
133
113
134−data YamlException =
135− YamlParserException
136− { parserProblem :: String
137− , parserContext :: String
138− , parserOffset :: Int
139− }
140− | YamlEmitterException
141− { emitterEvent :: Event
142− , emitterProblem :: String
143− }
144− | YamlOutOfMemory
145− | YamlInvalidEventStreamBeginning [Event]
146− | YamlInvalidEventStreamEnd [Event]
147− | YamlPrematureEventStreamEnd
148− | YamlNonScalarKey
149− | YamlInvalidStartingEvent Event
150− | YamlFileNotFound FilePath
151− | YamlOtherException SomeException
152− | YamlStringException String
153− deriving (Show, Typeable)
154−instance Exception YamlException
155−instance ErrorT.Error YamlException where
156− strMsg = YamlStringException
157−
158data ParserStruct
114data ParserStruct
159type Parser = Ptr ParserStruct
115type Parser = Ptr ParserStruct
160parserSize :: Int
116parserSize :: Int
@@ -194,24 +150,6 @@ foreign import ccall unsafe "fclose"
194 c_fclose :: File
150 c_fclose :: File
195 -> IO ()
151 -> IO ()
196
152
197−class MonadIO m => With m where
198− with :: (forall b'. (a -> IO b') -> IO b') -> (a -> m b) -> m b
199−
200−instance With IO where
201− with = id
202−instance With m => With (ReaderT r m) where
203− with orig f = ReaderT $ \r -> do
204− let f' a = (runReaderT $ f a) r
205− with orig f'
206−instance (ErrorT.Error e, With m) => With (ErrorT.ErrorT e m) where
207− with orig f = ErrorT.ErrorT $ with orig $ ErrorT.runErrorT . f
208−
209−allocaBytesR :: With m => Int -> (Ptr a -> m b) -> m b
210−allocaBytesR i = with (allocaBytes i)
211−
212−withCStringR :: With m => String -> (Ptr CChar -> m a) -> m a
213−withCStringR s = with (withCString s)
214−
215withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
153withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
216withForeignPtr' fp f = do
154withForeignPtr' fp f = do
217 r <- f $ unsafeForeignPtrToPtr fp
155 r <- f $ unsafeForeignPtrToPtr fp
@@ -240,23 +178,6 @@ makeString f a = do
240 then return ""
178 then return ""
241 else liftIO $ peekCString cchar
179 else liftIO $ peekCString cchar
242
180
243−parserParseOne :: (MonadFailure YamlException m, With m)
244− => Parser
245− -> m (Maybe Event)
246−parserParseOne parser = allocaBytesR eventSize $ \er -> do
247− res <- liftIO $ c_yaml_parser_parse parser er
248− event <-
249− if res == 0
250− then do
251− problem <- liftIO $ makeString c_get_parser_error_problem parser
252− context <- liftIO $ makeString c_get_parser_error_context parser
253− offset <- liftIO $ fromIntegral `fmap`
254− c_get_parser_error_offset parser
255− failure $ YamlParserException problem context offset
256− else liftIO $ getEvent er
257− liftIO $ c_yaml_event_delete er -- FIXME use finally
258− return event
259−
260data EventType = YamlNoEvent
181data EventType = YamlNoEvent
261 | YamlStreamStartEvent
182 | YamlStreamStartEvent
262 | YamlStreamEndEvent
183 | YamlStreamEndEvent
@@ -389,47 +310,6 @@ foreign import ccall unsafe "yaml_emitter_set_output_file"
389foreign import ccall unsafe "yaml_emitter_emit"
310foreign import ccall unsafe "yaml_emitter_emit"
390 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
311 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
391
312
392−foreign import ccall unsafe "get_emitter_error"
393− c_get_emitter_error :: Emitter -> IO (Ptr CUChar)
394−
395−emitEvent :: (MonadIO m, MonadFailure YamlException m)
396− => Event
397− -> YamlEncoder m ()
398−emitEvent e = do
399− emitter <- ask
400− res <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter
401− when (res == 0) $ do
402− problem <- liftIO $ makeString c_get_emitter_error emitter
403− failure $ YamlEmitterException e problem
404−
405−emitStream, emitDocument, emitSequence, emitMapping
406− :: (MonadIO m, MonadFailure YamlException m)
407− => YamlEncoder m ()
408− -> YamlEncoder m ()
409−emitStream e = emitEvent EventStreamStart >> e >> emitEvent EventStreamEnd
410−emitDocument e = emitEvent EventDocumentStart >> e
411− >> emitEvent EventDocumentEnd
412−emitSequence e = emitSequenceWithAnchor e Nothing
413−emitMapping e = emitMappingWithAnchor e Nothing
414−
415−emitSequenceWithAnchor, emitMappingWithAnchor
416− :: (MonadIO m, MonadFailure YamlException m)
417− => YamlEncoder m ()
418− -> Anchor
419− -> YamlEncoder m ()
420−emitSequenceWithAnchor e a = emitEvent (EventSequenceStart a) >> e
421− >> emitEvent EventSequenceEnd
422−emitMappingWithAnchor e a = emitEvent (EventMappingStart a) >> e
423− >> emitEvent EventMappingEnd
424−
425−
426−parseEvent :: (With m, MonadFailure YamlException m)
427− => YamlDecoder m (Maybe Event)
428−parseEvent = ask >>= parserParseOne
429−
430−type YamlDecoder = ReaderT Parser
431−type YamlEncoder = ReaderT Emitter
432−
433foreign import ccall unsafe "yaml_stream_start_event_initialize"
313foreign import ccall unsafe "yaml_stream_start_event_initialize"
434 c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt
314 c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt
435
315
@@ -485,7 +365,7 @@ foreign import ccall unsafe "yaml_alias_event_initialize"
485 -> IO CInt
365 -> IO CInt
486
366
487toEventRaw :: Event -> (EventRaw -> IO a) -> IO a
367toEventRaw :: Event -> (EventRaw -> IO a) -> IO a
488−toEventRaw e f = allocaBytesR eventSize $ \er -> do
368+toEventRaw e f = allocaBytes eventSize $ \er -> do
489 ret <- case e of
369 ret <- case e of
490 EventStreamStart ->
370 EventStreamStart ->
491 c_yaml_stream_start_event_initialize
371 c_yaml_stream_start_event_initialize
@@ -613,7 +493,7 @@ decodeFile file i = do
613 then return $ throwErr $ Err "Yaml out of memory"
493 then return $ throwErr $ Err "Yaml out of memory"
614 else do
494 else do
615 file' <- liftIO
495 file' <- liftIO
616− $ withCStringR file $ \file' -> withCStringR "r" $ \r' ->
496+ $ withCString file $ \file' -> withCString "r" $ \r' ->
617 c_fopen file' r'
497 c_fopen file' r'
618 if (file' == nullPtr)
498 if (file' == nullPtr)
619 then return $ throwErr $ Err
499 then return $ throwErr $ Err
@@ -643,17 +523,24 @@ runParser fp iter = do
643 Cont _ (Just err) -> return $ throwErr err
523 Cont _ (Just err) -> return $ throwErr err
644
524
645parserParseOne' :: Parser
525parserParseOne' :: Parser
646− -> IO (Either YamlException (Maybe Event))
526+ -> IO (Either String (Maybe Event))
647−parserParseOne' parser = allocaBytesR eventSize $ \er -> do
527+parserParseOne' parser = allocaBytes eventSize $ \er -> do
648 res <- liftIO $ c_yaml_parser_parse parser er
528 res <- liftIO $ c_yaml_parser_parse parser er
649 flip finally (c_yaml_event_delete er) $
529 flip finally (c_yaml_event_delete er) $
650 if res == 0
530 if res == 0
651 then do
531 then do
652 problem <- makeString c_get_parser_error_problem parser
532 problem <- makeString c_get_parser_error_problem parser
653 context <- makeString c_get_parser_error_context parser
533 context <- makeString c_get_parser_error_context parser
654− offset <- fromIntegral `fmap`
655− c_get_parser_error_offset parser
534+ offset <- c_get_parser_error_offset parser
656− return $ Left $ YamlParserException problem context offset
535+ return $ Left $ concat
536+ [ "YAML parse error: "
537+ , problem
538+ , "\nContext: "
539+ , context
540+ , "\nOffset: "
541+ , show offset
542+ , "\n"
543+ ]
657 else liftIO $ Right <$> getEvent er
544 else liftIO $ Right <$> getEvent er
658
545
659encode :: SC.StreamChunk c Event
546encode :: SC.StreamChunk c Event
@@ -685,8 +572,8 @@ encodeFile filePath = joinIM $ liftIO $ do
685 fp <- mallocForeignPtrBytes emitterSize
572 fp <- mallocForeignPtrBytes emitterSize
686 res <- withForeignPtr fp c_yaml_emitter_initialize
573 res <- withForeignPtr fp c_yaml_emitter_initialize
687 when (res == 0) $ fail "c_yaml_emitter_initialize failed"
574 when (res == 0) $ fail "c_yaml_emitter_initialize failed"
688− file <- withCStringR filePath $
575+ file <- withCString filePath $
689− \filePath' -> withCStringR "w" $
576+ \filePath' -> withCString "w" $
690 \w' -> c_fopen filePath' w'
577 \w' -> c_fopen filePath' w'
691 when (file == nullPtr) $ fail $ "could not open file for write: " ++ filePath
578 when (file == nullPtr) $ fail $ "could not open file for write: " ++ filePath
692 withForeignPtr fp $ flip c_yaml_emitter_set_output_file file
579 withForeignPtr fp $ flip c_yaml_emitter_set_output_file file