Skip to content

Instantly share code, notes, and snippets.

@yogeshsajanikar yogeshsajanikar/Merge3.hs
Last active Feb 10, 2016

Embed
What would you like to do?
3 way merge
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.