compare.hs

#!/usr/bin/env stack
-- stack --resolver lts-6 --install-ghc runghc --package protolude

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

import Protolude

getDifferences :: (Ord a, Ord b, Eq c) => (a -> (b, c)) -> [a] -> [a] -> [(b, (c, c))]
getDifferences _ _ [] = []
getDifferences _ [] _ = []
getDifferences splitter xs@(x:xs') ys@(y:ys') =
  let (x1, x2) = splitter x
      (y1, y2) = splitter y
  in
    case compare x1 y1 of
      LT -> getDifferences splitter xs' ys
      GT -> getDifferences splitter xs ys'
      EQ ->
        let next = getDifferences splitter xs' ys' in
        if x2 == y2
        then next
        else (x1, (x2, y2)):next



main :: IO ()
main = do
  let left = [("foo", 1),("bar", 2),("baz", 3)] :: [(Text, Int)]
  let right = [("foo", 1),("bar", 3),("baz", 3)]
  putStrLn $ (show $ getDifferences identity left right :: Text)

If I understand the logic of this right, this should be the same thing using Map?

import qualified Data.Map.Strict as M


getDifferences :: (Ord k, Eq v) => M.Map k v -> M.Map k v -> M.Map k (v, v)
getDifferences = M.mergeWithKey compare ignore ignore
  where
    compare k x y = if x == y then Nothing else Just (x, y)
    ignore = const M.empty


main :: IO ()
main = do
  let left = M.fromList [("foo", 1),("bar", 2),("baz", 3)] :: M.Map Text Int
  let right = M.fromList [("foo", 1),("bar", 3),("baz", 3)] :: M.Map Text Int
  putStrLn $ (show $ getDifferences left right :: Text)

Yes, that's right. Thanks.