@@ -7,11 +7,24 @@ module Data.Yaml.Builder
77 ( YamlBuilder (..)
88 , ToYaml (..)
99 , mapping
10+ , namedMapping
11+ , maybeNamedMapping
1012 , array
13+ , namedArray
14+ , maybeNamedArray
1115 , string
16+ , namedString
17+ , maybeNamedString
1218 , bool
19+ , namedBool
20+ , maybeNamedBool
1321 , null
22+ , namedNull
23+ , maybeNamedNull
1424 , scientific
25+ , namedScientific
26+ , maybeNamedScientific
27+ , alias
1528 , number
1629 , toByteString
1730 , toByteStringWith
@@ -36,7 +49,7 @@ import qualified Data.ByteString.Char8 as S8
3649import Data.Conduit
3750import qualified Data.HashSet as HashSet
3851import Data.Scientific (Scientific)
39−import Data.Text (Text)
52+import Data.Text (Text, unpack)
4053import Data.Text.Encoding (encodeUtf8)
4154import qualified Data.Text.Encoding as TE
4255import qualified Data.Text.Lazy as TL
@@ -64,47 +77,112 @@ instance ToYaml Text where
6477instance ToYaml Int where
6578 toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:)
6679
67−mapping :: [(Text, YamlBuilder)] -> YamlBuilder
68−mapping pairs = YamlBuilder $ \rest ->
69− EventMappingStart NoTag AnyMapping Nothing : foldr addPair (EventMappingEnd : rest) pairs
80+-- |
81+-- @since 0.11.0
82+maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder
83+maybeNamedMapping anchor pairs = YamlBuilder $ \rest ->
84+ EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs
7085 where
7186 addPair (key, YamlBuilder value) after
7287 = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing
7388 : value after
7489
75−array :: [YamlBuilder] -> YamlBuilder
76−array bs =
77− YamlBuilder $ (EventSequenceStart NoTag AnySequence Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)
90+mapping :: [(Text, YamlBuilder)] -> YamlBuilder
91+mapping = maybeNamedMapping Nothing
92+
93+-- |
94+-- @since 0.11.0
95+namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder
96+namedMapping name = maybeNamedMapping $ Just name
97+
98+-- |
99+-- @since 0.11.0
100+maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder
101+maybeNamedArray anchor bs =
102+ YamlBuilder $ (EventSequenceStart NoTag AnySequence (unpack <$> anchor):) . flip (foldr go) bs . (EventSequenceEnd:)
78103 where
79104 go (YamlBuilder b) = b
80105
81−string :: Text -> YamlBuilder
106+array :: [YamlBuilder] -> YamlBuilder
107+array = maybeNamedArray Nothing
108+
109+-- |
110+-- @since 0.11.0
111+namedArray :: Text -> [YamlBuilder] -> YamlBuilder
112+namedArray name = maybeNamedArray $ Just name
113+
114+-- |
115+-- @since 0.11.0
116+maybeNamedString :: Maybe Text -> Text -> YamlBuilder
82117-- Empty strings need special handling to ensure they get quoted. This avoids:
83118-- https://github.com/snoyberg/yaml/issues/24
84−string "" = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :)
85−string s =
119+maybeNamedString anchor "" = YamlBuilder (EventScalar "" NoTag SingleQuoted (unpack <$> anchor) :)
120+maybeNamedString anchor s =
86121 YamlBuilder (event :)
87122 where
88123 event
89124 -- Make sure that special strings are encoded as strings properly.
90125 -- See: https://github.com/snoyberg/yaml/issues/31
91− | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing
92− | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing
126+ | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted $ unpack <$> anchor
127+ | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag $ unpack <$> anchor
128+
129+string :: Text -> YamlBuilder
130+string = maybeNamedString Nothing
131+
132+-- |
133+-- @since 0.11.0
134+namedString :: Text -> Text -> YamlBuilder
135+namedString name = maybeNamedString $ Just name
93136
94137-- Use aeson's implementation which gets rid of annoying decimal points
138+-- |
139+-- @since 0.11.0
140+maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder
141+maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag (unpack <$> anchor) :)
142+
95143scientific :: Scientific -> YamlBuilder
96−scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)
144+scientific = maybeNamedScientific Nothing
145+
146+-- |
147+-- @since 0.11.0
148+namedScientific :: Text -> Scientific -> YamlBuilder
149+namedScientific name = maybeNamedScientific $ Just name
97150
98151{-# DEPRECATED number "Use scientific" #-}
99152number :: Scientific -> YamlBuilder
100153number = scientific
101154
155+-- |
156+-- @since 0.11.0
157+maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder
158+maybeNamedBool anchor True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag (unpack <$> anchor) :)
159+maybeNamedBool anchor False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag (unpack <$> anchor) :)
160+
102161bool :: Bool -> YamlBuilder
103−bool True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)
104−bool False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :)
162+bool = maybeNamedBool Nothing
163+
164+-- |
165+-- @since 0.11.0
166+namedBool :: Text -> Bool -> YamlBuilder
167+namedBool name = maybeNamedBool $ Just name
168+
169+-- |
170+-- @since 0.11.0
171+maybeNamedNull :: Maybe Text -> YamlBuilder
172+maybeNamedNull anchor = YamlBuilder (EventScalar "null" NullTag PlainNoTag (unpack <$> anchor) :)
105173
106174null :: YamlBuilder
107−null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :)
175+null = maybeNamedNull Nothing
176+
177+-- |
178+-- @since 0.11.0
179+namedNull :: Text -> YamlBuilder
180+namedNull name = maybeNamedNull $ Just name
181+
182+-- |
183+-- @since 0.11.0
184+alias :: Text -> YamlBuilder
185+alias anchor = YamlBuilder (EventAlias (unpack anchor) :)
108186
109187toEvents :: YamlBuilder -> [Event]
110188toEvents (YamlBuilder front) =