{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
--
-- Orphan instances and shared @'Generic'@ JSON options.
--
module Data.Aeson.Ext
    ( fromText
    , bsAesonOptions
    ) where

import Prelude

import Data.Aeson
import Data.Char (toLower)
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#else
import Data.Text (Text)
fromText :: Text -> Text
fromText = id
#endif

-- | Our custom Aeson @'Options'@
--
-- Omits @'Nothing'@ fields, and drops/lowers accordingly:
--
-- >>> fieldLabelModifier (bsAesonOptions "bs") "bsReleaseStage"
-- "releaseStage"
--
-- For sums, the first argument is taken as a suffix:
--
-- >>> constructorTagModifier (bsAesonOptions "ReasonType") "UnhandledExceptionReasonType"
-- "unhandledException"
--
bsAesonOptions :: String -> Options
bsAesonOptions :: String -> Options
bsAesonOptions String
prefixOrSuffix = Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
lowerFirst (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
dropPrefix String
prefixOrSuffix
    , constructorTagModifier :: String -> String
constructorTagModifier = String -> String
lowerFirst (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
dropSuffix String
prefixOrSuffix
    , omitNothingFields :: Bool
omitNothingFields = Bool
True
    }

dropPrefix :: String -> String -> String
dropPrefix :: String -> String -> String
dropPrefix String
prefix String
x = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
x (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
x

dropSuffix :: String -> String -> String
dropSuffix :: String -> String -> String
dropSuffix String
prefix = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
dropPrefix (String -> String
forall a. [a] -> [a]
reverse String
prefix) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

lowerFirst :: String -> String
lowerFirst :: String -> String
lowerFirst [] = []
lowerFirst (Char
x : String
rest) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest