Implement Ordering via hashing

Question

I have a relatively large set of algebraic data types where I can't automatically derive Eq and Ord because a single field in the data type is considered metadata and shouldn't be considered in equality and ordering. For example a data type might look like this:

data Foo = A Int | B String | C String Int | ... | Z String String Int 

Where every Int in this case is metadata.

So what I do is manually implement Eq by just comparing constructors. But for Ord this becomes insanity because if I have n constructors I have to implement n^2 compare functions. So currently my work around is to manually implement Hashable which requires me to implement a single hash function for every constructor. And then just do a hash compare in my Ord instance.

This has some problems obviously since compare (hash x) (hash y) == EQ -> x == y doesn't hold since two different values can share the same hash. However this can be handled by first manually checking for equality and if this is the case always say the left hand side is smaller then right hand side.

However now you have that for some values of any type it holds that a < b && b < a. Which I'm not sure is allowed in the Haskell Ord instance. So basically my question is if it is Oke to implement Ord like this or not? The reason I need Ord is because many libraries require Ord. For instance graph libraries and map libraries.

Here is a full example:

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Test where

import Prelude

import Data.Bits (xor)
import Data.Hashable (Hashable (..))

data Foo = A Int | B String | C String Int | Z String String Int

instance Eq Foo where
    (A _) == (A _)             = True
    (B x1) == (B x2)           = x1 == x2
    (C x1 _) == (C x2 _)       = x1 == x2
    (Z x1 y1 _) == (Z x2 y2 _) = x1 == x2 && y1 == y2
    _ == _                     = False

instance Hashable Foo where
    hashWithSalt s (A _)     = s `xor` (hash @Int 1)
    hashWithSalt s (B x)     = s `xor` (hash @Int 2) `xor` (hash x)
    hashWithSalt s (C x _)   = s `xor` (hash @Int 3) `xor` (hash x)
    hashWithSalt s (Z x y _) = s `xor` (hash @Int 4) `xor` (hash x) `xor` (hash y)

instance Ord Foo where
    compare (hash -> a) (hash -> b) = case compare a b of
                                        EQ -> if a == b then EQ else LT
                                        e -> e

Answer 1

Here's a hashless solution that may work even if you have multiple metadata types (where the Functor answer I posted separately doesn't work). If you have the flexibility to wrap your metadata in a newtype, you can use Eq and Ord instances for the newtype to "shield" the metadata from the derived Eq and Ord:

-- Meta data is always equal
newtype Meta a = Meta a
instance Eq (Meta a) where
  x == y = True
  x /= y = False
instance Ord (Meta a) where
  compare x y = EQ

Then, a type like:

data Foo = A (Meta Int) | B String | C String (Meta Bool) 
  | Z String String (Meta String) deriving (Eq, Ord)

with derived Eq and Ord instances compares as if the metadata isn't there:

main = do
  print $ Z "foo" "bar" (Meta "different") == Z "foo" "bar" (Meta "but still the same")
  print $ compare (A (Meta 10)) (A (Meta 20))

Here, the drawback is the usual issue with newtype wrappers: you need to wrap and unwrap (or coerce) metadata.

Full code:

newtype Meta a = Meta a
instance Eq (Meta a) where
  x == y = True
  x /= y = False
instance Ord (Meta a) where
  compare x y = EQ

data Foo = A (Meta Int) | B String | C String (Meta Bool)
  | Z String String (Meta String) deriving (Eq, Ord)

main = do
  print $ Z "foo" "bar" (Meta "different") == Z "foo" "bar" (Meta "but still the same")
  print $ compare (A (Meta 10)) (A (Meta 20))

Answer 2

Well, this turned out to be a little more complicated than I expected when I actually wrote it all up, so maybe someone can come up with something simpler, but...

If you have freedom to modify your types, I would suggest making your type polymorphic in the offending integer type and deriving a functor:

{-# LANGUAGE DeriveFunctor #-}
data FooF int = A int | B String | C String int | Z String String int deriving (Functor)

Now, your original type is given by the alias:

type Foo = FooF Int

You can use a standalone deriving clause to derive Eq and Ord for FooF ():

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
deriving instance Eq (FooF ())
deriving instance Ord (FooF ())

and then with a conversion function that forgets the integers:

forgetInts :: Foo -> FooF ()
forgetInts x = () <$ x

you can write Foo instances as follows:

import Data.Function
instance Eq Foo where
  (==) = (==) `on` forgetInts
instance Ord Foo where
  compare = compare `on` forgetInts

One drawback is that you might need some additional type signatures or annotations, since A 10 is no longer unambiguously FooF Int as opposed to FooF Double. See main below, for example.

Full code:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}

import Data.Function

data FooF int = A int | B String | C String int | Z String String int deriving (Functor)
type Foo = FooF Int
deriving instance Eq (FooF ())
deriving instance Ord (FooF ())

forgetInts :: Foo -> FooF ()
forgetInts x = () <$ x

instance Eq Foo where
  (==) = (==) `on` forgetInts
instance Ord Foo where
  compare = compare `on` forgetInts

main = do
  print $ Z "foo" "bar" 1 == (Z "foo" "bar" 2 :: Foo)
  print $ compare (A 10) (A 20 :: Foo)