{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}

-- | A 'Rubric' for JSON serialization using Aeson, along with some helper
-- newtypes and re-exports.
--
-- Required extensions:
--
-- - DataKinds
-- - DeriveGeneric
-- - DerivingVia
-- - FlexibleInstances
-- - MultiParamTypeClasses
-- - OverloadedStrings
-- - TypeApplications
-- - ScopedTypeVariables
--
-- Example of use for a record type:
--
-- >>> :{
-- data Foo = Foo {aa :: Int, bb :: Bool, cc :: Char}
--   deriving (Read, Show, Eq, Generic)
--   deriving (FromJSON, ToJSON) via (JSONRecord "obj" Foo)
-- instance Aliased JSON Foo where
--   aliases =
--     aliasListBegin
--       $ alias @"aa" "aax"
--       $ alias @"bb" "bbx"
--       $ alias @"cc" "ccx"
--       $ aliasListEnd
-- :}
--
-- Example of use for a sum type:
--
-- >>> :{
-- data Summy
--   = Aa Int
--   | Bb Bool
--   | Cc
--   deriving (Read, Show, Eq, Generic)
--   deriving (FromJSON, ToJSON) via (JSONSum "sum" Summy)
-- instance Aliased JSON Summy where
--   aliases =
--     aliasListBegin
--       $ alias @"Aa" "Aax"
--       $ alias @"Bb" "Bbx"
--       $ alias @"Cc" "Ccx"
--       $ aliasListEnd
-- :}
--
-- Some limitations:
-- 
-- - Fields in branches of sum types can't have selectors. When there is more than one field in a branch, they are parsed as a JSON Array.
-- 
-- - For sum types, only the "object with a single key consisting in the branch tag" style of serialization is supported.
--
module ByOtherNames.Aeson
  ( -- * JSON helpers
    JSONRubric (..),
    JSONRecord (..),
    JSONSum (..),

    -- * Re-exports from ByOtherNames
    Aliased (aliases),
    aliasListBegin,
    alias,
    aliasListEnd,

    -- * Re-exports from Data.Aeson
    FromJSON,
    ToJSON,
  )
where

import ByOtherNames
import Control.Applicative
import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Compose
import Data.Kind
import GHC.Generics
import GHC.TypeLits
import Data.Proxy
import Data.Foldable

-- | Aliases for JSON serialization fall under this 'Rubric'.
-- The constructor 'JSON' is used as a type, with DataKinds.
data JSONRubric = JSON

-- | The aliases will be of type "Data.Aeson.Key".
instance Rubric JSON where
  type AliasType JSON = Key

-- | Helper newtype for deriving 'FromJSON' and 'ToJSON' for record types,
-- using DerivingVia.
--
-- The @objectName@ type parameter of kind 'Symbol' is used in parse error messages.
type JSONRecord :: Symbol -> Type -> Type
newtype JSONRecord objectName r = JSONRecord r

-- | Helper newtype for deriving 'FromJSON' and 'ToJSON' for sum types,
-- using DerivingVia.
--
-- The 'Symbol' type parameter is used in parse error messages.
type JSONSum :: Symbol -> Type -> Type
newtype JSONSum objectName r = JSONSum r

--
--
instance (KnownSymbol objectName, Aliased JSON r, GSum FromJSON (Rep r)) => FromJSON (JSONSum objectName r) where
  parseJSON :: Value -> Parser (JSONSum objectName r)
parseJSON Value
v =
    let parsers :: Aliases (Rep r) (BranchParser (Rep r Any))
parsers = Aliases (Rep r) Key
-> (forall b.
    Key
    -> Slots ProductInBranchParser1 ProductInBranchParser b
    -> BranchParser b)
-> (forall v. FromJSON v => ProductInBranchParser1 v)
-> (forall v. FromJSON v => ProductInBranchParser v)
-> Aliases (Rep r) (BranchParser (Rep r Any))
forall (c :: * -> Constraint) (rep :: * -> *) (n :: * -> *)
       (m2 :: * -> *) a (m1 :: * -> *) z.
(GSum c rep, Functor n, Applicative m2) =>
Aliases rep a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases rep (n (rep z))
gToSum @FromJSON (Aliased 'JSON r => Aliases (Rep r) (AliasType 'JSON)
forall k (k :: k) r. Aliased k r => Aliases (Rep r) (AliasType k)
aliases @JSONRubric @JSON @r) 
          (\Key
a -> \case 
              ZeroSlots b
v -> (Object -> Parser b) -> BranchParser b
forall v. (Object -> Parser v) -> BranchParser v
BranchParser \Object
o -> do
                Value
Null :: Value <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
a
                b -> Parser b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
              SingleSlot ProductInBranchParser1 b
p -> (Object -> Parser b) -> BranchParser b
forall v. (Object -> Parser v) -> BranchParser v
BranchParser \Object
o -> do
                Value
value <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
a
                ProductInBranchParser1 b -> Value -> Parser b
forall v. ProductInBranchParser1 v -> Value -> Parser v
runProductInBranchParser1 ProductInBranchParser1 b
p Value
value
              ManySlots ProductInBranchParser b
p -> (Object -> Parser b) -> BranchParser b
forall v. (Object -> Parser v) -> BranchParser v
BranchParser \Object
o -> do
                [Value]
valueList <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
a
                (b
prod, [Value]
_) <- ProductInBranchParser b -> [Value] -> Parser (b, [Value])
forall v. ProductInBranchParser v -> [Value] -> Parser (v, [Value])
runProductInBranchParser ProductInBranchParser b
p [Value]
valueList
                b -> Parser b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
prod
            ) 
          ((Value -> Parser v) -> ProductInBranchParser1 v
forall v. (Value -> Parser v) -> ProductInBranchParser1 v
ProductInBranchParser1 Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON) 
          (([Value] -> Parser (v, [Value])) -> ProductInBranchParser v
forall v.
([Value] -> Parser (v, [Value])) -> ProductInBranchParser v
ProductInBranchParser \case 
            [] -> String -> Parser (v, [Value])
forall a. String -> Parser a
parseFail String
"not enough field values for branch"
            Value
v : [Value]
vs -> do
              v
r <- Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
              pure (v
r, [Value]
vs))
        parserForObject :: Object -> Parser (Rep r Any)
parserForObject Object
o = Aliases (Rep r) (Parser (Rep r Any)) -> Parser (Rep r Any)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (Aliases (Rep r) (Parser (Rep r Any)) -> Parser (Rep r Any))
-> Aliases (Rep r) (Parser (Rep r Any)) -> Parser (Rep r Any)
forall a b. (a -> b) -> a -> b
$ (BranchParser (Rep r Any) -> Parser (Rep r Any))
-> Aliases (Rep r) (BranchParser (Rep r Any))
-> Aliases (Rep r) (Parser (Rep r Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Object -> Parser (Rep r Any)) -> Object -> Parser (Rep r Any)
forall a b. (a -> b) -> a -> b
$ Object
o) ((Object -> Parser (Rep r Any)) -> Parser (Rep r Any))
-> (BranchParser (Rep r Any) -> Object -> Parser (Rep r Any))
-> BranchParser (Rep r Any)
-> Parser (Rep r Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchParser (Rep r Any) -> Object -> Parser (Rep r Any)
forall v. BranchParser v -> Object -> Parser v
runBranchParser) Aliases (Rep r) (BranchParser (Rep r Any))
parsers
     in r -> JSONSum objectName r
forall (objectName :: Symbol) r. r -> JSONSum objectName r
JSONSum (r -> JSONSum objectName r)
-> (Rep r Any -> r) -> Rep r Any -> JSONSum objectName r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep r Any -> r
forall a x. Generic a => Rep a x -> a
to (Rep r Any -> JSONSum objectName r)
-> Parser (Rep r Any) -> Parser (JSONSum objectName r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser (Rep r Any)) -> Value -> Parser (Rep r Any)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (Proxy objectName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy objectName
forall k (t :: k). Proxy t
Proxy @objectName)) Object -> Parser (Rep r Any)
parserForObject Value
v
newtype BranchParser v = BranchParser { BranchParser v -> Object -> Parser v
runBranchParser :: Object -> Parser v}
  deriving stock a -> BranchParser b -> BranchParser a
(a -> b) -> BranchParser a -> BranchParser b
(forall a b. (a -> b) -> BranchParser a -> BranchParser b)
-> (forall a b. a -> BranchParser b -> BranchParser a)
-> Functor BranchParser
forall a b. a -> BranchParser b -> BranchParser a
forall a b. (a -> b) -> BranchParser a -> BranchParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BranchParser b -> BranchParser a
$c<$ :: forall a b. a -> BranchParser b -> BranchParser a
fmap :: (a -> b) -> BranchParser a -> BranchParser b
$cfmap :: forall a b. (a -> b) -> BranchParser a -> BranchParser b
Functor

newtype ProductInBranchParser1 v = ProductInBranchParser1 { ProductInBranchParser1 v -> Value -> Parser v
runProductInBranchParser1 :: Value -> Parser v }
  deriving stock a -> ProductInBranchParser1 b -> ProductInBranchParser1 a
(a -> b) -> ProductInBranchParser1 a -> ProductInBranchParser1 b
(forall a b.
 (a -> b) -> ProductInBranchParser1 a -> ProductInBranchParser1 b)
-> (forall a b.
    a -> ProductInBranchParser1 b -> ProductInBranchParser1 a)
-> Functor ProductInBranchParser1
forall a b.
a -> ProductInBranchParser1 b -> ProductInBranchParser1 a
forall a b.
(a -> b) -> ProductInBranchParser1 a -> ProductInBranchParser1 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ProductInBranchParser1 b -> ProductInBranchParser1 a
$c<$ :: forall a b.
a -> ProductInBranchParser1 b -> ProductInBranchParser1 a
fmap :: (a -> b) -> ProductInBranchParser1 a -> ProductInBranchParser1 b
$cfmap :: forall a b.
(a -> b) -> ProductInBranchParser1 a -> ProductInBranchParser1 b
Functor
  deriving Functor ProductInBranchParser1
a -> ProductInBranchParser1 a
Functor ProductInBranchParser1
-> (forall a. a -> ProductInBranchParser1 a)
-> (forall a b.
    ProductInBranchParser1 (a -> b)
    -> ProductInBranchParser1 a -> ProductInBranchParser1 b)
-> (forall a b c.
    (a -> b -> c)
    -> ProductInBranchParser1 a
    -> ProductInBranchParser1 b
    -> ProductInBranchParser1 c)
-> (forall a b.
    ProductInBranchParser1 a
    -> ProductInBranchParser1 b -> ProductInBranchParser1 b)
-> (forall a b.
    ProductInBranchParser1 a
    -> ProductInBranchParser1 b -> ProductInBranchParser1 a)
-> Applicative ProductInBranchParser1
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 b
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 a
ProductInBranchParser1 (a -> b)
-> ProductInBranchParser1 a -> ProductInBranchParser1 b
(a -> b -> c)
-> ProductInBranchParser1 a
-> ProductInBranchParser1 b
-> ProductInBranchParser1 c
forall a. a -> ProductInBranchParser1 a
forall a b.
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 a
forall a b.
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 b
forall a b.
ProductInBranchParser1 (a -> b)
-> ProductInBranchParser1 a -> ProductInBranchParser1 b
forall a b c.
(a -> b -> c)
-> ProductInBranchParser1 a
-> ProductInBranchParser1 b
-> ProductInBranchParser1 c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 a
$c<* :: forall a b.
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 a
*> :: ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 b
$c*> :: forall a b.
ProductInBranchParser1 a
-> ProductInBranchParser1 b -> ProductInBranchParser1 b
liftA2 :: (a -> b -> c)
-> ProductInBranchParser1 a
-> ProductInBranchParser1 b
-> ProductInBranchParser1 c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ProductInBranchParser1 a
-> ProductInBranchParser1 b
-> ProductInBranchParser1 c
<*> :: ProductInBranchParser1 (a -> b)
-> ProductInBranchParser1 a -> ProductInBranchParser1 b
$c<*> :: forall a b.
ProductInBranchParser1 (a -> b)
-> ProductInBranchParser1 a -> ProductInBranchParser1 b
pure :: a -> ProductInBranchParser1 a
$cpure :: forall a. a -> ProductInBranchParser1 a
$cp1Applicative :: Functor ProductInBranchParser1
Applicative via (Compose ((->) Value) Parser)

newtype ProductInBranchParser v = ProductInBranchParser { ProductInBranchParser v -> [Value] -> Parser (v, [Value])
runProductInBranchParser :: [Value] -> Parser (v, [Value]) }
  deriving stock a -> ProductInBranchParser b -> ProductInBranchParser a
(a -> b) -> ProductInBranchParser a -> ProductInBranchParser b
(forall a b.
 (a -> b) -> ProductInBranchParser a -> ProductInBranchParser b)
-> (forall a b.
    a -> ProductInBranchParser b -> ProductInBranchParser a)
-> Functor ProductInBranchParser
forall a b. a -> ProductInBranchParser b -> ProductInBranchParser a
forall a b.
(a -> b) -> ProductInBranchParser a -> ProductInBranchParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ProductInBranchParser b -> ProductInBranchParser a
$c<$ :: forall a b. a -> ProductInBranchParser b -> ProductInBranchParser a
fmap :: (a -> b) -> ProductInBranchParser a -> ProductInBranchParser b
$cfmap :: forall a b.
(a -> b) -> ProductInBranchParser a -> ProductInBranchParser b
Functor

instance Applicative ProductInBranchParser where
  pure :: a -> ProductInBranchParser a
pure a
v = ([Value] -> Parser (a, [Value])) -> ProductInBranchParser a
forall v.
([Value] -> Parser (v, [Value])) -> ProductInBranchParser v
ProductInBranchParser \[Value]
vs -> (a, [Value]) -> Parser (a, [Value])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, [Value]
vs)
  ProductInBranchParser [Value] -> Parser (a -> b, [Value])
left <*> :: ProductInBranchParser (a -> b)
-> ProductInBranchParser a -> ProductInBranchParser b
<*> ProductInBranchParser [Value] -> Parser (a, [Value])
right =
    ([Value] -> Parser (b, [Value])) -> ProductInBranchParser b
forall v.
([Value] -> Parser (v, [Value])) -> ProductInBranchParser v
ProductInBranchParser \[Value]
vs0 -> do
      (a -> b
f, [Value]
vs1) <- [Value] -> Parser (a -> b, [Value])
left [Value]
vs0
      (a
x, [Value]
vs2) <- [Value] -> Parser (a, [Value])
right [Value]
vs1
      (b, [Value]) -> Parser (b, [Value])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
x, [Value]
vs2)


--
--
instance (KnownSymbol objectName, Aliased JSON r, GRecord FromJSON (Rep r)) => FromJSON (JSONRecord objectName r) where
  parseJSON :: Value -> Parser (JSONRecord objectName r)
parseJSON Value
v =
    let FieldParser Object -> Parser (Rep r Any)
parser = Aliases (Rep r) Key
-> (forall v. FromJSON v => Key -> FieldParser v)
-> FieldParser (Rep r Any)
forall (c :: * -> Constraint) (rep :: * -> *) (m :: * -> *) a z.
(GRecord c rep, Applicative m) =>
Aliases rep a -> (forall v. c v => a -> m v) -> m (rep z)
gToRecord @FromJSON (Aliased 'JSON r => Aliases (Rep r) (AliasType 'JSON)
forall k (k :: k) r. Aliased k r => Aliases (Rep r) (AliasType k)
aliases @JSONRubric @JSON @r) 
          (\Key
fieldName -> (Object -> Parser v) -> FieldParser v
forall a. (Object -> Parser a) -> FieldParser a
FieldParser (\Object
o ->(Value -> Parser v) -> Object -> Key -> Parser v
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON Object
o Key
fieldName))
        objectName :: String
objectName = Proxy objectName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy objectName
forall k (t :: k). Proxy t
Proxy @objectName)
     in r -> JSONRecord objectName r
forall (objectName :: Symbol) r. r -> JSONRecord objectName r
JSONRecord (r -> JSONRecord objectName r)
-> (Rep r Any -> r) -> Rep r Any -> JSONRecord objectName r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep r Any -> r
forall a x. Generic a => Rep a x -> a
to (Rep r Any -> JSONRecord objectName r)
-> Parser (Rep r Any) -> Parser (JSONRecord objectName r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser (Rep r Any)) -> Value -> Parser (Rep r Any)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
objectName Object -> Parser (Rep r Any)
parser Value
v
newtype FieldParser a = FieldParser (Object -> Parser a)
  deriving (a -> FieldParser b -> FieldParser a
(a -> b) -> FieldParser a -> FieldParser b
(forall a b. (a -> b) -> FieldParser a -> FieldParser b)
-> (forall a b. a -> FieldParser b -> FieldParser a)
-> Functor FieldParser
forall a b. a -> FieldParser b -> FieldParser a
forall a b. (a -> b) -> FieldParser a -> FieldParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FieldParser b -> FieldParser a
$c<$ :: forall a b. a -> FieldParser b -> FieldParser a
fmap :: (a -> b) -> FieldParser a -> FieldParser b
$cfmap :: forall a b. (a -> b) -> FieldParser a -> FieldParser b
Functor, Functor FieldParser
a -> FieldParser a
Functor FieldParser
-> (forall a. a -> FieldParser a)
-> (forall a b.
    FieldParser (a -> b) -> FieldParser a -> FieldParser b)
-> (forall a b c.
    (a -> b -> c) -> FieldParser a -> FieldParser b -> FieldParser c)
-> (forall a b. FieldParser a -> FieldParser b -> FieldParser b)
-> (forall a b. FieldParser a -> FieldParser b -> FieldParser a)
-> Applicative FieldParser
FieldParser a -> FieldParser b -> FieldParser b
FieldParser a -> FieldParser b -> FieldParser a
FieldParser (a -> b) -> FieldParser a -> FieldParser b
(a -> b -> c) -> FieldParser a -> FieldParser b -> FieldParser c
forall a. a -> FieldParser a
forall a b. FieldParser a -> FieldParser b -> FieldParser a
forall a b. FieldParser a -> FieldParser b -> FieldParser b
forall a b. FieldParser (a -> b) -> FieldParser a -> FieldParser b
forall a b c.
(a -> b -> c) -> FieldParser a -> FieldParser b -> FieldParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: FieldParser a -> FieldParser b -> FieldParser a
$c<* :: forall a b. FieldParser a -> FieldParser b -> FieldParser a
*> :: FieldParser a -> FieldParser b -> FieldParser b
$c*> :: forall a b. FieldParser a -> FieldParser b -> FieldParser b
liftA2 :: (a -> b -> c) -> FieldParser a -> FieldParser b -> FieldParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> FieldParser a -> FieldParser b -> FieldParser c
<*> :: FieldParser (a -> b) -> FieldParser a -> FieldParser b
$c<*> :: forall a b. FieldParser (a -> b) -> FieldParser a -> FieldParser b
pure :: a -> FieldParser a
$cpure :: forall a. a -> FieldParser a
$cp1Applicative :: Functor FieldParser
Applicative) via ((->) Object `Compose` Parser)


--
--
instance (Aliased JSON r, GSum ToJSON (Rep r)) => ToJSON (JSONSum objectName r) where
  toJSON :: JSONSum objectName r -> Value
toJSON (JSONSum r
o) =
    let (Key
key, [Value]
slots) = Aliases (Rep r) Key
-> (forall v. ToJSON v => v -> Value)
-> Rep r Value
-> (Key, [Value])
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GSum c rep =>
Aliases rep a -> (forall v. c v => v -> o) -> rep z -> (a, [o])
gFromSum @ToJSON @(Rep r) @Key @Value @Value (Aliased 'JSON r => Aliases (Rep r) (AliasType 'JSON)
forall k (k :: k) r. Aliased k r => Aliases (Rep r) (AliasType k)
aliases @JSONRubric @JSON @r) forall v. ToJSON v => v -> Value
toJSON (r -> Rep r Value
forall a x. Generic a => a -> Rep a x
from @r r
o)
     in case [Value]
slots of
          [] -> [Pair] -> Value
object [(Key
key, Value
Null)]
          [Value
x] -> [Pair] -> Value
object [(Key
key, Value -> Value
forall v. ToJSON v => v -> Value
toJSON Value
x)]
          [Value]
xs -> [Pair] -> Value
object [(Key
key, [Value] -> Value
forall v. ToJSON v => v -> Value
toJSON [Value]
xs)]

--
--
instance (Aliased JSON r, GRecord ToJSON (Rep r)) => ToJSON (JSONRecord objectName r) where
  toJSON :: JSONRecord objectName r -> Value
toJSON (JSONRecord r
o) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Aliases (Rep r) Pair -> [Pair]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (Aliases (Rep r) Pair -> [Pair]) -> Aliases (Rep r) Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Aliases (Rep r) Key
-> (forall v. ToJSON v => Key -> v -> Pair)
-> Rep r Any
-> Aliases (Rep r) Pair
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => a -> v -> o) -> rep z -> Aliases rep o
gFromRecord @ToJSON @(Rep r) @Key (Aliased 'JSON r => Aliases (Rep r) (AliasType 'JSON)
forall k (k :: k) r. Aliased k r => Aliases (Rep r) (AliasType k)
aliases @JSONRubric @JSON @r) (\Key
a v
v -> (Key
a, v -> Value
forall v. ToJSON v => v -> Value
toJSON v
v)) (r -> Rep r Any
forall a x. Generic a => a -> Rep a x
from @r r
o)

-- $setup
--
-- >>> :set -XBlockArguments
-- >>> :set -XTypeApplications
-- >>> :set -XDerivingStrategies
-- >>> :set -XDerivingVia
-- >>> :set -XDataKinds
-- >>> :set -XMultiParamTypeClasses
-- >>> :set -XDeriveGeneric
-- >>> :set -XOverloadedStrings
-- >>> import ByOtherNames.Aeson
-- >>> import Data.Aeson
-- >>> import Data.Aeson.Types
-- >>> import GHC.Generics
-- >>> import GHC.TypeLits