Strange hashable

StrangeHashable.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wall #-}

module StrangeHashable where

import Data.Hashable
import GHC.Generics (Generic)

data ListF a r = ConsF a r | NilF deriving Generic

instance (Hashable a, Hashable r) => Hashable (ListF a r)

data List a = List (ListF a (List a))

hashList :: forall a. Hashable a => List a -> Int
hashList (List l) = case l of
  ConsF a r -> hash (ConsF a (hashList r))
  NilF      -> hash (NilF :: ListF a Int)

nil :: List a
nil = List NilF

infixr .:

(.:) :: a -> List a -> List a
a .: as = List (ConsF a as)

hashNil :: Int
hashNil = hashList (nil :: List Int)

hashCons :: Int
hashCons = hashList (0 .: 0 .: nil :: List Int)

shouldn'tBeTrue :: Bool
shouldn'tBeTrue = hashNil == hashCons

hashIsBad :: Hashable a => a -> Int -> Bool
hashIsBad x y = hash (x, hash (x, y)) == y

hashIsReallyBad :: Bool
hashIsReallyBad = all (uncurry hashIsBad) manyPairs
  where manyPairs :: [(Int, Int)]
        manyPairs = (,) <$> [-1000..1000] <*> [-1000..1000]

-- >>> hashIsReallyBad
-- True