@@ -0,0 +1,52 @@
1+module Data.Aeson.Inflections where
2+
3+import Control.Lens
4+import Control.Monad
5+import Data.Char
6+import Data.Text as T (Text, pack, unpack)
7+import Data.Void
8+import qualified Text.Inflections as I
9+import Text.Megaparsec.Error
10+
11+
12+-- | Drops until first uppercase character and apply 'toUnderscore' to
13+-- the rest
14+defaultFieldLabelModifier :: String -> String
15+defaultFieldLabelModifier = toUnderscore . dropPrefix
16+
17+defaultFieldLabelModifier' :: Text -> Text
18+defaultFieldLabelModifier' = T.pack . defaultFieldLabelModifier . T.unpack
19+
20+-- | Just drops prefix
21+dropPrefix :: String -> String
22+dropPrefix = dropWhile (not . isUpper)
23+
24+-- | Cuts the prefix or throws error if prefix does not match. For TH
25+-- modifiers only
26+cutPrefix :: String -> String -> String
27+cutPrefix pref s = if pref == take plen s
28+ then drop plen s
29+ else error "Prefix does not match!"
30+ where
31+ plen = length pref
32+
33+-- | Drops prefix and turns first character to lowercase
34+dropPrefixLower :: String -> String
35+dropPrefixLower = over _head toLower . dropPrefix
36+
37+toUnderscore :: String -> String
38+toUnderscore = fromInflection I.toUnderscore
39+
40+toDashed :: String -> String
41+toDashed = fromInflection I.toDashed
42+
43+fromInflection
44+ :: (Text -> Either (ParseErrorBundle Text Void) Text)
45+ -> String
46+ -> String
47+fromInflection f = either error' T.unpack . f . T.pack
48+ where
49+ error' = error . show . I.InflectionParsingFailed
50+
51+toSpaced :: String -> String
52+toSpaced = fromInflection (I.toHumanized False <=< I.toUnderscore)