{-# LANGUAGE UndecidableInstances #-}

module Spotify.Types.Internal.CustomJSON where

import Data.Aeson (
    FromJSON (parseJSON),
    GFromJSON,
    Options (constructorTagModifier, fieldLabelModifier),
    Zero,
    defaultOptions,
    genericParseJSON,
 )
import Data.Char (isUpper, toLower)
import Data.List (dropWhileEnd, stripPrefix)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic (Rep))
import Type.Reflection (Typeable, typeRep)

newtype CustomJSON a = CustomJSON a deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CustomJSON a) x -> CustomJSON a
forall a x. CustomJSON a -> Rep (CustomJSON a) x
$cto :: forall a x. Rep (CustomJSON a) x -> CustomJSON a
$cfrom :: forall a x. CustomJSON a -> Rep (CustomJSON a) x
Generic)
instance (Generic a, GFromJSON Zero (Rep a), Typeable a) => FromJSON (CustomJSON a) where
    parseJSON :: Value -> Parser (CustomJSON a)
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> CustomJSON a
CustomJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions{[Char] -> [Char]
constructorTagModifier :: [Char] -> [Char]
constructorTagModifier :: [Char] -> [Char]
constructorTagModifier, [Char] -> [Char]
fieldLabelModifier :: [Char] -> [Char]
fieldLabelModifier :: [Char] -> [Char]
fieldLabelModifier}
      where
        fieldLabelModifier :: [Char] -> [Char]
fieldLabelModifier = [Char] -> [Char]
camelToSnake forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'_')
        constructorTagModifier :: [Char] -> [Char]
constructorTagModifier = [Char] -> [Char]
camelToSnake forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a))
        camelToSnake :: [Char] -> [Char]
camelToSnake = \case
            [] -> []
            Char
x : [Char]
xs -> Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
xs
          where
            go :: [Char] -> [Char]
go = \case
                [] -> []
                Char
x : [Char]
xs ->
                    if Char -> Bool
isUpper Char
x
                        then Char
'_' forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
xs
                        else Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
xs