Merge PR #1 (HsYAML 0.2 support & ToYAML encoding support)

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Revision history for HsYAML-aeson
 
+## 0.2.0.0
+
+* Changes in accordance with HsYAML-0.2.0.0 (#1)
+    * New convinence function `decode1Strict`
+    * New functions`encode1`, `encode1Strict`, `encodeValue`, `encodeValue'` for encoding JSON Values
+
 ## 0.1.0.0
 
 * First release. Released on an unsuspecting world.

HsYAML-aeson.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.2
 name:                HsYAML-aeson
-version:             0.1.0.0
+version:             0.2.0.0
 license:             GPL-2.0-or-later
 license-file:        LICENSE.GPLv2
 author:              Herbert Valerio Riedel
@@ -30,12 +30,15 @@ source-repository head
 library
   exposed-modules: Data.YAML.Aeson
   build-depends:
-    , HsYAML      ^>= 0.1.1.0
+    , HsYAML      ^>= 0.2
     , aeson       ^>= 1.4.0.0
     , base         >= 4.5 && < 4.13
     , bytestring  ^>= 0.9.2.1 || ^>= 0.10.0.2
+    , containers   >=0.4.2 && <0.7
     , mtl         ^>= 2.2.1
-    , text        ^>= 1.2.3.1
+    , scientific  ^>= 0.3.6.2
+    , text        ^>= 1.2.3
+    , unordered-containers ^>= 0.2
     , vector      ^>= 0.12.0.2
 
   hs-source-dirs:      src

cabal.project

@@ -0,0 +1,8 @@
+packages: .
+
+source-repository-package
+    type: git
+    location: https://github.com/haskell-hvr/HsYAML.git
+
+package HsYAML-aeson
+  flags: +exe

src/Data/YAML/Aeson.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE Trustworthy     #-}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 -- |
 -- Copyright: © Herbert Valerio Riedel 2015-2018
 -- SPDX-License-Identifier: GPL-2.0-or-later
@@ -21,20 +24,32 @@ module Data.YAML.Aeson
       -- ** High-level parsing/decoding via 'FromJSON' instances
       decode1
     , decode1'
+    , decode1Strict
       -- ** Parsing into JSON AST ('J.Value')
     , decodeValue
     , decodeValue'
     , scalarToValue
+      -- ** Encoding/Dumping 
+    , encode1
+    , encode1Strict
+    , encodeValue
+    , encodeValue'
     ) where
 
 import           Control.Applicative    as Ap
 import           Control.Monad.Identity (runIdentity)
 import           Data.Aeson             as J
 import qualified Data.Aeson.Types       as J
 import qualified Data.ByteString.Lazy   as BS.L
+import qualified Data.ByteString        as BS
 import           Data.Text              (Text)
 import qualified Data.Vector            as V
-import           Data.YAML              as Y
+import           Data.YAML              as Y  hiding (decode1, decode1Strict, encode1, encode1Strict)
+import           Data.YAML.Event        (Pos)
+import qualified Data.YAML.Token        as YT
+import           Data.Scientific
+import qualified Data.Map               as Map
+import qualified Data.HashMap.Strict    as HM
 
 -- | Parse a single YAML document using the 'coreSchemaResolver' and decode to Haskell types using 'FromJSON' instances.
 --
@@ -46,21 +61,27 @@ import           Data.YAML              as Y
 -- decoder configuration.
 --
 decode1 :: FromJSON v => BS.L.ByteString -> Either String v
-decode1 bs = do
-  vs <- decodeValue bs
-  case vs of
+decode1 bs = case decodeValue bs of
+  Left (_ ,err) -> Left err
+  Right vs -> case vs of
     [] -> Left "No documents found in YAML stream"
     (_:_:_) -> Left "Multiple documents encountered in YAML stream"
     [v1] -> do
       case J.fromJSON v1 of
         J.Success v2 -> Right $! v2
         J.Error err  -> Left ("fromJSON: " ++ err)
 
+-- | Like 'decode1' but takes a strict 'BS.ByteString'
+--
+-- @since 0.2.0
+decode1Strict :: FromJSON v => BS.ByteString -> Either String v
+decode1Strict = decode1 . BS.L.fromChunks . (:[])
+
 -- | Variant of 'decode1' allowing for customization. See 'decodeValue'' for documentation of parameters.
 decode1' :: FromJSON v => SchemaResolver -> (J.Value -> Either String Text) -> BS.L.ByteString -> Either String v
-decode1' schema keyconv bs = do
-  vs <- decodeValue' schema keyconv bs
-  case vs of
+decode1' schema keyconv bs = case decodeValue' schema keyconv bs of
+  Left (_ ,err) -> Left err
+  Right vs -> case vs of 
     [] -> Left "No documents found in YAML stream"
     (_:_:_) -> Left "Multiple documents encountered in YAML stream"
     [v1] -> do
@@ -83,7 +104,7 @@ decode1' schema keyconv bs = do
 -- which performs no conversion and will fail when encountering YAML
 -- Scalars that have not been resolved to a text Scalar (according to
 -- the respective YAML schema resolver).
-decodeValue :: BS.L.ByteString -> Either String [J.Value]
+decodeValue :: BS.L.ByteString -> Either (Pos, String) [J.Value]
 decodeValue = decodeValue' coreSchemaResolver identityKeyConv
   where
     identityKeyConv :: J.Value -> Either String Text
@@ -103,15 +124,15 @@ decodeValue' :: SchemaResolver  -- ^ YAML Schema resolver to use
                 -- ^ JSON object key conversion function. This operates on the YAML node as resolved by the 'SchemaResolver' and subsequently converted into a JSON Value according to the 'scalarToValue' conversion. See 'decodeValue' documentation for an example.
 
              -> BS.L.ByteString -- ^ YAML document to parse
-             -> Either String [J.Value]
+             -> Either (Pos, String) [J.Value]
 decodeValue' SchemaResolver{..} keyconv bs0
     = runIdentity (decodeLoader failsafeLoader bs0)
   where
-    failsafeLoader = Loader { yScalar   = \t s v -> pure $! schemaResolverScalar t s v >>= mkScl
-                            , ySequence = \t vs  -> pure $! schemaResolverSequence t >>= \_ -> mkArr vs
-                            , yMapping  = \t kvs -> pure $! schemaResolverMapping  t >>= \_ -> mkObj kvs
-                            , yAlias    = \_ c n -> pure $! if c then Left "cycle detected" else Right n
-                            , yAnchor   = \_ n   -> Ap.pure $! Right $! n
+    failsafeLoader = Loader { yScalar   = \t s v _ -> pure $! schemaResolverScalar t s v >>= mkScl
+                            , ySequence = \t vs _  -> pure $! schemaResolverSequence t >>= \_ -> mkArr vs
+                            , yMapping  = \t kvs _  -> pure $! schemaResolverMapping  t >>= \_ -> mkObj kvs
+                            , yAlias    = \_ c n _ -> pure $! if c then Left "cycle detected" else Right n
+                            , yAnchor   = \_ n _   -> Ap.pure $! Right $! n
                             }
 
     mkObj :: [(J.Value, J.Value)] -> Either String J.Value
@@ -141,3 +162,58 @@ scalarToValue (Y.SFloat x)   = Just $! J.Number (realToFrac x)
 scalarToValue (Y.SInt i)     = Just $! J.Number (fromInteger i)
 scalarToValue (SStr t)       = Just $! J.String t
 scalarToValue (SUnknown _ _) = Nothing
+
+
+-- | Equivalent to the fuction Data.ByteString.toStrict.
+-- O(n) Convert a lazy ByteString into a strict ByteString.
+{-# INLINE bsToStrict #-}
+bsToStrict :: BS.L.ByteString -> BS.ByteString
+#if MIN_VERSION_bytestring(0,10,0)
+bsToStrict = BS.L.toStrict
+#else
+bsToStrict = BS.concat . BS.L.toChunks
+#endif
+
+-- | @since 0.2.0
+instance ToYAML J.Value where
+  toYAML J.Null = Scalar () SNull
+  toYAML (J.Bool b) = toYAML b
+  toYAML (J.String txt) = toYAML txt
+  toYAML (J.Number sc) = case floatingOrInteger sc :: Either Double Integer of
+    Right d -> toYAML d
+    Left int -> toYAML int
+  toYAML (J.Array a) = toYAML (V.toList a)
+  toYAML (J.Object o) = toYAML (Map.fromList (HM.toList o))
+
+-- | Serialize JSON Value using the YAML 1.2 Core schema to a lazy 'BS.L.ByteString'.
+--
+-- 'encode1' emits exactly one YAML document.
+--
+-- See 'encodeValue' for more information about this functions' YAML
+-- encoder configuration.
+--
+-- @since 0.2.0
+encode1 :: ToJSON v => v -> BS.L.ByteString
+encode1 a = encodeValue [J.toJSON a]
+
+-- | Like 'encode1' but outputs 'BS.ByteString'
+--
+-- @since 0.2.0
+encode1Strict :: ToJSON v => v -> BS.ByteString
+encode1Strict = bsToStrict . encode1
+
+-- | Dump YAML Nodes as a lazy 'BS.L.ByteString'
+--
+-- Each YAML 'Node' is emitted as a individual YAML Document where each Document is terminated by a 'DocumentEnd' indicator.
+--
+-- This is a convenience wrapper over `encodeNode'`
+--
+-- @since 0.2.0
+encodeValue :: [J.Value] -> BS.L.ByteString
+encodeValue = encodeValue' coreSchemaEncoder YT.UTF8
+
+-- | Customizable variant of 'encodeNode'
+--
+-- @since 0.2.0
+encodeValue' :: SchemaEncoder -> YT.Encoding -> [J.Value] -> BS.L.ByteString
+encodeValue' schemaEncoder encoding values = Y.encodeNode' schemaEncoder encoding (map (Doc. toYAML) values)