module OryKratos.Types.Helper (uncapitalize, removeFieldLabelPrefix, customOptions) where

import Data.Aeson.Types (Options (..), defaultOptions)
import qualified Data.Char as Char
import Data.Function ((&))
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Time ()

uncapitalize :: String -> String
uncapitalize :: String -> String
uncapitalize (Char
first : String
rest) = Char -> Char
Char.toLower Char
first Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
uncapitalize [] = []

typeFieldRename :: String -> String
typeFieldRename :: String -> String
typeFieldRename String
"_type" = String
"type"
typeFieldRename String
"_data" = String
"data"
typeFieldRename String
"_pattern" = String
"pattern"
typeFieldRename String
x = String
x

customOptions :: Options
customOptions :: Options
customOptions =
  Options
defaultOptions
    { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
      fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
    }

-- | Remove a field label prefix during JSON parsing.
--   Also perform any replacements for special characters.
--   The @forParsing@ parameter is to distinguish between the cases in which we're using this
--   to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want
--   to replace special characters with their quoted equivalents (because we cannot have special
--   chars in identifier names), while we want to do vice versa when sending data instead.
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix Bool
forParsing String
prefix =
  Options
defaultOptions
    { omitNothingFields :: Bool
omitNothingFields = Bool
True,
      fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
uncapitalize (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error (String
"did not find prefix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix)) (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
replaceSpecialChars
    }
  where
    replaceSpecialChars :: String -> String
replaceSpecialChars String
field = (String -> (String -> String) -> String)
-> String -> [String -> String] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> (String -> String) -> String
forall a b. a -> (a -> b) -> b
(&) String
field (((String, String) -> String -> String)
-> [(String, String)] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String -> String
mkCharReplacement [(String, String)]
specialChars)
    specialChars :: [(String, String)]
specialChars =
      [ (String
"$", String
"'Dollar"),
        (String
"^", String
"'Caret"),
        (String
"|", String
"'Pipe"),
        (String
"=", String
"'Equal"),
        (String
"*", String
"'Star"),
        (String
"-", String
"'Dash"),
        (String
"&", String
"'Ampersand"),
        (String
"%", String
"'Percent"),
        (String
"#", String
"'Hash"),
        (String
"@", String
"'At"),
        (String
"!", String
"'Exclamation"),
        (String
"+", String
"'Plus"),
        (String
":", String
"'Colon"),
        (String
";", String
"'Semicolon"),
        (String
">", String
"'GreaterThan"),
        (String
"<", String
"'LessThan"),
        (String
".", String
"'Period"),
        (String
"_", String
"'Underscore"),
        (String
"?", String
"'Question_Mark"),
        (String
",", String
"'Comma"),
        (String
"'", String
"'Quote"),
        (String
"/", String
"'Slash"),
        (String
"(", String
"'Left_Parenthesis"),
        (String
")", String
"'Right_Parenthesis"),
        (String
"{", String
"'Left_Curly_Bracket"),
        (String
"}", String
"'Right_Curly_Bracket"),
        (String
"[", String
"'Left_Square_Bracket"),
        (String
"]", String
"'Right_Square_Bracket"),
        (String
"~", String
"'Tilde"),
        (String
"`", String
"'Backtick"),
        (String
"<=", String
"'Less_Than_Or_Equal_To"),
        (String
">=", String
"'Greater_Than_Or_Equal_To"),
        (String
"!=", String
"'Not_Equal"),
        (String
"~=", String
"'Tilde_Equal"),
        (String
"\\", String
"'Back_Slash"),
        (String
"\"", String
"'Double_Quote")
      ]
    mkCharReplacement :: (String, String) -> String -> String
mkCharReplacement (String
replaceStr, String
searchStr) = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replacer (String -> Text
T.pack String
searchStr) (String -> Text
T.pack String
replaceStr) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    replacer :: Text -> Text -> Text -> Text
replacer =
      if Bool
forParsing
        then (Text -> Text -> Text -> Text) -> Text -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text -> Text
T.replace
        else Text -> Text -> Text -> Text
T.replace