Merge pull request #23 from kutyel/feature-add-strip-suffix

Add StripSuffix modifier

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 '[]`
 

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
 

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]
 

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)