module Cfg.Deriving.KeyModifier
(
KeyModifier (..)
, Identity
, ToLower
, ToUpper
, LowerFirst
, UpperFirst
, StripPrefix
, StripSuffix
, CamelTo
, CamelToSnake
, CamelToKebab
, mapFirst
, camelTo
, camelToText
)
where
import Cfg.Options (RootKey (..))
import Data.Char (isLower, isUpper, toLower, toUpper)
import Data.Data (Proxy (..))
import Data.Functor
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.TypeLits
data Identity
data ToLower
data ToUpper
data LowerFirst
data UpperFirst
data StripPrefix (prefix :: Symbol)
data StripSuffix (suffix :: Symbol)
data CamelTo (separator :: Char)
type CamelToSnake = CamelTo '_'
type CamelToKebab = CamelTo '-'
class KeyModifier t where
getKeyModifier :: Text -> Text
instance (KeyModifier k) => KeyModifier ('TypeName k) where
getKeyModifier :: Text -> Text
getKeyModifier = forall (k :: a). KeyModifier k => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @k
instance (KeyModifier k) => KeyModifier ('ConstructorName k) where
getKeyModifier :: Text -> Text
getKeyModifier = forall (t :: a). KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @k
instance KeyModifier Identity where
getKeyModifier :: Text -> Text
getKeyModifier = Text -> Text
forall a. a -> a
id
instance KeyModifier '() where
getKeyModifier :: Text -> Text
getKeyModifier = Text -> Text
forall a. a -> a
id
instance KeyModifier '[] where
getKeyModifier :: Text -> Text
getKeyModifier = Text -> Text
forall a. a -> a
id
instance (KeyModifier a, KeyModifier as) => KeyModifier (a ': as) where
getKeyModifier :: Text -> Text
getKeyModifier = forall (t :: [a]). KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @as (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: a). KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @a
instance (KeyModifier a, KeyModifier b) => KeyModifier (a, b) where
getKeyModifier :: Text -> Text
getKeyModifier = forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @b (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @a
instance (KeyModifier a, KeyModifier b, KeyModifier c) => KeyModifier (a, b, c) where
getKeyModifier :: Text -> Text
getKeyModifier = forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @c (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @b (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @a
instance (KeyModifier a, KeyModifier b, KeyModifier c, KeyModifier d) => KeyModifier (a, b, c, d) where
getKeyModifier :: Text -> Text
getKeyModifier = forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @d (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @c (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @b (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. KeyModifier t => Text -> Text
forall a (k :: a). KeyModifier k => Text -> Text
getKeyModifier @a
instance KeyModifier ToLower where
getKeyModifier :: Text -> Text
getKeyModifier = Text -> Text
T.toLower
instance KeyModifier ToUpper where
getKeyModifier :: Text -> Text
getKeyModifier = Text -> Text
T.toUpper
instance KeyModifier LowerFirst where
getKeyModifier :: Text -> Text
getKeyModifier Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Maybe Text
mapFirst Char -> Char
toLower Text
t
instance KeyModifier UpperFirst where
getKeyModifier :: Text -> Text
getKeyModifier Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Maybe Text
mapFirst Char -> Char
toUpper Text
t
instance (KnownSymbol prefix) => KeyModifier (StripPrefix prefix) where
getKeyModifier :: Text -> Text
getKeyModifier Text
label =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
label (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack (String -> Text)
-> (Proxy prefix -> String) -> Proxy prefix -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy prefix -> Text) -> Proxy prefix -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @prefix) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
label
instance (KnownSymbol prefix) => KeyModifier (StripSuffix prefix) where
getKeyModifier :: Text -> Text
getKeyModifier Text
label =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
label (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
T.stripSuffix (String -> Text
T.pack (String -> Text)
-> (Proxy prefix -> String) -> Proxy prefix -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy prefix -> Text) -> Proxy prefix -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @prefix) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
label
instance (KnownChar separator) => KeyModifier (CamelTo separator) where
getKeyModifier :: Text -> Text
getKeyModifier = Char -> Text -> Text
camelToText (Proxy separator -> Char
forall (n :: Char) (proxy :: Char -> *).
KnownChar n =>
proxy n -> Char
charVal (Proxy separator -> Char) -> Proxy separator -> Char
forall a b. (a -> b) -> a -> b
$ forall (t :: Char). Proxy t
forall {k} (t :: k). Proxy t
Proxy @separator)
mapFirst :: (Char -> Char) -> Text -> Maybe Text
mapFirst :: (Char -> Char) -> Text -> Maybe Text
mapFirst Char -> Char
f Text
text = Text -> Maybe (Char, Text)
T.uncons Text
text Maybe (Char, Text) -> ((Char, Text) -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Char
first, Text
rest) -> Char -> Char
f Char
first Char -> Text -> Text
`T.cons` Text
rest
camelTo
:: Char
-> String
-> String
camelTo :: Char -> String -> String
camelTo Char
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go1
where
go1 :: String -> String
go1 String
"" = String
""
go1 (Char
x : Char
u : Char
l : String
xs) | Char -> Bool
isUpper Char
u Bool -> Bool -> Bool
&& Char -> Bool
isLower Char
l = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
u Char -> String -> String
forall a. a -> [a] -> [a]
: Char
l Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go1 String
xs
go1 (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go1 String
xs
go2 :: String -> String
go2 String
"" = String
""
go2 (Char
l : Char
u : String
xs) | Char -> Bool
isLower Char
l Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
u = Char
l Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
u Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go2 String
xs
go2 (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go2 String
xs
camelToText :: Char -> Text -> Text
camelToText :: Char -> Text -> Text
camelToText Char
c = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
camelTo Char
c (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack