Skip to content

Instantly share code, notes, and snippets.

Last active October 7, 2019 22:43
  • Star 10 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
Blog Post: Derive instances of representationally equal types

Reddit discusson thread.

I made a way to get more free stuff and free stuff is good.

The current implementation of deriveVia is here, it works with all the examples here. Needs GHC 8.2 and th-desugar.

It doesn't take long

for new Haskellers to get pampered by their compiler. For the price of a line or two the compiler offers to do your job, to write uninteresting code for you (in the form of type classes) such as equality, comparison, serialization, ... in the case of 3-D vectors

-- Eq   :: Type -> Constraint
-- Ord  :: Type -> Constraint
-- Show :: Type -> Constraint
-- Read :: Type -> Constraint

data V3 a = V3 a a a
  deriving (Eq, Ord, Show, Read, ...)

In the distant past GHC could only be cajoled into defining a few classes hard-coded into the compiler. With time that list grew to include more interesting classes — type classes over type constructors (of kind Type -> Type) rather than simple types (Type) — but always at the discretion of compiler writers.

{-# Language DeriveTraversable #-}

-- Functor     :: (Type -> Type) -> Constraint
-- Foldable    :: (Type -> Type) -> Constraint
-- Traversable :: (Type -> Type) -> Constraint

data V3 a = V3 a a a
  deriving (..., Functor, Foldable, Traversable)

With the advent of default methods and Generic the rubber band was on the other claw, library writers could now specify a generic, singular (privileged) function to be the default implementation of certain methods.

The JSON-library aeson provides default implementations of JSON serialization

class ToJSON a where
  toJSON :: a -> Value
  toJSON = genericToJSON defaultOptions
    toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value

class FromJSON a where
  parseJSON :: Value -> Parser a
  parseJSON = genericParseJSON defaultOptions
    parseJSON :: (Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a

so users don't even have to specify them

{-# Language DeriveGeneric #-}

import GHC.Generics (Generic)
import Data.Aeson   (ToJSON, FromJSON)

data V3 a = V3 a a a
    (..., Generic)

instance   ToJSON a =>   ToJSON (V3 a)
instance FromJSON a => FromJSON (V3 a)

Then we got the option of deriving any class like this

{-# Language ..., DeriveAnyClass #-}

data V3 a = V3 a a a
    (..., Generic, ToJSON, FromJSON)

and with the latest release (GHC 8.2) we get the option to be more explicit

{-# Language ..., DerivingStrategies #-}

data V3 a = V3 a a a
    (Eq, Ord, Show, Read, Generic)
    (Functor, Foldable, Traversable)

  deriving anyclass
    (ToJSON, FromJSON)
Copy link

"But wait..."

Defining Applicative can look like boilerplate too, if we have a Monad instance! (ignoring MRP, since it can be trivially worked around)

instance Applicative V3 where
  pure :: a -> V3 a
  pure = return

  (<*>) :: V3 (a -> b) -> V3 a -> V3 b
  (<*>) = ap

instance Monad V3 where
  return :: a -> V3 a
  return a = V3 a a a

  (>>=) :: V3 a -> (a -> V3 b) -> V3 b
  V3 a b c >>= f = V3 a' b' c' where
    V3 a' _ _ = f a
    V3 _ b' _ = f b
    V3 _ _ c' = f c

Using the same technique as earlier but with a different newtype WrappedMonad we can derive (Monad) → (Functor, Applicative) → (Num, Floating, Fractional)

data V3 a = V3 a a a
  deriving via WrappedMonad
    (Functor, Applicative)

  deriving via WrappedApplicative
    (Num, Floating, Fractional, Semigroup, Monoid)

instance Monad V3 ...

Copy link

Icelandjack commented Jul 2, 2017

As mention before there can only be a




but methods like arbitrary and coarbitrary of the QuickCheck library have many candidates

arbitraryBoundedEnum     :: (Bounded a, Enum     a) => Gen a
arbitraryBoundedIntegral :: (Bounded a, Integral a) => Gen a
arbitraryBoundedRandom   :: (Bounded a, Random   a) => Gen a
-- ...

so instead of picking a single we define multiple newtypes so we can derive Arbitrary from an Enum

data ABC = A | B | C 
    (Enum, Bounded, Show)
  deriving via WrappedArbitraryEnum
    (Arbitrary, CoArbitrary)


newtype UU = UU Int 
    (Eq, Show, Ord, Enum, Bounded, Generic)

  deriving newtype 
    (Num, Real, Integral)

  deriving via WrappedArbitraryIntegral
    (Arbitrary, CoArbitrary)

or Random

newtype UU = UU Int 
    (Bounded, Generic)

  deriving newtype 

  deriving anyclass

  deriving via WrappedArbitraryRandom

Copy link

Icelandjack commented Jul 2, 2017

We can derive Bifunctor, Bifoldable from Bitraversable using the WrappedBif newtype

data Pair2 a b = Pair2 a b
  deriving via WrappedBif
    (Bifunctor, Bifoldable)

  deriving via WrappedBifunctor
    (Functor, Foldable)

instance Bitraversable Pair2 where
  bitraverse :: Applicative f 
             => (a -> f a') 
             -> (b -> f b') 
             -> (Pair2 a b -> f (Pair2 a' b'))
  bitraverse f g (Pair2 a b) = Pair2 <$> f a <*> g b

and then Functor, Foldable can be derived using WrappedBifunctor. Same could be done with many other types when roles get updated.

Copy link

Icelandjack commented Jul 2, 2017

There are many more applications, some allow us to avoid boilerplate code and others allow us to codify ‘common Haskell knowledge’ (like getting Num from Applicative).

Another example of such knowledge is that Monad can be defined in terms of a Functor with return and join:

class Functor m => MonadJoin m where
  return_  :: a -> m a
  join_    :: m (m a) -> m a

so given an instance for MonadJoin we can derive Monad via WrappedMonadJoin

  deriving via WrappedMonad
  deriving via WrappedMonadJoin

instance MonadJoin MAYBE where
  return_ :: a -> MAYBE a
  return_ = JUST

  join_ :: MAYBE (MAYBE a) -> MAYBE a
  join_ (JUST (JUST a)) = JUST a
  join_ _               = NOTHING

Sometimes join is more intuitive, we may also wish to specify Applicative in terms of the equivalent Monoidal using WrappedMonoidal

class Functor f => Monoidal f where
  unit :: f ()
  (**) :: f a -> f b -> f (a,b)
data MAYBE a = ...
  deriving via WrappedMonoidal

instance Monoidal MAYBE where
  unit :: MAYBE ()
  unit = JUST ()

  (**) :: MAYBE a -> MAYBE b -> MAYBE (a, b)
  JUST a ** JUST b = JUST (a, b)
  _      ** _      = NOTHING

It also allows us to work with crazy hierarchies like this where we can derive everything..

Copy link

I will write more posts about more interesting deriving schemes but for now, what do you think?

Copy link

andorp commented Jul 3, 2017

Please keep writing.

Copy link

@andorp I'm already working on Part 2.

Copy link

Here's another use case: You can trivially get Storable from the more expressive Primitive.

Copy link

Icelandjack commented Sep 7, 2017

Thanks for the suggestion @andrewthad, maybe you know how to complete the instance declaration

newtype WrappedPrim a = WrapPrim a
  deriving newtype

instance Prim a => Storable (WrappedPrim a) where
  sizeOf :: WrappedPrim a -> Int
  sizeOf a = I# (sizeOf# a)

  alignment :: WrappedPrim a -> Int
  alignment a = I# (alignment# a)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment