9819ecb · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Add configurable encodeWith/encodeFileWith.

9819ecbPatrick Chilton8 years ago

ChangeLog.md+4

compare with master

unifiedsplit

@@ -1,5 +1,9 @@

1# ChangeLog for yaml

3+## 0.10.2.0

5+* Add `EncodeOptions` and `FormatOptions` to control the style of the encoded YAML. [#153](https://github.com/snoyberg/yaml/pull/153)

3## 0.10.1.1

7## 0.10.1.1

5* Correctly declare libyaml dependency on system-libyaml flag [#151](https://github.com/snoyberg/yaml/pull/151)

9* Correctly declare libyaml dependency on system-libyaml flag [#151](https://github.com/snoyberg/yaml/pull/151)

package.yaml+1−1

@@ -1,5 +1,5 @@

1name: yaml

2−version: 0.10.1.1

2+version: 0.10.2.0

3synopsis: Support for parsing and rendering YAML documents.

4description: README and API documentation are available at <https://www.stackage.org/package/yaml>

5category: Data

src/Data/Yaml.hs+101−38

@@ -28,7 +28,9 @@ module Data.Yaml

28#endif

29 ( -- * Encoding

30 encode

31+ , encodeWith

31 , encodeFile

32 , encodeFile

33+ , encodeFileWith

32 -- * Decoding

34 -- * Decoding

33 , decodeEither'

35 , decodeEither'

34 , decodeFileEither

36 , decodeFileEither

@@ -66,6 +68,15 @@ module Data.Yaml

66 -- * Classes

68 -- * Classes

67 , ToJSON (..)

69 , ToJSON (..)

68 , FromJSON (..)

70 , FromJSON (..)

71+ -- * Custom encoding

72+ , isSpecialString

73+ , EncodeOptions

74+ , defaultEncodeOptions

75+ , setStringStyle

76+ , setFormat

77+ , FormatOptions

78+ , defaultFormatOptions

79+ , setWidth

69 -- * Deprecated

80 -- * Deprecated

70 , decode

81 , decode

71 , decodeFile

82 , decodeFile

@@ -100,65 +111,117 @@ import qualified Data.Text.Lazy as TL

100import Data.Text.Lazy.Builder (toLazyText)

111import Data.Text.Lazy.Builder (toLazyText)

101import qualified Data.Vector as V

112import qualified Data.Vector as V

102import System.IO.Unsafe (unsafePerformIO)

113import System.IO.Unsafe (unsafePerformIO)

114+import Data.Text (Text)

103

115

104import Data.Yaml.Internal

116import Data.Yaml.Internal

105−import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)

117+import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith)

106import qualified Text.Libyaml as Y

118import qualified Text.Libyaml as Y

107

119

120+-- |

121+-- @since 0.10.2.0

122+data EncodeOptions = EncodeOptions

123+ { encodeOptionsStringStyle :: Text -> ( Tag, Style )

124+ , encodeOptionsFormat :: FormatOptions

125+ }

126+

127+-- | Set the string style in the encoded YAML. This is a function that decides

128+-- for each string the type of YAML string to output.

129+--

130+-- __WARNING__: You must ensure that special strings (like @"yes"@\/@"no"@\/@"null"@\/@"1234"@) are not encoded with the 'Plain' style, because

131+-- then they will be decoded as boolean, null or numeric values. You can use 'isSpecialString' to detect them.

132+--

133+-- By default, strings are encoded with the `Plain` style, except special strings, which are encoded with `SingleQuoted`.

134+--

135+-- @since 0.10.2.0

136+setStringStyle :: (Text -> ( Tag, Style )) -> EncodeOptions -> EncodeOptions

137+setStringStyle s opts = opts { encodeOptionsStringStyle = s }

138+

139+-- | Set the encoding formatting for the encoded YAML. By default, this is `defaultFormatOptions`.

140+--

141+-- @since 0.10.2.0

142+setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions

143+setFormat f opts = opts { encodeOptionsFormat = f }

144+

145+-- | Determine whether a string must be quoted in YAML and can't appear as plain text.

146+-- Useful if you want to use 'setStringStyle'.

147+--

148+-- @since 0.10.2.0

149+isSpecialString :: Text -> Bool

150+isSpecialString s = s `HashSet.member` specialStrings || isNumeric s

151+

152+-- |

153+-- @since 0.10.2.0

154+defaultEncodeOptions :: EncodeOptions

155+defaultEncodeOptions = EncodeOptions

156+ { encodeOptionsStringStyle = \s ->

157+ -- Empty strings need special handling to ensure they get quoted. This avoids:

158+ -- https://github.com/snoyberg/yaml/issues/24

159+ if isSpecialString s

160+ then ( NoTag, SingleQuoted )

161+ else ( StrTag, PlainNoTag )

162+ , encodeOptionsFormat = defaultFormatOptions

163+ }

164+

108-- | Encode a value into its YAML representation.

165-- | Encode a value into its YAML representation.

109encode :: ToJSON a => a -> ByteString

166encode :: ToJSON a => a -> ByteString

167+encode = encodeWith defaultEncodeOptions

168+

169+-- | Encode a value into its YAML representation with custom styling.

170+--

171+-- @since 0.10.2.0

172+encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString

110−encode obj = unsafePerformIO $ runConduitRes

173+encodeWith opts obj = unsafePerformIO $ runConduitRes

111− $ CL.sourceList (objToEvents $ toJSON obj)

174+ $ CL.sourceList (objToEvents opts $ toJSON obj)

112− .| Y.encode

175+ .| Y.encodeWith (encodeOptionsFormat opts)

113

176

114-- | Encode a value into its YAML representation and save to the given file.

177-- | Encode a value into its YAML representation and save to the given file.

115encodeFile :: ToJSON a => FilePath -> a -> IO ()

178encodeFile :: ToJSON a => FilePath -> a -> IO ()

116−encodeFile fp obj = runConduitRes

179+encodeFile = encodeFileWith defaultEncodeOptions

117− $ CL.sourceList (objToEvents $ toJSON obj)

118− .| Y.encodeFile fp

119

180

120−objToEvents :: Value -> [Y.Event]

181+-- | Encode a value into its YAML representation with custom styling and save to the given file.

182+--

183+-- @since 0.10.2.0

184+encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO ()

185+encodeFileWith opts fp obj = runConduitRes

186+ $ CL.sourceList (objToEvents opts $ toJSON obj)

187+ .| Y.encodeFileWith (encodeOptionsFormat opts) fp

188+

189+objToEvents :: EncodeOptions -> Value -> [Y.Event]

121−objToEvents o = (:) EventStreamStart

190+objToEvents opts o = (:) EventStreamStart

122 . (:) EventDocumentStart

191 . (:) EventDocumentStart

123 $ objToEvents' o

192 $ objToEvents' o

124 [ EventDocumentEnd

193 [ EventDocumentEnd

125 , EventStreamEnd

194 , EventStreamEnd

126 ]

195 ]

196+ where

197+ objToEvents' :: Value -> [Y.Event] -> [Y.Event]

198+ --objToEvents' (Scalar s) rest = scalarToEvent s : rest

199+ objToEvents' (Array list) rest =

200+ EventSequenceStart NoTag AnySequence Nothing

201+ : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)

202+ objToEvents' (Object pairs) rest =

203+ EventMappingStart NoTag AnyMapping Nothing

204+ : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)

