[#322] Strip Prefix with DerivingVia TomlTable (#366)

* [#322] Strip Prefix with DerivingVia TomlTable

Resolves #322

* Update src/Toml/Codec/Generic.hs

Co-authored-by: Veronika Romashkina <vrom911@gmail.com>

Co-authored-by: Veronika Romashkina <vrom911@gmail.com>

examples/Main.hs

@@ -8,8 +8,8 @@ module Main (main) where
 import Control.Applicative ((<|>))
 import Control.Arrow ((>>>))
 import Data.ByteString (ByteString)
-import Data.Hashable (Hashable)
 import Data.HashSet (HashSet)
+import Data.Hashable (Hashable)
 import Data.IntSet (IntSet)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
@@ -19,7 +19,7 @@ import Data.Time (fromGregorian)
 import GHC.Generics (Generic)
 
 import Toml (TomlCodec, TomlParseError (..), pretty, (.=), (<!>))
-import Toml.Codec.Generic (ByteStringAsBytes (..), HasCodec (..), TomlTable (..),
+import Toml.Codec.Generic (ByteStringAsBytes (..), HasCodec (..), TomlTableStrip (..),
                            stripTypeNameCodec)
 import Toml.Type (TOML (..), Value (..))
 import Toml.Type.Edsl (mkToml, table, (=:))
@@ -84,12 +84,12 @@ data Colour
 matchHex :: Colour -> Maybe Text
 matchHex = \case
     Hex t -> Just t
-    _ -> Nothing
+    _     -> Nothing
 
 matchRgb :: Colour -> Maybe Rgb
 matchRgb = \case
     RGB rgb -> Just rgb
-    _ -> Nothing
+    _       -> Nothing
 
 colourCodec :: Toml.Key -> TomlCodec Colour
 colourCodec key =
@@ -124,31 +124,31 @@ mapWithListCodec = MapWithList
     <$> Toml.tableMap Toml._KeyText (Toml.list innerCodec) "mapList" .= mapList
 
 data Test = Test
-    { testB      :: !Bool
-    , testI      :: !Int
-    , testF      :: !Double
-    , testS      :: !Text
-    , testA      :: ![Text]
-    , testNE     :: !(NonEmpty Text)
-    , testNET    :: !(NonEmpty Int)
-    , testM      :: !(Maybe Bool)
-    , testX      :: !TestInside
-    , testY      :: !(Maybe TestInside)
-    , testEven   :: !Int
-    , testN      :: !N
-    , testC      :: !ColorScheme
-    , testPair   :: !(Int, Text)
-    , testTriple :: !(Int, Text, Bool)
-    , testE1     :: !(Either Integer String)
-    , testE2     :: !(Either String Double)
-    , testStatus :: !UserStatus
-    , users      :: ![User]
-    , susers     :: !(Set User)
-    , husers     :: !(HashSet User)
-    , intset     :: !IntSet
-    , payloads   :: !(Map Text Int)
-    , colours    :: !(Map Text Colour)
-    , tableList  :: !MapWithList
+    { testB         :: !Bool
+    , testI         :: !Int
+    , testF         :: !Double
+    , testS         :: !Text
+    , testA         :: ![Text]
+    , testNE        :: !(NonEmpty Text)
+    , testNET       :: !(NonEmpty Int)
+    , testM         :: !(Maybe Bool)
+    , testX         :: !TestInside
+    , testY         :: !(Maybe TestInside)
+    , testEven      :: !Int
+    , testN         :: !N
+    , testC         :: !ColorScheme
+    , testPair      :: !(Int, Text)
+    , testTriple    :: !(Int, Text, Bool)
+    , testE1        :: !(Either Integer String)
+    , testE2        :: !(Either String Double)
+    , testStatus    :: !UserStatus
+    , users         :: ![User]
+    , susers        :: !(Set User)
+    , husers        :: !(HashSet User)
+    , intset        :: !IntSet
+    , payloads      :: !(Map Text Int)
+    , colours       :: !(Map Text Colour)
+    , tableList     :: !MapWithList
     , testHardcoded :: !Text
     }
 
@@ -210,7 +210,7 @@ data Address = Address
     { addressStreet :: !Text
     , addressHouse  :: !Int
     } deriving stock (Generic)
-      deriving HasCodec via (TomlTable Address)
+      deriving HasCodec via (TomlTableStrip Address)
 
 testGeneric :: TomlCodec GenericPerson
 testGeneric = stripTypeNameCodec

examples/generic.toml

@@ -1,5 +1,5 @@
 name = "foo"
 
 [address]
-    addressStreet = "Bar"
-    addressHouse = 42
+    street = "Bar"
+    house = 42

src/Toml/Codec/Generic.hs

@@ -131,14 +131,15 @@ module Toml.Codec.Generic
 
          -- * Deriving Via
        , TomlTable (..)
+       , TomlTableStrip (..)
        ) where
 
 import Data.ByteString (ByteString)
 import Data.Char (isLower, toLower)
 import Data.Coerce (coerce)
-import Data.Hashable (Hashable)
 import Data.HashMap.Strict (HashMap)
 import Data.HashSet (HashSet)
+import Data.Hashable (Hashable)
 import Data.IntMap.Strict (IntMap)
 import Data.IntSet (IntSet)
 import Data.Kind (Type)
@@ -153,8 +154,8 @@ import Data.Text (Text)
 import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
 import Data.Typeable (Typeable, typeRep)
 import Data.Word (Word8)
-import GHC.Generics ((:*:) (..), (:+:), C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1,
-                     Selector (..))
+import GHC.Generics (C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1, Selector (..), (:*:) (..),
+                     (:+:))
 import GHC.TypeLits (ErrorMessage (..), TypeError)
 import Numeric.Natural (Natural)
 
@@ -721,6 +722,39 @@ instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where
     hasItemCodec = Right $ Toml.diwrap $ genericCodec @a
     {-# INLINE hasItemCodec #-}
 
+{- | @newtype@ for generic deriving of 'HasCodec' typeclass for custom data
+types that should be wrapped into a separate table.
+
+Similar to 'TomlTable' but also strips the data type name prefix from
+TOML keys.
+
+@personCodec@ from the 'TomlTable' comment corresponds to the TOML of
+the following structure:
+
+@
+name = "foo"
+[address]
+    street = \"Bar\"
+    house = 42
+@
+
+@since x.x.x.x
+-}
+newtype TomlTableStrip a = TomlTableStrip
+    { unTomlTableStrip :: a
+    }
+
+-- | @since x.x.x.x
+instance (Generic a, GenericCodec (Rep a), Typeable a) => HasCodec (TomlTableStrip a) where
+    hasCodec :: Key -> TomlCodec (TomlTableStrip a)
+    hasCodec = Toml.diwrap . Toml.table (stripTypeNameCodec @a)
+    {-# INLINE hasCodec #-}
+
+-- | @since x.x.x.x
+instance (Generic a, GenericCodec (Rep a), Typeable a) => HasItemCodec (TomlTableStrip a) where
+    hasItemCodec = Right $ Toml.diwrap $ stripTypeNameCodec @a
+    {-# INLINE hasItemCodec #-}
+
 {- $bytestring
 There are two ways to encode 'ByteString' in TOML: