{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Data.OpenApi.Internal.AesonUtils (
    -- * Generic functions
    AesonDefaultValue(..),
    sopSwaggerGenericToJSON,
    sopSwaggerGenericToEncoding,
    sopSwaggerGenericToJSONWithOpts,
    sopSwaggerGenericParseJSON,
    -- * Options
    HasSwaggerAesonOptions(..),
    SwaggerAesonOptions,
    mkSwaggerAesonOptions,
    saoPrefix,
    saoAdditionalPairs,
    saoSubObject,
    ) where

import Prelude ()
import Prelude.Compat

import Control.Applicative ((<|>))
import Control.Lens     (makeLenses, (^.))
import Control.Monad    (unless)
import Data.Aeson       (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
import Data.Aeson.Types (Parser, Pair)
import Data.Char        (toLower, isUpper)
import Data.Foldable    (traverse_)
import Data.Text        (Text)

import Generics.SOP

import qualified Data.Text as T
import qualified Data.Set as Set
import qualified Data.HashMap.Strict.InsOrd as InsOrd
import qualified Data.HashSet.InsOrd as InsOrdHS

import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)

-------------------------------------------------------------------------------
-- SwaggerAesonOptions
-------------------------------------------------------------------------------

data SwaggerAesonOptions = SwaggerAesonOptions
    { SwaggerAesonOptions -> String
_saoPrefix          :: String
    , SwaggerAesonOptions -> [Pair]
_saoAdditionalPairs :: [Pair]
    , SwaggerAesonOptions -> Maybe String
_saoSubObject       :: Maybe String
    }

mkSwaggerAesonOptions
    :: String  -- ^ prefix
    -> SwaggerAesonOptions
mkSwaggerAesonOptions :: String -> SwaggerAesonOptions
mkSwaggerAesonOptions String
pfx = String -> [Pair] -> Maybe String -> SwaggerAesonOptions
SwaggerAesonOptions String
pfx [] forall a. Maybe a
Nothing

makeLenses ''SwaggerAesonOptions

class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where
    swaggerAesonOptions :: Proxy a -> SwaggerAesonOptions

    -- So far we use only default definitions
    aesonDefaults :: Proxy a -> POP Maybe (Code a)
    aesonDefaults Proxy a
_ = forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy :: Proxy AesonDefaultValue) forall a. AesonDefaultValue a => Maybe a
defaultValue

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

class AesonDefaultValue a where
    defaultValue :: Maybe a
    defaultValue = forall a. Maybe a
Nothing

instance AesonDefaultValue Text where defaultValue :: Maybe Text
defaultValue = forall a. Maybe a
Nothing
instance AesonDefaultValue (Maybe a) where defaultValue :: Maybe (Maybe a)
defaultValue = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
instance AesonDefaultValue [a] where defaultValue :: Maybe [a]
defaultValue = forall a. a -> Maybe a
Just []
instance AesonDefaultValue (Set.Set a) where defaultValue :: Maybe (Set a)
defaultValue = forall a. a -> Maybe a
Just forall a. Set a
Set.empty
instance AesonDefaultValue (InsOrdHS.InsOrdHashSet k) where defaultValue :: Maybe (InsOrdHashSet k)
defaultValue = forall a. a -> Maybe a
Just forall k. InsOrdHashSet k
InsOrdHS.empty
instance AesonDefaultValue (InsOrd.InsOrdHashMap k v) where defaultValue :: Maybe (InsOrdHashMap k v)
defaultValue = forall a. a -> Maybe a
Just forall k v. InsOrdHashMap k v
InsOrd.empty

-------------------------------------------------------------------------------
-- ToJSON
-------------------------------------------------------------------------------

-- | Generic serialisation for swagger records.
--
-- Features
--
-- * omits nulls, empty objects and empty arrays (configurable)
-- * possible to add fields
-- * possible to merge sub-object
sopSwaggerGenericToJSON
    :: forall a xs.
        ( HasDatatypeInfo a
        , HasSwaggerAesonOptions a
        , All2 ToJSON (Code a)
        , All2 Eq (Code a)
        , Code a ~ '[xs]
        )
    => a
    -> Value
sopSwaggerGenericToJSON :: forall a (xs :: [*]).
(HasDatatypeInfo a, HasSwaggerAesonOptions a, All2 ToJSON (Code a),
 All2 Eq (Code a), Code a ~ '[xs]) =>
a -> Value
sopSwaggerGenericToJSON a
x =
    let ps :: [Pair]
ps = forall (xs :: [*]).
(All2 ToJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> SOP I '[xs] -> DatatypeInfo '[xs] -> POP Maybe '[xs] -> [Pair]
sopSwaggerGenericToJSON' SwaggerAesonOptions
opts (forall a. Generic a => a -> Rep a
from a
x) (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy) (forall a. HasSwaggerAesonOptions a => Proxy a -> POP Maybe (Code a)
aesonDefaults Proxy a
proxy)
    in [Pair] -> Value
object (SwaggerAesonOptions
opts forall s a. s -> Getting a s a -> a
^. Lens' SwaggerAesonOptions [Pair]
saoAdditionalPairs forall a. [a] -> [a] -> [a]
++ [Pair]
ps)
  where
    proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
    opts :: SwaggerAesonOptions
opts  = forall a.
HasSwaggerAesonOptions a =>
Proxy a -> SwaggerAesonOptions
swaggerAesonOptions Proxy a
proxy

-- | *TODO:* This is only used by ToJSON (ParamSchema SwaggerKindSchema)
--
-- Also uses default `aesonDefaults`
sopSwaggerGenericToJSONWithOpts
    :: forall a xs.
        ( Generic a
        , All2 AesonDefaultValue (Code a)
        , HasDatatypeInfo a
        , All2 ToJSON (Code a)
        , All2 Eq (Code a)
        , Code a ~ '[xs]
        )
    => SwaggerAesonOptions
    -> a
    -> Value
sopSwaggerGenericToJSONWithOpts :: forall a (xs :: [*]).
(Generic a, All2 AesonDefaultValue (Code a), HasDatatypeInfo a,
 All2 ToJSON (Code a), All2 Eq (Code a), Code a ~ '[xs]) =>
SwaggerAesonOptions -> a -> Value
sopSwaggerGenericToJSONWithOpts SwaggerAesonOptions
opts a
x =
    let ps :: [Pair]
ps = forall (xs :: [*]).
(All2 ToJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> SOP I '[xs] -> DatatypeInfo '[xs] -> POP Maybe '[xs] -> [Pair]
sopSwaggerGenericToJSON' SwaggerAesonOptions
opts (forall a. Generic a => a -> Rep a
from a
x) (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy) POP Maybe '[xs]
defs
    in [Pair] -> Value
object (SwaggerAesonOptions
opts forall s a. s -> Getting a s a -> a
^. Lens' SwaggerAesonOptions [Pair]
saoAdditionalPairs forall a. [a] -> [a] -> [a]
++ [Pair]
ps)
  where
    proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
    defs :: POP Maybe '[xs]
defs = forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy :: Proxy AesonDefaultValue) forall a. AesonDefaultValue a => Maybe a
defaultValue

sopSwaggerGenericToJSON'
    :: (All2 ToJSON '[xs], All2 Eq '[xs])
    => SwaggerAesonOptions
    -> SOP I '[xs]
    -> DatatypeInfo '[xs]
    -> POP Maybe '[xs]
    -> [Pair]
sopSwaggerGenericToJSON' :: forall (xs :: [*]).
(All2 ToJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> SOP I '[xs] -> DatatypeInfo '[xs] -> POP Maybe '[xs] -> [Pair]
sopSwaggerGenericToJSON' SwaggerAesonOptions
opts (SOP (Z NP I x
fields)) (ADT String
_ String
_ (Record String
_ NP FieldInfo x
fieldsInfo :* NP ConstructorInfo xs
Nil) POP StrictnessInfo '[xs]
_) (POP (NP Maybe x
defs :* NP (NP Maybe) xs
Nil)) =
    forall (xs :: [*]).
(All ToJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> NP I xs -> NP FieldInfo xs -> NP Maybe xs -> [Pair]
sopSwaggerGenericToJSON'' SwaggerAesonOptions
opts NP I x
fields NP FieldInfo x
fieldsInfo NP Maybe x
defs
sopSwaggerGenericToJSON' SwaggerAesonOptions
_ SOP I '[xs]
_ DatatypeInfo '[xs]
_ POP Maybe '[xs]
_ = forall a. HasCallStack => String -> a
error String
"sopSwaggerGenericToJSON: unsupported type"

sopSwaggerGenericToJSON''
    :: (All ToJSON xs, All Eq xs)
    => SwaggerAesonOptions
    -> NP I xs
    -> NP FieldInfo xs
    -> NP Maybe xs
    -> [Pair]
sopSwaggerGenericToJSON'' :: forall (xs :: [*]).
(All ToJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> NP I xs -> NP FieldInfo xs -> NP Maybe xs -> [Pair]
sopSwaggerGenericToJSON'' (SwaggerAesonOptions String
prefix [Pair]
_ Maybe String
sub) = forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
go
  where
    go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
    go :: forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
go  NP I ys
Nil NP FieldInfo ys
Nil NP Maybe ys
Nil = []
    go (I x
x :* NP I xs
xs) (FieldInfo String
name :* NP FieldInfo xs
names) (Maybe x
def :* NP Maybe xs
defs)
        | forall a. a -> Maybe a
Just String
name' forall a. Eq a => a -> a -> Bool
== Maybe String
sub = case Value
json of
              Object Object
m -> forall v. KeyMap v -> [(Key, v)]
objectToList Object
m forall a. [a] -> [a] -> [a]
++ [Pair]
rest
              Value
Null     -> [Pair]
rest
              Value
_        -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"sopSwaggerGenericToJSON: subjson is not an object: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
json
        -- If default value: omit it.
        | forall a. a -> Maybe a
Just x
x forall a. Eq a => a -> a -> Bool
== Maybe x
def =
            [Pair]
rest
        | Bool
otherwise =
            (String -> Key
stringToKey String
name', Value
json) forall a. a -> [a] -> [a]
: [Pair]
rest
      where
        json :: Value
json  = forall a. ToJSON a => a -> Value
toJSON x
x
        name' :: String
name' = String -> String
fieldNameModifier String
name
        rest :: [Pair]
rest  = forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
go NP I xs
xs NP FieldInfo xs
names NP Maybe xs
defs

    fieldNameModifier :: String -> String
fieldNameModifier = String -> String
modifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1
    modifier :: String -> String
modifier = String -> String
lowerFirstUppers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    lowerFirstUppers :: String -> String
lowerFirstUppers String
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x forall a. [a] -> [a] -> [a]
++ String
y
      where (String
x, String
y) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper String
s

-------------------------------------------------------------------------------
-- FromJSON
-------------------------------------------------------------------------------

sopSwaggerGenericParseJSON
    :: forall a xs.
        ( HasDatatypeInfo a
        , HasSwaggerAesonOptions a
        , All2 FromJSON (Code a)
        , All2 Eq (Code a)
        , Code a ~ '[xs]
        )
    => Value
    -> Parser a
sopSwaggerGenericParseJSON :: forall a (xs :: [*]).
(HasDatatypeInfo a, HasSwaggerAesonOptions a,
 All2 FromJSON (Code a), All2 Eq (Code a), Code a ~ '[xs]) =>
Value -> Parser a
sopSwaggerGenericParseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Swagger Record Object" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    let ps :: Parser (SOP I '[xs])
ps = forall (xs :: [*]).
(All2 FromJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> Object
-> DatatypeInfo '[xs]
-> POP Maybe '[xs]
-> Parser (SOP I '[xs])
sopSwaggerGenericParseJSON' SwaggerAesonOptions
opts Object
obj (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy) (forall a. HasSwaggerAesonOptions a => Proxy a -> POP Maybe (Code a)
aesonDefaults Proxy a
proxy)
    in do
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Object -> Pair -> Parser ()
parseAdditionalField Object
obj) (SwaggerAesonOptions
opts forall s a. s -> Getting a s a -> a
^. Lens' SwaggerAesonOptions [Pair]
saoAdditionalPairs)
        forall a. Generic a => Rep a -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SOP I '[xs])
ps
  where
    proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
    opts :: SwaggerAesonOptions
opts  = forall a.
HasSwaggerAesonOptions a =>
Proxy a -> SwaggerAesonOptions
swaggerAesonOptions Proxy a
proxy

    parseAdditionalField :: Object -> Pair -> Parser ()
    parseAdditionalField :: Object -> Pair -> Parser ()
parseAdditionalField Object
obj (Key
k, Value
v) = do
        Value
v' <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
v forall a. Eq a => a -> a -> Bool
== Value
v') forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
            String
"Additonal field don't match for key " forall a. [a] -> [a] -> [a]
++ Key -> String
keyToString Key
k
            forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
v
            forall a. [a] -> [a] -> [a]
++ String
" /= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
v'

sopSwaggerGenericParseJSON'
    :: (All2 FromJSON '[xs], All2 Eq '[xs])
    => SwaggerAesonOptions
    -> Object
    -> DatatypeInfo '[xs]
    -> POP Maybe '[xs]
    -> Parser (SOP I '[xs])
sopSwaggerGenericParseJSON' :: forall (xs :: [*]).
(All2 FromJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> Object
-> DatatypeInfo '[xs]
-> POP Maybe '[xs]
-> Parser (SOP I '[xs])
sopSwaggerGenericParseJSON' SwaggerAesonOptions
opts Object
obj (ADT String
_ String
_ (Record String
_ NP FieldInfo x
fieldsInfo :* NP ConstructorInfo xs
Nil) POP StrictnessInfo '[xs]
_) (POP (NP Maybe x
defs :* NP (NP Maybe) xs
Nil)) =
    forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (xs :: [*]).
(All FromJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> Object -> NP FieldInfo xs -> NP Maybe xs -> Parser (NP I xs)
sopSwaggerGenericParseJSON'' SwaggerAesonOptions
opts Object
obj NP FieldInfo x
fieldsInfo NP Maybe x
defs
sopSwaggerGenericParseJSON' SwaggerAesonOptions
_ Object
_ DatatypeInfo '[xs]
_ POP Maybe '[xs]
_ = forall a. HasCallStack => String -> a
error String
"sopSwaggerGenericParseJSON: unsupported type"

sopSwaggerGenericParseJSON''
    :: (All FromJSON xs, All Eq xs)
    => SwaggerAesonOptions
    -> Object
    -> NP FieldInfo xs
    -> NP Maybe xs
    -> Parser (NP I xs)
sopSwaggerGenericParseJSON'' :: forall (xs :: [*]).
(All FromJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> Object -> NP FieldInfo xs -> NP Maybe xs -> Parser (NP I xs)
sopSwaggerGenericParseJSON'' (SwaggerAesonOptions String
prefix [Pair]
_ Maybe String
sub) Object
obj = forall (ys :: [*]).
(All FromJSON ys, All Eq ys) =>
NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
go
  where
    go :: (All FromJSON ys, All Eq ys) => NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
    go :: forall (ys :: [*]).
(All FromJSON ys, All Eq ys) =>
NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
go  NP FieldInfo ys
Nil NP Maybe ys
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (a :: k -> *). NP a '[]
Nil
    go (FieldInfo String
name :* NP FieldInfo xs
names) (Maybe x
def :* NP Maybe xs
defs)
        | forall a. a -> Maybe a
Just String
name' forall a. Eq a => a -> a -> Bool
== Maybe String
sub =
            -- Note: we might strip fields of outer structure.
            forall {x} {xs :: [*]}. x -> NP I xs -> NP I (x : xs)
cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser x -> Parser x
withDef forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
obj) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NP I xs)
rest
        | Bool
otherwise = case Maybe x
def of
            Just x
def' -> forall {x} {xs :: [*]}. x -> NP I xs -> NP I (x : xs)
cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? String -> Key
stringToKey String
name' forall a. Parser (Maybe a) -> a -> Parser a
.!= x
def' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NP I xs)
rest
            Maybe x
Nothing  ->  forall {x} {xs :: [*]}. x -> NP I xs -> NP I (x : xs)
cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
stringToKey String
name' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NP I xs)
rest
      where
        cons :: x -> NP I xs -> NP I (x : xs)
cons x
h NP I xs
t = forall a. a -> I a
I x
h forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I xs
t
        name' :: String
name' = String -> String
fieldNameModifier String
name
        rest :: Parser (NP I xs)
rest  = forall (ys :: [*]).
(All FromJSON ys, All Eq ys) =>
NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
go NP FieldInfo xs
names NP Maybe xs
defs

        withDef :: Parser x -> Parser x
withDef = case Maybe x
def of
            Just x
def' -> (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure x
def')
            Maybe x
Nothing   -> forall a. a -> a
id

    fieldNameModifier :: String -> String
fieldNameModifier = String -> String
modifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1
    modifier :: String -> String
modifier = String -> String
lowerFirstUppers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    lowerFirstUppers :: String -> String
lowerFirstUppers String
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x forall a. [a] -> [a] -> [a]
++ String
y
      where (String
x, String
y) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper String
s

-------------------------------------------------------------------------------
-- ToEncoding
-------------------------------------------------------------------------------

sopSwaggerGenericToEncoding
    :: forall a xs.
        ( HasDatatypeInfo a
        , HasSwaggerAesonOptions a
        , All2 ToJSON (Code a)
        , All2 Eq (Code a)
        , Code a ~ '[xs]
        )
    => a
    -> Encoding
sopSwaggerGenericToEncoding :: forall a (xs :: [*]).
(HasDatatypeInfo a, HasSwaggerAesonOptions a, All2 ToJSON (Code a),
 All2 Eq (Code a), Code a ~ '[xs]) =>
a -> Encoding
sopSwaggerGenericToEncoding a
x =
    let ps :: Series
ps = forall (xs :: [*]).
(All2 ToJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> SOP I '[xs] -> DatatypeInfo '[xs] -> POP Maybe '[xs] -> Series
sopSwaggerGenericToEncoding' SwaggerAesonOptions
opts (forall a. Generic a => a -> Rep a
from a
x) (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo Proxy a
proxy) (forall a. HasSwaggerAesonOptions a => Proxy a -> POP Maybe (Code a)
aesonDefaults Proxy a
proxy)
    in Series -> Encoding
pairs ([Pair] -> Series
pairsToSeries (SwaggerAesonOptions
opts forall s a. s -> Getting a s a -> a
^. Lens' SwaggerAesonOptions [Pair]
saoAdditionalPairs) forall a. Semigroup a => a -> a -> a
<> Series
ps)
  where
    proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
    opts :: SwaggerAesonOptions
opts  = forall a.
HasSwaggerAesonOptions a =>
Proxy a -> SwaggerAesonOptions
swaggerAesonOptions Proxy a
proxy

pairsToSeries :: [Pair] -> Series
pairsToSeries :: [Pair] -> Series
pairsToSeries = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Key
k, Value
v) -> (Key
k forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
v))

sopSwaggerGenericToEncoding'
    :: (All2 ToJSON '[xs], All2 Eq '[xs])
    => SwaggerAesonOptions
    -> SOP I '[xs]
    -> DatatypeInfo '[xs]
    -> POP Maybe '[xs]
    -> Series
sopSwaggerGenericToEncoding' :: forall (xs :: [*]).
(All2 ToJSON '[xs], All2 Eq '[xs]) =>
SwaggerAesonOptions
-> SOP I '[xs] -> DatatypeInfo '[xs] -> POP Maybe '[xs] -> Series
sopSwaggerGenericToEncoding' SwaggerAesonOptions
opts (SOP (Z NP I x
fields)) (ADT String
_ String
_ (Record String
_ NP FieldInfo x
fieldsInfo :* NP ConstructorInfo xs
Nil) POP StrictnessInfo '[xs]
_) (POP (NP Maybe x
defs :* NP (NP Maybe) xs
Nil)) =
    forall (xs :: [*]).
(All ToJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> NP I xs -> NP FieldInfo xs -> NP Maybe xs -> Series
sopSwaggerGenericToEncoding'' SwaggerAesonOptions
opts NP I x
fields NP FieldInfo x
fieldsInfo NP Maybe x
defs
sopSwaggerGenericToEncoding' SwaggerAesonOptions
_ SOP I '[xs]
_ DatatypeInfo '[xs]
_ POP Maybe '[xs]
_ = forall a. HasCallStack => String -> a
error String
"sopSwaggerGenericToEncoding: unsupported type"

sopSwaggerGenericToEncoding''
    :: (All ToJSON xs, All Eq xs)
    => SwaggerAesonOptions
    -> NP I xs
    -> NP FieldInfo xs
    -> NP Maybe xs
    -> Series
sopSwaggerGenericToEncoding'' :: forall (xs :: [*]).
(All ToJSON xs, All Eq xs) =>
SwaggerAesonOptions
-> NP I xs -> NP FieldInfo xs -> NP Maybe xs -> Series
sopSwaggerGenericToEncoding'' (SwaggerAesonOptions String
prefix [Pair]
_ Maybe String
sub) = forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
go
  where
    go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
    go :: forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
go  NP I ys
Nil NP FieldInfo ys
Nil NP Maybe ys
Nil = forall a. Monoid a => a
mempty
    go (I x
x :* NP I xs
xs) (FieldInfo String
name :* NP FieldInfo xs
names) (Maybe x
def :* NP Maybe xs
defs)
        | forall a. a -> Maybe a
Just String
name' forall a. Eq a => a -> a -> Bool
== Maybe String
sub = case forall a. ToJSON a => a -> Value
toJSON x
x of
              Object Object
m -> [Pair] -> Series
pairsToSeries (forall v. KeyMap v -> [(Key, v)]
objectToList Object
m) forall a. Semigroup a => a -> a -> a
<> Series
rest
              Value
Null     -> Series
rest
              Value
_        -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"sopSwaggerGenericToJSON: subjson is not an object: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. ToJSON a => a -> Value
toJSON x
x)
        -- If default value: omit it.
        | forall a. a -> Maybe a
Just x
x forall a. Eq a => a -> a -> Bool
== Maybe x
def =
            Series
rest
        | Bool
otherwise =
            (String -> Key
stringToKey String
name' forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= x
x) forall a. Semigroup a => a -> a -> a
<> Series
rest
      where
        name' :: String
name' = String -> String
fieldNameModifier String
name
        rest :: Series
rest  = forall (ys :: [*]).
(All ToJSON ys, All Eq ys) =>
NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
go NP I xs
xs NP FieldInfo xs
names NP Maybe xs
defs

    fieldNameModifier :: String -> String
fieldNameModifier = String -> String
modifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1
    modifier :: String -> String
modifier = String -> String
lowerFirstUppers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    lowerFirstUppers :: String -> String
lowerFirstUppers String
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x forall a. [a] -> [a] -> [a]
++ String
y
      where (String
x, String
y) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper String
s