Generic data types in Haskell Hackage GitHub CI

Utilities for GHC.Generics.

Generic deriving for standard classes

Example: generically deriving Semigroup instances for products

Semi-automatic method using gmappend

data Foo a = Bar [a] [a] deriving Generic

instance Semigroup (Foo a) where
  (<>) = gmappend

This library also synergizes with the DerivingVia extension (introduced in GHC 8.6), thanks to the Generically newtype.

data Foo a = Bar [a] [a]
  deriving Generic
  deriving Semigroup via (Generically (Foo a))

These examples can be found in test/example.hs.


Note for completeness, the first example uses the following extensions and imports:

{-# LANGUAGE DeriveGeneric #-}

-- base
import Data.Semigroup (Semigroup(..))

-- generic-data
import Generic.Data (gmappend)
import Generic.Data.Orphans ()

The second example makes these additions on top:

{-# LANGUAGE
    DerivingStrategies,
    DerivingVia #-}  -- since GHC 8.6.1

-- In addition to the previous imports
import Generic.Data (Generically(..))

Supported classes

Supported classes that GHC currently can’t derive: Semigroup, Monoid, Applicative, Alternative, Eq1, Ord1, Show1.

Other classes from base are also supported, even though GHC can already derive them:

  • Eq, Ord, Enum, Bounded, Show, Read (derivable by the standard);
  • Functor, Foldable, Traversable (derivable via extensions, DeriveFunctor, etc.).

To derive type classes outside of the standard library, it might be worth taking a look at one-liner.

Type metadata

Extract type names, constructor names, number and arities of constructors, etc..

Type surgery

generic-data offers simple operations (microsurgeries) on generic representations.

More surgeries can be found in generic-data-surgery, and suprisingly, in generic-lens and one-liner.

For more details, see also:

  • the module Generic.Data.Microsurgery;

  • the files test/lens-surgery.hs and one-liner-surgery.hs.

Surgery example

Derive an instance of Show generically for a record type, but as if it were not a record.

{-# LANGUAGE DeriveGeneric #-}
import Generic.Data (Generic, gshowsPrec)
import Generic.Data.Microsurgery (toData, derecordify)

-- An example record type
newtype T = T { unT :: Int } deriving Generic

-- Naively deriving Show would result in this being shown:
--
-- show (T 3) = "T {unT = 3}"
--
-- But instead, with a simple surgery, unrecordify, we can forget T was
-- declared as a record:
--
-- show (T 3) = "T 3"

instance Show T where
  showsPrec n = gshowsPrec n . derecordify . toData

-- This example can be found in test/microsurgery.hs

Alternatively, using DerivingVia:

{-# LANGUAGE DeriveGeneric, DerivingVia #-}
import Generic.Data (Generic)  -- Reexported from GHC.Generics

-- Constructors must be visible to use DerivingVia
import Generic.Data.Microsurgery (Surgery, Surgery'(..), Generically(..), Derecordify)

data V = V { v1 :: Int, v2 :: Int }
  deriving Generic
  deriving Show via (Surgery Derecordify V)

-- show (V {v1 = 3, v2 = 4}) = "V 3 4"

Related links

generic-data aims to subsume generic deriving features of the following packages:

  • semigroups: generic Semigroup, Monoid, but with a heavier dependency footprint.
  • transformers-compat: generic Eq1, Ord1, Show1.
  • generic-deriving: doesn’t derive the classes in base (defines clones of these classes as a toy example); has Template Haskell code to derive Generic (not in generic-data).

Other relevant links.


Internal module policy

Modules under Generic.Data.Internal are not subject to any versioning policy. Breaking changes may apply to them at any time.

If something in those modules seems useful, please report it or create a pull request to export it from an external module.


All contributions are welcome. Open an issue or a pull request on Github!

Changes

0.9.2.0

  • Add instance of Bounded for FiniteEnumeration (the same as Generically)

0.9.1.0

  • Fix conIdToString (it was completely broken)
  • Add conIdMin and conIdMax representing the leftmost and rightmost constructors of a data type.
  • Add NonEmptyType and IsEmptyType to express the constraint that a generic type must or must not be empty.
  • Reexport Generic and Generic1 for convenience.

0.9.0.0

  • Improved definition of gfoldMap, gtraverse, and sequenceA. The optimized Core of Traversable instances eliminates all GHC.Generic instance boilerplate. In many cases, it is identical to the result of GHC’s DeriveFoldable and DeriveTraversable extensions (note: this was already not a problem for gfmap).

    It’s worth noting that there are currently issues with inlining which prevent optimizations that generic-data would ideally rely on.

    • The biggest issue is that GHC will not even inline the to and from methods of the Generic instance it derives for large types (this shows up at around 5 constructors and 10 fields, which is indeed not really big). This will be fixed by a patch for GHC (WIP): https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2965

    • There appear to be some more inlining issues beyond that (issue #40).

0.8.3.0

  • Add generic Read. Thanks to RyanGlScott.

0.8.2.0

  • Add microsurgery CopyRep.
  • Improve documentation of Microsurgery module.
  • Fix a bug where gshowsPrec would incorrectly display prefix uses of symbol data constructors or record selectors (e.g., data R = (:!:) Int Int or data S = MkS { (##) :: Int -> Int }). Thanks to RyanGlScott.
  • Fix a bug where gshowsPrec would incorrectly display infix uses of alphanumeric data constructors (e.g., data T = Int `MkT` Int). Thanks to RyanGlScott.

0.8.1.0

  • Add Old type family mapping newtypes to their underlying type.

0.8.0.0

  • Add GenericProduct, for deriving via GenericProduct B when B is not the type A you want the derived instance for. Note this used to be Generically’s behavior for Monoid before 0.7.0.0.

  • Add generic implementations for Ix. Thanks to Topsii.

  • Add conIdNamed, to get a ConId by its type-level name

  • Add instance Show (ConId a)

  • Improve type errors for deriving Semigroup and Monoid via Generically. Thanks to yairchu.

0.7.0.0

  • Change Monoid instance for Generically, to be compatible with users’ non-generic instances of Semigroup. Thanks to yairchu.
  • Add gcoerce, gcoerceBinop.

0.6.0.1

  • Fix derivation of Show1 for (:.:)

0.6.0.0

  • Add Surgery newtype for DerivingVia
  • Derecordify, Typeage, RenameFields, RenameConstrs, OnFields are no longer type families, but defunctionalized symbols to be applied using GSurgery.

0.5.0.0

  • Specialize onData to Data
  • Add some instances for U1 and V1 in Microsurgery
  • Add OnFields and DOnFields surgeries (“higher-kindification”)

0.4.0.0

  • Created Microsurgery module. Initial set of surgeries:

    • Derecordify
    • Typeage
    • RenameFields, RenameConstrs
    • Some doc about using generic-lens for surgeries

0.3.0.0

  • Add generic implementations of enumFrom, enumFromThen, enumFromTo, enumFromThenTo. They are actually required to be explicit for correct Enum instances. Thanks to Topsii.
  • Parameterize GEnum by a type-level option, and add FiniteEnum option to allow Enum to be derived for composite types. Thanks to Topsii.

0.2.0.0

  • Remove Generic.Data.Types.Map
  • Add Generic.Data.Data.Types.toData and fromData
  • Remove Defun module (subsumed by first-class-families package)

0.1.1.0

  • Add gconIndex
  • Interface for constructor tags
  • Type-level Meta accessors
  • Add basic Newtype functions

0.1.0.0

Released generic-data