Блог

Я ищу лучший способ проверить, все ли значения данного типа равны.

Например, рассмотрим:

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

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

Это работает, но это не совсем масштабируемое решение. Есть ли более идиоматический способ выполнения этого типа действий, который мне не хватает?

Альтернативный:

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

Это будет сравнивать xa == xb amp;amp; xa == xc amp;amp; 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 amp;amp; xb == xc amp;amp; xc == xd .

Доступ ко «всем Int s в a Foo » может быть выполнен с использованием фреймворка scrap-your-boilerplate или универсальных GHC, но это выглядит излишним, если у вас действительно много полей.

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

Здесь так много вещей на уровне типов, что я настоятельно рекомендую отказаться от этого, если это действительно, действительно необходимо.

Это, очевидно, излишне, но вот 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 amp;amp; 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