diff --git a/README.md b/README.md index 77eec75..4b1c4b6 100644 --- a/README.md +++ b/README.md @@ -36,6 +36,8 @@ main = BL.putStrLn $ encode testData * `Prefixed str` = `CustomJSON '[FieldLabelModifier (StripPrefix str)]` * `PrefixedSnake str` = `CustomJSON '[FieldLabelModifier (StripPrefix str, CamelToSnake)]` +* `Suffixed str` = `CustomJSON '[FieldLabelModifier (StripSuffix str)]` +* `SuffixedSnake str` = `CustomJSON '[FieldLabelModifier (StripSuffix str, CamelToSnake)]` * `Snake` = `CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]]` * `Vanilla` = `CustomJSON '[]` diff --git a/src/Deriving/Aeson.hs b/src/Deriving/Aeson.hs index 5c890f6..4e1cd6e 100644 --- a/src/Deriving/Aeson.hs +++ b/src/Deriving/Aeson.hs @@ -1,12 +1,12 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -------------------- -- | Type-directed aeson instance CustomJSONisation @@ -27,6 +27,7 @@ module Deriving.Aeson , SumTwoElemArray -- * Name modifiers , StripPrefix + , StripSuffix , CamelTo , CamelToKebab , CamelToSnake @@ -38,7 +39,7 @@ module Deriving.Aeson , FromJSON , ToJSON , Generic - )where + ) where import Data.Aeson import Data.Coerce @@ -86,6 +87,9 @@ data UnwrapUnaryRecords -- | Strip prefix @t@. If it doesn't have the prefix, keep it as-is. data StripPrefix t +-- | Strip suffix @t@. If it doesn't have the suffix, keep it as-is. +data StripSuffix t + -- | Generic CamelTo constructor taking in a separator char data CamelTo (separator :: Symbol) @@ -105,6 +109,12 @@ class StringModifier t where instance KnownSymbol k => StringModifier (StripPrefix k) where getStringModifier = fromMaybe <*> stripPrefix (symbolVal (Proxy @k)) +stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] +stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b) + +instance KnownSymbol k => StringModifier (StripSuffix k) where + getStringModifier = fromMaybe <*> stripSuffix (symbolVal (Proxy @k)) + instance StringModifier '[] where getStringModifier = id diff --git a/src/Deriving/Aeson/Stock.hs b/src/Deriving/Aeson/Stock.hs index 3fc98ce..416cc37 100644 --- a/src/Deriving/Aeson/Stock.hs +++ b/src/Deriving/Aeson/Stock.hs @@ -4,6 +4,8 @@ module Deriving.Aeson.Stock ( Prefixed , PrefixedSnake + , Suffixed + , SuffixedSnake , Snake , Vanilla -- * Reexports @@ -21,6 +23,12 @@ type Prefixed str = CustomJSON '[FieldLabelModifier (StripPrefix str)] -- | Strip @str@ prefices and convert from CamelCase to snake_case type PrefixedSnake str = CustomJSON '[FieldLabelModifier '[StripPrefix str, CamelToSnake]] +-- | Field names are suffixed by @str@; strip them from JSON representation +type Suffixed str = CustomJSON '[FieldLabelModifier (StripSuffix str)] + +-- | Strip @str@ suffixes and convert from CamelCase to snake_case +type SuffixedSnake str = CustomJSON '[FieldLabelModifier '[StripSuffix str, CamelToSnake]] + -- | Convert from CamelCase to snake_case type Snake = CustomJSON '[FieldLabelModifier CamelToSnake] diff --git a/tests/test.hs b/tests/test.hs index ed40944..a078a82 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -26,6 +26,10 @@ data Foo = Foo { fooFoo :: Int, fooBar :: Int } deriving (FromJSON, ToJSON) via Prefixed "foo" Foo +data Something = Something { somethingKun :: Int, somethingElseKun :: Int } + deriving Generic + deriving (FromJSON, ToJSON) via Suffixed "Kun" Something + testData :: [User] testData = [User 42 "Alice" Nothing "human", User 43 "Bob" (Just "xyz") "bot"] @@ -57,6 +61,7 @@ data MultipleFieldRenames = MultipleFieldRenames main = do BL.putStrLn $ encode testData BL.putStrLn $ encode $ Foo 0 1 + BL.putStrLn $ encode $ Something 0 1 assertEq (toJSON RenamedCtorOptA)