205+

206+ objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest

207+

208+ objToEvents' (String s) rest = EventScalar (encodeUtf8 s) tag style Nothing : rest

209+ where

210+ ( tag, style ) = encodeOptionsStringStyle opts s

211+ objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest

212+ objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest

213+ objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest

214+ -- Use aeson's implementation which gets rid of annoying decimal points

215+ objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest

216+

217+ pairToEvents :: Pair -> [Y.Event] -> [Y.Event]

218+ pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v

127

219

128{- FIXME

220{- FIXME

129scalarToEvent :: YamlScalar -> Event

221scalarToEvent :: YamlScalar -> Event

130scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing

222scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing

131-}

223-}

132

224

133−objToEvents' :: Value -> [Y.Event] -> [Y.Event]

134−--objToEvents' (Scalar s) rest = scalarToEvent s : rest

135−objToEvents' (Array list) rest =

136− EventSequenceStart NoTag AnySequence Nothing

137− : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)

138−objToEvents' (Object pairs) rest =

139− EventMappingStart NoTag AnyMapping Nothing

140− : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)

141−

142−-- Empty strings need special handling to ensure they get quoted. This avoids:

143−-- https://github.com/snoyberg/yaml/issues/24

144−objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest

145−

146−objToEvents' (String s) rest =

