generic-override
generic-override copied to clipboard
Override type constructors names
Allow overriding the names of type constructors, inspired by this reddit post
Is there an easy way to "tag" a sum type with some additional metadata, e.g. a textual representation, and to be able to use it when writing type class instances? In the example below, I'd like to tag
Black
andWhite
with the strings"black"
and"white"
and then use them to simplify writing serialization/deserialization instances:
By introducing a Rename :: Symbol -> Symbol -> Type
construct we can reuse the Generically
instance from aeson (see also #15)
-- >> toJSON White
-- String "white"
data PlayerColor = Black | White
deriving
stock Generic
deriving (Read, Show, ToJSON, FromJSON, ToField, FromField)
via Generically (Override PlayerColor
'[ "Black" `Rename` "black"
, "White" `Rename` "white"
])
There are other options for renaming, such as positional renaming based on a list of constructor renamings Renaming :: [Symbol] -> Type
where the empty string can be ignored
via Generically (Override PlayerColor '[ Renaming '[ "black", "white" ]])
The argument of Override _
can also be a list of a polykind [k]
, so that it an accept [Symbol]
directly
via Generically (Override PlayerColor '[ "black", "white" ])
The first one is not diffcult to implement, requires a change to a single instance
type Rename :: Symbol -> Symbol -> Type
data Rename old new
type
RenameConstructor :: [Type] -> Symbol -> Symbol
type family
RenameConstructor tys old where
RenameConstructor '[] old = old
RenameConstructor (Rename old new:_) old = new
RenameConstructor (_:tys) old = RenameConstructor tys old
instance
( GOverride' ('Inspect ('Just (RenameConstructor xs conName)) ms mp) xs f
) => GOverride' ('Inspect ignore ms mp) xs
(M1 C ('MetaCons conName conFixity conIsRecord) f)
where
type OverrideRep ('Inspect ignore ms mp) xs
(M1 C ('MetaCons conName conFixity conIsRecord) f) =
M1 C
('MetaCons (RenameConstructor xs conName) conFixity conIsRecord)
(OverrideRep ('Inspect ('Just (RenameConstructor xs conName)) ms mp) xs f)
overrideFrom (M1 x) = M1 (overrideFrom @('Inspect ('Just (RenameConstructor xs conName)) ms mp) @xs x)
{-# INLINE overrideFrom #-}
overrideTo (M1 x) = M1 (overrideTo @('Inspect ('Just (RenameConstructor xs conName)) ms mp) @xs x)
{-# INLINE overrideTo #-}