Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-deriving-aeson for openSUSE:Factory checked in at 2023-01-18 13:09:46 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-deriving-aeson (Old) and /work/SRC/openSUSE:Factory/.ghc-deriving-aeson.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-deriving-aeson" Wed Jan 18 13:09:46 2023 rev:2 rq:1059061 version:0.2.9 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-deriving-aeson/ghc-deriving-aeson.changes 2022-08-01 21:32:15.645976950 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-deriving-aeson.new.32243/ghc-deriving-aeson.changes 2023-01-18 13:09:56.800513735 +0100 @@ -1,0 +2,8 @@ +Sun Jan 8 14:38:02 UTC 2023 - Peter Simons <[email protected]> + +- Update deriving-aeson to version 0.2.9. + ## 0.2.9 + + * Fixed a bug in chaining `ConstructorTagModifier` & `FieldLabelModifier` + +------------------------------------------------------------------- Old: ---- deriving-aeson-0.2.8.tar.gz deriving-aeson.cabal New: ---- deriving-aeson-0.2.9.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-deriving-aeson.spec ++++++ --- /var/tmp/diff_new_pack.r5tBdP/_old 2023-01-18 13:09:57.308516652 +0100 +++ /var/tmp/diff_new_pack.r5tBdP/_new 2023-01-18 13:09:57.312516675 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-deriving-aeson # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,13 +19,12 @@ %global pkg_name deriving-aeson %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.8 +Version: 0.2.9 Release: 0 Summary: Type driven generic aeson instance customisation License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-rpm-macros @@ -51,7 +50,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ deriving-aeson-0.2.8.tar.gz -> deriving-aeson-0.2.9.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/CHANGELOG.md new/deriving-aeson-0.2.9/CHANGELOG.md --- old/deriving-aeson-0.2.8/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,55 +1,59 @@ -# Revision history for deriving-aeson - -## 0.2.8 - -* Supported GHC 9.2 -* Supported aeson-2.0 - -## 0.2.7 - -* Added a `StringModifier` instance to a list of types -* Added `Rename :: Symbol -> Symbol -> Type` - -## 0.2.6 - -* Added `StringModifier` instances to 3 and 4-tuples -* Fixed the bug making `SumTwoElemArray` point `ObjectWithSingleField` - -## 0.2.5 - -* Added a generic `CamelTo` constructor - -## 0.2.4 - -* Added `RejectUnknownFields` - -## 0.2.3 - -* Fixed a bug in `SumTaggedObject` - -## 0.2.2 - -* Added `UnwrapUnaryRecords` - -## 0.2.1 - -* Remove redundant type variables from `Sum*` - -## 0.2 - -* Added `Sum*` for changing the encoding of variants -* Added `Vanilla = CustomJSON '[]` -* Renamed `ContructorTagModifier` to `ConstructorTagModifier` -* Added `toEncoding` implementation to `CustomJSON` - -## 0.1.2 - -* Reexported `CustomJSON(..)` from `Deriving.Aeson.Stock` - -## 0.1.1 - -* Added `Deriving.Aeson.Stock` - -## 0 -- 2020-02-26 - -* First version. Released on an unsuspecting world. +# Revision history for deriving-aeson + +## 0.2.9 + +* Fixed a bug in chaining `ConstructorTagModifier` & `FieldLabelModifier` + +## 0.2.8 + +* Supported GHC 9.2 +* Supported aeson-2.0 + +## 0.2.7 + +* Added a `StringModifier` instance to a list of types +* Added `Rename :: Symbol -> Symbol -> Type` + +## 0.2.6 + +* Added `StringModifier` instances to 3 and 4-tuples +* Fixed the bug making `SumTwoElemArray` point `ObjectWithSingleField` + +## 0.2.5 + +* Added a generic `CamelTo` constructor + +## 0.2.4 + +* Added `RejectUnknownFields` + +## 0.2.3 + +* Fixed a bug in `SumTaggedObject` + +## 0.2.2 + +* Added `UnwrapUnaryRecords` + +## 0.2.1 + +* Remove redundant type variables from `Sum*` + +## 0.2 + +* Added `Sum*` for changing the encoding of variants +* Added `Vanilla = CustomJSON '[]` +* Renamed `ContructorTagModifier` to `ConstructorTagModifier` +* Added `toEncoding` implementation to `CustomJSON` + +## 0.1.2 + +* Reexported `CustomJSON(..)` from `Deriving.Aeson.Stock` + +## 0.1.1 + +* Added `Deriving.Aeson.Stock` + +## 0 -- 2020-02-26 + +* First version. Released on an unsuspecting world. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/README.md new/deriving-aeson-0.2.9/README.md --- old/deriving-aeson-0.2.8/README.md 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,73 +1,73 @@ -deriving-aeson -==== - -[](https://hackage.haskell.org/package/deriving-aeson) - -[](https://discord.gg/DG93Tgs) - - - -This package provides a newtype wrapper where you can customise -[aeson](https://hackage.haskell.org/package/aeson)'s generic methods using a -type-level interface, which synergises well with DerivingVia. - -```haskell -{-# LANGUAGE DerivingVia, DataKinds, DeriveGeneric #-} -import Data.Aeson -import Deriving.Aeson -import qualified Data.ByteString.Lazy.Char8 as BL - -data User = User - { userId :: Int - , userName :: String - , userAPIToken :: Maybe String - } deriving Generic - deriving (FromJSON, ToJSON) - via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "user", CamelToSnake]] User - -testData :: [User] -testData = [User 42 "Alice" Nothing, User 43 "Bob" (Just "xyz")] - -main = BL.putStrLn $ encode testData --- [{"name":"Alice","id":42},{"api_token":"xyz","name":"Bob","id":43}] -``` - -`Deriving.Aeson.Stock` contains some aliases for even less boilerplates. - -* `Prefixed str` = `CustomJSON '[FieldLabelModifier (StripPrefix str)]` -* `PrefixedSnake str` = `CustomJSON '[FieldLabelModifier (StripPrefix str, CamelToSnake)]` -* `Snake` = `CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]]` -* `Vanilla` = `CustomJSON '[]` - -How it works ----- - -The wrapper type has a phantom type parameter `t`, a type-level builder of an [Option](http://hackage.haskell.org/package/aeson-1.4.6.0/docs/Data-Aeson.html#t:Options). -Type-level primitives are reduced to one `Option` by the `AesonOptions` class. - -```haskell -newtype CustomJSON t a = CustomJSON { unCustomJSON :: a } - -class AesonOptions xs where - aesonOptions :: Options - -instance AesonOptions xs => AesonOptions (OmitNothingFields ': xs) where - aesonOptions = (aesonOptions @xs) { omitNothingFields = True } - -... -``` - -You can use any (static) function for name modification by adding an instance of `StringModifier`. - -```haskell -data ToLower -instance StringModifier ToLower where - getStringModifier "" = "" - getStringModifier (c : xs) = toLower c : xs -``` - -Previous studies ----- - -* [Type-driven safe derivation of ToJSON and FromJSON, using DerivingVia in GHC 8.6 and some type-level hacks](https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d) -* [Strip prefices from JSON representation](https://gist.github.com/fumieval/5c89205d418d5f9cafac801afbe94969) +deriving-aeson +==== + +[](https://hackage.haskell.org/package/deriving-aeson) + +[](https://discord.gg/DG93Tgs) + + + +This package provides a newtype wrapper where you can customise +[aeson](https://hackage.haskell.org/package/aeson)'s generic methods using a +type-level interface, which synergises well with DerivingVia. + +```haskell +{-# LANGUAGE DerivingVia, DataKinds, DeriveGeneric #-} +import Data.Aeson +import Deriving.Aeson +import qualified Data.ByteString.Lazy.Char8 as BL + +data User = User + { userId :: Int + , userName :: String + , userAPIToken :: Maybe String + } deriving Generic + deriving (FromJSON, ToJSON) + via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "user", CamelToSnake]] User + +testData :: [User] +testData = [User 42 "Alice" Nothing, User 43 "Bob" (Just "xyz")] + +main = BL.putStrLn $ encode testData +-- [{"name":"Alice","id":42},{"api_token":"xyz","name":"Bob","id":43}] +``` + +`Deriving.Aeson.Stock` contains some aliases for even less boilerplates. + +* `Prefixed str` = `CustomJSON '[FieldLabelModifier (StripPrefix str)]` +* `PrefixedSnake str` = `CustomJSON '[FieldLabelModifier (StripPrefix str, CamelToSnake)]` +* `Snake` = `CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]]` +* `Vanilla` = `CustomJSON '[]` + +How it works +---- + +The wrapper type has a phantom type parameter `t`, a type-level builder of an [Option](http://hackage.haskell.org/package/aeson-1.4.6.0/docs/Data-Aeson.html#t:Options). +Type-level primitives are reduced to one `Option` by the `AesonOptions` class. + +```haskell +newtype CustomJSON t a = CustomJSON { unCustomJSON :: a } + +class AesonOptions xs where + aesonOptions :: Options + +instance AesonOptions xs => AesonOptions (OmitNothingFields ': xs) where + aesonOptions = (aesonOptions @xs) { omitNothingFields = True } + +... +``` + +You can use any (static) function for name modification by adding an instance of `StringModifier`. + +```haskell +data ToLower +instance StringModifier ToLower where + getStringModifier "" = "" + getStringModifier (c : xs) = toLower c : xs +``` + +Previous studies +---- + +* [Type-driven safe derivation of ToJSON and FromJSON, using DerivingVia in GHC 8.6 and some type-level hacks](https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d) +* [Strip prefices from JSON representation](https://gist.github.com/fumieval/5c89205d418d5f9cafac801afbe94969) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/deriving-aeson.cabal new/deriving-aeson-0.2.9/deriving-aeson.cabal --- old/deriving-aeson-0.2.8/deriving-aeson.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/deriving-aeson.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,36 +1,36 @@ -cabal-version: 2.4 -name: deriving-aeson -version: 0.2.8 -synopsis: Type driven generic aeson instance customisation -description: This package provides a newtype wrapper with - FromJSON/ToJSON instances customisable via a phantom type parameter. - The instances can be rendered to the original type using DerivingVia. -bug-reports: https://github.com/fumieval/deriving-aeson -license: BSD-3-Clause -license-file: LICENSE -author: Fumiaki Kinoshita -maintainer: [email protected] -copyright: Copyright (c) 2020 Fumiaki Kinoshita -category: JSON, Generics -extra-source-files: CHANGELOG.md, README.md -tested-with: GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.4, GHC == 9.2.1 - -source-repository head - type: git - location: https://github.com/fumieval/deriving-aeson.git - -library - exposed-modules: - Deriving.Aeson - Deriving.Aeson.Stock - build-depends: base >= 4.12 && <5, aeson >= 1.4.7.0 && <2.1 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall -Wcompat - -test-suite test - type: exitcode-stdio-1.0 - main-is: test.hs - build-depends: base, aeson, deriving-aeson, bytestring - hs-source-dirs: tests - default-language: Haskell2010 +cabal-version: 2.4 +name: deriving-aeson +version: 0.2.9 +synopsis: Type driven generic aeson instance customisation +description: This package provides a newtype wrapper with + FromJSON/ToJSON instances customisable via a phantom type parameter. + The instances can be rendered to the original type using DerivingVia. +bug-reports: https://github.com/fumieval/deriving-aeson +license: BSD-3-Clause +license-file: LICENSE +author: Fumiaki Kinoshita +maintainer: [email protected] +copyright: Copyright (c) 2020 Fumiaki Kinoshita +category: JSON, Generics +extra-source-files: CHANGELOG.md, README.md +tested-with: GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 + +source-repository head + type: git + location: https://github.com/fumieval/deriving-aeson.git + +library + exposed-modules: + Deriving.Aeson + Deriving.Aeson.Stock + build-depends: base >= 4.12 && <5, aeson >= 1.4.7.0 && <2.2 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -Wcompat + +test-suite test + type: exitcode-stdio-1.0 + main-is: test.hs + build-depends: base, aeson, deriving-aeson, bytestring + hs-source-dirs: tests + default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/src/Deriving/Aeson/Stock.hs new/deriving-aeson-0.2.9/src/Deriving/Aeson/Stock.hs --- old/deriving-aeson-0.2.8/src/Deriving/Aeson/Stock.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/src/Deriving/Aeson/Stock.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,28 +1,28 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} - -module Deriving.Aeson.Stock - ( Prefixed - , PrefixedSnake - , Snake - , Vanilla - -- * Reexports - , CustomJSON(..) - , FromJSON - , ToJSON - , Generic) where - -import Data.Kind (Type) -import Deriving.Aeson - --- | Field names are prefixed by @str@; strip them from JSON representation -type Prefixed str = CustomJSON '[FieldLabelModifier (StripPrefix str)] - --- | Strip @str@ prefices and convert from CamelCase to snake_case -type PrefixedSnake str = CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]] - --- | Convert from CamelCase to snake_case -type Snake = CustomJSON '[FieldLabelModifier CamelToSnake] - --- | No customisation -type Vanilla = CustomJSON ('[] :: [Type]) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +module Deriving.Aeson.Stock + ( Prefixed + , PrefixedSnake + , Snake + , Vanilla + -- * Reexports + , CustomJSON(..) + , FromJSON + , ToJSON + , Generic) where + +import Data.Kind (Type) +import Deriving.Aeson + +-- | Field names are prefixed by @str@; strip them from JSON representation +type Prefixed str = CustomJSON '[FieldLabelModifier (StripPrefix str)] + +-- | Strip @str@ prefices and convert from CamelCase to snake_case +type PrefixedSnake str = CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]] + +-- | Convert from CamelCase to snake_case +type Snake = CustomJSON '[FieldLabelModifier CamelToSnake] + +-- | No customisation +type Vanilla = CustomJSON ('[] :: [Type]) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/src/Deriving/Aeson.hs new/deriving-aeson-0.2.9/src/Deriving/Aeson.hs --- old/deriving-aeson-0.2.8/src/Deriving/Aeson.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/src/Deriving/Aeson.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,192 +1,193 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE UndecidableInstances #-} --------------------- --- | Type-directed aeson instance CustomJSONisation --------------------- -module Deriving.Aeson - ( CustomJSON(..) - , FieldLabelModifier - , ConstructorTagModifier - , OmitNothingFields - , RejectUnknownFields - , TagSingleConstructors - , NoAllNullaryToStringTag - , UnwrapUnaryRecords - -- * Sum encoding - , SumTaggedObject - , SumUntaggedValue - , SumObjectWithSingleField - , SumTwoElemArray - -- * Name modifiers - , StripPrefix - , CamelTo - , CamelToKebab - , CamelToSnake - , Rename - -- * Interface - , AesonOptions(..) - , StringModifier(..) - -- * Reexports - , FromJSON - , ToJSON - , Generic - )where - -import Data.Aeson -import Data.Aeson.Types -import Data.Coerce -import Data.Kind -import Data.List (stripPrefix) -import Data.Maybe (fromMaybe) -import Data.Proxy -import GHC.Generics -import GHC.TypeLits - --- | A newtype wrapper which gives FromJSON/ToJSON instances with modified options. -newtype CustomJSON t a = CustomJSON { unCustomJSON :: a } - -instance (AesonOptions t, Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomJSON t a) where - parseJSON = (coerce `asTypeOf` fmap CustomJSON) . genericParseJSON (aesonOptions @t) - {-# INLINE parseJSON #-} - -instance (AesonOptions t, Generic a, GToJSON Zero (Rep a), GToEncoding Zero (Rep a)) => ToJSON (CustomJSON t a) where - toJSON = genericToJSON (aesonOptions @t) . unCustomJSON - {-# INLINE toJSON #-} - toEncoding = genericToEncoding (aesonOptions @t) . unCustomJSON - {-# INLINE toEncoding #-} - --- | Function applied to field labels. Handy for removing common record prefixes for example. -data FieldLabelModifier t - --- | Function applied to constructor tags which could be handy for lower-casing them for example. -data ConstructorTagModifier t - --- | Record fields with a Nothing value will be omitted from the resulting object. -data OmitNothingFields - --- | JSON Documents mapped to records with unmatched keys will be rejected -data RejectUnknownFields - --- | Encode types with a single constructor as sums, so that allNullaryToStringTag and sumEncoding apply. -data TagSingleConstructors - --- | the encoding will always follow the 'sumEncoding'. -data NoAllNullaryToStringTag - --- | Unpack single-field records -data UnwrapUnaryRecords - --- | Strip prefix @t@. If it doesn't have the prefix, keep it as-is. -data StripPrefix t - --- | Generic CamelTo constructor taking in a separator char -data CamelTo (separator :: Symbol) - --- | CamelCase to snake_case -type CamelToSnake = CamelTo "_" - --- | CamelCase to kebab-case -type CamelToKebab = CamelTo "-" - --- | Rename fields called @from@ to @to@. -data Rename (from :: Symbol) (to :: Symbol) - --- | Reify a function which modifies names -class StringModifier t where - getStringModifier :: String -> String - -instance KnownSymbol k => StringModifier (StripPrefix k) where - getStringModifier = fromMaybe <*> stripPrefix (symbolVal (Proxy @k)) - -instance StringModifier '[] where - getStringModifier = id - --- | Left-to-right (@'foldr' ('flip' ('.')) 'id'@) composition -instance (StringModifier a, StringModifier as) => StringModifier (a ': as) where - getStringModifier = getStringModifier @as . getStringModifier @a - --- | Left-to-right (@'flip' '.'@) composition -instance (StringModifier a, StringModifier b) => StringModifier (a, b) where - getStringModifier = getStringModifier @b . getStringModifier @a - --- | Left-to-right (@'flip' '.'@) composition -instance (StringModifier a, StringModifier b, StringModifier c) => StringModifier (a, b, c) where - getStringModifier = getStringModifier @c . getStringModifier @b . getStringModifier @a - --- | Left-to-right (@'flip' '.'@) composition -instance (StringModifier a, StringModifier b, StringModifier c, StringModifier d) => StringModifier (a, b, c, d) where - getStringModifier = getStringModifier @d . getStringModifier @c . getStringModifier @b . getStringModifier @a - -instance (KnownSymbol separator, NonEmptyString separator) => StringModifier (CamelTo separator) where - getStringModifier = camelTo2 char - where - char = case symbolVal (Proxy @separator) of - c : _ -> c - _ -> error "Impossible" - -instance (KnownSymbol from, KnownSymbol to) => StringModifier (Rename from to) where - getStringModifier s = if s == symbolVal (Proxy @from) then symbolVal (Proxy @to) else s - -type family NonEmptyString (xs :: Symbol) :: Constraint where - NonEmptyString "" = TypeError ('Text "Empty string separator provided for camelTo separator") - NonEmptyString _ = () - --- | @{ "tag": t, "content": c}@ -data SumTaggedObject t c - --- | @CONTENT@ -data SumUntaggedValue - --- | @{ TAG: CONTENT }@ -data SumObjectWithSingleField - --- | @[TAG, CONTENT]@ -data SumTwoElemArray - --- | Reify 'Options' from a type-level list -class AesonOptions xs where - aesonOptions :: Options - -instance AesonOptions '[] where - aesonOptions = defaultOptions - -instance AesonOptions xs => AesonOptions (UnwrapUnaryRecords ': xs) where - aesonOptions = (aesonOptions @xs) { unwrapUnaryRecords = True } - -instance AesonOptions xs => AesonOptions (OmitNothingFields ': xs) where - aesonOptions = (aesonOptions @xs) { omitNothingFields = True } - -instance AesonOptions xs => AesonOptions (RejectUnknownFields ': xs) where - aesonOptions = (aesonOptions @xs) { rejectUnknownFields = True } - -instance (StringModifier f, AesonOptions xs) => AesonOptions (FieldLabelModifier f ': xs) where - aesonOptions = (aesonOptions @xs) { fieldLabelModifier = getStringModifier @f } - -instance (StringModifier f, AesonOptions xs) => AesonOptions (ConstructorTagModifier f ': xs) where - aesonOptions = (aesonOptions @xs) { constructorTagModifier = getStringModifier @f } - -instance AesonOptions xs => AesonOptions (TagSingleConstructors ': xs) where - aesonOptions = (aesonOptions @xs) { tagSingleConstructors = True } - -instance AesonOptions xs => AesonOptions (NoAllNullaryToStringTag ': xs) where - aesonOptions = (aesonOptions @xs) { allNullaryToStringTag = False } - -instance (KnownSymbol t, KnownSymbol c, AesonOptions xs) => AesonOptions (SumTaggedObject t c ': xs) where - aesonOptions = (aesonOptions @xs) { sumEncoding = TaggedObject (symbolVal (Proxy @t)) (symbolVal (Proxy @c)) } - -instance (AesonOptions xs) => AesonOptions (SumUntaggedValue ': xs) where - aesonOptions = (aesonOptions @xs) { sumEncoding = UntaggedValue } - -instance (AesonOptions xs) => AesonOptions (SumObjectWithSingleField ': xs) where - aesonOptions = (aesonOptions @xs) { sumEncoding = ObjectWithSingleField } - -instance (AesonOptions xs) => AesonOptions (SumTwoElemArray ': xs) where - aesonOptions = (aesonOptions @xs) { sumEncoding = TwoElemArray } +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} +-------------------- +-- | Type-directed aeson instance CustomJSONisation +-------------------- +module Deriving.Aeson + ( CustomJSON(..) + , FieldLabelModifier + , ConstructorTagModifier + , OmitNothingFields + , RejectUnknownFields + , TagSingleConstructors + , NoAllNullaryToStringTag + , UnwrapUnaryRecords + -- * Sum encoding + , SumTaggedObject + , SumUntaggedValue + , SumObjectWithSingleField + , SumTwoElemArray + -- * Name modifiers + , StripPrefix + , CamelTo + , CamelToKebab + , CamelToSnake + , Rename + -- * Interface + , AesonOptions(..) + , StringModifier(..) + -- * Reexports + , FromJSON + , ToJSON + , Generic + )where + +import Data.Aeson +import Data.Coerce +import Data.Kind +import Data.List (stripPrefix) +import Data.Maybe (fromMaybe) +import Data.Proxy +import GHC.Generics +import GHC.TypeLits + +-- | A newtype wrapper which gives FromJSON/ToJSON instances with modified options. +newtype CustomJSON t a = CustomJSON { unCustomJSON :: a } + +instance (AesonOptions t, Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomJSON t a) where + parseJSON = (coerce `asTypeOf` fmap CustomJSON) . genericParseJSON (aesonOptions @t) + {-# INLINE parseJSON #-} + +instance (AesonOptions t, Generic a, GToJSON Zero (Rep a), GToEncoding Zero (Rep a)) => ToJSON (CustomJSON t a) where + toJSON = genericToJSON (aesonOptions @t) . unCustomJSON + {-# INLINE toJSON #-} + toEncoding = genericToEncoding (aesonOptions @t) . unCustomJSON + {-# INLINE toEncoding #-} + +-- | Function applied to field labels. Handy for removing common record prefixes for example. +data FieldLabelModifier t + +-- | Function applied to constructor tags which could be handy for lower-casing them for example. +data ConstructorTagModifier t + +-- | Record fields with a Nothing value will be omitted from the resulting object. +data OmitNothingFields + +-- | JSON Documents mapped to records with unmatched keys will be rejected +data RejectUnknownFields + +-- | Encode types with a single constructor as sums, so that allNullaryToStringTag and sumEncoding apply. +data TagSingleConstructors + +-- | the encoding will always follow the 'sumEncoding'. +data NoAllNullaryToStringTag + +-- | Unpack single-field records +data UnwrapUnaryRecords + +-- | Strip prefix @t@. If it doesn't have the prefix, keep it as-is. +data StripPrefix t + +-- | Generic CamelTo constructor taking in a separator char +data CamelTo (separator :: Symbol) + +-- | CamelCase to snake_case +type CamelToSnake = CamelTo "_" + +-- | CamelCase to kebab-case +type CamelToKebab = CamelTo "-" + +-- | Rename fields called @from@ to @to@. +data Rename (from :: Symbol) (to :: Symbol) + +-- | Reify a function which modifies names +class StringModifier t where + getStringModifier :: String -> String + +instance KnownSymbol k => StringModifier (StripPrefix k) where + getStringModifier = fromMaybe <*> stripPrefix (symbolVal (Proxy @k)) + +instance StringModifier '[] where + getStringModifier = id + +-- | Left-to-right (@'foldr' ('flip' ('.')) 'id'@) composition +instance (StringModifier a, StringModifier as) => StringModifier (a ': as) where + getStringModifier = getStringModifier @as . getStringModifier @a + +-- | Left-to-right (@'flip' '.'@) composition +instance (StringModifier a, StringModifier b) => StringModifier (a, b) where + getStringModifier = getStringModifier @b . getStringModifier @a + +-- | Left-to-right (@'flip' '.'@) composition +instance (StringModifier a, StringModifier b, StringModifier c) => StringModifier (a, b, c) where + getStringModifier = getStringModifier @c . getStringModifier @b . getStringModifier @a + +-- | Left-to-right (@'flip' '.'@) composition +instance (StringModifier a, StringModifier b, StringModifier c, StringModifier d) => StringModifier (a, b, c, d) where + getStringModifier = getStringModifier @d . getStringModifier @c . getStringModifier @b . getStringModifier @a + +instance (KnownSymbol separator, NonEmptyString separator) => StringModifier (CamelTo separator) where + getStringModifier = camelTo2 char + where + char = case symbolVal (Proxy @separator) of + c : _ -> c + _ -> error "Impossible" + +instance (KnownSymbol from, KnownSymbol to) => StringModifier (Rename from to) where + getStringModifier s = if s == symbolVal (Proxy @from) then symbolVal (Proxy @to) else s + +type family NonEmptyString (xs :: Symbol) :: Constraint where + NonEmptyString "" = TypeError ('Text "Empty string separator provided for camelTo separator") + NonEmptyString _ = () + +-- | @{ "tag": t, "content": c}@ +data SumTaggedObject t c + +-- | @CONTENT@ +data SumUntaggedValue + +-- | @{ TAG: CONTENT }@ +data SumObjectWithSingleField + +-- | @[TAG, CONTENT]@ +data SumTwoElemArray + +-- | Reify 'Options' from a type-level list +class AesonOptions xs where + aesonOptions :: Options + +instance AesonOptions '[] where + aesonOptions = defaultOptions + +instance AesonOptions xs => AesonOptions (UnwrapUnaryRecords ': xs) where + aesonOptions = (aesonOptions @xs) { unwrapUnaryRecords = True } + +instance AesonOptions xs => AesonOptions (OmitNothingFields ': xs) where + aesonOptions = (aesonOptions @xs) { omitNothingFields = True } + +instance AesonOptions xs => AesonOptions (RejectUnknownFields ': xs) where + aesonOptions = (aesonOptions @xs) { rejectUnknownFields = True } + +instance (StringModifier f, AesonOptions xs) => AesonOptions (FieldLabelModifier f ': xs) where + aesonOptions = let next = aesonOptions @xs in + next { fieldLabelModifier = fieldLabelModifier next . getStringModifier @f } + +instance (StringModifier f, AesonOptions xs) => AesonOptions (ConstructorTagModifier f ': xs) where + aesonOptions = let next = aesonOptions @xs in + next { constructorTagModifier = constructorTagModifier next . getStringModifier @f } + +instance AesonOptions xs => AesonOptions (TagSingleConstructors ': xs) where + aesonOptions = (aesonOptions @xs) { tagSingleConstructors = True } + +instance AesonOptions xs => AesonOptions (NoAllNullaryToStringTag ': xs) where + aesonOptions = (aesonOptions @xs) { allNullaryToStringTag = False } + +instance (KnownSymbol t, KnownSymbol c, AesonOptions xs) => AesonOptions (SumTaggedObject t c ': xs) where + aesonOptions = (aesonOptions @xs) { sumEncoding = TaggedObject (symbolVal (Proxy @t)) (symbolVal (Proxy @c)) } + +instance (AesonOptions xs) => AesonOptions (SumUntaggedValue ': xs) where + aesonOptions = (aesonOptions @xs) { sumEncoding = UntaggedValue } + +instance (AesonOptions xs) => AesonOptions (SumObjectWithSingleField ': xs) where + aesonOptions = (aesonOptions @xs) { sumEncoding = ObjectWithSingleField } + +instance (AesonOptions xs) => AesonOptions (SumTwoElemArray ': xs) where + aesonOptions = (aesonOptions @xs) { sumEncoding = TwoElemArray } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/deriving-aeson-0.2.8/tests/test.hs new/deriving-aeson-0.2.9/tests/test.hs --- old/deriving-aeson-0.2.8/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/deriving-aeson-0.2.9/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,32 +1,88 @@ -{-# LANGUAGE DerivingVia, DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -module Main where - -import Data.Aeson -import Deriving.Aeson -import Deriving.Aeson.Stock -import qualified Data.ByteString.Lazy.Char8 as BL - - -data User = User - { userId :: Int - , userName :: String - , userAPIToken :: Maybe String - , userType :: String - } deriving Generic - deriving (FromJSON, ToJSON) - via CustomJSON '[ OmitNothingFields - , FieldLabelModifier '[StripPrefix "user", CamelToSnake, Rename "type" "user_type"] - ] User - -data Foo = Foo { fooFoo :: Int, fooBar :: Int } - deriving Generic - deriving (FromJSON, ToJSON) - via Prefixed "foo" Foo - -testData :: [User] -testData = [User 42 "Alice" Nothing "human", User 43 "Bob" (Just "xyz") "bot"] - -main = do - BL.putStrLn $ encode testData - BL.putStrLn $ encode $ Foo 0 1 +{-# LANGUAGE DerivingVia, DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Data.Aeson +import Deriving.Aeson +import Deriving.Aeson.Stock +import System.Exit (die) +import qualified Data.ByteString.Lazy.Char8 as BL + + +data User = User + { userId :: Int + , userName :: String + , userAPIToken :: Maybe String + , userType :: String + } deriving Generic + deriving (FromJSON, ToJSON) + via CustomJSON '[ OmitNothingFields + , FieldLabelModifier '[StripPrefix "user", CamelToSnake, Rename "type" "user_type"] + ] User + +data Foo = Foo { fooFoo :: Int, fooBar :: Int } + deriving Generic + deriving (FromJSON, ToJSON) + via Prefixed "foo" Foo + +testData :: [User] +testData = [User 42 "Alice" Nothing "human", User 43 "Bob" (Just "xyz") "bot"] + +data MultipleCtorRenames + = RenamedCtorOptA + | RenamedCtorOptB (Maybe ()) + | RenamedCtorOptC Char + deriving (Eq, Generic, Show) + deriving (ToJSON) + via CustomJSON + [ ConstructorTagModifier (Rename "RenamedCtorOptA" "nullary") + , ConstructorTagModifier (Rename "RenamedCtorOptB" "twisted-bool") + , ConstructorTagModifier (Rename "RenamedCtorOptC" "wrapped-char") + ] MultipleCtorRenames + +data MultipleFieldRenames = MultipleFieldRenames + { fooField1 :: Int + , fooField2 :: Bool + , fooField3 :: String + } + deriving (Eq, Generic, Show) + deriving (ToJSON) + via CustomJSON + [ FieldLabelModifier (Rename "fooField1" "field-1") + , FieldLabelModifier (Rename "fooField2" "field-2") + , FieldLabelModifier (Rename "fooField3" "field-3") + ] MultipleFieldRenames + +main = do + BL.putStrLn $ encode testData + BL.putStrLn $ encode $ Foo 0 1 + + assertEq + (toJSON RenamedCtorOptA) + (object [("tag", "nullary")]) + "Support multiple constructor modifiers" + + assertEq + (toJSON $ RenamedCtorOptB Nothing) + (object [("tag", String "twisted-bool"), ("contents", Null)]) + "Support multiple constructor modifiers" + + assertEq + (toJSON $ RenamedCtorOptC '?') + (object [("tag", String "wrapped-char"), ("contents", String "?")]) + "Support multiple constructor modifiers" + + assertEq + (toJSON $ MultipleFieldRenames 42 True "meaning of life") + (object [("field-1", Number 42) + ,("field-2", Bool True) + ,("field-3", String "meaning of life") + ]) + "Support multiple field modifiers" + +assertEq :: (Show a, Eq a) => a -> a -> String -> IO () +assertEq x y expectation | x == y = pure () + | otherwise = die msg + where + msg = concat [expectation, " -- not fulfilled:\n\t", show x, "\n\t /= \n\t", show y]
