Comparison chaining for a blog post

chain.hs

import Data.Monoid

chain :: (Ord a) => [a] -> [a] -> Ordering
chain xs = mconcat . (zipWith compare xs)

chain [1, 2, 3] [1, 2, -1]
-- GT

chain [1, 2, 3] [1, 2, 3]
-- EQ

chain [1, 2, 3] [1, 2, 4]
-- LT

guava.java

public int compareTo(Foo that) {
  return ComparisonChain.start()
      .compare(this.aString, that.aString)
      .compare(this.anInt, that.anInt)
      .compare(this.anEnum, that.anEnum, Ordering.natural().nullsLast())
      .result();
}

ifthenelse.java

public int compareTo(Foo that) {
  int c1 = this.aString.compareTo(that.aString);
  if (c1 != 0) return c1;
  int c2 = this.anInt.compareTo(that.anInt);
  if (c2 != 0) ...
}

ordering.hs

-- lexicographical ordering
instance Monoid Ordering where
        mempty         = EQ
        LT `mappend` _ = LT
        EQ `mappend` y = y
        GT `mappend` _ = GT

mconcat = foldr mappend mempty

runChain.hs

import Control.Monad.Error

type Comparison = Either Ordering ()

unchain :: Ordering -> Comparison
unchain EQ = Right ()
unchain LT = Left LT
unchain GT = Left GT

runChain :: Comparison -> Ordering
runChain (Right _) = EQ
runChain (Left x) = x

-- Either requires an error instance, this is a bit ugly
instance Error Ordering where
  noMsg = LT
  strMsg _ = LT

-- Lowest possible precedence
infixl 0 <?
(<?) :: (Ord a) => a -> a -> Comparison
a <? b = unchain $ compare a b

runChain $ do
  1 <? 1
  "abc" <? "ab" ++ "c"
  2.0000 <? 1.9999
-- GT