3 way merge

Merge3.hs

{-# LANGUAGE TypeFamilies #-}
module Mergeable where

import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import Data.Maybe


data Diff a = Same a
            | Change a a
            | Add a
            | Remove a
            deriving (Eq, Ord, Show)

currentValue :: Diff a -> Maybe a
currentValue (Same a) = Just a
currentValue (Change a _) = Just a
currentValue (Add a) = Just a
currentValue (Remove a) = Nothing

class Mergeable c where

  type Diffable c 

  diff :: c -> c -> Diffable c

  add :: c -> Diffable c

  remove :: c -> Diffable c

  merge :: Diffable c -> Diffable c -> Maybe c

  fromDiffable :: Diffable c -> Maybe c


instance (Ord a, Mergeable a, Ord k) => Mergeable (Map k a) where

  type Diffable (Map k a) = Map k (Diffable a)

  diff = Map.mergeWithKey combine onlyhead onlybase
    where
      combine k h b = Just $ diff h b
      onlyhead = add
      onlybase = remove

  add mh = add <$> mh

  remove mb = remove <$> mb

  merge x y = Just $ Map.mergeWithKey combine onlyleft onlyright x y
    where
      combine k h b = merge h b
      onlyleft = fmap (fromJust . fromDiffable)
      onlyright = fmap (fromJust. fromDiffable)

instance Mergeable Int where

  type Diffable Int = Diff Int

  diff a b | a == b = Same a
           | otherwise = Change a b

  add = Add

  remove = Remove

  merge (Same a) (Same b) | a == b = Just a
                          | otherwise = Nothing

  merge (Same a) (Change c b) | a /= b = Nothing
                              | otherwise = Just c

  merge (Change b c) (Same a) = merge (Same a) (Change b c)

  merge (Change a b) (Change c d) | b /= d = Nothing
                                  | otherwise = Just c -- Let the second win

  merge _ _ = Nothing

  fromDiffable = currentValue