module Data.Aeson.Casing.Internal where

import           Data.Aeson.Types
import           Data.Char

-- | Creates an Aeson options object that drops a specific number of characters
-- from the front of a field name, then applies a casing function.
aesonDrop :: Int -> (String -> String) -> Options
aesonDrop :: Int -> (String -> String) -> Options
aesonDrop Int
n String -> String
f = Options
defaultOptions
        { fieldLabelModifier = f . drop n }

-- | Creates an Aeson options object that drops the field name prefix from a
-- field, then applies a casing function. We assume a convention of the prefix
-- always being lower case, and the first letter of the actual field name being
-- uppercase. This accommodated for field names in GHC 7.8 and below.
--
-- > data Person = Person
-- >        { personFirstName :: Text
-- >        , personLastName  :: Text
-- >        } deriving (Generic)
-- >
-- > data Dog = Dog
-- >        { dogFirstName :: Text
-- >        } deriving (Generic)
--
-- In the above cases, dog and person are always dropped from the JSON field
-- names.
aesonPrefix :: (String -> String) -> Options
aesonPrefix :: (String -> String) -> Options
aesonPrefix String -> String
f = Options
defaultOptions
        { fieldLabelModifier = f . dropFPrefix }

----

-- | Snake casing, where the words are always lower case and separated by an
-- underscore.
snakeCase :: String -> String
snakeCase :: String -> String
snakeCase = Char -> String -> String
symbCase Char
'_'

-- | Train casing, where the words are always lower case and separated by
-- a hyphen

trainCase :: String -> String
trainCase :: String -> String
trainCase = Char -> String -> String
symbCase Char
'-'

-- | Camel casing, where the words are separated by the first letter of each
-- word being a capital. However, the first letter of the field is never a
-- capital.
camelCase :: String -> String
camelCase :: String -> String
camelCase = (Char -> Char) -> String -> String
applyFirst Char -> Char
toLower

-- | Pascal casing, where the words are separated by the first letter of each
-- word being a capital. The first letter of the field is always a capital.
pascalCase :: String -> String
pascalCase :: String -> String
pascalCase = (Char -> Char) -> String -> String
applyFirst Char -> Char
toUpper

----

-- | Generic casing for symbol separated names
symbCase :: Char -> (String -> String)
symbCase :: Char -> String -> String
symbCase Char
sym =  String -> String
u (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
applyFirst Char -> Char
toLower
  where u :: String -> String
u []                       = []
        u (Char
x:String
xs) | Char -> Bool
isUpper Char
x = Char
sym Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
u String
xs
                 | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
u String
xs

applyFirst :: (Char -> Char) -> String -> String
applyFirst :: (Char -> Char) -> String -> String
applyFirst Char -> Char
_ []     = []
applyFirst Char -> Char
f [Char
x]    = [Char -> Char
f Char
x]
applyFirst Char -> Char
f (Char
x:String
xs) = Char -> Char
f Char
xChar -> String -> String
forall a. a -> [a] -> [a]
: String
xs

dropFPrefix :: String -> String
dropFPrefix :: String -> String
dropFPrefix []                 = []
dropFPrefix (Char
x:String
xs) | Char -> Bool
isUpper Char
x = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
                   | Bool
otherwise = String -> String
dropFPrefix String
xs

dropCPrefix :: String -> String
dropCPrefix :: String -> String
dropCPrefix [] = []
dropCPrefix [Char
x] = [Char
x]
dropCPrefix (Char
x0:Char
x1:String
xs) | Char -> Bool
isLower Char
x1 = Char
x0 Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
                       | Bool
otherwise  = String -> String
dropCPrefix (Char
x1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs)