カスタムタイプのすべての値が等しいかどうかをチェックする方法

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を比較します。

アクセス「Foo内のすべてのInt sが」スクラップ・ご-定型のフレームワーク、またはGHCジェネリックを利用して行うことができますが、あなたが本当にフィールドの多くを持っていない限り、それはやり過ぎに見えます。

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

実際に必要な場合を除いて、私は強くお勧めするタイプレベルのものがここにあります。

Answer 2

これは明らかに行き過ぎであるが、ここであなたは自動的にあなたのレコード内の同じタイプのすべてのフィールドが同じ値を持っている場合はtrueを返すような関数fieldsMatch :: FieldsMatch a => a -> Boolを提供型クラスFieldsMatchを生成することができますGHC.Genericsベースのソリューションです。

{-# 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