Skip to content

Override type constructors names #19

@Icelandjack

Description

@Icelandjack

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

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions