{-# LANGUAGE LambdaCase #-}

module Data.Aeson.Extra (
  buildObject,
  optionalField,
  requiredField,
  stripPrefix,
) where

import Prelude

import Data.Aeson (ToJSON (..))
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Char qualified as Char

{- | Build a JSON object omitting optional keys if a corresponding value is 'Nothing'.

Example:
@
    buildObject
      $ requiredField "field1" 'a'
      . requiredField "field2" 'c'
      . optionalField "field3" (Just "hello")
      . optionalField "field4" Nothing
@
builds this JSON object:
@
    {
      "field1": 'a',
      "field2": 'c',
      "field3": "hello"
    }
@
omitting optional 'field4'.
-}
buildObject :: (Aeson.Object -> Aeson.Object) -> Aeson.Value
buildObject :: (Object -> Object) -> Value
buildObject = Object -> Value
Aeson.Object (Object -> Value)
-> ((Object -> Object) -> Object) -> (Object -> Object) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Object
forall v. KeyMap v
KeyMap.empty)

optionalField :: (ToJSON a) => Aeson.Key -> Maybe a -> Aeson.Object -> Aeson.Object
optionalField :: forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField = (Object -> Object)
-> (a -> Object -> Object) -> Maybe a -> Object -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object -> Object
forall a. a -> a
id ((a -> Object -> Object) -> Maybe a -> Object -> Object)
-> (Key -> a -> Object -> Object)
-> Key
-> Maybe a
-> Object
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> a -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField

requiredField :: (ToJSON a) => Aeson.Key -> a -> Aeson.Object -> Aeson.Object
requiredField :: forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
key a
value = Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
key (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
value)

{- | A field label modifier that strips a prefix from the camelCased field name;
>>> stripPrefix "preamble" "preambleTitle"
"title"
-}
stripPrefix ::
  -- | Field prefix to strip
  String ->
  -- | Field name
  String ->
  String
stripPrefix :: String -> String -> String
stripPrefix String
prefix String
field = (String, String) -> String
go (String
prefix, String
field)
 where
  go :: (String, String) -> String
go = \case
    (Char
p1 : String
ps, Char
f1 : String
fs) | Char
p1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
f1 -> (String, String) -> String
go (String
ps, String
fs)
    ([], Char
f1 : String
fs) -> Char -> Char
Char.toLower Char
f1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
fs
    (String, String)
_ ->
      String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Unexpected field name '"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"', must start from '"
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' and have other characters after."