Deciding whether a list of sum types is homogeneous

I ran into a problem recently where I had to decide whether a set of sum types was homogeneous (all the same). In itself, this is a pretty simple problem. However, there were a few complicating factors:

• There exists a type within the types (call it Id) that is ignored in the comparisons.

• There exists a type (call it Mix) that immediately makes the set non-homogeneous, even if all the types are Mix.

The extension of this problem was, given a list of types, is there a single type that can be removed that will make the rest of the types homogeneous (excepting, of course, the Mix type).

For example, if we define our type as:

data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)

then [Bar, Bar, Bar] is homogeneous, [Bar, Bar, Baz] would be homogeneous if Baz were removed. Further, [Bar, Bar, Id] is homogeneous, and [Mix, Mix, Mix] is not. Finally, [Bar, Bar, Mix] contains a Mix type, and hence would not be homogeneous even if this type were removed.

```
import Data.List as List
import Data.Map as Map

data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)

-- Is a list of the above sum types homogeneous?
-- Note that Id is ignored in the comparisons, and Mix immediately
-- makes this False.
homogeneous :: [Foo] -> Bool
homogeneous [] = True
homogeneous [x] = if x == Mix then False else True
homogeneous (x:xs) = all isEqNotMix xs
where isEqNotMix y = ((y == x || y == Id) && y /= Mix)

-- Find a type that would make the set homogeneous if it were removed.
-- Note that if we have an already homogeneous set, then removing the
-- single homoogeneous type from the list will leave it being homogenoeous.
-- The final part of the tuple returns whether it was a homogeneous list or not.
-- Note that in the case of no such type existing, the result is
-- (Mixed, Mixed, False).
homogeneousButOne :: [Foo] -> (Foo, Foo, Bool)
homogeneousButOne xs = case xs of
[] -> (Id, Id, True)
[x] -> (x, x, homogeneous [x])

homogeneous could also be defined using pattern matching, though that would not necessarily be an improvement.

However, homogeneousButOne can definitely be simplified using pattern matching, with no need for Data.Map or Data.List.

data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)

homogeneous :: [Foo] -> Bool
homogeneous []           = True
homogeneous (Mix : _)    = False
homogeneous (Id  : xs)   = homogeneous xs
homogeneous (x   : [])   = True
homogeneous (a:Id:rest)  = homogeneous (a:rest)
homogeneous (a:b:rest)   = (a == b) && homogeneous (b:rest)

homogeneousButOne :: [Foo] -> (Foo, Foo, Bool)
homogeneousButOne xs
  | null nonId           = (Id, Id, True)
  | x' == Mix            = (Mix, Mix, False)
  | length nonId == 3    = majority2of3 nonId
  | homogeneous nonId    = (x', x', True)
  | homogeneous xs'      = (head xs', x', False)
  | x' == predominant    = (predominant, alt, False)
  | otherwise            = (Mix, Mix, False)
  where nonId = filter (/= Id) xs
        (x':xs') = nonId
        majority2of3 (a:b:c:[]) =
          if      a == b then (a, c, a == c)
          else if a == c then (a, b, a == b)
          else if b == c then (b, a, b == a)
          else                (Mix, Mix, False)
        (predominant, alt, _) = homogeneousButOne xs'

StackExchange Code Review Q#51668, answer score: 2