[Haskell-cafe] EduHaskell

Viktor Dukhovni ietf-dane at dukhovni.org
Mon Sep 25 23:48:14 UTC 2017


On Mon, Sep 25, 2017 at 02:11:20PM -0700, erwig wrote:

> Again, thanks for all the responses so far! I'm still wondering
> which, if any, of the existing alternative preludes would potentially
> be a good substitute for educational purposes.

A small comment, for what it is worth:  as a still learning novice,
I find the error messages in GHC 8.2 to be significantly easier to
understand than in previous releases.  Perhaps students will also
find that to be the case.

As to having or not having "Eq" by default, I have a brief anecdote:

I just did some work to improve performance in the HDBC Sqlite
driver, and had to deal with bit-rot in the tests.  I moved the
time conversion tests from the deprecated System.Time interface to
the preferred Data.Time interface, but found an obstacle in that
ZonedTime has no Eq instance.  This makes sense, because equality
of time with a time zone is ambiguous, are two such times equal
when they refer to the same UTC time, or should the Time Zone name
and summer only flags also be required to be equal?  So choosing
a suitable Eq implementation can be a subtle issue.

For the purpose of the tests, full equality was previously chosen
for System.Time, and I let that stand, so I needed to define an
equivalent Eq instance for Data.Time's ZonedTIme, and wanted to
avoid compiler warnings from creation of orphan instances.  So I
wrapped ZonedTime in a newtype ZonedTimeEq and created an Eq instance
for that, but the tests also wanted this to be "Convertible" to
various related types.  So I engaged some rather fancy machinery:

    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE UndecidableInstances #-}

    newtype ZonedTimeEq = ZonedTimeEq { _zt :: ZonedTime }

    instance Show ZonedTimeEq where
	show = show . _zt

    instance Eq ZonedTimeEq where
	a == b = let a' = _zt a
		     b' = _zt b
		  in zonedTimeToUTC a' == zonedTimeToUTC b' &&
		     zonedTimeZone a' == zonedTimeZone b'

    instance (Convertible a ZonedTime) => (Convertible a ZonedTimeEq) where
	safeConvert v = ZonedTimeEq <$> (safeConvert v)
    instance (Convertible ZonedTime b) => (Convertible ZonedTimeEq b) where
	safeConvert (ZonedTimeEq v) = safeConvert v

I just wrote the definitions I wanted to write, and each time the
compiler produced warnings, it helpfully told me that the definitions
were illegal without an extension to make it go.   So it took three
iterations to add FlexibleInstances, MultiParamTypeClasses and
finally UndecidableInstances to make the compiler happy.

The moral of the story is that Eq can be subtle, and sometimes lack
of an Eq instance is not an oversight, but is a hint that there be
dragons with deciding equality for the type in question.  And it is
in such cases that the instance machinery comes into play to let one
make the appropriate choice for the problem at hand.

-- 
	Viktor.

P.S. Perhaps my ZonedTimeEq "solution" is suboptimal, if there's
a better way, please drop me a note.


More information about the Haskell-Cafe mailing list