diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,15 @@ -# Revision history for HsYAML-aeson +See also http://pvp.haskell.org/faq + +## 0.2.0.0 + +This release incorporates the work from [Vijay Tadikamalla's GSOC 2019 Project](https://vijayphoenix.github.io/blog/gsoc-the-conclusion/). + +* **Breaking change**: The result types of `decode1`, `decode1'`, `decodeValue`, and `decodeValue'` have been changed from `Either String _` to `Either (Pos,String) _` to mirror the error-reporting change in the `HsYAML-0.2` API +* New functions `encode1`, `encode1Strict`, `encodeValue`, and `encodeValue'` for serializing JSON Values as YAML documents +* New convenience function `decode1Strict` +* New (orphan) `instance ToYAML Data.Aeson.Value` + +---- ## 0.1.0.0 diff --git a/HsYAML-aeson.cabal b/HsYAML-aeson.cabal --- 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 @@ -30,12 +30,15 @@ library exposed-modules: Data.YAML.Aeson build-depends: - , HsYAML ^>= 0.1.1.0 + , HsYAML ^>= 0.2.0 , aeson ^>= 1.4.0.0 - , base >= 4.5 && < 4.13 + , base >= 4.5 && < 4.14 , 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 diff --git a/LICENSE.GPLv2 b/LICENSE.GPLv2 --- a/LICENSE.GPLv2 +++ b/LICENSE.GPLv2 @@ -1,6 +1,7 @@ GNU GENERAL PUBLIC LICENSE Version 2, June 1991 + Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/src/Data/YAML/Aeson.hs b/src/Data/YAML/Aeson.hs --- a/src/Data/YAML/Aeson.hs +++ b/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 @@ -- ** 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 as BS import qualified Data.ByteString.Lazy as BS.L +import qualified Data.HashMap.Strict as HM +import qualified Data.Map as Map +import Data.Scientific 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.Schema +import qualified Data.YAML.Token as YT -- | Parse a single YAML document using the 'coreSchemaResolver' and decode to Haskell types using 'FromJSON' instances. -- @@ -45,28 +60,49 @@ -- See 'decodeValue' for more information about this functions' YAML -- decoder configuration. -- -decode1 :: FromJSON v => BS.L.ByteString -> Either String v -decode1 bs = do - vs <- decodeValue bs - 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) +-- __NOTE__: In contrast to 'FromYAML'-based decoding, error +-- source-locations are not available when errors occur in the +-- `FromJSON' decoding phase due to limitations of the 'FromJSON' +-- class; in such cases an improper 'Pos' value with a negative +-- 'posCharOffset' will be returned. +-- +-- @since 0.2.0 +decode1 :: FromJSON v => BS.L.ByteString -> Either (Pos,String) v +decode1 bs = case decodeValue bs of + Left err -> Left err + Right vs -> case vs of + [] -> Left (zeroPos, "No documents found in YAML stream") + (_:_:_) -> Left (dummyPos, "Multiple documents encountered in YAML stream") + [v1] -> do + case J.fromJSON v1 of + J.Success v2 -> Right $! v2 + J.Error err -> Left (dummyPos, "fromJSON: " ++ err) + where + zeroPos = Pos { posByteOffset = 0, posCharOffset = 0, posLine = 1, posColumn = 0 } + dummyPos = Pos { posByteOffset = -1, posCharOffset = -1, posLine = 1, posColumn = 0 } +-- | Like 'decode1' but takes a strict 'BS.ByteString' +-- +-- @since 0.2.0 +decode1Strict :: FromJSON v => BS.ByteString -> Either (Pos,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 - [] -> 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) +-- +-- @since 0.2.0 +decode1' :: FromJSON v => SchemaResolver -> (J.Value -> Either String Text) -> BS.L.ByteString -> Either (Pos,String) v +decode1' schema keyconv bs = case decodeValue' schema keyconv bs of + Left err -> Left err + Right vs -> case vs of + [] -> Left (zeroPos, "No documents found in YAML stream") + (_:_:_) -> Left (dummyPos, "Multiple documents encountered in YAML stream") + [v1] -> do + case J.fromJSON v1 of + J.Success v2 -> Right $! v2 + J.Error err -> Left (dummyPos, "fromJSON: " ++ err) + where + zeroPos = Pos { posByteOffset = 0, posCharOffset = 0, posLine = 1, posColumn = 0 } + dummyPos = Pos { posByteOffset = -1, posCharOffset = -1, posLine = 1, posColumn = 0 } -- | Parse YAML documents into JSON 'Value' ASTs -- @@ -83,12 +119,14 @@ -- 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] +-- +-- @since 0.2.0 +decodeValue :: BS.L.ByteString -> Either (Pos, String) [J.Value] decodeValue = decodeValue' coreSchemaResolver identityKeyConv where identityKeyConv :: J.Value -> Either String Text identityKeyConv (J.String k) = Right k - identityKeyConv _ = Left "non-String key encountered in mapping" + identityKeyConv _ = Left "non-String key encountered in mapping" -- | Parse YAML documents into JSON 'Value' ASTs -- @@ -97,40 +135,47 @@ -- __NOTE__: This decoder ignores YAML tags and relies on the YAML -- 'SchemaResolver' provided to ensure that scalars have been resolved -- to the proper known core YAML types. - +-- +-- @since 0.2.0 decodeValue' :: SchemaResolver -- ^ YAML Schema resolver to use -> (J.Value -> Either String Text) -- ^ 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 pos -> pure $! case schemaResolverScalar t s v of + Left e -> Left (pos, e) + Right vs -> mkScl vs pos + , ySequence = \t vs pos -> pure $! case schemaResolverSequence t of + Left e -> Left (pos, e) + Right _ -> mkArr vs + , yMapping = \t kvs pos -> pure $! case schemaResolverMapping t of + Left e -> Left (pos, e) + Right _ -> mkObj pos kvs + , yAlias = \_ c n pos -> pure $! if c then Left (pos, "cycle detected") else Right n + , yAnchor = \_ n _ -> Ap.pure $! Right $! n } - mkObj :: [(J.Value, J.Value)] -> Either String J.Value - mkObj xs = object <$> mapM mkPair xs + mkObj :: Pos -> [(J.Value, J.Value)] -> Either (Pos, String) J.Value + mkObj pos xs = object <$> mapM (mkPair pos) xs - mkPair :: (J.Value,J.Value) -> Either String J.Pair - mkPair (k, v) = do - k' <- keyconv k - Right (k', v) + mkPair :: Pos -> (J.Value,J.Value) -> Either (Pos, String) J.Pair + mkPair pos (k, v) = case keyconv k of + Right k' -> Right (k', v) + Left s -> Left (pos, s) - mkArr :: [J.Value] -> Either String J.Value + mkArr :: [J.Value] -> Either (Pos, String) J.Value mkArr xs = Right $! J.Array $! V.fromList xs - mkScl :: Y.Scalar -> Either String J.Value - mkScl s = case scalarToValue s of - Nothing -> Left "unresolved YAML scalar encountered" + mkScl :: Y.Scalar -> Pos -> Either (Pos, String) J.Value + mkScl s pos = case scalarToValue s of + Nothing -> Left (pos, "unresolved YAML scalar encountered") Just v -> Right $! v --- | Convert a YAML 'Scalar' into a JSON 'J.Value' +-- | Convert a YAML t'Scalar' into a JSON 'J.Value' -- -- This conversion will return 'Nothing' for 'SUnknown', -- i.e. unresolved YAML nodes. @@ -141,3 +186,58 @@ 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 v'Data.YAML.Event.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)