Lazy functors
Question
I have a data type like
data Pair a = Pair a a
Shall I define Functor
and related instances
with lazy pattern matching or with strict pattern matching?
That is, shall I define
instance Functor Pair where
fmap f ~(Pair a b) = Pair (f a) (f b)
instance Applicative Pair where
pure a = Pair a a
~(Pair fa fb) <*> ~(Pair a b) = Pair (fa a) (fb b)
instance Fold.Foldable Pair where
foldMap = Trav.foldMapDefault
instance Trav.Traversable Pair where
sequenceA ~(Pair a b) = liftA2 Pair a b
or shall I define
instance Functor Pair where
fmap f (Pair a b) = Pair (f a) (f b)
instance Applicative Pair where
pure a = Pair a a
(Pair fa fb) <*> (Pair a b) = Pair (fa a) (fb b)
instance Fold.Foldable Pair where
foldMap = Trav.foldMapDefault
instance Trav.Traversable Pair where
sequenceA (Pair a b) = liftA2 Pair a b
?
Answer
We can deduce the answers from the following laws applied to undefined values.
import Control.Monad.Identity (Identity(Identity))
fmap id x == x
pure id <*> x == x
f <*> pure x == pure ($x) <*> f
-- there are no laws mentioned in the Traversable documentation,
-- but I find the following one natural enough
sequenceA (fmap Identity x) = Identity x
With the first definitions with lazy matching the laws are violated:
fmap id undefined == Pair undefined undefined
-- because of laziness in the second operand of <*> we get:
pure id <*> undefined == Pair undefined undefined
-- if the second operand is matched strictly, and the first one lazily,
-- then we get:
undefined <*> pure undefined == Pair undefined undefined
pure ($ undefined) <*> undefined == undefined
-- given that fmap matches strict now, since lazy matching is incorrect
sequenceA (fmap Identity undefined) == Identity (Pair undefined undefined)
In contrast to that the strict pattern matching is correct in this respect:
fmap id undefined == undefined
pure id <*> undefined == undefined
undefined <*> pure undefined == undefined
pure ($ undefined) <*> undefined == undefined
sequenceA (fmap Identity undefined) = Identity undefined
It is a good idea to comply with these laws since they minimize the surprise of the users of your data type, including yourself.
If you use strict record fields (denoted with !
)
then there is no (Pair undefined undefined)
,
only undefined
.
That is, in this case the laws would hold
independent of the mode of pattern matching.
However, this shall not suggest,
that using strict record fields is generally prefered