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 Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
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
fieldLabel ->
        if Text
prefix Text -> Text -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`isPrefixOf` String -> Text
T.pack String
fieldLabel
          then String -> String
originalModifier String
fieldLabel
          else String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Prefixes don't match: `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` isn't a prefix of `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fieldLabel String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`. Search for jsonDeriveWithAffix to learn more."
    }
  where
    originalOptions :: Options
originalOptions = Int -> Options
derivingStrategy (Int -> Options) -> Int -> Options
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 Char -> String -> String
forall a. a -> [a] -> [a]
: String
chars

jsonDeriveOptionsSnakeCase :: Int -> Options
jsonDeriveOptionsSnakeCase :: Int -> Options
jsonDeriveOptionsSnakeCase Int
n =
  Options
defaultOptions
    { fieldLabelModifier = camelToSnake . lowerFirst . drop n
    , omitNothingFields = True
    , constructorTagModifier = camelToSnake . lowerFirst . drop 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 ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe Pair] -> [Pair]
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 = Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
key Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 = (v -> Pair) -> Maybe v -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
key Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) Maybe v
mVal

infixr 8 .=?

-- | Conditionally encode a value for 'objectOptional'
(?.>) :: Bool -> Pair -> Maybe Pair
Bool
True ?.> :: Bool -> Pair -> Maybe Pair
?.> Pair
pair = Pair -> Maybe Pair
forall a. a -> Maybe a
Just Pair
pair
Bool
False ?.> Pair
_ = Maybe 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
_ = Series
forall a. Monoid a => a
mempty

infixr 7 `thenPair`

snakeCaseOptions :: Options
snakeCaseOptions :: Options
snakeCaseOptions =
  Options
defaultOptions
    { fieldLabelModifier = camelTo2 '_'
    , constructorTagModifier = camelTo2 '_'
    }

snakeCaseFormOptions :: F.FormOptions
snakeCaseFormOptions :: FormOptions
snakeCaseFormOptions =
  FormOptions
F.defaultFormOptions
    { F.fieldLabelModifier = camelTo2 '_'
    }

newtype UnixTimestamp = UnixTimestamp {UnixTimestamp -> UTCTime
unUnixTimestamp :: UTCTime}
  deriving newtype (Int -> UnixTimestamp -> String -> String
[UnixTimestamp] -> String -> String
UnixTimestamp -> String
(Int -> UnixTimestamp -> String -> String)
-> (UnixTimestamp -> String)
-> ([UnixTimestamp] -> String -> String)
-> Show UnixTimestamp
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnixTimestamp -> String -> String
showsPrec :: Int -> UnixTimestamp -> String -> String
$cshow :: UnixTimestamp -> String
show :: UnixTimestamp -> String
$cshowList :: [UnixTimestamp] -> String -> String
showList :: [UnixTimestamp] -> String -> String
Show, UnixTimestamp -> UnixTimestamp -> Bool
(UnixTimestamp -> UnixTimestamp -> Bool)
-> (UnixTimestamp -> UnixTimestamp -> Bool) -> Eq UnixTimestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnixTimestamp -> UnixTimestamp -> Bool
== :: UnixTimestamp -> UnixTimestamp -> Bool
$c/= :: UnixTimestamp -> UnixTimestamp -> Bool
/= :: UnixTimestamp -> UnixTimestamp -> Bool
Eq)

instance FromJSON UnixTimestamp where
  parseJSON :: Value -> Parser UnixTimestamp
parseJSON Value
a = UTCTime -> UnixTimestamp
UnixTimestamp (UTCTime -> UnixTimestamp)
-> (POSIXTime -> UTCTime) -> POSIXTime -> UnixTimestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UnixTimestamp)
-> Parser POSIXTime -> Parser UnixTimestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser POSIXTime
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a

instance ToJSON UnixTimestamp where
  toJSON :: UnixTimestamp -> Value
toJSON (UnixTimestamp UTCTime
a) = POSIXTime -> Value
forall a. ToJSON a => a -> Value
toJSON (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
a)