@@ -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 , (.=)
@@ -16,11 +22,24 @@ import Data.Conduit
1622import Data.ByteString (ByteString)
1723import Text.Libyaml
1824import Data.Text (Text)
25+import Data.Scientific (Scientific)
26+import Data.Aeson.Types (Value(..))
27+import qualified Data.HashSet as HashSet
28+import qualified Data.Text as T
1929import Data.Text.Encoding (encodeUtf8)
2030import System.IO.Unsafe (unsafePerformIO)
2131import Control.Arrow (second)
2232import qualified Data.ByteString.Char8 as S8
2333import Control.Monad.Trans.Resource (runResourceT)
34+#if MIN_VERSION_aeson(0, 7, 0)
35+import qualified Data.Text.Encoding as TE
36+import qualified Data.Text.Lazy as TL
37+import Data.Text.Lazy.Builder (toLazyText)
38+import Data.Aeson.Encode (encodeToTextBuilder)
39+#else
40+import qualified Data.ByteString.Char8 as S8
41+#endif
42+import Prelude hiding (null)
2443
2544(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)
2645k .= v = (k, toYaml v)
@@ -55,7 +74,54 @@ array bs =
5574 go (YamlBuilder b) rest = b rest
5675
5776string :: Text -> YamlBuilder
58−string t = YamlBuilder (EventScalar (encodeUtf8 t) StrTag PlainNoTag Nothing:)
77+-- Empty strings need special handling to ensure they get quoted. This avoids:
78+-- https://github.com/snoyberg/yaml/issues/24
79+string "" = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :)
80+string s =
81+ YamlBuilder (event :)
82+ where
83+ event
84+ -- Make sure that special strings are encoded as strings properly.
85+ -- See: https://github.com/snoyberg/yaml/issues/31
86+ | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing
87+ | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing
88+
89+ -- | Strings which must be escaped so as not to be treated as non-string scalars.
90+ specialStrings :: HashSet.HashSet Text
91+ specialStrings = HashSet.fromList $ T.words
92+ "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 ~"
93+
94+ isNumeric :: Text -> Bool
95+ isNumeric =
96+ T.all isNumeric'
97+ where
98+ isNumeric' c = ('0' <= c && c <= '9')
99+ || c == 'e'
100+ || c == 'E'
101+ || c == '.'
102+ || c == '-'
103+ || c == '+'
104+
105+
106+-- Use aeson's implementation which gets rid of annoying decimal points
107+scientific :: Scientific -> YamlBuilder
108+scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)
109+
110+{-# DEPRECATED number "Use scientific" #-}
111+#if MIN_VERSION_aeson(0,7,0)
112+number :: Scientific -> YamlBuilder
113+number = scientific
114+#else
115+number :: Number -> YamlBuilder
116+number n rest = YamlBuilder (EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing :)
117+#endif
118+
119+bool :: Bool -> YamlBuilder
120+bool True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)
121+bool False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :)
122+
123+null :: YamlBuilder
124+null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :)
59125
60126toEvents :: YamlBuilder -> [Event]
61127toEvents (YamlBuilder front) =