----------------------------------------------------------------------
-- |
-- Module: Web.Slack.Util
-- Description:
--
--
--
----------------------------------------------------------------------

module Web.Slack.Util
  ( formOpts
  , jsonOpts
  , toQueryParamIfJust
  )
  where

-- aeson
import Data.Aeson.TH
import Data.Aeson.Types

-- base
import Data.Char
import Data.Maybe (maybeToList)
import GHC.Exts (fromList)

-- http-api-data
import Web.HttpApiData (toQueryParam, ToHttpApiData)
import Web.FormUrlEncoded (Form, FormOptions(FormOptions))

-- text
import Data.Text (Text)
import qualified Data.Text as Text


-- |
--
--

formOpts
  :: Text
  -> FormOptions
formOpts :: Text -> FormOptions
formOpts Text
prefix =
  (String -> String) -> FormOptions
FormOptions (Text -> String -> String
modifyLabel Text
prefix)


-- |
--
--

jsonOpts
  :: Text
  -> Options
jsonOpts :: Text -> Options
jsonOpts Text
prefix =
  Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = Text -> String -> String
modifyLabel Text
prefix
    }


-- |
--
--

modifyLabel
  :: Text
  -> String
  -> String
modifyLabel :: Text -> String -> String
modifyLabel Text
prefix =
  (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addUnderscores
    (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
Text.length Text
prefix)


-- |
--
--

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


toQueryParamIfJust :: ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust :: Text -> Maybe a -> Form
toQueryParamIfJust Text
key =
  [(Text, Text)] -> Form
forall l. IsList l => [Item l] -> l
fromList ([(Text, Text)] -> Form)
-> (Maybe a -> [(Text, Text)]) -> Maybe a -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Text, Text) -> [(Text, Text)])
-> (Maybe a -> Maybe (Text, Text)) -> Maybe a -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Text, Text)) -> Maybe a -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
justVal -> (Text
key, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
justVal))