diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog for yaml +## 0.10.4.0 + +* Add `decodeMarked` and `decodeFileMarked` functions to `Text.Libyaml`, and + extend native bindings to extract mark information. [#157](https://github.com/snoyberg/yaml/issues/157) + ## 0.10.3.0 * Add support for anchors and aliases to Data.Yaml.Builder [#155](https://github.com/snoyberg/yaml/pull/155) diff --git a/c/helper.c b/c/helper.c --- a/c/helper.c +++ b/c/helper.c @@ -56,19 +56,9 @@ return p->context; } -unsigned int get_parser_error_index(yaml_parser_t *p) -{ - return p->problem_mark.index; -} - -unsigned int get_parser_error_line(yaml_parser_t *p) -{ - return p->problem_mark.line; -} - -unsigned int get_parser_error_column(yaml_parser_t *p) +const yaml_mark_t * get_parser_error_mark(yaml_parser_t *p) { - return p->problem_mark.column; + return &p->problem_mark; } char const * get_emitter_error(yaml_emitter_t *e) @@ -155,6 +145,31 @@ unsigned char * get_alias_anchor(yaml_event_t *e) { return e->data.alias.anchor; +} + +const yaml_mark_t * get_start_mark(yaml_event_t *e) +{ + return &e->start_mark; +} + +const yaml_mark_t * get_end_mark(yaml_event_t *e) +{ + return &e->end_mark; +} + +unsigned int get_mark_index(yaml_mark_t *m) +{ + return m->index; +} + +unsigned int get_mark_line(yaml_mark_t *m) +{ + return m->line; +} + +unsigned int get_mark_column(yaml_mark_t *m) +{ + return m->column; } int yaml_parser_set_input_filename(yaml_parser_t *parser, const char *filename) diff --git a/src/Text/Libyaml.hs b/src/Text/Libyaml.hs --- a/src/Text/Libyaml.hs +++ b/src/Text/Libyaml.hs @@ -12,7 +12,8 @@ -- "Data.Yaml". module Text.Libyaml ( -- * The event stream - Event (..) + MarkedEvent(..) + , Event (..) , Style (..) , SequenceStyle (..) , MappingStyle (..) @@ -23,8 +24,10 @@ , encode , encodeWith , decode + , decodeMarked , encodeFile , decodeFile + , decodeFileMarked , encodeFileWith , FormatOptions , defaultFormatOptions @@ -74,6 +77,15 @@ | EventMappingEnd deriving (Show, Eq) +-- | Event with start and end marks. +-- +-- @since 0.10.4.0 +data MarkedEvent = MarkedEvent + { yamlEvent :: Event + , yamlStartMark :: YamlMark + , yamlEndMark :: YamlMark + } + -- | Style for scalars - e.g. quoted / folded -- data Style = Any @@ -166,6 +178,24 @@ -> File -> IO () +data MarkRawStruct +type MarkRaw = Ptr MarkRawStruct + +foreign import ccall unsafe "get_mark_index" + c_get_mark_index :: MarkRaw -> IO CULong + +foreign import ccall unsafe "get_mark_line" + c_get_mark_line :: MarkRaw -> IO CULong + +foreign import ccall unsafe "get_mark_column" + c_get_mark_column :: MarkRaw -> IO CULong + +getMark :: MarkRaw -> IO YamlMark +getMark m = YamlMark + <$> (fromIntegral <$> c_get_mark_index m) + <*> (fromIntegral <$> c_get_mark_line m) + <*> (fromIntegral <$> c_get_mark_column m) + data FileStruct type File = Ptr FileStruct @@ -196,14 +226,8 @@ foreign import ccall "get_parser_error_context" c_get_parser_error_context :: Parser -> IO (Ptr CUChar) -foreign import ccall unsafe "get_parser_error_index" - c_get_parser_error_index :: Parser -> IO CULong - -foreign import ccall unsafe "get_parser_error_line" - c_get_parser_error_line :: Parser -> IO CULong - -foreign import ccall unsafe "get_parser_error_column" - c_get_parser_error_column :: Parser -> IO CULong +foreign import ccall unsafe "get_parser_error_mark" + c_get_parser_error_mark :: Parser -> IO MarkRaw makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String makeString f a = do @@ -228,6 +252,12 @@ foreign import ccall unsafe "get_event_type" c_get_event_type :: EventRaw -> IO CInt +foreign import ccall unsafe "get_start_mark" + c_get_start_mark :: EventRaw -> IO MarkRaw + +foreign import ccall unsafe "get_end_mark" + c_get_end_mark :: EventRaw -> IO MarkRaw + foreign import ccall unsafe "get_scalar_value" c_get_scalar_value :: EventRaw -> IO (Ptr CUChar) @@ -277,10 +307,12 @@ readTag :: (EventRaw -> IO (Ptr CUChar)) -> EventRaw -> IO Tag readTag getTag er = bsToTag <$> (getTag er >>= packCString . castPtr) -getEvent :: EventRaw -> IO (Maybe Event) +getEvent :: EventRaw -> IO (Maybe MarkedEvent) getEvent er = do et <- c_get_event_type er - case toEnum $ fromEnum et of + startMark <- c_get_start_mark er >>= getMark + endMark <- c_get_end_mark er >>= getMark + event <- case toEnum $ fromEnum et of YamlNoEvent -> return Nothing YamlStreamStartEvent -> return $ Just EventStreamStart YamlStreamEndEvent -> return $ Just EventStreamEnd @@ -314,6 +346,7 @@ anchor <- readAnchor c_get_mapping_start_anchor er return $ Just $ EventMappingStart tag style anchor YamlMappingEndEvent -> return $ Just EventMappingEnd + return $ (\e -> MarkedEvent e startMark endMark) <$> event -- Emitter @@ -519,9 +552,19 @@ deriving (Show, Typeable) instance Exception ToEventRawException +-- | Create a conduit that yields events from a bytestring. decode :: MonadResource m => B.ByteString -> ConduitM i Event m () -decode bs | B8.null bs = return () -decode bs = +decode = mapOutput yamlEvent . decodeMarked + +-- | Create a conduit that yields marked events from a bytestring. +-- +-- This conduit will yield identical events to that of "decode", but also +-- includes start and end marks for each event. +-- +-- @since 0.10.4.0 +decodeMarked :: MonadResource m => B.ByteString -> ConduitM i MarkedEvent m () +decodeMarked bs | B8.null bs = return () +decodeMarked bs = bracketP alloc cleanup (runParser . fst) where alloc = mask_ $ do @@ -561,8 +604,18 @@ then withCString openMode $ \openMode' -> c_fdopen fd openMode' else return nullPtr +-- | Creata a conduit that yields events from a file. decodeFile :: MonadResource m => FilePath -> ConduitM i Event m () -decodeFile file = +decodeFile = mapOutput yamlEvent . decodeFileMarked + +-- | Create a conduit that yields marked events from a file. +-- +-- This conduit will yield identical events to that of "decodeFile", but also +-- includes start and end marks for each event. +-- +-- @since 0.10.4.0 +decodeFileMarked :: MonadResource m => FilePath -> ConduitM i MarkedEvent m () +decodeFileMarked file = bracketP alloc cleanup (runParser . fst) where alloc = mask_ $ do @@ -589,7 +642,7 @@ c_yaml_parser_delete ptr free ptr -runParser :: MonadResource m => Parser -> ConduitM i Event m () +runParser :: MonadResource m => Parser -> ConduitM i MarkedEvent m () runParser parser = do e <- liftIO $ parserParseOne' parser case e of @@ -598,7 +651,7 @@ Right (Just ev) -> yield ev >> runParser parser parserParseOne' :: Parser - -> IO (Either YamlException (Maybe Event)) + -> IO (Either YamlException (Maybe MarkedEvent)) parserParseOne' parser = allocaBytes eventSize $ \er -> do res <- liftIO $ c_yaml_parser_parse parser er flip finally (c_yaml_event_delete er) $ @@ -606,10 +659,7 @@ then do problem <- makeString c_get_parser_error_problem parser context <- makeString c_get_parser_error_context parser - index <- c_get_parser_error_index parser - line <- c_get_parser_error_line parser - column <- c_get_parser_error_column parser - let problemMark = YamlMark (fromIntegral index) (fromIntegral line) (fromIntegral column) + problemMark <- c_get_parser_error_mark parser >>= getMark return $ Left $ YamlParseException problem context problemMark else Right <$> getEvent er diff --git a/yaml.cabal b/yaml.cabal --- a/yaml.cabal +++ b/yaml.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c51a347a61ff899c59797c2412463b7e5aee6030236d3fb6a9d6e5883c1e739f +-- hash: 709e1d268c9776e928f3581610b43834991bb3729a78783c205e3c01695ead9d name: yaml -version: 0.10.3.0 +version: 0.10.4.0 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at category: Data