147− event : rest

148− where

149− event

150− -- Make sure that special strings are encoded as strings properly.

151− -- See: https://github.com/snoyberg/yaml/issues/31

152− | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing

153− | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing

154−objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest

155−objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest

156−objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest

157−-- Use aeson's implementation which gets rid of annoying decimal points

158−objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest

159−

160−pairToEvents :: Pair -> [Y.Event] -> [Y.Event]

161−pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v

162

225

163decode :: FromJSON a

226decode :: FromJSON a

164 => ByteString

227 => ByteString

src/Data/Yaml/Builder.hs+16−2

@@ -14,8 +14,12 @@ module Data.Yaml.Builder

14 , scientific

15 , number

16 , toByteString

17+ , toByteStringWith

17 , writeYamlFile

18 , writeYamlFile

19+ , writeYamlFileWith

18 , (.=)

20 , (.=)

21+ , FormatOptions

22+ , setWidth

19 ) where

23 ) where

21import Prelude hiding (null)

25import Prelude hiding (null)

@@ -110,7 +114,17 @@ toSource :: (Monad m, ToYaml a) => a -> ConduitM i Event m ()

110toSource = mapM_ yield . toEvents . toYaml

114toSource = mapM_ yield . toEvents . toYaml

111

115

112toByteString :: ToYaml a => a -> ByteString

116toByteString :: ToYaml a => a -> ByteString

117+toByteString = toByteStringWith defaultFormatOptions

118+

119+-- |

120+-- @since 0.10.2.0

121+toByteStringWith :: ToYaml a => FormatOptions -> a -> ByteString

113−toByteString yb = unsafePerformIO $ runConduitRes $ toSource yb .| encode

122+toByteStringWith opts yb = unsafePerformIO $ runConduitRes $ toSource yb .| encodeWith opts

114

123

115writeYamlFile :: ToYaml a => FilePath -> a -> IO ()

124writeYamlFile :: ToYaml a => FilePath -> a -> IO ()

125+writeYamlFile = writeYamlFileWith defaultFormatOptions

126+

127+-- |

128+-- @since 0.10.2.0

129+writeYamlFileWith :: ToYaml a => FormatOptions -> FilePath -> a -> IO ()

116−writeYamlFile fp yb = runConduitRes $ toSource yb .| encodeFile fp

130+writeYamlFileWith opts fp yb = runConduitRes $ toSource yb .| encodeFileWith opts fp

src/Text/Libyaml.hs+49−7

@@ -21,9 +21,14 @@ module Text.Libyaml

21 , Anchor

22 -- * Encoding and decoding

23 , encode

24+ , encodeWith

24 , decode

25 , decode

25 , encodeFile

26 , encodeFile

26 , decodeFile

27 , decodeFile

28+ , encodeFileWith

29+ , FormatOptions

30+ , defaultFormatOptions

31+ , setWidth

27 -- * Error handling

32 -- * Error handling

28 , YamlException (..)

33 , YamlException (..)

29 , YamlMark (..)

34 , YamlMark (..)

@@ -608,9 +613,34 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do

608 return $ Left $ YamlParseException problem context problemMark

613 return $ Left $ YamlParseException problem context problemMark

609 else Right <$> getEvent er

614 else Right <$> getEvent er

610

615

616+-- | Contains options relating to the formatting (indendation, width) of the YAML output.

617+--

618+-- @since 0.10.2.0

619+data FormatOptions = FormatOptions

620+ { formatOptionsWidth :: Maybe Int

621+ }

622+

623+-- |

624+-- @since 0.10.2.0

625+defaultFormatOptions :: FormatOptions

626+defaultFormatOptions = FormatOptions

627+ { formatOptionsWidth = Just 80 -- by default the width is set to 0 in the C code, which gets turned into 80 in yaml_emitter_emit_stream_start

628+ }

629+

630+-- | Set the maximum number of columns in the YAML output, or 'Nothing' for infinite. By default, the limit is 80 characters.

631+--

632+-- @since 0.10.2.0

633+setWidth :: Maybe Int -> FormatOptions -> FormatOptions

634+setWidth w opts = opts { formatOptionsWidth = w }

635+

611encode :: MonadResource m => ConduitM Event o m ByteString

636encode :: MonadResource m => ConduitM Event o m ByteString

612−encode =

637+encode = encodeWith defaultFormatOptions

638+

639+-- |

640+-- @since 0.10.2.0

641+encodeWith :: MonadResource m => FormatOptions -> ConduitM Event o m ByteString

642+encodeWith opts =

613− runEmitter alloc close

643+ runEmitter opts alloc close

614 where

644 where

615 alloc emitter = do

645 alloc emitter = do

616 fbuf <- mallocForeignPtrBytes bufferSize

646 fbuf <- mallocForeignPtrBytes bufferSize

@@ -623,11 +653,20 @@ encode =

623 fptr <- newForeignPtr_ $ castPtr ptr'

653 fptr <- newForeignPtr_ $ castPtr ptr'

624 return $ B.fromForeignPtr fptr 0 $ fromIntegral len

654 return $ B.fromForeignPtr fptr 0 $ fromIntegral len

625

655

656+

626encodeFile :: MonadResource m

657encodeFile :: MonadResource m

627 => FilePath

658 => FilePath

628 -> ConduitM Event o m ()

659 -> ConduitM Event o m ()

629−encodeFile filePath =

660+encodeFile = encodeFileWith defaultFormatOptions

661+

662+-- |

663+-- @since 0.10.2.0

664+encodeFileWith :: MonadResource m

665+ => FormatOptions

666+ -> FilePath

667+ -> ConduitM Event o m ()

668+encodeFileWith opts filePath =

630− bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)

669+ bracketP getFile c_fclose $ \file -> runEmitter opts (alloc file) (\u _ -> return u)

631 where

670 where

632 getFile = do

671 getFile = do

633 file <- openFile filePath write_flags "w"

672 file <- openFile filePath write_flags "w"

@@ -638,10 +677,11 @@ encodeFile filePath =

638 alloc file emitter = c_yaml_emitter_set_output_file emitter file

677 alloc file emitter = c_yaml_emitter_set_output_file emitter file

639

678

640runEmitter :: MonadResource m

679runEmitter :: MonadResource m

680+ => FormatOptions

641− => (Emitter -> IO a) -- ^ alloc

681+ -> (Emitter -> IO a) -- ^ alloc

642 -> (() -> a -> IO b) -- ^ close

682 -> (() -> a -> IO b) -- ^ close

643 -> ConduitM Event o m b

683 -> ConduitM Event o m b

644−runEmitter allocI closeI =

684+runEmitter opts allocI closeI =

645 bracketP alloc cleanup go

685 bracketP alloc cleanup go

646 where

686 where

647 alloc = mask_ $ do

687 alloc = mask_ $ do

@@ -651,7 +691,9 @@ runEmitter allocI closeI =

651#ifndef __NO_UNICODE__

691#ifndef __NO_UNICODE__

652 c_yaml_emitter_set_unicode emitter 1

692 c_yaml_emitter_set_unicode emitter 1

653#endif

693#endif

654− c_yaml_emitter_set_width emitter (-1) -- prevent libyaml from wrapping strings at 80 chars

694+ c_yaml_emitter_set_width emitter $ case formatOptionsWidth opts of

695+ Nothing -> -1 --infinite

696+ Just width -> fromIntegral width

655 a <- allocI emitter

697 a <- allocI emitter

656 return (emitter, a)

698 return (emitter, a)

657 cleanup (emitter, _) = do

699 cleanup (emitter, _) = do