Merge pull request #329 from github/ordered-map-but-this-time-working

Ordered map, but this time working

semantic-diff.cabal

@@ -77,6 +77,7 @@ test-suite semantic-diff-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
+  other-modules:       OrderedMapSpec
   build-depends:       base
                      , containers
                      , free

src/Interpreter.hs

@@ -10,7 +10,8 @@ import Syntax
 import Term
 import Control.Monad.Free
 import Control.Comonad.Cofree hiding (unwrap)
-import OrderedMap
+import qualified OrderedMap as Map
+import OrderedMap ((!))
 import Data.Maybe
 
 hylo :: Functor f => (t -> f b -> b) -> (a -> (t, f a)) -> a -> b
@@ -40,21 +41,20 @@ run _ (Pure diff) = Just diff
 run comparable (Free (Recursive (annotation1 :< a) (annotation2 :< b) f)) = run comparable . f $ recur a b where
   recur (Indexed a') (Indexed b') | length a' == length b' = annotate . Indexed $ zipWith (interpret comparable) a' b'
   recur (Fixed a') (Fixed b') | length a' == length b' = annotate . Fixed $ zipWith (interpret comparable) a' b'
-  recur (Keyed a') (Keyed b') | keys a' == keys b' = annotate . Keyed . fromList . fmap repack $ keys b'
+  recur (Keyed a') (Keyed b') | Map.keys a' == bKeys = annotate . Keyed . Map.fromList . fmap repack $ bKeys
     where
+      bKeys = Map.keys b'
       repack key = (key, interpretInBoth key a' b')
-      interpretInBoth key x y = maybeInterpret (lookup key x) (lookup key y)
-      maybeInterpret (Just x) (Just y) = interpret comparable x y
-      maybeInterpret _ _ = error "maybeInterpret assumes that its operands are `Just`s."
+      interpretInBoth key x y = interpret comparable (x ! key) (y ! key)
   recur _ _ = Pure $ Replace (annotation1 :< a) (annotation2 :< b)
 
   annotate = Free . Annotated (annotation1, annotation2)
 
 run comparable (Free (ByKey a b f)) = run comparable $ f byKey where
-  byKey = unions [ deleted, inserted, patched ]
-  deleted = (Pure . Delete) <$> difference a b
-  inserted = (Pure . Insert) <$> difference b a
-  patched = intersectionWith (interpret comparable) a b
+  byKey = Map.unions [ deleted, inserted, patched ]
+  deleted = (Pure . Delete) <$> Map.difference a b
+  inserted = (Pure . Insert) <$> Map.difference b a
+  patched = Map.intersectionWith (interpret comparable) a b
 
 run comparable (Free (ByIndex a b f)) = run comparable . f $ ses (constructAndRun comparable) diffCost a b
 

src/OrderedMap.hs

@@ -39,7 +39,7 @@ empty :: OrderedMap key value
 empty = OrderedMap []
 
 union :: Eq key => OrderedMap key value -> OrderedMap key value -> OrderedMap key value
-union (OrderedMap a) (OrderedMap b) = OrderedMap $ a ++ filter ((`elem` extant) . fst) b
+union (OrderedMap a) (OrderedMap b) = OrderedMap $ a ++ filter (not . (`elem` extant) . fst) b
   where extant = fst <$> a
 
 unions :: Eq key => [OrderedMap key value] -> OrderedMap key value

test/OrderedMapSpec.hs

@@ -0,0 +1,44 @@
+module OrderedMapSpec where
+
+import OrderedMap as Map
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "difference" $ do
+    it "should return those elements of a not in b" $
+      Map.difference a b `shouldBe` (Map.fromList [ ("a", 1) ])
+
+    it "is asymmetrical" $ do
+      Map.difference a b `shouldNotBe` Map.difference b a
+
+  describe "union" $ do
+    it "should return those elements in either a or b" $
+      Map.union a b `shouldBe` (Map.fromList $ Map.toList a ++ [ ("d", -4) ])
+
+    it "is asymmetrical" $ do
+      Map.union a b `shouldNotBe` Map.union b a
+
+  describe "unions" $ do
+    it "is equivalent to `union` for two maps" $
+      Map.unions [ a, b ] `shouldBe` Map.union a b
+
+    it "does not duplicate elements" $
+      Map.unions [ a, b, a, b, a, b ] `shouldBe` Map.union a b
+
+  describe "intersectionWith" $ do
+    it "should return those elements in both a and b, combined with a function" $
+      Map.intersectionWith (-) a b `shouldBe` (Map.fromList [ ("b", 4), ("c", 6) ])
+
+    it "is asymmetrical" $ do
+      Map.intersectionWith (-) a b `shouldNotBe` Map.intersectionWith (-) b a
+
+  describe "keys" $ do
+    it "should return all the keys in a map" $
+      Map.keys a `shouldBe` [ "a", "b", "c" ]
+
+    it "is ordered" $
+      Map.keys (Map.union b a) `shouldBe` [ "b", "c", "d", "a" ]
+
+  where a = Map.fromList [ ("a", 1), ("b", 2), ("c", 3) ]
+        b = Map.fromList [ ("b", -2), ("c", -3), ("d", -4) ]

test/Spec.hs

@@ -1,5 +1,7 @@
 module Main where
 
+import qualified OrderedMapSpec
+
 import Categorizable
 import Diff
 import Interpreter
@@ -235,6 +237,8 @@ main = hspec $ do
     it "should produce ranges offset by its start index" $
       rangesAndWordsFrom 100 "a b" `shouldBe` [ (Range 100 101, "a"), (Range 102 103, "b") ]
 
+  describe "OrderedMap" OrderedMapSpec.spec
+
     where
       rightRowText text = rightRow [ Text text ]
       rightRow xs = Row EmptyLine (Line xs)