@@ -72,6 +72,7 @@ module Data.Yaml
7272 , isSpecialString
7373 , EncodeOptions
7474 , defaultEncodeOptions
75+ , defaultStringStyle
7576 , setStringStyle
7677 , setFormat
7778 , FormatOptions
@@ -94,18 +95,10 @@ import Data.Aeson
9495 , Object, Array
9596 , withObject, withText, withArray, withScientific, withBool
9697 )
97−import qualified Data.Scientific as S
98−import qualified Data.ByteString.Builder.Scientific
99−import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)
98+import Data.Aeson.Types (parseMaybe, parseEither, Parser)
10099import Data.ByteString (ByteString)
101−import qualified Data.ByteString.Builder as BB
102−import qualified Data.ByteString.Lazy as BL
103100import Data.Conduit ((.|), runConduitRes)
104101import qualified Data.Conduit.List as CL
105−import qualified Data.HashMap.Strict as M
106−import qualified Data.HashSet as HashSet
107−import Data.Text.Encoding (encodeUtf8)
108−import qualified Data.Text as T
109102import qualified Data.Vector as V
110103import System.IO.Unsafe (unsafePerformIO)
111104import Data.Text (Text)
@@ -114,13 +107,6 @@ import Data.Yaml.Internal
114107import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith)
115108import qualified Text.Libyaml as Y
116109
117−-- |
118−-- @since 0.10.2.0
119−data EncodeOptions = EncodeOptions
120− { encodeOptionsStringStyle :: Text -> ( Tag, Style )
121− , encodeOptionsFormat :: FormatOptions
122− }
123−
124110-- | Set the string style in the encoded YAML. This is a function that decides
125111-- for each string the type of YAML string to output.
126112--
@@ -145,25 +131,18 @@ setStringStyle s opts = opts { encodeOptionsStringStyle = s }
145131setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions
146132setFormat f opts = opts { encodeOptionsFormat = f }
147133
148−-- | Determine whether a string must be quoted in YAML and can't appear as plain text.
149−-- Useful if you want to use 'setStringStyle'.
150−--
134+-- |
151135-- @since 0.10.2.0
152−isSpecialString :: Text -> Bool
153−isSpecialString s = s `HashSet.member` specialStrings || isNumeric s
136+data EncodeOptions = EncodeOptions
137+ { encodeOptionsStringStyle :: Text -> ( Tag, Style )
138+ , encodeOptionsFormat :: FormatOptions
139+ }
154140
155141-- |
156142-- @since 0.10.2.0
157143defaultEncodeOptions :: EncodeOptions
158144defaultEncodeOptions = EncodeOptions
159− { encodeOptionsStringStyle = \s ->
160− -- Empty strings need special handling to ensure they get quoted. This avoids:
161− -- https://github.com/snoyberg/yaml/issues/24
162− case () of
163− ()
164− | "\n" `T.isInfixOf` s -> ( NoTag, Literal )
165− | isSpecialString s -> ( NoTag, SingleQuoted )
166− | otherwise -> ( StrTag, PlainNoTag )
145+ { encodeOptionsStringStyle = defaultStringStyle
167146 , encodeOptionsFormat = defaultFormatOptions
168147 }
169148
@@ -176,7 +155,7 @@ encode = encodeWith defaultEncodeOptions
176155-- @since 0.10.2.0
177156encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString
178157encodeWith opts obj = unsafePerformIO $ runConduitRes
179− $ CL.sourceList (objToEvents opts $ toJSON obj)
158+ $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)
180159 .| Y.encodeWith (encodeOptionsFormat opts)
181160
182161-- | Encode a value into its YAML representation and save to the given file.
@@ -188,53 +167,9 @@ encodeFile = encodeFileWith defaultEncodeOptions
188167-- @since 0.10.2.0
189168encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO ()
190169encodeFileWith opts fp obj = runConduitRes
191− $ CL.sourceList (objToEvents opts $ toJSON obj)
170+ $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)
192171 .| Y.encodeFileWith (encodeOptionsFormat opts) fp
193172
194−objToEvents :: EncodeOptions -> Value -> [Y.Event]
195−objToEvents opts o = (:) EventStreamStart
196− . (:) EventDocumentStart
197− $ objToEvents' o
198− [ EventDocumentEnd
199− , EventStreamEnd
200− ]
201− where
202− objToEvents' :: Value -> [Y.Event] -> [Y.Event]
203− --objToEvents' (Scalar s) rest = scalarToEvent s : rest
204− objToEvents' (Array list) rest =
205− EventSequenceStart NoTag AnySequence Nothing
206− : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)
207− objToEvents' (Object pairs) rest =
208− EventMappingStart NoTag AnyMapping Nothing
209− : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)
210−
211− objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest
212−
213− objToEvents' (String s) rest = EventScalar (encodeUtf8 s) tag style Nothing : rest
214− where
215− ( tag, style ) = encodeOptionsStringStyle opts s
216− objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest
217− objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest
218− objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest
219−
220− objToEvents' (Number s) rest =
221− let builder
222− -- Special case the 0 exponent to remove the trailing .0
223− | S.base10Exponent s == 0 = BB.integerDec $ S.coefficient s
224− | otherwise = Data.ByteString.Builder.Scientific.scientificBuilder s
225− lbs = BB.toLazyByteString builder
226− bs = BL.toStrict lbs
227− in EventScalar bs IntTag PlainNoTag Nothing : rest
228−
229− pairToEvents :: Pair -> [Y.Event] -> [Y.Event]
230− pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v
231−
232−{- FIXME
233−scalarToEvent :: YamlScalar -> Event
234−scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing
235−-}
236−
237−
238173decode :: FromJSON a
239174 => ByteString
240175 -> Maybe a