Merge branch 'ordered-map' into split-rendering-of-keyed-nodes

app/TreeSitter.hs

@@ -6,7 +6,7 @@ import Range
 import Syntax
 import Term
 import Control.Comonad.Cofree
-import qualified Data.Map as Map
+import qualified OrderedMap as Map
 import Data.Set
 import Foreign
 import Foreign.C

semantic-diff.cabal

@@ -18,6 +18,7 @@ library
                      , Operation
                      , Algorithm
                      , Interpreter
+                     , OrderedMap
                      , Parser
                      , Patch
                      , SES

src/Interpreter.hs

@@ -1,5 +1,6 @@
 module Interpreter (interpret, Comparable) where
 
+import Prelude hiding (lookup)
 import Algorithm
 import Diff
 import Operation
@@ -9,7 +10,7 @@ import Syntax
 import Term
 import Control.Monad.Free
 import Control.Comonad.Cofree hiding (unwrap)
-import Data.Map
+import OrderedMap
 import Data.Maybe
 
 hylo :: Functor f => (t -> f b -> b) -> (a -> (t, f a)) -> a -> b
@@ -42,7 +43,7 @@ run comparable (Free (Recursive (annotation1 :< a) (annotation2 :< b) f)) = run
   recur (Keyed a') (Keyed b') | keys a' == keys b' = annotate . Keyed . fromList . fmap repack $ keys b'
     where
       repack key = (key, interpretInBoth key a' b')
-      interpretInBoth key x y = maybeInterpret (Data.Map.lookup key x) (Data.Map.lookup key y)
+      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."
   recur _ _ = Pure $ Replace (annotation1 :< a) (annotation2 :< b)

src/Operation.hs

@@ -1,11 +1,11 @@
 module Operation where
 
 import Diff
-import Data.Map
+import OrderedMap
 import Term
 
 data Operation a annotation f
   = Recursive (Term a annotation) (Term a annotation) (Diff a annotation -> f)
-  | ByKey (Map String (Term a annotation)) (Map String (Term a annotation)) (Map String (Diff a annotation) -> f)
+  | ByKey (OrderedMap String (Term a annotation)) (OrderedMap String (Term a annotation)) (OrderedMap String (Diff a annotation) -> f)
   | ByIndex [Term a annotation] [Term a annotation] ([Diff a annotation] -> f)
   deriving Functor

src/OrderedMap.hs

@@ -0,0 +1,53 @@
+module OrderedMap (
+    OrderedMap
+  , fromList
+  , toList
+  , keys
+  , (!)
+  , OrderedMap.lookup
+  , size
+  , empty
+  , union
+  , unions
+  , intersectionWith
+  , difference
+  ) where
+
+data OrderedMap key value = OrderedMap { toList :: [(key, value)] }
+  deriving (Show, Eq, Functor, Foldable, Traversable)
+
+fromList :: [(key, value)] -> OrderedMap key value
+fromList list = OrderedMap list
+
+keys :: OrderedMap key value -> [key]
+keys (OrderedMap pairs) = fst <$> pairs
+
+infixl 9 !
+
+(!) :: Eq key => OrderedMap key value -> key -> value
+map ! key = case OrderedMap.lookup key map of
+  Just value -> value
+  Nothing -> error "no value found for key"
+
+lookup :: Eq key => key -> OrderedMap key value -> Maybe value
+lookup key = Prelude.lookup key . toList
+
+size :: OrderedMap key value -> Int
+size = length . toList
+
+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
+  where extant = fst <$> a
+
+unions :: Eq key => [OrderedMap key value] -> OrderedMap key value
+unions = foldl union empty
+
+intersectionWith :: Eq key => (a -> b -> c) -> OrderedMap key a -> OrderedMap key b -> OrderedMap key c
+intersectionWith combine (OrderedMap a) (OrderedMap b) = OrderedMap $ a >>= (\ (key, value) -> maybe [] (pure . ((,) key) . combine value) $ Prelude.lookup key b)
+
+difference :: Eq key => OrderedMap key a -> OrderedMap key b -> OrderedMap key a
+difference (OrderedMap a) (OrderedMap b) = OrderedMap $ filter (not . (`elem` extant) . fst) a
+  where extant = fst <$> b

src/Syntax.hs

@@ -1,6 +1,6 @@
 module Syntax where
 
-import Data.Map
+import OrderedMap
 
 -- | A node in an abstract syntax tree.
 data Syntax
@@ -14,5 +14,5 @@ data Syntax
   -- | An ordered branch of child nodes, expected to be of fixed length in the grammar, e.g. a binary operator & its operands.
   | Fixed [f]
   -- | A branch of child nodes indexed by some String identity. This is useful for identifying e.g. methods & properties in a class scope by their names. Note that comments can generally occur in these scopes as well; one strategy for dealing with this is to identify comments by their text in the source.
-  | Keyed (Map String f)
+  | Keyed (OrderedMap String f)
   deriving (Functor, Show, Eq, Foldable, Traversable)

src/Term.hs

@@ -1,6 +1,6 @@
 module Term where
 
-import Data.Map hiding (size)
+import OrderedMap hiding (size)
 import Data.Maybe
 import Control.Comonad.Cofree
 import Syntax

src/Unified.hs

@@ -9,7 +9,7 @@ import Control.Arrow
 import Control.Monad.Free
 import Control.Comonad.Cofree
 import Data.List hiding (foldl)
-import qualified Data.Map as Map
+import qualified OrderedMap as Map
 import Rainbow
 
 unified :: Diff a Info -> String -> String -> IO ByteString
@@ -44,4 +44,3 @@ range patch = range . extract <$> after patch where
 
 change :: String -> [Chunk String] -> [Chunk String]
 change bound content = [ chunk "{", chunk bound ] ++ content ++ [ chunk bound, chunk "}" ]
-

test/Spec.hs

@@ -12,7 +12,7 @@ import Control.Comonad.Cofree
 import Control.Monad
 import Control.Monad.Free hiding (unfold)
 import qualified Data.List as List
-import qualified Data.Map as Map
+import qualified OrderedMap as Map
 import qualified Data.Set as Set
 import GHC.Generics
 import Test.Hspec