5fa9d63 · typeable/yaml

.gitignore+1

compare with master

unifiedsplit

@@ -3,3 +3,4 @@ dist

3cabal-dev/

4.cabal-sandbox/

5cabal.sandbox.config

6+.stack-work/

Data/Yaml.hs−16

@@ -144,22 +144,6 @@ pairToEvents (k, v) rest =

144 EventScalar (encodeUtf8 k) StrTag PlainNoTag Nothing

145 : objToEvents' v rest

146

147−-- | Strings which must be escaped so as not to be treated as non-string scalars.

148−specialStrings :: HashSet.HashSet Text

149−specialStrings = HashSet.fromList $ T.words

150− "y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~"

151−

152−isNumeric :: Text -> Bool

153−isNumeric =

154− T.all isNumeric'

155− where

156− isNumeric' c = ('0' <= c && c <= '9')

157− || c == 'e'

158− || c == 'E'

159− || c == '.'

160− || c == '-'

161− || c == '+'

162−

163decode :: FromJSON a

147decode :: FromJSON a

164 => ByteString

148 => ByteString

165 -> Maybe a

149 -> Maybe a

Data/Yaml/Builder.hs+51−1

@@ -1,4 +1,6 @@

1{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE CPP #-}

2-- | NOTE: This module is a highly experimental preview release. It may change

4-- | NOTE: This module is a highly experimental preview release. It may change

3-- drastically, or be entirely removed, in a future release.

5-- drastically, or be entirely removed, in a future release.

4module Data.Yaml.Builder

6module Data.Yaml.Builder

@@ -7,6 +9,10 @@ module Data.Yaml.Builder

7 , mapping

9 , mapping

8 , array

10 , array

9 , string

11 , string

12+ , bool

13+ , null

14+ , scientific

15+ , number

10 , toByteString

16 , toByteString

11 , writeYamlFile

17 , writeYamlFile

12 , (.=)

18 , (.=)

@@ -15,12 +21,26 @@ module Data.Yaml.Builder

15import Data.Conduit

21import Data.Conduit

16import Data.ByteString (ByteString)

22import Data.ByteString (ByteString)

17import Text.Libyaml

23import Text.Libyaml

24+import Data.Yaml.Internal

18import Data.Text (Text)

25import Data.Text (Text)

26+import Data.Scientific (Scientific)

27+import Data.Aeson.Types (Value(..))

28+import qualified Data.HashSet as HashSet

29+import qualified Data.Text as T

19import Data.Text.Encoding (encodeUtf8)

30import Data.Text.Encoding (encodeUtf8)

20import System.IO.Unsafe (unsafePerformIO)

31import System.IO.Unsafe (unsafePerformIO)

21import Control.Arrow (second)

32import Control.Arrow (second)

22import qualified Data.ByteString.Char8 as S8

33import qualified Data.ByteString.Char8 as S8

23import Control.Monad.Trans.Resource (runResourceT)

34import Control.Monad.Trans.Resource (runResourceT)

35+#if MIN_VERSION_aeson(0, 7, 0)

36+import qualified Data.Text.Encoding as TE

37+import qualified Data.Text.Lazy as TL

38+import Data.Text.Lazy.Builder (toLazyText)

39+import Data.Aeson.Encode (encodeToTextBuilder)

40+#else

41+import qualified Data.ByteString.Char8 as S8

42+#endif

43+import Prelude hiding (null)

24

44

25(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)

45(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)

26k .= v = (k, toYaml v)

46k .= v = (k, toYaml v)

@@ -55,7 +75,37 @@ array bs =

55 go (YamlBuilder b) rest = b rest

75 go (YamlBuilder b) rest = b rest

56

76

57string :: Text -> YamlBuilder

77string :: Text -> YamlBuilder

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

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

80+string "" = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :)

81+string s =

82+ YamlBuilder (event :)

83+ where

84+ event

85+ -- Make sure that special strings are encoded as strings properly.

86+ -- See: https://github.com/snoyberg/yaml/issues/31

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

58−string t = YamlBuilder (EventScalar (encodeUtf8 t) StrTag PlainNoTag Nothing:)

88+ | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing

89+

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

