deriving-aeson-0.2.9/0000755000000000000000000000000007346545000012625 5ustar0000000000000000deriving-aeson-0.2.9/CHANGELOG.md0000644000000000000000000000212707346545000014440 0ustar0000000000000000# 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. deriving-aeson-0.2.9/LICENSE0000644000000000000000000000277307346545000013643 0ustar0000000000000000Copyright Fumiaki Kinoshita (c) 2020 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Fumiaki Kinoshita nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. deriving-aeson-0.2.9/README.md0000644000000000000000000000532007346545000014104 0ustar0000000000000000deriving-aeson ==== [![Hackage](https://img.shields.io/hackage/v/deriving-aeson.svg)](https://hackage.haskell.org/package/deriving-aeson) ![Haskell CI](https://github.com/fumieval/deriving-aeson/workflows/Haskell%20CI/badge.svg) [![Discord](https://img.shields.io/discord/664807830116892674?color=%237095ec&label=Discord&style=plastic)](https://discord.gg/DG93Tgs) ![logo](https://github.com/fumieval/deriving-aeson/blob/master/logo/logo.png?raw=true) 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-0.2.9/Setup.hs0000644000000000000000000000005607346545000014262 0ustar0000000000000000import Distribution.Simple main = defaultMain deriving-aeson-0.2.9/deriving-aeson.cabal0000644000000000000000000000247507346545000016533 0ustar0000000000000000cabal-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: fumiexcel@gmail.com 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 deriving-aeson-0.2.9/src/Deriving/0000755000000000000000000000000007346545000015163 5ustar0000000000000000deriving-aeson-0.2.9/src/Deriving/Aeson.hs0000644000000000000000000001576307346545000016600 0ustar0000000000000000{-# 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 } deriving-aeson-0.2.9/src/Deriving/Aeson/0000755000000000000000000000000007346545000016230 5ustar0000000000000000deriving-aeson-0.2.9/src/Deriving/Aeson/Stock.hs0000644000000000000000000000137407346545000017654 0ustar0000000000000000{-# 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]) deriving-aeson-0.2.9/tests/0000755000000000000000000000000007346545000013767 5ustar0000000000000000deriving-aeson-0.2.9/tests/test.hs0000644000000000000000000000526007346545000015305 0ustar0000000000000000{-# 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]