diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.8.13 + +* Pretty module [#66](https://github.com/snoyberg/yaml/pull/66) + ## 0.8.12 * Proper handling of `String "+123"` [#64](https://github.com/snoyberg/yaml/issues/64) diff --git a/Data/Yaml.hs b/Data/Yaml.hs --- a/Data/Yaml.hs +++ b/Data/Yaml.hs @@ -144,22 +144,6 @@ EventScalar (encodeUtf8 k) StrTag PlainNoTag Nothing : objToEvents' v rest --- | Strings which must be escaped so as not to be treated as non-string scalars. -specialStrings :: HashSet.HashSet Text -specialStrings = HashSet.fromList $ T.words - "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 ~" - -isNumeric :: Text -> Bool -isNumeric = - T.all isNumeric' - where - isNumeric' c = ('0' <= c && c <= '9') - || c == 'e' - || c == 'E' - || c == '.' - || c == '-' - || c == '+' - decode :: FromJSON a => ByteString -> Maybe a diff --git a/Data/Yaml/Builder.hs b/Data/Yaml/Builder.hs --- a/Data/Yaml/Builder.hs +++ b/Data/Yaml/Builder.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} -- | NOTE: This module is a highly experimental preview release. It may change -- drastically, or be entirely removed, in a future release. module Data.Yaml.Builder @@ -7,6 +9,10 @@ , mapping , array , string + , bool + , null + , scientific + , number , toByteString , writeYamlFile , (.=) @@ -15,12 +21,26 @@ import Data.Conduit import Data.ByteString (ByteString) import Text.Libyaml +import Data.Yaml.Internal import Data.Text (Text) +import Data.Scientific (Scientific) +import Data.Aeson.Types (Value(..)) +import qualified Data.HashSet as HashSet +import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import System.IO.Unsafe (unsafePerformIO) import Control.Arrow (second) import qualified Data.ByteString.Char8 as S8 import Control.Monad.Trans.Resource (runResourceT) +#if MIN_VERSION_aeson(0, 7, 0) +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as TL +import Data.Text.Lazy.Builder (toLazyText) +import Data.Aeson.Encode (encodeToTextBuilder) +#else +import qualified Data.ByteString.Char8 as S8 +#endif +import Prelude hiding (null) (.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder) k .= v = (k, toYaml v) @@ -55,7 +75,37 @@ go (YamlBuilder b) rest = b rest string :: Text -> YamlBuilder -string t = YamlBuilder (EventScalar (encodeUtf8 t) StrTag PlainNoTag Nothing:) +-- Empty strings need special handling to ensure they get quoted. This avoids: +-- https://github.com/snoyberg/yaml/issues/24 +string "" = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :) +string s = + YamlBuilder (event :) + where + event + -- Make sure that special strings are encoded as strings properly. + -- See: https://github.com/snoyberg/yaml/issues/31 + | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing + | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing + +-- Use aeson's implementation which gets rid of annoying decimal points +scientific :: Scientific -> YamlBuilder +scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :) + +{-# DEPRECATED number "Use scientific" #-} +#if MIN_VERSION_aeson(0,7,0) +number :: Scientific -> YamlBuilder +number = scientific +#else +number :: Number -> YamlBuilder +number n rest = YamlBuilder (EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing :) +#endif + +bool :: Bool -> YamlBuilder +bool True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :) +bool False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :) + +null :: YamlBuilder +null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :) toEvents :: YamlBuilder -> [Event] toEvents (YamlBuilder front) = diff --git a/Data/Yaml/Internal.hs b/Data/Yaml/Internal.hs --- a/Data/Yaml/Internal.hs +++ b/Data/Yaml/Internal.hs @@ -9,6 +9,8 @@ , parse , decodeHelper , decodeHelper_ + , specialStrings + , isNumeric ) where import qualified Text.Libyaml as Y @@ -41,6 +43,7 @@ import Data.Attoparsec.Number #endif import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import qualified Data.HashSet as HashSet data ParseException = NonScalarKey | UnknownAlias { _anchorName :: Y.AnchorName } @@ -257,3 +260,19 @@ (Left . AesonException) Right (parseEither parseJSON y) + +-- | Strings which must be escaped so as not to be treated as non-string scalars. +specialStrings :: HashSet.HashSet Text +specialStrings = HashSet.fromList $ T.words + "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 ~" + +isNumeric :: Text -> Bool +isNumeric = + T.all isNumeric' + where + isNumeric' c = ('0' <= c && c <= '9') + || c == 'e' + || c == 'E' + || c == '.' + || c == '-' + || c == '+' diff --git a/Data/Yaml/Pretty.hs b/Data/Yaml/Pretty.hs new file mode 100644 --- /dev/null +++ b/Data/Yaml/Pretty.hs @@ -0,0 +1,58 @@ +-- | Prettier YAML encoding. +-- +-- Since 0.8.13 +module Data.Yaml.Pretty + ( encodePretty + , Config + , getConfCompare + , setConfCompare + , defConfig + ) where + +import Data.Yaml.Builder +import Data.Aeson.Types +import Data.Text (Text) +import Data.Monoid +import qualified Data.Vector as V +import qualified Data.HashMap.Strict as HM +import Data.Function (on) +import Data.List (sortBy) +import Data.ByteString (ByteString) +import Prelude hiding (null) + +-- | +-- Since 0.8.13 +data Config = Config + { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects + } + +-- | The default configuration: do not sort objects. +-- +-- Since 0.8.13 +defConfig :: Config +defConfig = Config mempty + +-- | +-- Since 0.8.13 +getConfCompare :: Config -> Text -> Text -> Ordering +getConfCompare = confCompare + +-- | +-- Since 0.8.13 +setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config +setConfCompare cmp c = c { confCompare = cmp } + +pretty :: Config -> Value -> YamlBuilder +pretty cfg = go + where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o) + go (Array a) = array (fmap go $ V.toList a) + go Null = null + go (String s) = string s + go (Number n) = number n + go (Bool b) = bool b + +-- | Configurable 'encode'. +-- +-- Since 0.8.13 +encodePretty :: ToJSON a => Config -> a -> ByteString +encodePretty cfg = toByteString . pretty cfg . toJSON diff --git a/test/Data/YamlSpec.hs b/test/Data/YamlSpec.hs --- a/test/Data/YamlSpec.hs +++ b/test/Data/YamlSpec.hs @@ -22,6 +22,7 @@ import Test.Mockery.Directory import qualified Data.Yaml as D +import qualified Data.Yaml.Pretty as Pretty import Data.Yaml (object, array, (.=)) import Data.Maybe import qualified Data.HashMap.Strict as M @@ -65,6 +66,10 @@ it "encode/decode strings" caseEncodeDecodeStrings it "decode invalid file" caseDecodeInvalid it "processes datatypes" caseDataTypes + describe "Data.Yaml.Pretty" $ do + it "encode/decode" caseEncodeDecodeDataPretty + it "encode/decode strings" caseEncodeDecodeStringsPretty + it "processes datatypes" caseDataTypesPretty describe "Data.Yaml aliases" $ do it "simple scalar alias" caseSimpleScalarAlias it "simple sequence alias" caseSimpleSequenceAlias @@ -299,6 +304,11 @@ let out = D.decode $ D.encode sample out @?= Just sample +caseEncodeDecodeDataPretty :: Assertion +caseEncodeDecodeDataPretty = do + let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample + out @?= Just sample + caseEncodeDecodeFileData :: Assertion caseEncodeDecodeFileData = withFile "" $ \fp -> do D.encodeFile fp sample @@ -310,6 +320,11 @@ let out = D.decode $ D.encode sample out @?= Just sample +caseEncodeDecodeStringsPretty :: Assertion +caseEncodeDecodeStringsPretty = do + let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample + out @?= Just sample + caseDecodeInvalid :: Assertion caseDecodeInvalid = do let invalid = B8.pack "\tthis is 'not' valid :-)" @@ -391,6 +406,18 @@ , ("null", D.Null) ] +caseDataTypesPretty :: Assertion +caseDataTypesPretty = + D.decode (Pretty.encodePretty Pretty.defConfig val) @?= Just val + where + val = object + [ ("string", D.String "foo") + , ("int", D.Number 5) + , ("float", D.Number 4.3) + , ("true", D.Bool True) + , ("false", D.Bool False) + , ("null", D.Null) + ] caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")]) caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)]) diff --git a/yaml.cabal b/yaml.cabal --- a/yaml.cabal +++ b/yaml.cabal @@ -1,5 +1,5 @@ name: yaml -version: 0.8.12 +version: 0.8.13 license: BSD3 license-file: LICENSE author: Michael Snoyman , Anton Ageev ,Kirill Simonov @@ -57,6 +57,7 @@ Data.Yaml Data.Yaml.Aeson Data.Yaml.Builder + Data.Yaml.Pretty Data.Yaml.Parser Data.Yaml.Include other-modules: