diff --git a/app/TreeSitter.hs b/app/TreeSitter.hs index 1d0604ca6..f022d88a2 100644 --- a/app/TreeSitter.hs +++ b/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 diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 2176e3b23..05c386d28 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -18,6 +18,7 @@ library , Operation , Algorithm , Interpreter + , OrderedMap , Parser , Patch , SES diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 60d6377e5..7b902c71e 100644 --- a/src/Interpreter.hs +++ b/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) diff --git a/src/Operation.hs b/src/Operation.hs index 732476971..34565daf9 100644 --- a/src/Operation.hs +++ 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 diff --git a/src/OrderedMap.hs b/src/OrderedMap.hs new file mode 100644 index 000000000..b3f31c68a --- /dev/null +++ b/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 diff --git a/src/Syntax.hs b/src/Syntax.hs index d0b6b83c5..9e8536c1f 100644 --- a/src/Syntax.hs +++ 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) diff --git a/src/Term.hs b/src/Term.hs index 3f053cc94..e83560140 100644 --- a/src/Term.hs +++ b/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 diff --git a/src/Unified.hs b/src/Unified.hs index dcc352886..b3ecce57d 100644 --- a/src/Unified.hs +++ b/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 "}" ] - diff --git a/test/Spec.hs b/test/Spec.hs index 63ab705bd..8a119aa99 100644 --- a/test/Spec.hs +++ b/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