[Haskell-cafe] Avoiding code-duplication for what is roughly fmap

[Tom Ellis]

On Fri, Oct 04, 2019 at 08:38:33AM +0100, Tom Ellis wrote:
> On Thu, Oct 03, 2019 at 04:55:24PM -0400, Sebastiaan Joosten wrote:
> > I'm writing a lot of code that looks like this:
> > instance WhiteSpaced ClassItem where
> >   removeWS (Method a b c) = Method (removeWS a) (removeWS b) (removeWS c)
> >   removeWS (Declaration b) = Declaration (removeWS b)
> 
> I'll give you an example using product-profunctors, but could you provide
> the class and data type definitions?  I'd like the example to actually
> reflect the reality of the situation you are dealing with.

It sounds like you've already got a satisfactory implementation using
generics.  I'll give a sketch of the product-profunctors version.  It is,
itself, a sort of generics library.

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

import Data.Profunctor (Profunctor, dimap)
import Data.Profunctor.Product (ProductProfunctor, SumProfunctor,
                                empty, (***!),
                                defaultEmpty, defaultProfunctorProduct)
import Data.Profunctor.Product.Default (Default, def)

-- The thing we're trying to generate
newtype WhiteSpaced a b = WhiteSpaced { removeWSExplicit :: a -> b }

-- Some data types whose implementation we won't bother giving
data Contract
data MethodHeader
data DefinitionExpr
data Balanced

-- A data type to which we're interested in giving a default
-- "WhiteSpaced" instance of some sort
data ClassItem
    = Method Contract MethodHeader DefinitionExpr
    | Declaration Balanced

-- The typeclass polymorphic function we're interested in
removeWS :: Default WhiteSpaced a a => a -> a
removeWS = removeWSExplicit def

-- Boilerplate instance.  Generally derived by TH or generics, but
-- that's not implemented for sum types yet ...
instance ( SumProfunctor p
         , ProductProfunctor p
         , Default p Contract Contract
         , Default p MethodHeader MethodHeader
         , Default p DefinitionExpr DefinitionExpr
         , Default p Balanced Balanced ) =>
         Default p ClassItem ClassItem where
  def = error "To be filled in -- by hand, TH, or generics"

-- Boilerplate instances.  I believe they can be derived via "deriving
-- via newtype".
instance Functor (WhiteSpaced a) where
  fmap f = WhiteSpaced . fmap f . removeWSExplicit

instance Applicative (WhiteSpaced a) where
  pure    = WhiteSpaced . pure
  f <*> x = WhiteSpaced (removeWSExplicit f <*> removeWSExplicit x)

instance Profunctor WhiteSpaced where
  dimap f g = WhiteSpaced . dimap f g . removeWSExplicit

instance ProductProfunctor WhiteSpaced where
  empty  = defaultEmpty
  (***!) = defaultProfunctorProduct