yaml 0.8.32 → 0.9.0
raw patch · 10 files changed
+207/−77 lines, 10 files
Files
- ChangeLog.md +4/−0
- c/helper.c +24/−5
- c/helper.h +4/−1
- src/Data/Yaml.hs +2/−2
- src/Data/Yaml/Builder.hs +2/−2
- src/Data/Yaml/Internal.hs +2/−2
- src/Data/Yaml/Parser.hs +2/−2
- src/Text/Libyaml.hs +91/−59
- test/Data/YamlSpec.hs +74/−2
- yaml.cabal +2/−2
ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog for yaml +## 0.9.0++* Expose style and tags on mappings and sequences in Text.Libyaml [#141](https://github.com/snoyberg/yaml/pull/141)+ ## 0.8.32 * Escape keys as necessary [#137](https://github.com/snoyberg/yaml/issues/137)
c/helper.c view
@@ -108,11 +108,6 @@ return s; } -unsigned long get_scalar_tag_len(yaml_event_t *e)-{- return strlen((char *) get_scalar_tag(e));-}- int get_scalar_style(yaml_event_t *e) { return e->data.scalar.style;@@ -128,9 +123,33 @@ return e->data.sequence_start.anchor; } +int get_sequence_start_style(yaml_event_t *e)+{+ return e->data.sequence_start.style;+}++unsigned char * get_sequence_start_tag(yaml_event_t *e)+{+ unsigned char *s = e->data.sequence_start.tag;+ if (!s) s = (unsigned char *) "";+ return s;+}+ unsigned char * get_mapping_start_anchor(yaml_event_t *e) { return e->data.mapping_start.anchor;+}++int get_mapping_start_style(yaml_event_t *e)+{+ return e->data.mapping_start.style;+}++unsigned char * get_mapping_start_tag(yaml_event_t *e)+{+ unsigned char *s = e->data.mapping_start.tag;+ if (!s) s = (unsigned char *) "";+ return s; } unsigned char * get_alias_anchor(yaml_event_t *e)
c/helper.h view
@@ -28,9 +28,12 @@ unsigned long get_scalar_length(yaml_event_t *e); unsigned char * get_scalar_tag(yaml_event_t *e);-unsigned long get_scalar_tag_len(yaml_event_t *e);+unsigned char * get_sequence_start_tag(yaml_event_t *e);+unsigned char * get_mapping_start_tag(yaml_event_t *e); int get_scalar_style(yaml_event_t *e);+int get_sequence_start_style(yaml_event_t *e);+int get_mapping_start_style(yaml_event_t *e); unsigned char * get_scalar_anchor(yaml_event_t *e); unsigned char * get_sequence_start_anchor(yaml_event_t *e);
src/Data/Yaml.hs view
@@ -132,10 +132,10 @@ objToEvents' :: Value -> [Y.Event] -> [Y.Event] --objToEvents' (Scalar s) rest = scalarToEvent s : rest objToEvents' (Array list) rest =- EventSequenceStart Nothing+ EventSequenceStart NoTag AnySequence Nothing : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list) objToEvents' (Object pairs) rest =- EventMappingStart Nothing+ EventMappingStart NoTag AnyMapping Nothing : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs) -- Empty strings need special handling to ensure they get quoted. This avoids:
src/Data/Yaml/Builder.hs view
@@ -62,7 +62,7 @@ mapping :: [(Text, YamlBuilder)] -> YamlBuilder mapping pairs = YamlBuilder $ \rest ->- EventMappingStart Nothing : foldr addPair (EventMappingEnd : rest) pairs+ EventMappingStart NoTag AnyMapping Nothing : foldr addPair (EventMappingEnd : rest) pairs where addPair (key, YamlBuilder value) after = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing@@ -70,7 +70,7 @@ array :: [YamlBuilder] -> YamlBuilder array bs =- YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)+ YamlBuilder $ (EventSequenceStart NoTag AnySequence Nothing:) . flip (foldr go) bs . (EventSequenceEnd:) where go (YamlBuilder b) = b
src/Data/Yaml/Internal.hs view
@@ -195,8 +195,8 @@ me <- CL.head case me of Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag- Just (EventSequenceStart a) -> parseS a id- Just (EventMappingStart a) -> parseM a M.empty+ Just (EventSequenceStart _ _ a) -> parseS a id+ Just (EventMappingStart _ _ a) -> parseM a M.empty Just (EventAlias an) -> do m <- lift get case Map.lookup an m of
src/Data/Yaml/Parser.hs view
@@ -162,11 +162,11 @@ go EventDocumentStart = start go (EventAlias a) = return $ Alias a go (EventScalar a b c d) = tell' d $ Scalar a b c d- go (EventSequenceStart mname) = do+ go (EventSequenceStart _tag _style mname) = do vals <- goS id let val = Sequence vals mname tell' mname val- go (EventMappingStart mname) = do+ go (EventMappingStart _tag _style mname) = do pairs <- goM id let val = Mapping pairs mname tell' mname val
src/Text/Libyaml.hs view
@@ -14,6 +14,8 @@ ( -- * The event stream Event (..) , Style (..)+ , SequenceStyle (..)+ , MappingStyle (..) , Tag (..) , AnchorName , Anchor@@ -49,8 +51,7 @@ import Data.Conduit hiding (Source, Sink, Conduit) import Data.Data -import Data.ByteString (ByteString, packCStringLen)-import qualified Data.ByteString+import Data.ByteString (ByteString, packCString, packCStringLen) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as BU@@ -62,12 +63,14 @@ | EventDocumentEnd | EventAlias !AnchorName | EventScalar !ByteString !Tag !Style !Anchor- | EventSequenceStart !Anchor+ | EventSequenceStart !Tag !SequenceStyle !Anchor | EventSequenceEnd- | EventMappingStart !Anchor+ | EventMappingStart !Tag !MappingStyle !Anchor | EventMappingEnd deriving (Show, Eq) +-- | Style for scalars - e.g. quoted / folded+-- data Style = Any | Plain | SingleQuoted@@ -77,6 +80,18 @@ | PlainNoTag deriving (Show, Read, Eq, Enum, Bounded, Ord, Data, Typeable) +-- | Style for sequences - e.g. block or flow+-- +-- @since 0.9.0+data SequenceStyle = AnySequence | BlockSequence | FlowSequence+ deriving (Show, Eq, Enum, Bounded, Ord, Data, Typeable)++-- | Style for mappings - e.g. block or flow+-- +-- @since 0.9.0+data MappingStyle = AnyMapping | BlockMapping | FlowMapping+ deriving (Show, Eq, Enum, Bounded, Ord, Data, Typeable)+ data Tag = StrTag | FloatTag | NullTag@@ -217,9 +232,6 @@ foreign import ccall unsafe "get_scalar_tag" c_get_scalar_tag :: EventRaw -> IO (Ptr CUChar) -foreign import ccall unsafe "get_scalar_tag_len"- c_get_scalar_tag_len :: EventRaw -> IO CULong- foreign import ccall unsafe "get_scalar_style" c_get_scalar_style :: EventRaw -> IO CInt @@ -229,12 +241,37 @@ foreign import ccall unsafe "get_sequence_start_anchor" c_get_sequence_start_anchor :: EventRaw -> IO CString +foreign import ccall unsafe "get_sequence_start_style"+ c_get_sequence_start_style :: EventRaw -> IO CInt++foreign import ccall unsafe "get_sequence_start_tag"+ c_get_sequence_start_tag :: EventRaw -> IO (Ptr CUChar)+ foreign import ccall unsafe "get_mapping_start_anchor" c_get_mapping_start_anchor :: EventRaw -> IO CString +foreign import ccall unsafe "get_mapping_start_style"+ c_get_mapping_start_style :: EventRaw -> IO CInt++foreign import ccall unsafe "get_mapping_start_tag"+ c_get_mapping_start_tag :: EventRaw -> IO (Ptr CUChar)+ foreign import ccall unsafe "get_alias_anchor" c_get_alias_anchor :: EventRaw -> IO CString +readAnchor :: (EventRaw -> IO CString) -> EventRaw -> IO Anchor+readAnchor getAnchor er = do+ yanchor <- getAnchor er+ if yanchor == nullPtr+ then return Nothing+ else Just <$> peekCString yanchor++readStyle :: (Enum a) => (EventRaw -> IO CInt) -> EventRaw -> IO a+readStyle getStyle er = toEnum . fromEnum <$> getStyle er ++readTag :: (EventRaw -> IO (Ptr CUChar)) -> EventRaw -> IO Tag+readTag getTag er = bsToTag <$> (getTag er >>= packCString . castPtr) + getEvent :: EventRaw -> IO (Maybe Event) getEvent er = do et <- c_get_event_type er@@ -253,37 +290,24 @@ YamlScalarEvent -> do yvalue <- c_get_scalar_value er ylen <- c_get_scalar_length er- ytag <- c_get_scalar_tag er- ytag_len <- c_get_scalar_tag_len er- ystyle <- c_get_scalar_style er- let ytag_len' = fromEnum ytag_len let yvalue' = castPtr yvalue- let ytag' = castPtr ytag let ylen' = fromEnum ylen bs <- packCStringLen (yvalue', ylen')- tagbs <-- if ytag_len' == 0- then return Data.ByteString.empty- else packCStringLen (ytag', ytag_len')- let style = toEnum $ fromEnum ystyle- yanchor <- c_get_scalar_anchor er- anchor <- if yanchor == nullPtr- then return Nothing- else Just <$> peekCString yanchor- return $ Just $ EventScalar bs (bsToTag tagbs) style anchor+ tag <- readTag c_get_scalar_tag er+ style <- readStyle c_get_scalar_style er+ anchor <- readAnchor c_get_scalar_anchor er+ return $ Just $ EventScalar bs tag style anchor YamlSequenceStartEvent -> do- yanchor <- c_get_sequence_start_anchor er- anchor <- if yanchor == nullPtr- then return Nothing- else Just <$> peekCString yanchor- return $ Just $ EventSequenceStart anchor+ tag <- readTag c_get_sequence_start_tag er+ style <- readStyle c_get_sequence_start_style er+ anchor <- readAnchor c_get_sequence_start_anchor er+ return $ Just $ EventSequenceStart tag style anchor YamlSequenceEndEvent -> return $ Just EventSequenceEnd YamlMappingStartEvent -> do- yanchor <- c_get_mapping_start_anchor er- anchor <- if yanchor == nullPtr- then return Nothing- else Just <$> peekCString yanchor- return $ Just $ EventMappingStart anchor+ tag <- readTag c_get_mapping_start_tag er+ style <- readStyle c_get_mapping_start_style er+ anchor <- readAnchor c_get_mapping_start_anchor er+ return $ Just $ EventMappingStart tag style anchor YamlMappingEndEvent -> return $ Just EventMappingEnd -- Emitter@@ -430,40 +454,48 @@ 0 -- plain_implicit qi -- quoted_implicit style' -- style- EventSequenceStart Nothing ->- c_yaml_sequence_start_event_initialize- er- nullPtr- nullPtr- 1- 0 -- YAML_ANY_SEQUENCE_STYLE- EventSequenceStart (Just anchor) ->- withCString anchor $ \anchor' -> do- let anchorP = castPtr anchor'+ EventSequenceStart tag style Nothing ->+ withCString (tagToString tag) $ \tag' -> do+ let tagP = castPtr tag' c_yaml_sequence_start_event_initialize- er- anchorP- nullPtr- 1- 0 -- YAML_ANY_SEQUENCE_STYLE+ er+ nullPtr+ tagP+ 1+ (toEnum $ fromEnum style)+ EventSequenceStart tag style (Just anchor) ->+ withCString (tagToString tag) $ \tag' -> do+ let tagP = castPtr tag'+ withCString anchor $ \anchor' -> do+ let anchorP = castPtr anchor'+ c_yaml_sequence_start_event_initialize+ er+ anchorP+ tagP+ 1+ (toEnum $ fromEnum style) EventSequenceEnd -> c_yaml_sequence_end_event_initialize er- EventMappingStart Nothing ->- c_yaml_mapping_start_event_initialize- er- nullPtr- nullPtr- 1- 0 -- YAML_ANY_SEQUENCE_STYLE- EventMappingStart (Just anchor) ->- withCString anchor $ \anchor' -> do- let anchorP = castPtr anchor'+ EventMappingStart tag style Nothing ->+ withCString (tagToString tag) $ \tag' -> do+ let tagP = castPtr tag' c_yaml_mapping_start_event_initialize er- anchorP nullPtr+ tagP 1- 0 -- YAML_ANY_SEQUENCE_STYLE+ (toEnum $ fromEnum style)+ EventMappingStart tag style (Just anchor) ->+ withCString (tagToString tag) $ \tag' -> do+ withCString anchor $ \anchor' -> do+ let tagP = castPtr tag'+ let anchorP = castPtr anchor'+ c_yaml_mapping_start_event_initialize+ er+ anchorP+ tagP+ 1+ (toEnum $ fromEnum style) EventMappingEnd -> c_yaml_mapping_end_event_initialize er EventAlias anchor ->
test/Data/YamlSpec.hs view
@@ -63,6 +63,14 @@ it "count scalars with anchor" caseCountScalarsWithAnchor it "count sequences with anchor" caseCountSequencesWithAnchor it "count mappings with anchor" caseCountMappingsWithAnchor+ it "count sequences with custom tag" caseCountSequenceTags+ it "count mappings with custom tag" caseCountMappingTags+ it "count count sequences with ! tag" caseCountEmptySequenceTags+ it "count count mappings with ! tag" caseCountEmptyMappingTags+ it "count block style sequences" caseCountBlockStyleSequences+ it "count flow style sequences" caseCountFlowStyleSequences+ it "count block style mappings" caseCountBlockStyleMappings+ it "count flow style mappings" caseCountFlowStyleMappings it "count aliases" caseCountAliases it "count scalars" caseCountScalars it "largest string" caseLargestString@@ -230,7 +238,7 @@ caseHelper yamlString isSequenceStartA 1 where yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"- isSequenceStartA (Y.EventSequenceStart (Just _)) = True+ isSequenceStartA (Y.EventSequenceStart Y.NoTag _ (Just _)) = True isSequenceStartA _ = False caseCountMappingsWithAnchor :: Assertion@@ -238,7 +246,7 @@ caseHelper yamlString isMappingA 1 where yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"- isMappingA (Y.EventMappingStart (Just _)) = True+ isMappingA (Y.EventMappingStart _ _ (Just _)) = True isMappingA _ = False caseCountAliases :: Assertion@@ -248,6 +256,70 @@ yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor" isAlias Y.EventAlias{} = True isAlias _ = False++caseCountMappingTags :: Assertion+caseCountMappingTags =+ caseHelper yamlString isCustomTaggedMapping 1+ where+ yamlString = "foo: !bar\n k: v\n k2: v2"+ isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True+ isCustomTaggedMapping _ = False++caseCountEmptyMappingTags :: Assertion+caseCountEmptyMappingTags =+ caseHelper yamlString isCustomTaggedMapping 1+ where+ yamlString = "foo: !\n k: v\n k2: v2"+ isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!") _ _) = True+ isCustomTaggedMapping _ = False++caseCountSequenceTags :: Assertion+caseCountSequenceTags =+ caseHelper yamlString isCustomTaggedSequence 1+ where+ yamlString = "foo: !bar [x, y, z]"+ isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True+ isCustomTaggedSequence _ = False++caseCountEmptySequenceTags :: Assertion+caseCountEmptySequenceTags =+ caseHelper yamlString isCustomTaggedSequence 1+ where+ yamlString = "foo: ! [x, y, z]"+ isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!") _ _) = True+ isCustomTaggedSequence _ = False++caseCountFlowStyleSequences :: Assertion+caseCountFlowStyleSequences =+ caseHelper yamlString isFlowStyleSequence 1+ where+ yamlString = "foo: [x, y, z]"+ isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True+ isFlowStyleSequence _ = False++caseCountBlockStyleSequences :: Assertion+caseCountBlockStyleSequences =+ caseHelper yamlString isBlockStyleSequence 1+ where+ yamlString = "foo:\n- x\n- y\n- z\n"+ isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True+ isBlockStyleSequence _ = False++caseCountFlowStyleMappings :: Assertion+caseCountFlowStyleMappings =+ caseHelper yamlString isFlowStyleMapping 1+ where+ yamlString = "foo: { bar: 1, baz: 2 }"+ isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True+ isFlowStyleMapping _ = False++caseCountBlockStyleMappings :: Assertion+caseCountBlockStyleMappings =+ caseHelper yamlString isBlockStyleMapping 1+ where+ yamlString = "foo: bar\nbaz: quux"+ isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True+ isBlockStyleMapping _ = False caseCountScalars :: Assertion caseCountScalars = do
yaml.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7a233a8f2ad181b26ff4049e7128d5380951fb67007e81166d2364c7dada6b95+-- hash: 2de1bae80ae10ae93990897198f5e06bc3ff88eefd9e0087e6384bca7a887515 name: yaml-version: 0.8.32+version: 0.9.0 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at <https://www.stackage.org/package/yaml> category: Data