Using GHC Generics, we can define operations that only depend on the structure of a type (the number of constructor and their arities).
We want a function zipWithP
that takes a function f
and zips two tuples applying f
between matching fields. Perhaps something with a signature matching this:
zipWithP
:: forall c s. _
=> (forall s. c s => s -> s -> s) -> a -> a -> a
Here f :: forall s. c s => s -> s -> s
is polymorphic, allowing the tuple to be heterogeneous, as long as the fields are all instances of c
. That requirement will be captured by the _
constraint, which is up to the implementation, as long as it works.
There are libraries that capture common constructions, notably one-liner and generics-sop.
In increasing order of automation...
The classical solution is to use the GHC.Generics
module. A Generic
instance represents an isomorphism between a user-defined type a
and an "generic representation" Rep a
associated with it.
This generic representation is constructed from a fixed set of types defined in GHC.Generics
. (The documentation of the module has more details about that representation.)
The standard steps are:
define functions on that fixed set of types (possibly a subset of it);
adapt them to user-defined types by using the isomorphism given by a Generic
instance.
Step 1 is typically a type class. Here GZipWith
is the class of generic representations that can be zipped. The type constructors handled here are, in decreasing order of importance:
K1
represents fields (just apply f
);
(:*:)
represents type products (zip the operands separately);
- the
M1
newtype carries information at the type-level, that we aren't using here so we just wrap/unwrap with it;
U1
represents nullary constructors, mostly for completeness.
Step 2 defines zipWithP
by composing gZipWith
with from
/to
where appropriate.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Generics
class GZipWith c f where
gZipWith :: (forall s. c s => s -> s -> s) -> f p -> f p -> f p
instance c a => GZipWith c (K1 _i a) where
gZipWith f (K1 a) (K1 b) = K1 (f a b)
instance (GZipWith c f, GZipWith c g) => GZipWith c (f :*: g) where
gZipWith f (a1 :*: a2) (b1 :*: b2) = gZipWith @c f a1 b1 :*: gZipWith @c f a2 b2
instance GZipWith c f => GZipWith c (M1 _i _c f) where
gZipWith f (M1 a) (M1 b) = M1 (gZipWith @c f a b)
instance GZipWith c U1 where
gZipWith _ _ _ = U1
zipWithP
:: forall c a. (Generic a, GZipWith c (Rep a))
=> (forall s. c s => s -> s -> s) -> a -> a -> a
zipWithP f a b = to (gZipWith @c f (from a) (from b))
main = do
print (zipWithP @Num (+) (1,2) (3,4) :: (Int, Integer))
generics-sop provides high-level combinators to program generically with operations that feel like fmap
/traverse
/zip
...
In this case, the relevant combinator is hcliftA2
, which zips generic heterogeneous tuples of fields with a binary function. More explanations after the code.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative (liftA2)
import Data.Proxy (Proxy(..))
import Generics.SOP
zipWithP
:: forall c a k
. (Generic a, Code a ~ '[k], All c k)
=> (forall s. c s => s -> s -> s) -> a -> a -> a
zipWithP f x y =
case (from x, from y) of
(SOP (Z u), SOP (Z v)) ->
to (SOP (Z (hcliftA2 (Proxy :: Proxy c) (liftA2 f) u v)))
main = do
print (zipWithP @Num (+) (1,2) (3,4) :: (Int, Integer))
Starting from the top of zipWithP
.
Constraints:
Code a ~ '[k]
: a
must be a single-constructor type (Code a :: [[*]]
is the list of constructors of a
, each given as the list of its fields).
All c k
: all fields of the constructor k
satisfy the constraint c
.
Body:
from
maps from regular type a
to a generic Sum Of Products (SOP I (Code a)
).
- We assumed that the type
a
has a single constructor. We apply that knowledge by pattern-matching to get rid of the "sum" layer. We get u
and v
, whose types are products (NP I k
).
- We apply
hcliftA2
to zip the two tuples u
and v
.
- Fields are wrapped in a type constructor
I
/Identity
(functor-functor or HKD style), hence there is also a liftA2
layer on top of f
.
- We get a new tuple, and go backwards from the first two steps, by applying constructors and
to
(the inverse of from
).
See the generics-sop documentation for more details.
zipWithP
belongs to a class of operations that are commonly described by "do this for each field". one-liner exports operations, some of whose names may look familiar (map...
, traverse...
), that are essentially specializations of a single "generalized traversal" associated with any generic type.
In particular, zipWithP
is called binaryOp
.
{-# LANGUAGE TypeApplications #-}
import Generics.OneLiner
main = print (binaryOp @Num (+) (1,2) (3,4) :: (Int, Integer))