Small impr in diffBy

Author: phadej

src/Data/TreeDiff/List.hs

@@ -2,8 +2,7 @@
 -- | A list diff.
 module Data.TreeDiff.List (diffBy, Edit (..)) where
 
-import Control.DeepSeq  (NFData (..))
-import Data.List.Compat (sortOn)
+import Control.DeepSeq (NFData (..))
 
 import qualified Data.Vector as V
 
@@ -39,36 +38,35 @@ instance NFData a => NFData (Edit a) where
 -- of more obviously correct implementation.
 --
 diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
-diffBy eq xs' ys' = reverse (snd (lcs xn yn))
+diffBy eq xs' ys' = reverse (getCell (lcs xn yn))
   where
     xn = V.length xs
     yn = V.length ys
 
     xs = V.fromList xs'
     ys = V.fromList ys'
 
-    memo :: V.Vector (Int, [Edit a])
+    memo :: V.Vector (Cell [Edit a])
     memo = V.fromList
         [ impl xi yi
         | xi <- [0 .. xn]
         , yi <- [0 .. yn]
         ]
 
-    lcs :: Int -> Int -> (Int, [Edit a])
+    lcs :: Int -> Int -> Cell [Edit a]
     lcs xi yi = memo V.! (yi + xi * (yn + 1))
 
-    impl :: Int -> Int -> (Int, [Edit a])
-    impl 0 0 = (0, [])
+    impl :: Int -> Int -> Cell [Edit a]
+    impl 0 0 = Cell 0 []
     impl 0 m = case lcs 0 (m-1) of
-        (w, edit) -> (w + 1, Ins (ys V.! (m - 1)) : edit)
+        Cell w edit -> Cell (w + 1) (Ins (ys V.! (m - 1)) : edit)
     impl n 0 = case lcs (n -1) 0 of
-        (w, edit) -> (w + 1, Del (xs V.! (n - 1)) : edit)
+        Cell w edit -> Cell (w + 1) (Del (xs V.! (n - 1)) : edit)
 
-    impl n m = head $ sortOn fst
-        [ edit
-        , bimap (+1) (Ins y :) (lcs n (m - 1))
-        , bimap (+1) (Del x :) (lcs (n - 1) m)
-        ]
+    impl n m = bestOfThree
+        edit
+        (bimap (+1) (Ins y :) (lcs n (m - 1)))
+        (bimap (+1) (Del x :) (lcs (n - 1) m))
       where
         x = xs V.! (n - 1)
         y = ys V.! (m - 1)
@@ -77,5 +75,18 @@ diffBy eq xs' ys' = reverse (snd (lcs xn yn))
             | eq x y    = bimap id   (Cpy x :)   (lcs (n - 1) (m - 1))
             | otherwise = bimap (+1) (Swp x y :) (lcs (n -1 ) (m - 1))
 
-bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
-bimap f g (x, y) = (f x, g y)
+data Cell a = Cell !Int !a
+
+getCell :: Cell a -> a
+getCell (Cell _ x) = x
+
+bestOfThree :: Cell a -> Cell a -> Cell a -> Cell a
+bestOfThree a@(Cell i _x) b@(Cell j _y) c@(Cell k _z)
+    | i <= j
+    = if i <= k then a else c
+
+    | otherwise
+    = if j <= k then b else c
+
+bimap :: (Int -> Int) -> (a -> b) -> Cell a -> Cell b
+bimap f g (Cell i x) = Cell (f i) (g x)

tests/Tests.hs

@@ -1,10 +1,7 @@
-{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Main (main) where
 
 import Data.Proxy                 (Proxy (..))
-import Data.TreeDiff
-import Data.TreeDiff.Golden
-import Data.TreeDiff.QuickCheck
 import GHC.Generics               (Generic)
 import Prelude ()
 import Prelude.Compat
@@ -18,6 +15,10 @@ import qualified Text.PrettyPrint.ANSI.Leijen as WL
 import qualified Text.Trifecta                as T (eof, parseString)
 import qualified Text.Trifecta.Result         as T (ErrInfo (..), Result (..))
 
+import Data.TreeDiff
+import Data.TreeDiff.Golden
+import Data.TreeDiff.QuickCheck
+
 main :: IO ()
 main = defaultMain $ testGroup "tests"
     [ testProperty "trifecta-pretty roundtrip" roundtripTrifectaPretty
@@ -26,7 +27,7 @@ main = defaultMain $ testGroup "tests"
     ]
 
 -------------------------------------------------------------------------------
--- QuickCheck: ediffEq
+-- Roundtrip
 -------------------------------------------------------------------------------
 
 -- | This property tests that we can parse pretty printed 'Expr'.

tree-diff.cabal

@@ -180,4 +180,6 @@ benchmark tree-diff-bench
     , tree-diff
 
   -- extra dependencies
-  build-depends:    criterion ^>=1.5.9.0, Diff ^>=0.4.0
+  build-depends:
+    , criterion  ^>=1.5.9.0
+    , Diff       ^>=0.4.0