为不同的数据类型构造函数使用不同的最小完整定义

Question

我有一个类型类Transforming,有两个完整的定义apply和fill.这里是:

import Data.Set (Set, foldr, union, empty, map, singleton)
import Prelude hiding (foldr, map)

class Transforming t where
  apply :: (Ord a) => t a -> a -> Set a
  apply trans = fill trans . singleton
  fill  :: (Ord a) => t a -> Set a -> Set a
  fill trans = foldr union empty . map (apply trans)

(具体细节或多或少对问题不重要,但我想我会把它们包括在内)

现在,我设置它来推断成员函数的方式很好,但通常是天真的.因此,如果我正在创建一个实例,Transforming我可能想要实现任何一个apply或fill取决于什么是最有效的,并让Haskell处理另一个.(或者在极少数情况下实现两者)这很好,这是一个类型类的点.但是,此时我想创建一个新的数据类型如下

data SimpleTransform a = SingletonTrans (a -> a) | GenericTrans (a -> Set a)

现在,当我想要实现这个SimpleTransform实例时,Transforming我想实现fill为构造的实例SingletonTrans和实现apply用它构造的实例GenericTrans.我想写这样的东西:

instance Transforming Transform where
  fill (SingletonTrans f) = map f
  apply (GenericTrans f) = f

但这不起作用.由于Transform是单一数据类型,我需要完全定义两个最小定义之一,而不是部分定义两者.现在有办法解决这个问题.最简单的是完全定义两个实例,但这是一个非常简单的例子,随着我的类型类中完整定义的数量增加,构造函数的数量增加,这开始需要重复大量的代码.

有没有办法可以为同一数据类型的不同构造函数使用不同的完整定义？有什么方法我应该重构我的代码,以使这不必要吗？

Answer 1

这是一种方式:

applyDef trans = fill trans . singleton
fillDef trans = foldr union empty . map (apply trans)

class Transforming t where
  apply :: (Ord a) => t a -> a -> Set a
  apply = applyDef
  fill  :: (Ord a) => t a -> Set a -> Set a
  fill = fillDef

instance Transforming Transform where
  fill (SingletonTrans f) = map f
  fill trans = fillDef trans
  apply (GenericTrans f) = f
  apply trans = applyDef trans

Answer 2

另一种方式,使用 Data.Functor.Sum

newtype SingletonTrans' a = SingletonTrans' (a -> a)
instance Transforming SingletonTrans' where
  fill (SingletonTrans' f) = map f

newtype GenericTrans' a = GenericTrans' (a -> Set a)
instance Transforming GenericTrans' where
  apply (GenericTrans' g) = g

instance (Transforming f, Transforming g) => Transforming (Sum f g) where
  fill (InL f) = fill f
  fill (InR g) = fill g
  apply (InL f) = apply f
  apply (InR g) = apply g

type SimpleTransform = Sum SingletonTrans' GenericTrans'

你甚至可以使用PatternSynonyms,使SimpleTransform行为就像原来的定义:

pattern SingletonTrans :: (a -> a) -> SimpleTransform a
pattern SingletonTrans f = InL (SingletonTrans' f)

pattern GenericTrans :: (a -> Set a) -> SimpleTransform a
pattern GenericTrans g = InR (GenericTrans' g)