为记录类型定义一个幺半群实例

Question

假设我有一个像

这样的类型

data Options = Options
  { _optionOne :: Maybe Integer
  , _optionTwo :: Maybe Integer
  , _optionThree :: Maybe String
  } deriving Show

有更多的领域。我想为这种类型定义一个Monoid 实例，它的mempty 值是一个Options，所有字段为Nothing。有没有比

更简洁的写法

instance Monoid Options where
  mempty = Options Nothing Nothing Nothing
  mappend = undefined

当我的Options 有大量字段时，这将避免编写一堆Nothings 的需要？

Answer 1

查看有关 hackage 的 generic-monoid 包。具体来说，Data.Monoid.Generic 模块。我们可以使用DerivingVia 扩展自动派生半群和幺半群实例。这样，当您的记录很大并且记录中的每个字段都已经是一个幺半群时，您可以避免编写大量的 mappend 和 mempty 函数。文档给出了以下示例：

data X = X [Int] String
  deriving (Generic, Show, Eq)
  deriving Semigroup via GenericSemigroup X
  deriving Monoid    via GenericMonoid X

这是因为[Int] 是一个幺半群而String 是一个幺半群。在这两个字段中，mappend 是连接，mempty 是空列表 [] 和空字符串 ""。因此我们可以将 X 设为一个幺半群。

X [] "" == (mempty :: X)
True

请记住，如果要定义 Monoid，Haskell 要求您需要一个半群。我们看到typeclass of Monoid 具有Semigroup 约束：

class Semigroup a => Monoid a where
 ...

很遗憾，Option 记录中并非所有字段都是幺半群。具体来说，Maybe Int 不满足开箱即用的Semigroup 约束，因为 Haskell 不知道您想如何添加 mappend 两个 Ints，也许您会添加 (+) 他们或者您'd like to multiply (*) them etc. 我们可以通过从Data.Monoid 借用常见的幺半群（或编写我们自己的）并制作Option 类群的所有字段来轻松解决这个问题。

{-# DeriveGeneric #-}
{-# DerivingVia   #-}

import GHC.Generics
import Data.Monoid
import Data.Monoid.Generic

data Options = Options
  { _optionOne   :: First Integer
  , _optionTwo   :: Sum   Integer
  , _optionThree :: Maybe String
  } 
  deriving (Generic, Show, Eq)
  deriving Semigroup via GenericSemigroup Options
  deriving Monoid    via GenericMonoid Options

您在问题中未定义 mappend 函数，所以我只是随机挑选了一些幺半群来展示多样性（您可能会发现 Maybe wrappers 很有趣，因为它们的 mempty 是 Nothing）。 First 的 mappend 总是选择第一个参数而不是第二个参数，它的 mempty 是 Nothing。 Sum 的mappend 只是添加了Integers，它的mempty 为零0。 Maybe String 已经是一个幺半群，其中mappend 为String 连接，mempty 为Nothing。一旦每个字段都是一个幺半群，我们就可以通过GenericSemigroup 和GenericMonoid 推导出半群和幺半群。

mempty :: Options
Options {
  _optionOne = First { getFirst = Nothing },
  _optionTwo = Sum { getSum = 0 },
  _optionThree = Nothing
}

确实，mempty 符合我们的预期，我们不必为 Options 类型编写任何幺半群或半群实例。 Haskell 能够为我们推导出它！

附：关于使用 Maybe a 作为幺半群的快速说明。它的mempty 是Nothing，但它还要求a 是一个半群。如果mappend 的任何一个参数（或者因为我们谈论的是半群，它的<>）是Nothing，则选择另一个参数。但是，如果两个参数都是Just，我们使用a 的底层半群实例的<>。

instance Semigroup a => Semigroup (Maybe a) where
    Nothing <> b       = b
    a       <> Nothing = a
    Just a  <> Just b  = Just (a <> b)

instance Semigroup a => Monoid (Maybe a) where
    mempty = Nothing

Answer 2

我建议只写Nothings，甚至明确拼出所有记录字段，这样您就可以确保在添加具有不同mempty 值的新字段或重新排序时不会错过任何情况字段：

mempty = Options
  { _optionOne = Nothing
  , _optionTwo = Nothing
  , _optionThree = Nothing
  }

我之前没试过，不过好像你可以用generic-deriving这个包，只要你记录的所有字段都是Monoids。您将添加以下语言编译指示和导入：

{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics (Generic)
import Generics.Deriving.Monoid

将deriving (Generic) 添加到您的数据类型，并将所有非Monoid 字段包装到Data.Monoid 的类型中，并使用您想要的组合行为，例如First、Last、Sum，或Product:

data Options = Options
  { _optionOne :: Last Integer
  , _optionTwo :: Last Integer
  , _optionThree :: Maybe String
  } deriving (Generic, Show)

例子：

• Last (Just 2) <> Last (Just 3) = Last {getLast = Just 3}
• First (Just 2) <> First (Just 3) = First {getFirst = Just 2}
• Sum 2 <> Sum 3 = Sum {getSum = 5}
• Product 2 <> Product 3 = Product {getProduct = 6}

然后使用Generics.Deriving.Monoid 中的以下函数来创建您的默认实例：

memptydefault :: (Generic a, Monoid' (Rep a)) => a
mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a

在上下文中：

instance Monoid Options where
  mempty = memptydefault
  mappend = ...

Answer 3

如果您的记录类型的Monoid 实例自然地遵循记录字段的Monoid 实例，那么您可以使用Generics.Deriving.Monoid。代码可能如下所示：

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics
import Generics.Deriving.Monoid

data Options = { .. your options .. }
             deriving (Show, Generic)

instance Monoid Options where
  mempty = memptydefault
  mappend = mappenddefault

请注意，记录字段也必须是 Monoid，因此您必须将 Integers 包装成 Sum 或 Product（或者可能是其他一些 newtype），具体取决于您的确切行为想要。

然后，假设您希望生成的 monoid 与 Integer 之上的加法同步并使用 Sum 新类型，则生成的行为将是：

> mempty :: Options
Options {_optionOne = Nothing, _optionTwo = Nothing, _optionThree = Nothing}
> Options (Just $ Sum 1) (Just $ Sum 2) (Just $ Sum 3) <> Options (Just $ Sum 1) (Just $ Sum 2) Nothing
Options {_optionOne = Just (Sum {getSum = 2}), _optionTwo = Just (Sum {getSum = 4}), _optionThree = Just (Sum {getSum = 3})}