yaml 0.11.1.2 → 0.11.2.0

raw patch · 7 files changed

+290/−148 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• src/Data/Yaml.hs +10/−75
• src/Data/Yaml/Builder.hs +71/−39
• src/Data/Yaml/Internal.hs +95/−5
• src/Data/Yaml/Pretty.hs +2/−1
• test/Data/YamlSpec.hs +99/−26
• yaml.cabal +2/−2

@@ -1,5 +1,16 @@ # ChangeLog for yaml +## 0.11.2.0++* Reduces some of the code duplication between the `encode` and `encodePretty` functions+* The output of `encodePretty` has been improved:+    - Multiline strings now use `Literal` style instead of `SingleQuoted`+    - Special keys are now quoted in mappings [#179](https://github.com/snoyberg/yaml/issues/179)+* Support for complex keys in mappings: [#182](https://github.com/snoyberg/yaml/issues/182)+    - Adds `complexMapping` function to `Data.Yaml.Builder`+    - Decode functions now return a `NonStringKey` error when attempting to decode a mapping with a complex key as it is not possible to decode these to an Aeson `Value`+* Adds missing `ToYaml` instances+ ## 0.11.1.2  * Compiles with GHC 8.8.1 (`MonadFail` split)

@@ -72,6 +72,7 @@     , isSpecialString     , EncodeOptions     , defaultEncodeOptions+    , defaultStringStyle     , setStringStyle     , setFormat     , FormatOptions@@ -94,18 +95,10 @@     , Object, Array     , withObject, withText, withArray, withScientific, withBool     )-import qualified Data.Scientific as S-import qualified Data.ByteString.Builder.Scientific-import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)+import Data.Aeson.Types (parseMaybe, parseEither, Parser) import Data.ByteString (ByteString)-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Lazy as BL import Data.Conduit ((.|), runConduitRes) import qualified Data.Conduit.List as CL-import qualified Data.HashMap.Strict as M-import qualified Data.HashSet as HashSet-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text as T import qualified Data.Vector as V import System.IO.Unsafe (unsafePerformIO) import Data.Text (Text)@@ -114,13 +107,6 @@ import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith) import qualified Text.Libyaml as Y --- |--- @since 0.10.2.0-data EncodeOptions = EncodeOptions-  { encodeOptionsStringStyle :: Text -> ( Tag, Style )-  , encodeOptionsFormat :: FormatOptions-  }- -- | Set the string style in the encoded YAML. This is a function that decides -- for each string the type of YAML string to output. --@@ -145,25 +131,18 @@ setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions setFormat f opts = opts { encodeOptionsFormat = f } --- | Determine whether a string must be quoted in YAML and can't appear as plain text.--- Useful if you want to use 'setStringStyle'.---+-- | -- @since 0.10.2.0-isSpecialString :: Text -> Bool-isSpecialString s = s `HashSet.member` specialStrings || isNumeric s+data EncodeOptions = EncodeOptions+  { encodeOptionsStringStyle :: Text -> ( Tag, Style )+  , encodeOptionsFormat :: FormatOptions+  }  -- | -- @since 0.10.2.0 defaultEncodeOptions :: EncodeOptions defaultEncodeOptions = EncodeOptions-  { encodeOptionsStringStyle = \s ->-    -- Empty strings need special handling to ensure they get quoted. This avoids:-    -- https://github.com/snoyberg/yaml/issues/24-    case () of-      ()-        | "\n" `T.isInfixOf` s -> ( NoTag, Literal )-        | isSpecialString s -> ( NoTag, SingleQuoted )-        | otherwise -> ( StrTag, PlainNoTag )+  { encodeOptionsStringStyle = defaultStringStyle   , encodeOptionsFormat = defaultFormatOptions   } @@ -176,7 +155,7 @@ -- @since 0.10.2.0 encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString encodeWith opts obj = unsafePerformIO $ runConduitRes-    $ CL.sourceList (objToEvents opts $ toJSON obj)+    $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)    .| Y.encodeWith (encodeOptionsFormat opts)  -- | Encode a value into its YAML representation and save to the given file.@@ -188,52 +167,8 @@ -- @since 0.10.2.0 encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO () encodeFileWith opts fp obj = runConduitRes-    $ CL.sourceList (objToEvents opts $ toJSON obj)+    $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)    .| Y.encodeFileWith (encodeOptionsFormat opts) fp--objToEvents :: EncodeOptions -> Value -> [Y.Event]-objToEvents opts o = (:) EventStreamStart-              . (:) EventDocumentStart-              $ objToEvents' o-              [ EventDocumentEnd-              , EventStreamEnd-              ]-  where-    objToEvents' :: Value -> [Y.Event] -> [Y.Event]-    --objToEvents' (Scalar s) rest = scalarToEvent s : rest-    objToEvents' (Array list) rest =-        EventSequenceStart NoTag AnySequence Nothing-      : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)-    objToEvents' (Object pairs) rest =-        EventMappingStart NoTag AnyMapping Nothing-      : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)--    objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest--    objToEvents' (String s) rest = EventScalar (encodeUtf8 s) tag style Nothing : rest-      where-        ( tag, style ) = encodeOptionsStringStyle opts s-    objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest-    objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest-    objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest--    objToEvents' (Number s) rest =-      let builder-            -- Special case the 0 exponent to remove the trailing .0-            | S.base10Exponent s == 0 = BB.integerDec $ S.coefficient s-            | otherwise = Data.ByteString.Builder.Scientific.scientificBuilder s-          lbs = BB.toLazyByteString builder-          bs = BL.toStrict lbs-       in EventScalar bs IntTag PlainNoTag Nothing : rest--    pairToEvents :: Pair -> [Y.Event] -> [Y.Event]-    pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v--{- FIXME-scalarToEvent :: YamlScalar -> Event-scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing--}-  decode :: FromJSON a        => ByteString

@@ -9,6 +9,9 @@     , mapping     , namedMapping     , maybeNamedMapping+    , mappingComplex+    , namedMappingComplex+    , maybeNamedMappingComplex     , array     , namedArray     , maybeNamedArray@@ -37,7 +40,6 @@  import Prelude hiding (null) -import Control.Arrow (second) #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Text (encodeToTextBuilder) #else@@ -47,10 +49,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import Data.Conduit-import qualified Data.HashSet as HashSet import Data.Scientific (Scientific) import Data.Text (Text, unpack)-import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText)@@ -68,119 +69,148 @@     toYaml :: a -> YamlBuilder instance ToYaml YamlBuilder where     toYaml = id-instance ToYaml a => ToYaml [(Text, a)] where-    toYaml = mapping . map (second toYaml)+instance (ToYaml a, ToYaml b) => ToYaml [(a, b)] where+    toYaml = mappingComplex . map (\(k, v) -> (toYaml k, toYaml v)) instance ToYaml a => ToYaml [a] where     toYaml = array . map toYaml instance ToYaml Text where     toYaml = string+instance ToYaml String where+    toYaml = string . T.pack instance ToYaml Int where-    toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:)+    toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:)+instance ToYaml Double where+    toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:)+instance ToYaml Scientific where+    toYaml = scientific+instance ToYaml Bool where+    toYaml = bool+instance ToYaml a => ToYaml (Maybe a) where+    toYaml = maybe null toYaml  -- |--- @since 0.11.0+-- @since 0.10.3.0 maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder-maybeNamedMapping anchor pairs = YamlBuilder $ \rest ->-    EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs+maybeNamedMapping anchor pairs = maybeNamedMappingComplex anchor complexPairs   where-    addPair (key, YamlBuilder value) after-        = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing-        : value after+    complexPairs = map (\(k, v) -> (string k, v)) pairs +-- |+-- @since 0.8.7 mapping :: [(Text, YamlBuilder)] -> YamlBuilder mapping = maybeNamedMapping Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder namedMapping name = maybeNamedMapping $ Just name  -- |--- @since 0.11.0+-- @since 0.11.2.0+maybeNamedMappingComplex :: Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder+maybeNamedMappingComplex anchor pairs = YamlBuilder $ \rest ->+    EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs+  where+    addPair (YamlBuilder key, YamlBuilder value) after = key $ value after++-- |+-- @since 0.11.2.0+mappingComplex :: [(YamlBuilder, YamlBuilder)] -> YamlBuilder+mappingComplex = maybeNamedMappingComplex Nothing++-- |+-- @since 0.11.2.0+namedMappingComplex :: Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder+namedMappingComplex name = maybeNamedMappingComplex $ Just name++-- |+-- @since 0.10.3.0 maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder maybeNamedArray anchor bs =     YamlBuilder $ (EventSequenceStart NoTag AnySequence (unpack <$> anchor):) . flip (foldr go) bs . (EventSequenceEnd:)   where     go (YamlBuilder b) = b +-- |+-- @since 0.8.7 array :: [YamlBuilder] -> YamlBuilder array = maybeNamedArray Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedArray :: Text -> [YamlBuilder] -> YamlBuilder namedArray name = maybeNamedArray $ Just name  -- |--- @since 0.11.0+-- @since 0.10.3.0 maybeNamedString :: Maybe Text -> Text -> YamlBuilder--- Empty strings need special handling to ensure they get quoted. This avoids:--- https://github.com/snoyberg/yaml/issues/24-maybeNamedString anchor ""  = YamlBuilder (EventScalar "" NoTag SingleQuoted (unpack <$> anchor) :)-maybeNamedString anchor 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 $ unpack <$> anchor-        | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag $ unpack <$> anchor+maybeNamedString anchor s = YamlBuilder (stringScalar defaultStringStyle anchor s :) +-- |+-- @since 0.8.7 string :: Text -> YamlBuilder string = maybeNamedString Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedString :: Text -> Text -> YamlBuilder namedString name = maybeNamedString $ Just name   -- Use aeson's implementation which gets rid of annoying decimal points -- |--- @since 0.11.0+-- @since 0.10.3.0 maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder-maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag (unpack <$> anchor) :)+maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) NoTag PlainNoTag (unpack <$> anchor) :) +-- |+-- @since 0.8.13 scientific :: Scientific -> YamlBuilder scientific = maybeNamedScientific Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedScientific :: Text -> Scientific -> YamlBuilder namedScientific name = maybeNamedScientific $ Just name +-- |+-- @since 0.8.13 {-# DEPRECATED number "Use scientific" #-} number :: Scientific -> YamlBuilder number = scientific  -- |--- @since 0.11.0+-- @since 0.10.3.0 maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder-maybeNamedBool anchor True   = YamlBuilder (EventScalar "true" BoolTag PlainNoTag (unpack <$> anchor) :)-maybeNamedBool anchor False  = YamlBuilder (EventScalar "false" BoolTag PlainNoTag (unpack <$> anchor) :)+maybeNamedBool anchor True   = YamlBuilder (EventScalar "true" NoTag PlainNoTag (unpack <$> anchor) :)+maybeNamedBool anchor False  = YamlBuilder (EventScalar "false" NoTag PlainNoTag (unpack <$> anchor) :) +-- |+-- @since 0.8.13 bool :: Bool -> YamlBuilder bool = maybeNamedBool Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedBool :: Text -> Bool -> YamlBuilder namedBool name = maybeNamedBool $ Just name  -- |--- @since 0.11.0+-- @since 0.10.3.0 maybeNamedNull :: Maybe Text -> YamlBuilder-maybeNamedNull anchor = YamlBuilder (EventScalar "null" NullTag PlainNoTag (unpack <$> anchor) :)+maybeNamedNull anchor = YamlBuilder (EventScalar "null" NoTag PlainNoTag (unpack <$> anchor) :) +-- |+-- @since 0.8.13 null :: YamlBuilder null = maybeNamedNull Nothing  -- |--- @since 0.11.0+-- @since 0.10.3.0 namedNull :: Text -> YamlBuilder namedNull name = maybeNamedNull $ Just name  -- |--- @since 0.11.0+-- @since 0.10.3.0 alias :: Text -> YamlBuilder alias anchor = YamlBuilder (EventAlias (unpack anchor) :) @@ -191,6 +221,8 @@ toSource :: (Monad m, ToYaml a) => a -> ConduitM i Event m () toSource = mapM_ yield . toEvents . toYaml +-- |+-- @since 0.8.7 toByteString :: ToYaml a => a -> ByteString toByteString = toByteStringWith defaultFormatOptions 

@@ -11,9 +11,14 @@     , parse     , decodeHelper     , decodeHelper_+    , textToScientific+    , stringScalar+    , defaultStringStyle+    , isSpecialString     , specialStrings     , isNumeric-    , textToScientific+    , objToStream+    , objToEvents     ) where  #if !MIN_VERSION_base(4,8,0)@@ -26,11 +31,14 @@ import Control.Monad.State.Strict import Control.Monad.Reader import Data.Aeson-import Data.Aeson.Internal (JSONPath, JSONPathElement(..))+import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError) import Data.Aeson.Types hiding (parse) import qualified Data.Attoparsec.Text as Atto import Data.Bits (shiftL, (.|.)) import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Builder.Scientific (scientificBuilder) import Data.Char (toUpper, ord) import Data.List import Data.Conduit ((.|), ConduitM, runConduit)@@ -41,10 +49,10 @@ import qualified Data.Map as Map import           Data.Set (Set) import qualified Data.Set as Set-import Data.Scientific (Scientific)+import Data.Scientific (Scientific, base10Exponent, coefficient) import Data.Text (Text, pack) import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Data.Typeable import qualified Data.Vector as V@@ -60,6 +68,7 @@                     | InvalidYaml (Maybe YamlException)                     | AesonException String                     | OtherParseException SomeException+                    | NonStringKey JSONPath                     | NonStringKeyAlias Y.AnchorName Value                     | CyclicIncludes                     | LoadSettingsException FilePath ParseException@@ -108,6 +117,7 @@         ]   AesonException s -> "Aeson exception:\n" ++ s   OtherParseException exc -> "Generic parse exception:\n" ++ show exc+  NonStringKey path -> formatError path "Non-string keys are not supported"   NonStringKeyAlias anchor value -> unlines     [ "Non-string key alias:"     , "  Anchor name: " ++ anchor@@ -250,7 +260,9 @@                             Nothing -> liftIO $ throwIO $ UnknownAlias an                             Just (String t) -> return t                             Just v -> liftIO $ throwIO $ NonStringKeyAlias an v-                    _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing+                    _ -> do+                        path <- ask+                        liftIO $ throwIO $ NonStringKey path              (mergedKeys', al') <- local (Key s :) $ do               o <- parseO@@ -301,10 +313,88 @@             Right             ((,) (parseStateWarnings st) <$> parseEither parseJSON y) +type StringStyle = Text -> ( Tag, Style )++-- | Encodes a string with the supplied style. This function handles the empty+-- string case properly to avoid https://github.com/snoyberg/yaml/issues/24+--+-- @since 0.11.2.0+stringScalar :: StringStyle -> Maybe Text -> Text -> Event+stringScalar _ anchor "" = EventScalar "" NoTag SingleQuoted (T.unpack <$> anchor)+stringScalar stringStyle anchor s = EventScalar (encodeUtf8 s) tag style (T.unpack <$> anchor)+  where+    ( tag, style ) = stringStyle s++-- |+-- @since 0.11.2.0+defaultStringStyle :: StringStyle+defaultStringStyle = \s ->+    case () of+      ()+        | "\n" `T.isInfixOf` s -> ( NoTag, Literal )+        | isSpecialString s -> ( NoTag, SingleQuoted )+        | otherwise -> ( NoTag, PlainNoTag )++-- | Determine whether a string must be quoted in YAML and can't appear as plain text.+-- Useful if you want to use 'setStringStyle'.+--+-- @since 0.10.2.0+isSpecialString :: Text -> Bool+isSpecialString s = s `HashSet.member` specialStrings || isNumeric s+ -- | Strings which must be escaped so as not to be treated as non-string scalars.+--+-- @since 0.8.32 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 ~ *" +-- |+-- @since 0.8.32 isNumeric :: Text -> Bool isNumeric = either (const False) (const True) . textToScientific++-- | Encode a value as a YAML document stream.+--+-- @since 0.11.2.0+objToStream :: ToJSON a => StringStyle -> a -> [Y.Event]+objToStream stringStyle o =+      (:) EventStreamStart+    . (:) EventDocumentStart+    $ objToEvents stringStyle o+        [ EventDocumentEnd+        , EventStreamEnd+        ]++-- | Encode a value as a list of 'Event's.+--+-- @since 0.11.2.0+objToEvents :: ToJSON a => StringStyle -> a -> [Y.Event] -> [Y.Event]+objToEvents stringStyle = objToEvents' . toJSON+  where+    objToEvents' (Array list) rest =+        EventSequenceStart NoTag AnySequence Nothing+      : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)++    objToEvents' (Object o) rest =+        EventMappingStart NoTag AnyMapping Nothing+      : foldr pairToEvents (EventMappingEnd : rest) (M.toList o)+      where+        pairToEvents :: Pair -> [Y.Event] -> [Y.Event]+        pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v++    objToEvents' (String s) rest = stringScalar stringStyle Nothing s : rest++    objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest++    objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest+    objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest++    objToEvents' (Number s) rest =+      let builder+            -- Special case the 0 exponent to remove the trailing .0+            | base10Exponent s == 0 = BB.integerDec $ coefficient s+            | otherwise = scientificBuilder s+          lbs = BB.toLazyByteString builder+          bs = BL.toStrict lbs+       in EventScalar bs IntTag PlainNoTag Nothing : rest

@@ -10,6 +10,7 @@     , getConfDropNull     , setConfDropNull     , defConfig+    , pretty     ) where  import Prelude hiding (null)@@ -34,7 +35,7 @@ -- @since 0.8.13 data Config = Config   { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects-  , confDropNull :: Bool+  , confDropNull :: Bool -- ^ Drop null values from objects   }  -- | The default configuration: do not sort objects or drop keys

@@ -27,6 +27,8 @@ import Test.Mockery.Directory  import qualified Data.Yaml as D+import qualified Data.Yaml.Builder as B+import qualified Data.Yaml.Internal as Internal import qualified Data.Yaml.Pretty as Pretty import Data.Yaml (object, array, (.=)) import Data.Maybe@@ -53,18 +55,40 @@  deriveJSON defaultOptions ''TestJSON +testJSON :: TestJSON+testJSON = TestJSON+         { string = "str"+         , number = 2+         , anArray = V.fromList ["a", "b"]+         , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]+         , extrastring = "1234-foo"+         }+ shouldDecode :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> a -> IO () shouldDecode bs expected = do-  actual <- D.decodeThrow bs-  actual `shouldBe` expected+    actual <- D.decodeThrow bs+    actual `shouldBe` expected +shouldDecodeEvents :: B8.ByteString -> [Y.Event] -> IO ()+shouldDecodeEvents bs expected = do+    actual <- runConduitRes $ Y.decode bs .| CL.consume+    map anyStyle actual `shouldBe` map anyStyle expected++anyStyle :: Y.Event -> Y.Event+anyStyle (Y.EventScalar bs tag _ anchor)     = Y.EventScalar bs tag Y.Any anchor+anyStyle (Y.EventSequenceStart tag _ anchor) = Y.EventSequenceStart tag Y.AnySequence anchor+anyStyle (Y.EventMappingStart tag _ anchor)  = Y.EventMappingStart tag Y.AnyMapping anchor+anyStyle event = event+ testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString-testEncodeWith opts es = runConduitRes (CL.sourceList events .| Y.encodeWith opts)-  where-    events =-      [Y.EventStreamStart, Y.EventDocumentStart] ++ es ++-      [Y.EventDocumentEnd, Y.EventStreamEnd]+testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts +eventStream :: [Y.Event] -> [Y.Event]+eventStream events =+    [Y.EventStreamStart, Y.EventDocumentStart]+    ++ events+    ++ [Y.EventDocumentEnd, Y.EventStreamEnd]+ main :: IO () main = hspec spec @@ -86,6 +110,7 @@         it "count scalars" caseCountScalars         it "largest string" caseLargestString         it "encode/decode" caseEncodeDecode+        it "encode/decode events" caseEncodeDecodeEvents         it "encode/decode file" caseEncodeDecodeFile         it "interleaved encode/decode" caseInterleave         it "decode invalid document (without segfault)" caseDecodeInvalidDocument@@ -101,6 +126,9 @@         it "encode/decode" caseEncodeDecodeDataPretty         it "encode/decode strings" caseEncodeDecodeStringsPretty         it "processes datatypes" caseDataTypesPretty+    describe "Data.Yaml.Builder" $ do+        it "encode/decode" caseEncodeDecodeDataBuilder+        it "encode/decode complex mapping" caseEncodeDecodeComplexMappingBuilder     describe "Data.Yaml aliases" $ do         it "simple scalar alias" caseSimpleScalarAlias         it "simple sequence alias" caseSimpleSequenceAlias@@ -159,13 +187,7 @@     describe "decodeFileEither" $ do         it "loads YAML through JSON into Haskell data" $ do           tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"-          tj `shouldBe` TestJSON-                          { string = "str"-                          , number = 2-                          , anArray = V.fromList ["a", "b"]-                          , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]-                          , extrastring = "1234-foo"-                          }+          tj `shouldBe` testJSON          context "when file does not exist" $ do             it "returns Left" $ do@@ -188,19 +210,10 @@      it "truncates files" caseTruncatesFiles -    it "quoting keys #137" $ do-      let keys = T.words "true false NO YES 1.2 1e5 null"-          bs = D.encode $ M.fromList $ map (, ()) keys-          text = decodeUtf8 bs-      forM_ keys $ \key -> do-        let quoted = T.concat ["'", key, "'"]-        unless (quoted `T.isInfixOf` text) $ error $ concat-          [ "Could not find quoted key: "-          , T.unpack quoted-          , "\n\n"-          , T.unpack text-          ] :: IO ()+    it "encode quotes special keys #137" $ caseSpecialKeys D.encode +    it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig)+     describe "non-decimal numbers #135" $ do       let go str val = it str $ encodeUtf8 (T.pack str) `shouldDecode` val       go "12345" (12345 :: Int)@@ -479,6 +492,13 @@     yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"     yamlBS = B8.pack yamlString +caseEncodeDecodeEvents :: Assertion+caseEncodeDecodeEvents = do+    let events = Internal.objToEvents D.defaultStringStyle testJSON []+    result <- Internal.decodeHelper_ . CL.sourceList $ eventStream events+    let (_, value) = either (error . show) id result+    value @?= testJSON+ caseEncodeDecodeFile :: Assertion caseEncodeDecodeFile = withFile "" $ \tmpPath -> do     eList <- runConduitRes $ Y.decodeFile filePath .| CL.consume@@ -528,8 +548,26 @@         , ("bar3", D.String "")         ]     , D.String ""+    , D.Number 1+    , D.Number 0.1+    , D.Bool True+    , D.Null     ] +sampleBuilder :: B.YamlBuilder+sampleBuilder = B.array+    [ B.string "foo"+    , B.mapping+        [ ("bar1", B.string "bar2")+        , ("bar3", B.string "")+        ]+    , B.string ""+    , B.scientific 1+    , B.scientific 0.1+    , B.bool True+    , B.null+    ]+ caseEncodeDecodeData :: Assertion caseEncodeDecodeData = D.encode sample `shouldDecode` sample @@ -537,6 +575,28 @@ caseEncodeDecodeDataPretty =     Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample +caseEncodeDecodeDataBuilder :: Assertion+caseEncodeDecodeDataBuilder = do+    let events = B.unYamlBuilder sampleBuilder []+    bs <- testEncodeWith Y.defaultFormatOptions events+    bs `shouldDecodeEvents` eventStream events++caseEncodeDecodeComplexMappingBuilder :: Assertion+caseEncodeDecodeComplexMappingBuilder = do+    let events = B.unYamlBuilder builder []+    bs <- testEncodeWith Y.defaultFormatOptions events+    bs `shouldDecodeEvents` eventStream events+  where+    builder :: B.YamlBuilder+    builder = B.mappingComplex+        [ ( B.mapping+              [ ("foo", B.scientific 1)+              , ("bar", B.scientific 2)+              ]+          , B.bool True+          )+        ]+ caseEncodeDecodeFileData :: Assertion caseEncodeDecodeFileData = withFile "" $ \fp -> do     D.encodeFile fp sample@@ -737,6 +797,19 @@     res <- D.decodeFileEither fp     either (Left . show) Right res `shouldBe` Right val +caseSpecialKeys :: (HashMap Text () -> B8.ByteString) -> Assertion+caseSpecialKeys encoder = do+      let keys = T.words "true false NO YES 1.2 1e5 null"+          bs = encoder $ M.fromList $ map (, ()) keys+          text = decodeUtf8 bs+      forM_ keys $ \key -> do+        let quoted = T.concat ["'", key, "'"]+        unless (quoted `T.isInfixOf` text) $ error $ concat+          [ "Could not find quoted key: "+          , T.unpack quoted+          , "\n\n"+          , T.unpack text+          ] :: IO ()  taggedSequence :: [Y.Event] taggedSequence =

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: fd80752d31072e9d0302c6aab5e524dff535a5e9d72ff7b14a2c1bd0e8cdc86a+-- hash: 1755dcdb4772fa7e743958ba68b120522981238fdcdac9fdc7494a36809ff6ae  name:           yaml-version:        0.11.1.2+version:        0.11.2.0 synopsis:       Support for parsing and rendering YAML documents. description:    README and API documentation are available at <https://www.stackage.org/package/yaml> category:       Data