@@ -1,10 +1,28 @@
1−module Data.Aeson.Inflections where
1+module Data.Aeson.Inflections
2+ ( defaultFieldLabelModifier
3+ , defaultFieldLabelModifier'
4+ , deriveDefaultJSON
5+ , deriveEnumJSON
6+ , dropPrefix
7+ , dropPrefixLower
8+ , dropByPrefixLength
9+ , cutPrefix
10+ , cutOptionalPrefix
11+ , toUnderscore
12+ , toDashed
13+ , toSpaced
14+ ) where
215
316import Control.Lens
417import Control.Monad
18+import Data.Aeson
19+import Data.Aeson.TH
520import Data.Char
6−import Data.Text as T (Text, pack, unpack)
21+import Data.Maybe
22+import Data.Text (Text)
23+import qualified Data.Text as T
724import Data.Void
25+import Language.Haskell.TH
826import qualified Text.Inflections as I
927import Text.Megaparsec.Error
1028
@@ -17,10 +35,24 @@ defaultFieldLabelModifier = toUnderscore . dropPrefix
1735defaultFieldLabelModifier' :: Text -> Text
1836defaultFieldLabelModifier' = T.pack . defaultFieldLabelModifier . T.unpack
1937
38+deriveDefaultJSON :: Name -> Q [Dec]
39+deriveDefaultJSON = deriveJSON defaultOptions
40+ { fieldLabelModifier = defaultFieldLabelModifier }
41+
42+deriveEnumJSON :: String -> Name -> Q [Dec]
43+deriveEnumJSON prefix = deriveJSON defaultOptions
44+ { constructorTagModifier = toUnderscore . cutPrefix prefix }
45+
2046-- | Just drops prefix
2147dropPrefix :: String -> String
2248dropPrefix = dropWhile (not . isUpper)
2349
50+-- | The same as @Prelude.drop@, but takes a string, instead of a length.
51+-- This makes code more explicit (easier to see what exactly we are expecting to
52+-- @drop@)
53+dropByPrefixLength :: Text -> (String -> String)
54+dropByPrefixLength t = drop (T.length t)
55+
2456-- | Cuts the prefix or throws error if prefix does not match. For TH
2557-- modifiers only
2658cutPrefix :: String -> String -> String
@@ -30,6 +62,10 @@ cutPrefix pref s = if pref == take plen s
3062 where
3163 plen = length pref
3264
65+-- | Drop prefix if exists
66+cutOptionalPrefix :: Text -> Text -> Text
67+cutOptionalPrefix prefix txt = fromMaybe txt $ T.stripPrefix prefix txt
68+
3369-- | Drops prefix and turns first character to lowercase
3470dropPrefixLower :: String -> String
3571dropPrefixLower = over _head toLower . dropPrefix