如何避免编写这种类型的Haskell样板代码

Question

我经常遇到这种情况,因为它很烦人.

假设我有一个总和类型,它可以包含一个x或一堆其他与之无关的事物x-

data Foo x = X x | Y Int | Z String | ...(other constructors not involving x)

要声明一个Functor实例,我必须这样做 -

instance Functor Foo where
    fmap f (X x) = X (f x)
    fmap _ (Y y) = Y y
    fmap _ (Z z) = Z z
    ... And so on

虽然我想做的是 -

instance Functor Foo where
    fmap f (X x) = X (f x)
    fmap _ a = a

即我只关心X构造函数,所有其他构造函数都只是"通过".但是当然这不会编译,因为a左边是a与等式右边不同的类型.

有没有办法可以避免为其他构造函数编写这个样板文件？

Answer 1

这有两个主要的简单解决方案.

首先,对于简单类型,只需deriving (Functor)使用必要的扩展.

另一种解决方案是定义另一种数据类型:

data Bar = S String | B Bool | I Int  -- "Inner" type
data Foo a = X a | Q Bar              -- "Outer" type

instance Functor Foo where
    fmap f (X a) = X (f a)
    fmap _ (Q b) = Q b -- `b' requires no type change. 

所以你可以再写一行来删除很多.

它不完全适合模式匹配,但它至少解决了这个问题.

Answer 2

我假设我们想要为一般情况提供解决方案,其中更改类型参数不一定在正确的位置DeriveFunctor.

我们可以区分两种情况.

在简单的情况下,输出数据类型不是递归的.在这里,棱镜是一个合适的解决方案:

{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

data Foo x y = X x | Y y | Z String

makePrisms ''Foo

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX = over _X

如果我们的数据是递归的,那么事情会变得更复杂.现在makePrisms不会创建类型更改棱镜.我们可以通过将其分解为显式修复点来消除定义中的递归.这样我们的棱镜仍然可以改变:

import Control.Lens

newtype Fix f = Fix {out :: f (Fix f)}

-- k marks the recursive positions
-- so the original type would be "data Foo x y = ... | Two (Foo x y) (Foo x y)"
data FooF x y k = X x | Y y | Z String | Two k k deriving (Functor)

type Foo x y = Fix (FooF x y)

makePrisms ''FooF

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX f = 
   Fix .               -- rewrap 
   over _X f .         -- map f over X if possible
   fmap (mapOverX f) . -- map over recursively
   out                 -- unwrap

或者我们可以分解自下而上的转变:

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata f = go where go = f . fmap go . out

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX f = cata (Fix . over _X f)

有关使用仿函数的修复点进行泛型编程的大量文献,以及许多库,例如this或this.您可能希望搜索"递归方案"以进一步参考.

Answer 3

看起来像是棱镜的工作.

免责声明:我是镜头/棱镜新手.

{-# LANGUAGE TemplateHaskell   #-}

import Control.Lens
import Control.Lens.Prism

data Foo x = X x | Y Int | Z String deriving Show

makePrisms ''Foo

instance Functor Foo where
   -- super simple impl, by András Kovács
   fmap = over _X
   -- My overly complicated idea
   --    fmap f = id & outside _X .~ (X . f)
   -- Original still more complicated implementation below
   --     fmap f (X x) = X (f x)
   --     fmap _ a = id & outside _X .~ undefined $ a

用法:

*Main> fmap (++ "foo") (Y 3)
Y 3
*Main> fmap (++ "foo") (X "abc")
X "abcfoo"