git.iko.soy/typeable/yaml
on master help sign in
Support for !!str tag
94b101fMichael Snoyman
Data/Yaml.hs+12−11
compare with master
unifiedsplit
@@ -149,22 +149,23 @@ parse = do
149 requireEvent EventStreamEnd
149 requireEvent EventStreamEnd
150 return res
150 return res
151
151
152−parseScalar :: ByteString -> Anchor -> Style
152+parseScalar :: ByteString -> Anchor -> Style -> Tag
153 -> C.Sink Event Parse Text
153 -> C.Sink Event Parse Text
154−parseScalar v a style = do
154+parseScalar v a style tag = do
155 let res = decodeUtf8With lenientDecode v
155 let res = decodeUtf8With lenientDecode v
156 case a of
156 case a of
157 Nothing -> return res
157 Nothing -> return res
158 Just an -> do
158 Just an -> do
159− lift $ modify (Map.insert an $ textToValue style res)
159+ lift $ modify (Map.insert an $ textToValue style tag res)
160 return res
160 return res
161
161
162−textToValue :: Style -> Text -> Value
162+textToValue :: Style -> Tag -> Text -> Value
163−textToValue SingleQuoted t = String t
163+textToValue SingleQuoted _ t = String t
164−textToValue DoubleQuoted t = String t
164+textToValue DoubleQuoted _ t = String t
165+textToValue _ StrTag t = String t
165−textToValue Folded t = String t
166+textToValue Folded _ t = String t
166−textToValue _ "null" = Null
167+textToValue _ _ "null" = Null
167−textToValue _ t
168+textToValue _ _ t
168 | any (t `isLike`) ["y", "yes", "on", "true"] = Bool True
169 | any (t `isLike`) ["y", "yes", "on", "true"] = Bool True
169 | any (t `isLike`) ["n", "no", "off", "false"] = Bool False
170 | any (t `isLike`) ["n", "no", "off", "false"] = Bool False
170 | Right (x, "") <- signed decimal t = Number $ I x
171 | Right (x, "") <- signed decimal t = Number $ I x
@@ -178,7 +179,7 @@ parseO :: C.Sink Event Parse Value
178parseO = do
179parseO = do
179 me <- CL.head
180 me <- CL.head
180 case me of
181 case me of
181− Just (EventScalar v _t style a) -> fmap (textToValue style) $ parseScalar v a style
182+ Just (EventScalar v tag style a) -> fmap (textToValue style tag) $ parseScalar v a style tag
182 Just (EventSequenceStart a) -> parseS a id
183 Just (EventSequenceStart a) -> parseS a id
183 Just (EventMappingStart a) -> parseM a M.empty
184 Just (EventMappingStart a) -> parseM a M.empty
184 Just (EventAlias an) -> do
185 Just (EventAlias an) -> do
@@ -223,7 +224,7 @@ parseM a front = do
223 _ -> do
224 _ -> do
224 CL.drop 1
225 CL.drop 1
225 s <- case me of
226 s <- case me of
226− Just (EventScalar v _ style a') -> parseScalar v a' style
227+ Just (EventScalar v tag style a') -> parseScalar v a' style tag
227 _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing
228 _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing
228 o <- parseO
229 o <- parseO
229
230
test/main.hs+7−5
@@ -56,6 +56,7 @@ main = hspecX $ do
56 describe "numbers" $ do
56 describe "numbers" $ do
57 it "parses as string when quoted" caseQuotedNumber
57 it "parses as string when quoted" caseQuotedNumber
58 it "parses as number when unquoted" caseUnquotedNumber
58 it "parses as number when unquoted" caseUnquotedNumber
59+ it "parses as number !!str is present" caseAttribNumber
59 describe "booleans" $ do
60 describe "booleans" $ do
60 it "parses when all lowercase" caseLowercaseBool
61 it "parses when all lowercase" caseLowercaseBool
61 it "parses when all uppercase" caseUppercaseBool
62 it "parses when all uppercase" caseUppercaseBool
@@ -292,9 +293,9 @@ caseMergeSequence = do
292 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
293 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
293 let res = fromJust maybeRes
294 let res = fromJust maybeRes
294 mappingKey res "foo1" @?= (mkScalar "foo")
295 mappingKey res "foo1" @?= (mkScalar "foo")
295− mappingKey res "k1" @?= (D.Number 1)
296+ mappingKey res "k1" @?= (D.String "1")
296− mappingKey res "k2" @?= (D.Number 2)
297+ mappingKey res "k2" @?= (D.String "2")
297− mappingKey res "k3" @?= (D.Number 4)
298+ mappingKey res "k3" @?= (D.String "4")
298
299
299caseDataTypes :: Assertion
300caseDataTypes :: Assertion
300caseDataTypes =
301caseDataTypes =
@@ -309,9 +310,10 @@ caseDataTypes =
309 , ("null", D.Null)
310 , ("null", D.Null)
310 ]
311 ]
311
312
312−caseQuotedNumber, caseUnquotedNumber :: Assertion
313+caseQuotedNumber, caseUnquotedNumber, caseAttribNumber :: Assertion
313caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])
314caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])
314caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])
315caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])
316+caseAttribNumber = D.decode "foo: !!str 1234" @?= Just (object [("foo", D.String "1234")])
315
317
316obj :: Maybe D.Value
318obj :: Maybe D.Value
317obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])
319obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])
@@ -319,4 +321,4 @@ obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool
319caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
321caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
320caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj
322caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj
321caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj
323caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj
322−caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj
324+caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj