Implement Ordering via hashing

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

Solution

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))