activitystreams-aeson/Codec/ActivityStream/Internal.hs

{-# LANGUAGE ViewPatterns #-}

module Codec.ActivityStream.Internal (commonOpts, commonOptsCC, ensure) where

import Control.Monad (mzero)
import Data.Aeson
import Data.Aeson.TH
import Data.Char
import Data.HashMap.Strict (HashMap, member)
import Data.Monoid ((<>))
import Data.Text (Text, pack, unpack)

ensure :: Monad m => String -> HashMap Text Value -> [Text] -> m ()
ensure objName obj keys = mapM_ go keys
  where go k
          | member k obj = return ()
          | otherwise = fail ("Object \"" <> objName <>
                              "\" does not contain property \"" <>
                              unpack k <> "\"")

toCamelCaseUpper :: String -> String
toCamelCaseUpper = toCamelCase True

toCamelCaseLower :: String -> String
toCamelCaseLower = toCamelCase False

toCamelCase :: Bool -> String -> String
toCamelCase = go
  where go _ ""    = ""
        go _ ('-':cs)   = go True cs
        go True (c:cs)  = toUpper c : go False cs
        go False (c:cs) = c : go False cs

fromCamelCase :: String -> String
fromCamelCase (c:cs)
  | isUpper c = toLower c : go cs
  | otherwise = go (c:cs)
  where go "" = ""
        go (c:cs)
          | c == ' '  = go cs
          | isUpper c = '-' : toLower c : go cs
          | otherwise = c : go cs

commonOpts :: String -> Options
commonOpts prefix = defaultOptions
  { fieldLabelModifier = drop (length prefix)
  , omitNothingFields  = True
  }

commonOptsCC :: String -> Options
commonOptsCC prefix = defaultOptions
  { fieldLabelModifier     = fromCamelCase . drop (length prefix)
  , constructorTagModifier = fromCamelCase
  , omitNothingFields      = True

  }