91+scientific :: Scientific -> YamlBuilder

92+scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)

93+

94+{-# DEPRECATED number "Use scientific" #-}

95+#if MIN_VERSION_aeson(0,7,0)

96+number :: Scientific -> YamlBuilder

97+number = scientific

98+#else

99+number :: Number -> YamlBuilder

100+number n rest = YamlBuilder (EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing :)

101+#endif

102+

103+bool :: Bool -> YamlBuilder

104+bool True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)

105+bool False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :)

106+

107+null :: YamlBuilder

108+null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :)

59

109

60toEvents :: YamlBuilder -> [Event]

110toEvents :: YamlBuilder -> [Event]

61toEvents (YamlBuilder front) =

111toEvents (YamlBuilder front) =

Data/Yaml/Internal.hs+19

@@ -9,6 +9,8 @@ module Data.Yaml.Internal

9 , parse

10 , decodeHelper

11 , decodeHelper_

12+ , specialStrings

13+ , isNumeric

12 ) where

14 ) where

13

15

14import qualified Text.Libyaml as Y

16import qualified Text.Libyaml as Y

@@ -41,6 +43,7 @@ import Data.Scientific (fromFloatDigits)

41import Data.Attoparsec.Number

43import Data.Attoparsec.Number

42#endif

44#endif

43import Control.Monad.Trans.Resource (ResourceT, runResourceT)

45import Control.Monad.Trans.Resource (ResourceT, runResourceT)

46+import qualified Data.HashSet as HashSet

44

47

45data ParseException = NonScalarKey

48data ParseException = NonScalarKey

46 | UnknownAlias { _anchorName :: Y.AnchorName }

49 | UnknownAlias { _anchorName :: Y.AnchorName }

@@ -257,3 +260,19 @@ decodeHelper_ src = do

257 (Left . AesonException)

260 (Left . AesonException)

258 Right

261 Right

259 (parseEither parseJSON y)

262 (parseEither parseJSON y)

263+

264+-- | Strings which must be escaped so as not to be treated as non-string scalars.

265+specialStrings :: HashSet.HashSet Text

266+specialStrings = HashSet.fromList $ T.words

267+ "y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~"

268+

269+isNumeric :: Text -> Bool

270+isNumeric =

271+ T.all isNumeric'

272+ where

273+ isNumeric' c = ('0' <= c && c <= '9')

274+ || c == 'e'

275+ || c == 'E'

276+ || c == '.'

277+ || c == '-'

278+ || c == '+'

Data/Yaml/Pretty.hsnew file+46

@@ -0,0 +1,46 @@

1+-- | Prettier YAML encoding.

2+module Data.Yaml.Pretty

3+ ( encodePretty

4+ , Config

5+ , getConfCompare

6+ , setConfCompare

7+ , defConfig

8+ ) where

9+

10+import Data.Yaml.Builder

11+import Data.Aeson.Types

12+import Data.Text (Text)

13+import Data.Monoid

14+import qualified Data.Vector as V

15+import qualified Data.HashMap.Strict as HM

16+import Data.Function (on)

17+import Data.List (sortBy)

18+import Data.ByteString (ByteString)

19+import Prelude hiding (null)

20+

21+data Config = Config

22+ { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects

23+ }

24+

25+-- | The default configuration: do not sort objects.

26+defConfig :: Config

27+defConfig = Config mempty

28+

29+getConfCompare :: Config -> Text -> Text -> Ordering

30+getConfCompare = confCompare

31+

32+setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config

33+setConfCompare cmp c = c { confCompare = cmp }

34+

35+pretty :: Config -> Value -> YamlBuilder

36+pretty cfg = go

37+ where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o)

38+ go (Array a) = array (fmap go $ V.toList a)

39+ go Null = null

40+ go (String s) = string s

41+ go (Number n) = number n

42+ go (Bool b) = bool b

43+

44+-- | Configurable 'encode'.

45+encodePretty :: ToJSON a => Config -> a -> ByteString

46+encodePretty cfg = toByteString . pretty cfg . toJSON

stack.yamlnew file+9

@@ -0,0 +1,9 @@

1+flags:

2+ yaml:

3+ no-exe: false

4+ system-libyaml: false

5+ no-unicode: false

6+packages:

7+- '.'

8+extra-deps: []

9+resolver: lts-2.22

test/Data/YamlSpec.hs+27

@@ -22,6 +22,7 @@ import Data.Either.Compat

22import Test.Mockery.Directory

23

24import qualified Data.Yaml as D

25+import qualified Data.Yaml.Pretty as Pretty

25import Data.Yaml (object, array, (.=))

26import Data.Yaml (object, array, (.=))

26import Data.Maybe

27import Data.Maybe

27import qualified Data.HashMap.Strict as M

28import qualified Data.HashMap.Strict as M

@@ -65,6 +66,10 @@ spec = do

65 it "encode/decode strings" caseEncodeDecodeStrings

66 it "encode/decode strings" caseEncodeDecodeStrings

66 it "decode invalid file" caseDecodeInvalid

67 it "decode invalid file" caseDecodeInvalid

67 it "processes datatypes" caseDataTypes

68 it "processes datatypes" caseDataTypes

69+ describe "Data.Yaml.Pretty" $ do

70+ it "encode/decode" caseEncodeDecodeDataPretty

71+ it "encode/decode strings" caseEncodeDecodeStringsPretty

72+ it "processes datatypes" caseDataTypesPretty

68 describe "Data.Yaml aliases" $ do

73 describe "Data.Yaml aliases" $ do

69 it "simple scalar alias" caseSimpleScalarAlias

74 it "simple scalar alias" caseSimpleScalarAlias

70 it "simple sequence alias" caseSimpleSequenceAlias

75 it "simple sequence alias" caseSimpleSequenceAlias

@@ -299,6 +304,11 @@ caseEncodeDecodeData = do

299 let out = D.decode $ D.encode sample

304 let out = D.decode $ D.encode sample

300 out @?= Just sample

305 out @?= Just sample

301

306

307+caseEncodeDecodeDataPretty :: Assertion

308+caseEncodeDecodeDataPretty = do

309+ let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample

310+ out @?= Just sample

311+

302caseEncodeDecodeFileData :: Assertion

312caseEncodeDecodeFileData :: Assertion

303caseEncodeDecodeFileData = withFile "" $ \fp -> do

313caseEncodeDecodeFileData = withFile "" $ \fp -> do

304 D.encodeFile fp sample

314 D.encodeFile fp sample

@@ -310,6 +320,11 @@ caseEncodeDecodeStrings = do

310 let out = D.decode $ D.encode sample

320 let out = D.decode $ D.encode sample

311 out @?= Just sample

321 out @?= Just sample

312

322

323+caseEncodeDecodeStringsPretty :: Assertion

324+caseEncodeDecodeStringsPretty = do

325+ let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample

326+ out @?= Just sample

327+

313caseDecodeInvalid :: Assertion

328caseDecodeInvalid :: Assertion

314caseDecodeInvalid = do

329caseDecodeInvalid = do

315 let invalid = B8.pack "\tthis is 'not' valid :-)"

330 let invalid = B8.pack "\tthis is 'not' valid :-)"

@@ -391,6 +406,18 @@ caseDataTypes =

391 , ("null", D.Null)

406 , ("null", D.Null)

392 ]

407 ]

393

408

409+caseDataTypesPretty :: Assertion

410+caseDataTypesPretty =

411+ D.decode (Pretty.encodePretty Pretty.defConfig val) @?= Just val

412+ where

413+ val = object

414+ [ ("string", D.String "foo")

415+ , ("int", D.Number 5)

416+ , ("float", D.Number 4.3)

417+ , ("true", D.Bool True)

418+ , ("false", D.Bool False)

419+ , ("null", D.Null)

420+ ]

394caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion

421caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion

395caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])

422caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])

396caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])

423caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])

yaml.cabal+1

@@ -57,6 +57,7 @@ library

57 Data.Yaml

58 Data.Yaml.Aeson

59 Data.Yaml.Builder

60+ Data.Yaml.Pretty

60 Data.Yaml.Parser

61 Data.Yaml.Parser

61 Data.Yaml.Include

62 Data.Yaml.Include

62 other-modules:

63 other-modules: