module Chat.Flowdock.Internal where
import Control.Lens
import Control.Lens.Action
import Data.Aeson.TH
import Data.Char
import Language.Haskell.TH.Syntax (Dec, Name, Q)
adjustNames :: String -> String
adjustNames s = case snakeCase $ dropWhile (not . isUpper) s of
[] -> []
(x:xs) -> toLower x : xs
jsonize :: Name -> Q [Dec]
jsonize = deriveJSON (defaultOptions { fieldLabelModifier = adjustNames
, omitNothingFields = True })
jsonizeAll :: (Traversable t) => MonadicFold Q (t Name) [Dec]
jsonizeAll = traverse . act jsonize
snakeCase :: String -> String
snakeCase (a:b:c) | isAlpha a, isUpper b = a : '_' : snakeCase (toLower b : c)
snakeCase (a:b) = a : snakeCase b
snakeCase x = x
jsonizeSnake :: Name -> Q [Dec]
jsonizeSnake = deriveJSON (defaultOptions { fieldLabelModifier = adjustNames
, omitNothingFields = True })
jsonizeToSnake :: Name -> Q [Dec]
jsonizeToSnake = deriveToJSON (defaultOptions { fieldLabelModifier = adjustNames
, omitNothingFields = True })