Question

我正在寻找一种更好的方法来检查给定类型的所有值是否相等。

例如，考虑：

data Foo = Foo {a :: Int, b :: Int, c :: Int, d :: Int}

allFooEqual :: Foo -> Bool
allFooEqual foo = (a foo == b foo) && (a foo == c foo) && (a foo == d foo)

这很有效，但它不是一个可扩展的解决方案。有没有更惯用的方式来执行我所缺少的这种行为？

Answer 1

替代方案：

allFooEqual :: Foo -> Bool
allFooEqual (Foo xa xb xc xd) = all (xa==) [xb,xc,xd]

这将比较xa == xb && xa == xc && xa == xd。

另：

atMostOne :: Eq a => [a] -> Bool
atMostOne xs = and $ zipWith (==) xs (drop 1 xs)

allFooEqual :: Foo -> Bool
allFooEqual (Foo xa xb xc xd) = atMostOne [xa,xb,xc,xd]

这将比较xa == xb && xb == xc && xc == xd。

访问＆{34} Int＆＃34;中的所有Foo s可以利用废弃的样板框架或GHC Generics来完成，但除非你真的有很多领域，否则看起来有点过分。

allFooEqual :: Foo -> Bool
allFooEqual f = atMostOne [ x 
   | Just x <- gmapQ (mkQ Nothing (Just :: Int -> Maybe Int)) f ]

这里有如此多的类型级别的东西，我强烈建议反对它，除非真的，真的需要。

Answer 2

这显然有些过分，但这里有一个基于GHC.Generics的解决方案，可让您自动生成类型类FieldsMatch，它提供了一个函数fieldsMatch :: FieldsMatch a => a -> Bool，如果所有字段都返回true记录中的相同类型具有相同的值。

{-# LANGUAGE TypeOperators, ExistentialQuantification, DefaultSignatures, 
      FlexibleContexts #-}
module FieldsMatch (FieldsMatch(..)) where

import GHC.Generics
import Data.Typeable

-- `Some` is an existential type that we need to store each field
data Some = forall a. (Eq a, Typeable a) => Some a

-- This is the class we will be deriving
class FieldsMatch a where
  -- in general, this is the type of `fieldsMatch`...
  fieldsMatch :: a -> Bool

  -- ... except the default implementation has slightly different constraints.
  default fieldsMatch :: (Generic a, GetFields (Rep a)) => a -> Bool
  fieldsMatch = noneDiffering . getFields . from
    where
      noneDiffering :: [Some] -> Bool
      noneDiffering [] = True
      noneDiffering (x:xs) = all (notDiffering x) xs && noneDiffering xs

      notDiffering :: Some -> Some -> Bool
      Some x `notDiffering` Some y = case cast y of
        Nothing -> True
        Just z -> x == z

class GetFields f where
  -- | This function takes the generic representation of a datatype and
  -- recursively traverses it to collect all its fields. These need to
  -- have types satisfying `Eq` and `Typeable`.
  getFields :: f a -> [Some]

instance (GetFields a, GetFields b) => GetFields (a :*: b) where
  getFields (l :*: r) = getFields l ++ getFields r

instance (GetFields a, GetFields b) => GetFields (a :+: b) where
  getFields (L1 l) = getFields l
  getFields (R1 r) = getFields r

instance GetFields U1 where
  getFields U1 = []

instance (Typeable a, Eq a) => GetFields (K1 i a) where
  getFields (K1 x) = [Some x]

instance GetFields a => GetFields (M1 i t a) where
  getFields (M1 x) = getFields x

  default fieldsMatch :: (Generic a, GetFields (Rep a)) => a -> Bool
  fieldsMatch = noneDiffering . getFields . from
    where
      noneDiffering :: [Some] -> Bool
      noneDiffering [] = True
      noneDiffering (x:xs) = all (notDiffering x) xs || noneDiffering xs

      notDiffering :: Some -> Some -> Bool
      Some x `notDiffering` Some y = case cast y of
        Nothing -> True
    Just z -> x == z

你可以在GHCi中试试这个：

ghci> :set -XDeriveGeneric
ghci> data Foo b = Foo Int Int b Bool deriving (Generic)
ghci> instance (Eq b, Typeable b) => FieldsMatch (Foo b)
ghci> Foo 1 1 True True -- fields of the same type are equal
True
ghci> Foo 1 2 True (1,2) -- 1 /= 2 even though they are the same type
False

如何检查自定义类型中的所有值是否相等

2 个答案: