module GTVM.Internal.Json
  ( module GTVM.Internal.Json
  , ToJSON(..), genericToEncoding, genericToJSON
  , FromJSON(..), genericParseJSON
  ) where

import Data.Aeson
import Data.Aeson.Types ( Parser )
import GHC.Generics ( Generic, Rep )

-- We cheat and use the same string for both the field label and constructor tag
-- modifier, because we figure that you'll only be using this on a product type
-- or an enum-like sum type (no inner fields).
jcGtvmhs :: String -> Options
jcGtvmhs :: String -> Options
jcGtvmhs String
x = Options
defaultOptions
  { fieldLabelModifier     = labelMod
  , constructorTagModifier = labelMod
  , rejectUnknownFields    = True
  } where labelMod :: String -> String
labelMod = Char -> String -> String
camelTo2 Char
'_' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
x)

-- | Shortcut for genericParseJSON (gtvm-hs)
gpjg :: (Generic a, GFromJSON Zero (Rep a)) => String -> Value -> Parser a
gpjg :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Value -> Parser a
gpjg = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser a)
-> (String -> Options) -> String -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options
jcGtvmhs

-- | Shortcut for genericToJSON (gtvm-hs)
gtjg :: (Generic a, GToJSON' Value Zero (Rep a)) => String -> a -> Value
gtjg :: forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
String -> a -> Value
gtjg = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> a -> Value)
-> (String -> Options) -> String -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options
jcGtvmhs

-- | Shortcut for genericToEncoding (gtvm-hs)
gteg :: (Generic a, GToJSON' Encoding Zero (Rep a)) => String -> a -> Encoding
gteg :: forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
String -> a -> Encoding
gteg = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> a -> Encoding)
-> (String -> Options) -> String -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options
jcGtvmhs