git.iko.soy/typeable/yaml
on master help sign in
Merge pull request #66 from phadej/pretty

Pretty, resolve #65

commit5fa9d63531f294e2678d09cc936eb00644d3fb6c authorMichael Snoyman <michael@snoyman.com> dateThu 13 Aug 2015, 13:00 (11 years ago) parent438f0bc960441e
8 files changed+154−17
compare with master
unifiedsplit
.gitignore+1 Data/Yaml.hs−16 Data/Yaml/Builder.hs+51−1 Data/Yaml/Internal.hs+19 Data/Yaml/Pretty.hs+46 stack.yaml+9 test/Data/YamlSpec.hs+27 yaml.cabal+1
.gitignore+1
@@ -3,3 +3,4 @@ dist
33cabal-dev/
44.cabal-sandbox/
55cabal.sandbox.config
6+.stack-work/
Data/Yaml.hs−16
@@ -144,22 +144,6 @@ pairToEvents (k, v) rest =
144144 EventScalar (encodeUtf8 k) StrTag PlainNoTag Nothing
145145 : objToEvents' v rest
146146
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−
163147decode :: FromJSON a
164148 => ByteString
165149 -> Maybe a
Data/Yaml/Builder.hs+51−1
@@ -1,4 +1,6 @@
11{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE CPP #-}
24-- | NOTE: This module is a highly experimental preview release. It may change
35-- drastically, or be entirely removed, in a future release.
46module Data.Yaml.Builder
@@ -7,6 +9,10 @@ module Data.Yaml.Builder
79 , mapping
810 , array
911 , string
12+ , bool
13+ , null
14+ , scientific
15+ , number
1016 , toByteString
1117 , writeYamlFile
1218 , (.=)
@@ -15,12 +21,26 @@ module Data.Yaml.Builder
1521import Data.Conduit
1622import Data.ByteString (ByteString)
1723import Text.Libyaml
24+import Data.Yaml.Internal
1825import 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
1930import Data.Text.Encoding (encodeUtf8)
2031import System.IO.Unsafe (unsafePerformIO)
2132import Control.Arrow (second)
2233import qualified Data.ByteString.Char8 as S8
2334import 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)
2444
2545(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)
2646k .= v = (k, toYaml v)
@@ -55,7 +75,37 @@ array bs =
5575 go (YamlBuilder b) rest = b rest
5676
5777string :: Text -> YamlBuilder
58−string t = YamlBuilder (EventScalar (encodeUtf8 t) StrTag PlainNoTag Nothing:)
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
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 :)
59109
60110toEvents :: YamlBuilder -> [Event]
61111toEvents (YamlBuilder front) =
Data/Yaml/Internal.hs+19
@@ -9,6 +9,8 @@ module Data.Yaml.Internal
99 , parse
1010 , decodeHelper
1111 , decodeHelper_
12+ , specialStrings
13+ , isNumeric
1214 ) where
1315
1416import qualified Text.Libyaml as Y
@@ -41,6 +43,7 @@ import Data.Scientific (fromFloatDigits)
4143import Data.Attoparsec.Number
4244#endif
4345import Control.Monad.Trans.Resource (ResourceT, runResourceT)
46+import qualified Data.HashSet as HashSet
4447
4548data ParseException = NonScalarKey
4649 | UnknownAlias { _anchorName :: Y.AnchorName }
@@ -257,3 +260,19 @@ decodeHelper_ src = do
257260 (Left . AesonException)
258261 Right
259262 (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
2222import Test.Mockery.Directory
2323
2424import qualified Data.Yaml as D
25+import qualified Data.Yaml.Pretty as Pretty
2526import Data.Yaml (object, array, (.=))
2627import Data.Maybe
2728import qualified Data.HashMap.Strict as M
@@ -65,6 +66,10 @@ spec = do
6566 it "encode/decode strings" caseEncodeDecodeStrings
6667 it "decode invalid file" caseDecodeInvalid
6768 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
6873 describe "Data.Yaml aliases" $ do
6974 it "simple scalar alias" caseSimpleScalarAlias
7075 it "simple sequence alias" caseSimpleSequenceAlias
@@ -299,6 +304,11 @@ caseEncodeDecodeData = do
299304 let out = D.decode $ D.encode sample
300305 out @?= Just sample
301306
307+caseEncodeDecodeDataPretty :: Assertion
308+caseEncodeDecodeDataPretty = do
309+ let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample
310+ out @?= Just sample
311+
302312caseEncodeDecodeFileData :: Assertion
303313caseEncodeDecodeFileData = withFile "" $ \fp -> do
304314 D.encodeFile fp sample
@@ -310,6 +320,11 @@ caseEncodeDecodeStrings = do
310320 let out = D.decode $ D.encode sample
311321 out @?= Just sample
312322
323+caseEncodeDecodeStringsPretty :: Assertion
324+caseEncodeDecodeStringsPretty = do
325+ let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample
326+ out @?= Just sample
327+
313328caseDecodeInvalid :: Assertion
314329caseDecodeInvalid = do
315330 let invalid = B8.pack "\tthis is 'not' valid :-)"
@@ -391,6 +406,18 @@ caseDataTypes =
391406 , ("null", D.Null)
392407 ]
393408
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+ ]
394421caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion
395422caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])
396423caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])
yaml.cabal+1
@@ -57,6 +57,7 @@ library
5757 Data.Yaml
5858 Data.Yaml.Aeson
5959 Data.Yaml.Builder
60+ Data.Yaml.Pretty
6061 Data.Yaml.Parser
6162 Data.Yaml.Include
6263 other-modules: