generic-override icon indicating copy to clipboard operation
generic-override copied to clipboard

Override type constructors names

Open Icelandjack opened this issue 2 years ago • 0 comments

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 and White 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 #-}

Icelandjack avatar Aug 04 '22 03:08 Icelandjack