Merge pull request #248 from github/apply-review-feedback

Apply review feedback

src/Interpreter.hs

@@ -1,15 +1,16 @@
 module Interpreter (interpret, Comparable) where
 
 import Algorithm
-import Control.Monad.Free
-import Control.Comonad.Cofree
-import Operation
 import Diff
-import Syntax
-import Data.Map
+import Operation
 import Patch
 import SES
+import Syntax
 import Term
+import Control.Monad.Free
+import Control.Comonad.Cofree
+import Data.Map
+import Data.Maybe
 
 hylo :: Functor f => (t -> f b -> b) -> (a -> (t, f a)) -> a -> b
 hylo down up a = down annotation $ hylo down up <$> syntax where
@@ -33,17 +34,18 @@ run :: (Eq a, Eq annotation) => Comparable a annotation -> Algorithm a annotatio
 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' =
-    Free . Annotated (annotation1, annotation2) . Indexed $ zipWith (interpret comparable) a' b'
-  recur (Fixed a') (Fixed b') | length a' == length b' =
-    Free . Annotated (annotation1, annotation2) . Fixed $ zipWith (interpret comparable) a' b'
-  recur (Keyed a') (Keyed b') | keys a' == keys b' =
-    Free . Annotated (annotation1, annotation2) . Keyed . fromList . fmap repack $ keys 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'
+    where
       repack key = (key, interpretInBoth key a' b')
       interpretInBoth key a' b' = maybeInterpret (Data.Map.lookup key a') (Data.Map.lookup key b')
       maybeInterpret (Just a) (Just b) = interpret comparable a b
+      maybeInterpret _ _ = error "maybeInterpret assumes that its operands are `Just`s."
   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
@@ -55,6 +57,4 @@ run comparable (Free (ByIndex a b f)) = run comparable . f $ ses (constructAndRu
 type Comparable a annotation = Term a annotation -> Term a annotation -> Bool
 
 interpret :: (Eq a, Eq annotation) => Comparable a annotation -> Term a annotation -> Term a annotation -> Diff a annotation
-interpret comparable a b = maybeReplace $ constructAndRun comparable a b where
-  maybeReplace (Just a) = a
-  maybeReplace Nothing = Pure $ Replace a b
+interpret comparable a b = fromMaybe (Pure $ Replace a b) $ constructAndRun comparable a b

src/SES.hs

@@ -2,9 +2,11 @@ module SES where
 
 import Patch
 import Diff
+import Term
 import Control.Monad.Free
 import Control.Comonad.Cofree
-import Term
+import Data.Foldable (minimumBy)
+import Data.Ord (comparing)
 
 type Compare a annotation = Term a annotation -> Term a annotation -> Maybe (Diff a annotation)
 type Cost a annotation = Diff a annotation -> Integer
@@ -13,17 +15,10 @@ ses :: Compare a annotation -> Cost a annotation -> [Term a annotation] -> [Term
 ses _ _ [] b = (Pure . Insert) <$> b
 ses _ _ a [] = (Pure . Delete) <$> a
 ses diffTerms cost (a : as) (b : bs) = case diffTerms a b of
-  Just f | deleteCost < insertCost && deleteCost < copyCost -> delete
-         | insertCost < copyCost -> insert
-         | otherwise -> copy
-    where
-      copy = f : ses diffTerms cost as bs
-      copyCost = sumCost copy
-  Nothing | deleteCost < insertCost -> delete
-          | otherwise -> insert
+  Just f -> minimumBy (comparing sumCost) [ delete, insert, copy f ]
+  Nothing -> minimumBy (comparing sumCost) [ delete, insert ]
   where
     delete = (Pure . Delete $ a) : ses diffTerms cost as (b : bs)
     insert = (Pure . Insert $ b) : ses diffTerms cost (a : as) bs
-    deleteCost = sumCost delete
-    insertCost = sumCost insert
-    sumCost a = sum $ cost <$> a
+    sumCost script = sum $ cost <$> script
+    copy head = head : ses diffTerms cost as bs

src/Syntax.hs

@@ -2,9 +2,17 @@ module Syntax where
 
 import Data.Map
 
-data Syntax a f =
+-- | A node in an abstract syntax tree.
+data Syntax
+  a -- ^ The type of leaves in the syntax tree, typically String, but possibly some datatype representing different leaves more precisely.
+  f -- ^ The type representing another level of the tree, e.g. the children of branches. Often Cofree or Fix or similar.
+  =
+  -- | A terminal syntax node, e.g. an identifier, or atomic literal.
   Leaf a
+  -- | An ordered branch of child nodes, expected to be variadic in the grammar, e.g. a list of statements or uncurried function parameters.
   | Indexed [f]
+  -- | 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)
   deriving (Functor, Show, Eq, Foldable, Traversable)

src/Term.hs

@@ -11,7 +11,7 @@ type Term a annotation = Cofree (Syntax a) annotation
 instance Categorizable annotation => Categorizable (Term a annotation) where
   categories (annotation :< _) = categories annotation
 
-zipTerms :: Term a annotation -> Term a annotation -> Maybe (Cofree (Syntax a) (annotation, annotation))
+zipTerms :: Term a annotation -> Term a annotation -> Maybe (Term a (annotation, annotation))
 zipTerms (annotation1 :< a) (annotation2 :< b) = annotate $ zipUnwrap a b
   where
     annotate = fmap ((annotation1, annotation2) :<)