From 63e7ce918c2ef9920641bfacb6a852f22e4aaea0 Mon Sep 17 00:00:00 2001 From: vijayphoenix Date: Fri, 19 Jul 2019 01:05:29 +0530 Subject: [PATCH] Functions for Encoding JSON Values --- CHANGELOG.md | 6 ++++ HsYAML-aeson.cabal | 5 ++- cabal.project | 8 +++++ src/Data/YAML/Aeson.hs | 77 ++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 93 insertions(+), 3 deletions(-) create mode 100644 cabal.project diff --git a/CHANGELOG.md b/CHANGELOG.md index d1a61a4..68d1416 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/HsYAML-aeson.cabal b/HsYAML-aeson.cabal index bf940ef..ce7a57f 100644 --- a/HsYAML-aeson.cabal +++ b/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 @@ -34,8 +34,11 @@ library , 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 + , scientific ^>= 0.3.6.2 , text ^>= 1.2.3.1 + , unordered-containers >= 0.2 && < 0.3 , vector ^>= 0.12.0.2 hs-source-dirs: src diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..3b64a5f --- /dev/null +++ b/cabal.project @@ -0,0 +1,8 @@ +packages: . + +source-repository-package + type: git + location: https://github.com/hvr/HsYAML.git + +package HsYAML-aeson + flags: +exe \ No newline at end of file diff --git a/src/Data/YAML/Aeson.hs b/src/Data/YAML/Aeson.hs index e9b5944..babafd8 100644 --- a/src/Data/YAML/Aeson.hs +++ b/src/Data/YAML/Aeson.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Trustworthy #-} @@ -19,12 +20,18 @@ module Data.YAML.Aeson ( -- * Parsing YAML using JSON models -- ** High-level parsing/decoding via 'FromJSON' instances - Data.YAML.Aeson.decode1 + decode1 , decode1' + , decode1Strict -- ** Parsing into JSON AST ('J.Value') , decodeValue , decodeValue' , scalarToValue + -- ** Encoding/Dumping + , encode1 + , encode1Strict + , encodeValue + , encodeValue' ) where import Control.Applicative as Ap @@ -32,10 +39,15 @@ 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. -- @@ -57,6 +69,12 @@ decode1 bs = case decodeValue bs 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 = case decodeValue' schema keyconv bs of @@ -142,3 +160,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)