{-# LANGUAGE FlexibleContexts #-}

-- | Helper functions to derive JSON encoder/decoder
module Zuul.Aeson (zuulParseJSON, zuulToJSON) where

import Data.Aeson (GFromJSON, GToJSON', Options (fieldLabelModifier), Value, Zero, defaultOptions, genericParseJSON, genericToJSON)
import Data.Aeson.Types (Parser)
import Data.Char (isUpper, toLower)
import qualified Data.Text as T
import GHC.Generics (Generic, Rep)

zuulOptions :: T.Text -> Options
zuulOptions :: Text -> Options
zuulOptions Text
prefix = Options
defaultOptions {fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
recordToJson}
  where
    recordToJson :: String -> String
recordToJson = String -> String
updateCase (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 (Text -> Int
T.length Text
prefix)
    updateCase :: String -> String
updateCase [] = []
    updateCase (Char
x : String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs
    updateCase' :: String -> String
updateCase' [] = []
    updateCase' (Char
x : String
xs)
      | Char -> Bool
isUpper Char
x = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs
      | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs

-- | An helper function to implement the parseJSON class
zuulParseJSON :: (Generic a, GFromJSON Zero (Rep a)) => T.Text -> Value -> Parser a
zuulParseJSON :: Text -> Value -> Parser a
zuulParseJSON = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser a)
-> (Text -> Options) -> Text -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Options
zuulOptions

-- | An helper function to implement the toJSON class
zuulToJSON :: (Generic a, GToJSON' Value Zero (Rep a)) => T.Text -> a -> Value
zuulToJSON :: Text -> a -> Value
zuulToJSON = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> a -> Value) -> (Text -> Options) -> Text -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Options
zuulOptions