module Web.Slack.AesonUtils where

import Data.Aeson
import Data.Aeson qualified as J
import Data.Aeson.Types (Pair)
import Data.Char qualified as Char
import Data.Text qualified as T
import Web.FormUrlEncoded qualified as F
import Web.Slack.Prelude

-- | Checks that a record's field labels each start with the given 'prefix',
-- then uses a given 'drop (length prefix)' derivingStrategy to drop that prefix from generated JSON.
--
-- If used in a Template Haskell splice, gives a compile-time error if the prefixes don't match up.
-- Warning: This function should not be used outside of a Template Haskell splice, as it calls `error` in the case that the prefixes don't match up!
--
-- Example usage:
--
-- data PrefixedRecord = PrefixedRecord { prefixedRecordOne :: Int, prefixedRecordTwo :: Char }

-- $(deriveFromJSON (jsonDeriveWithAffix "prefixedRecord" jsonDeriveOptionsSnakeCase) ''PrefixedRecord)

jsonDeriveWithAffix :: Text -> (Int -> Options) -> Options
jsonDeriveWithAffix :: Text -> (Int -> Options) -> Options
jsonDeriveWithAffix Text
prefix Int -> Options
derivingStrategy =
  Options
originalOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = \String
fieldLabel ->
        if Text
prefix forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`isPrefixOf` String -> Text
T.pack String
fieldLabel
          then String -> String
originalModifier String
fieldLabel
          else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Prefixes don't match: `" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
prefix forall a. Semigroup a => a -> a -> a
<> String
"` isn't a prefix of `" forall a. Semigroup a => a -> a -> a
<> String
fieldLabel forall a. Semigroup a => a -> a -> a
<> String
"`. Search for jsonDeriveWithAffix to learn more."
    }
  where
    originalOptions :: Options
originalOptions = Int -> Options
derivingStrategy forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
prefix
    originalModifier :: String -> String
originalModifier = Options -> String -> String
fieldLabelModifier Options
originalOptions

camelToSnake :: String -> String
camelToSnake :: String -> String
camelToSnake = Char -> String -> String
camelTo2 Char
'_'

lowerFirst :: String -> String
lowerFirst :: String -> String
lowerFirst [] = []
lowerFirst (Char
c : String
chars) = Char -> Char
Char.toLower Char
c forall a. a -> [a] -> [a]
: String
chars

jsonDeriveOptionsSnakeCase :: Int -> Options
jsonDeriveOptionsSnakeCase :: Int -> Options
jsonDeriveOptionsSnakeCase Int
n =
  Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
camelToSnake forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
lowerFirst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
n
    , omitNothingFields :: Bool
omitNothingFields = Bool
True
    , constructorTagModifier :: String -> String
constructorTagModifier = String -> String
camelToSnake forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
lowerFirst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
n
    }

-- | Create a 'Value' from a list of name\/value @Maybe Pair@'s.
-- For 'Nothing', instead of outputting @null@, that field will not be output at all.
-- If duplicate keys arise, later keys and their associated values win.
--
-- Example:
--
-- @
-- objectOptional
--   [ "always" .=! 1
--   , "just" .=? Just 2
--   , "nothing" .=? Nothing
--   ]
-- @
--
-- will result in the JSON
--
-- @
-- {
--   "always": 1,
--   "just": 2
-- }
-- @
--
-- The field @nothing@ is ommited because it was 'Nothing'.
objectOptional :: [Maybe Pair] -> Value
objectOptional :: [Maybe Pair] -> Value
objectOptional = [Pair] -> Value
J.object forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes

-- | Encode a value for 'objectOptional'
(.=!) :: ToJSON v => Key -> v -> Maybe Pair
Key
key .=! :: forall v. ToJSON v => Key -> v -> Maybe Pair
.=! v
val = forall a. a -> Maybe a
Just (Key
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
val)

infixr 8 .=!

-- | Encode a Maybe value for 'objectOptional'
(.=?) :: ToJSON v => Key -> Maybe v -> Maybe Pair
Key
key .=? :: forall v. ToJSON v => Key -> Maybe v -> Maybe Pair
.=? Maybe v
mVal = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe v
mVal

infixr 8 .=?

-- | Conditionally encode a value for 'objectOptional'
(?.>) :: Bool -> Pair -> Maybe Pair
Bool
True ?.> :: Bool -> Pair -> Maybe Pair
?.> Pair
pair = forall a. a -> Maybe a
Just Pair
pair
Bool
False ?.> Pair
_ = forall a. Maybe a
Nothing

infixr 7 ?.>

-- | Conditionally express a pair in a JSON series
thenPair :: Bool -> J.Series -> J.Series
thenPair :: Bool -> Series -> Series
thenPair Bool
True Series
s = Series
s
thenPair Bool
False Series
_ = forall a. Monoid a => a
mempty

infixr 7 `thenPair`

snakeCaseOptions :: Options
snakeCaseOptions :: Options
snakeCaseOptions =
  Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = Char -> String -> String
camelTo2 Char
'_'
    , constructorTagModifier :: String -> String
constructorTagModifier = Char -> String -> String
camelTo2 Char
'_'
    }

snakeCaseFormOptions :: F.FormOptions
snakeCaseFormOptions :: FormOptions
snakeCaseFormOptions =
  FormOptions
F.defaultFormOptions
    { fieldLabelModifier :: String -> String
F.fieldLabelModifier = Char -> String -> String
camelTo2 Char
'_'
    }