{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Yaml.Config.Kebab where
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic, Rep)
import qualified Data.Aeson as Aeson
import qualified Data.Char as Char
import qualified Language.Haskell.TH.Syntax as TH
newtype AesonKebab a = AesonKebab a
aesonKebabOptions :: Aeson.Options
aesonKebabOptions :: Options
aesonKebabOptions =
Options
Aeson.defaultOptions
{ fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = String -> String
kebab
}
kebab :: String -> String
kebab :: String -> String
kebab String
s = do
Char
c <- String
s
if Char -> Bool
Char.isUpper Char
c then [Char
'-', Char -> Char
Char.toLower Char
c] else [Char
c]
kebabName :: TH.Name -> String
kebabName :: Name -> String
kebabName = String -> String
kebab (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
getName
getName :: TH.Name -> String
getName :: Name -> String
getName (TH.Name (TH.OccName String
s) NameFlavour
_) =
case String
s of
Char
'$' : String
_ -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 String
s)
String
_ -> String
s
instance
( Generic a
, Aeson.GToJSON Aeson.Zero (Rep a)
, Aeson.GToEncoding Aeson.Zero (Rep a)
) => ToJSON (AesonKebab a)
where
toJSON :: AesonKebab a -> Value
toJSON (AesonKebab a
a) = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
aesonKebabOptions a
a
toEncoding :: AesonKebab a -> Encoding
toEncoding (AesonKebab a
a) = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
aesonKebabOptions a
a
instance
( Generic a
, Aeson.GFromJSON Aeson.Zero (Rep a)
) => FromJSON (AesonKebab a)
where
parseJSON :: Value -> Parser (AesonKebab a)
parseJSON Value
v = a -> AesonKebab a
forall a. a -> AesonKebab a
AesonKebab (a -> AesonKebab a) -> Parser a -> Parser (AesonKebab a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
aesonKebabOptions Value
v