Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-tree-diff for openSUSE:Factory checked in at 2021-03-24 16:16:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tree-diff (Old) and /work/SRC/openSUSE:Factory/.ghc-tree-diff.new.2401 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-tree-diff" Wed Mar 24 16:16:38 2021 rev:4 rq:880899 version:0.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tree-diff/ghc-tree-diff.changes 2021-03-10 08:57:47.142921832 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-tree-diff.new.2401/ghc-tree-diff.changes 2021-03-24 16:17:51.192247568 +0100 @@ -1,0 +2,13 @@ +Wed Mar 17 09:45:13 UTC 2021 - [email protected] + +- Update tree-diff to version 0.2. + ## 0.2 + + - Change the pretty printing to use less horizontal space. + `Pretty` datastructure is changed. + - Change `Expr` to use `OMap`; pretty-printing preserves field order. + - Add `strict` and `these` instances + - Add `Eq` and `NFData (Edit a)` instances. + - Bump lower bounds + +------------------------------------------------------------------- Old: ---- tree-diff-0.1.tar.gz tree-diff.cabal New: ---- tree-diff-0.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tree-diff.spec ++++++ --- /var/tmp/diff_new_pack.p9Fu62/_old 2021-03-24 16:17:51.680248079 +0100 +++ /var/tmp/diff_new_pack.p9Fu62/_new 2021-03-24 16:17:51.680248079 +0100 @@ -19,13 +19,12 @@ %global pkg_name tree-diff %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1 +Version: 0.2 Release: 0 Summary: Diffing of (expression) trees License: GPL-2.0-or-later URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/6.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-aeson-devel @@ -35,14 +34,19 @@ BuildRequires: ghc-bytestring-builder-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-containers-devel +BuildRequires: ghc-deepseq-devel BuildRequires: ghc-hashable-devel BuildRequires: ghc-parsec-devel BuildRequires: ghc-parsers-devel BuildRequires: ghc-pretty-devel +BuildRequires: ghc-primitive-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-scientific-devel +BuildRequires: ghc-semialign-devel +BuildRequires: ghc-strict-devel BuildRequires: ghc-tagged-devel BuildRequires: ghc-text-devel +BuildRequires: ghc-these-devel BuildRequires: ghc-time-devel BuildRequires: ghc-unordered-containers-devel BuildRequires: ghc-uuid-types-devel @@ -87,7 +91,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ tree-diff-0.1.tar.gz -> tree-diff-0.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/ChangeLog.md new/tree-diff-0.2/ChangeLog.md --- old/tree-diff-0.1/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,12 @@ +## 0.2 + +- Change the pretty printing to use less horizontal space. + `Pretty` datastructure is changed. +- Change `Expr` to use `OMap`; pretty-printing preserves field order. +- Add `strict` and `these` instances +- Add `Eq` and `NFData (Edit a)` instances. +- Bump lower bounds + ## 0.1 - Support GHC-7.4 ... 8.8 (use allow-newer for GHC-8.8-alpha). diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/bench/tree-diff-bench.hs new/tree-diff-0.2/bench/tree-diff-bench.hs --- old/tree-diff-0.1/bench/tree-diff-bench.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tree-diff-0.2/bench/tree-diff-bench.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,62 @@ +{-# OPTIONS -fno-warn-orphans #-} +module Main (main) where + +import Control.DeepSeq (NFData (..)) +import Control.Exception (evaluate) +import Criterion.Main (bench, bgroup, defaultMain, nf) + +import qualified Data.Algorithm.Diff as Diff + +import Data.TreeDiff.List (diffBy) + +smallA :: [Int] +smallB :: [Int] + +smallA = [0, 5 .. 100] +smallB = [0, 3 .. 72] + +bigA :: [Int] +bigA = [0, 5 .. 10000] + +bigB :: [Int] +bigB = [0, 3 .. 7200] + +main :: IO () +main = do + evaluate (rnf smallA) + evaluate (rnf smallB) + + evaluate (rnf bigA) + evaluate (rnf bigB) + + defaultMain + [ bgroup "same" + [ bgroup "small" + [ bench "lib" $ nf (uncurry (diffBy (==))) (smallA, smallA) + , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (smallA, smallA) + ] + , bgroup "big" + [ bench "lib" $ nf (uncurry (diffBy (==))) (bigA, bigA) + , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (bigA, bigA) + ] + ] + , bgroup "different" + [ bgroup "small" + [ bench "lib" $ nf (uncurry (diffBy (==))) (smallA, smallB) + , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (smallA, smallB) + ] + , bgroup "big" + [ bench "lib" $ nf (uncurry (diffBy (==))) (bigA, bigB) + , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (bigA, bigB) + ] + ] + ] + +------------------------------------------------------------------------------- +-- Orphans +------------------------------------------------------------------------------- + +instance (NFData a, NFData b) => NFData (Diff.PolyDiff a b) where + rnf (Diff.First x) = rnf x + rnf (Diff.Second y) = rnf y + rnf (Diff.Both x y) = rnf x `seq` rnf y diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/fixtures/exfoo.expr new/tree-diff-0.2/fixtures/exfoo.expr --- old/tree-diff-0.1/fixtures/exfoo.expr 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/fixtures/exfoo.expr 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ -Foo - {fooBar = [Just "pub", Just (concat ["night\n", "club"])], - fooInt = 42, - fooNew = True, - fooQuu = _??_ 125.375 Proxy, - fooStr = "Some Name"} +Foo { + fooBar = [Just "pub", Just (concat ["night\n", "club"])], + fooInt = 42, + fooNew = True, + fooQuu = _??_ 125.375 Proxy, + fooStr = "Some Name"} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Class.hs new/tree-diff-0.2/src/Data/TreeDiff/Class.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Class.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Class.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,10 +24,11 @@ import Data.List.Compat (uncons) import Data.Proxy (Proxy (..)) import GHC.Generics - ((:*:) (..), (:+:) (..), Constructor (..), Generic (..), K1 (..), M1 (..), - Selector (..), U1 (..), V1) + ((:*:) (..), (:+:) (..), Constructor (..), Generic (..), K1 (..), + M1 (..), Selector (..), U1 (..), V1) import qualified Data.Map as Map +import qualified Data.TreeDiff.OMap as OMap import Data.TreeDiff.Expr @@ -64,8 +65,8 @@ import qualified Data.Time as Time -- bytestring -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS @@ -94,6 +95,30 @@ -- aeson import qualified Data.Aeson as Aeson +-- strict +import qualified Data.Strict as Strict + +-- these +import Data.These (These (..)) + +-- primitive +-- import qualified Data.Primitive as Prim + +-- $setup +-- >>> :set -XDeriveGeneric +-- >>> import Data.Foldable (traverse_) +-- >>> import Data.Ratio ((%)) +-- >>> import Data.Time (Day (..)) +-- >>> import Data.Scientific (Scientific) +-- >>> import GHC.Generics (Generic) +-- >>> import qualified Data.ByteString.Char8 as BS8 +-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8 +-- >>> import Data.TreeDiff.Pretty + +------------------------------------------------------------------------------- +-- Code +------------------------------------------------------------------------------- + -- | Difference between two 'ToExpr' values. -- -- >>> let x = (1, Just 2) :: (Int, Maybe Int) @@ -105,13 +130,13 @@ -- >>> instance ToExpr Foo -- -- >>> prettyEditExpr $ ediff (Foo (Right 2) [Just True] "fo") (Foo (Right 3) [Just True] "fo") --- Foo {fooBool = [Just True], fooInt = Right -2 +3, fooString = "fo"} +-- Foo {fooInt = Right -2 +3, fooBool = [Just True], fooString = "fo"} -- -- >>> prettyEditExpr $ ediff (Foo (Right 42) [Just True, Just False] "old") (Foo (Right 42) [Nothing, Just False, Just True] "new") --- Foo --- {fooBool = [-Just True, +Nothing, Just False, +Just True], --- fooInt = Right 42, --- fooString = -"old" +"new"} +-- Foo { +-- fooInt = Right 42, +-- fooBool = [-Just True, +Nothing, Just False, +Just True], +-- fooString = -"old" +"new"} -- ediff :: ToExpr a => a -> a -> Edit EditExpr ediff x y = exprDiff (toExpr x) (toExpr y) @@ -179,7 +204,7 @@ App' exprs -> App cn exprs Rec' [] -> App cn [] Rec' [(_,e)] -> App cn [e] - Rec' pairs -> Rec cn (Map.fromList pairs) + Rec' pairs -> Rec cn (OMap.fromList pairs) where cn = conName z @@ -526,15 +551,32 @@ instance ToExpr Aeson.Value ------------------------------------------------------------------------------- --- Doctest +-- strict ------------------------------------------------------------------------------- --- $setup --- >>> :set -XDeriveGeneric --- >>> import Data.Foldable (traverse_) --- >>> import Data.Ratio ((%)) --- >>> import Data.Time (Day (..)) --- >>> import Data.Scientific (Scientific) --- >>> import Data.TreeDiff.Pretty --- >>> import qualified Data.ByteString.Char8 as BS8 --- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8 +instance ToExpr a => ToExpr (Strict.Maybe a) where + toExpr = toExpr . Strict.toLazy + +instance (ToExpr a, ToExpr b) => ToExpr (Strict.Either a b) where + toExpr = toExpr . Strict.toLazy + +instance (ToExpr a, ToExpr b) => ToExpr (Strict.These a b) where + toExpr = toExpr . Strict.toLazy + +instance (ToExpr a, ToExpr b) => ToExpr (Strict.Pair a b) where + toExpr = toExpr . Strict.toLazy + +------------------------------------------------------------------------------- +-- these +------------------------------------------------------------------------------- + +instance (ToExpr a, ToExpr b) => ToExpr (These a b) where + toExpr (This x) = App "This" [toExpr x] + toExpr (That y) = App "That" [toExpr y] + toExpr (These x y) = App "These " [toExpr x, toExpr y] + +------------------------------------------------------------------------------- +-- primitive +------------------------------------------------------------------------------- + +-- TODO: add instances diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Expr.hs new/tree-diff-0.2/src/Data/TreeDiff/Expr.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Expr.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Expr.hs 2001-09-09 03:46:40.000000000 +0200 @@ -12,11 +12,15 @@ import Prelude () import Prelude.Compat -import Data.Map (Map) +import Control.DeepSeq (NFData (..)) +import Data.Semialign (alignWith) +import Data.These (These (..)) + import Data.TreeDiff.List +import Data.TreeDiff.OMap (OMap) -import qualified Data.Map as Map -import qualified Test.QuickCheck as QC +import qualified Data.TreeDiff.OMap as OMap +import qualified Test.QuickCheck as QC -- | Constructor name is a string type ConstructorName = String @@ -29,17 +33,22 @@ -- Having richer structure than just 'Tree' allows to have richer diffs. data Expr = App ConstructorName [Expr] -- ^ application - | Rec ConstructorName (Map FieldName Expr) -- ^ record constructor + | Rec ConstructorName (OMap FieldName Expr) -- ^ record constructor | Lst [Expr] -- ^ list constructor deriving (Eq, Show) +instance NFData Expr where + rnf (App n es) = rnf n `seq` rnf es + rnf (Rec n fs) = rnf n `seq` rnf fs + rnf (Lst es) = rnf es + instance QC.Arbitrary Expr where arbitrary = QC.scale (min 25) $ QC.sized arb where arb n | n <= 0 = QC.oneof [ (`App` []) <$> arbName - , (`Rec` mempty) <$> arbName + , (`Rec` OMap.empty) <$> arbName ] - arb n | otherwise = do + | otherwise = do n' <- QC.choose (0, n `div` 3) QC.oneof [ App <$> arbName <*> QC.liftArbitrary (arb n') @@ -49,8 +58,8 @@ shrink (Lst es) = es ++ [ Lst es' | es' <- QC.shrink es ] - shrink (Rec n fs) = Map.elems fs - ++ [ Rec n' fs | n' <- QC.shrink n ] + shrink (Rec n fs) = OMap.elems fs + ++ [ Rec n' fs | n' <- QC.shrink n ] ++ [ Rec n fs' | fs' <- QC.shrink fs ] shrink (App n es) = es ++ [ App n' es | n' <- QC.shrink n ] @@ -72,16 +81,22 @@ where impl ea eb | ea == eb = Cpy (EditExp ea) + -- application impl ea@(App a as) eb@(App b bs) - | a == b = Cpy $ EditApp a (map recurse (diffBy (==) as bs)) + | a == b = Cpy $ EditApp a (map recurse (diffBy (==) as bs)) | otherwise = Swp (EditExp ea) (EditExp eb) + + -- records impl ea@(Rec a as) eb@(Rec b bs) - | a == b = Cpy $ EditRec a $ Map.unions [inter, onlyA, onlyB] + | a == b = Cpy $ EditRec a $ alignWith cls as bs | otherwise = Swp (EditExp ea) (EditExp eb) where - inter = Map.intersectionWith exprDiff as bs - onlyA = fmap (Del . EditExp) (Map.difference as inter) - onlyB = fmap (Ins . EditExp) (Map.difference bs inter) + cls :: These Expr Expr -> Edit EditExpr + cls (This x) = Del (EditExp x) + cls (That y) = Ins (EditExp y) + cls (These x y) = exprDiff x y + + -- lists impl (Lst as) (Lst bs) = Cpy $ EditLst (map recurse (diffBy (==) as bs)) @@ -96,7 +111,13 @@ -- | Type used in the result of 'ediff'. data EditExpr = EditApp ConstructorName [Edit EditExpr] - | EditRec ConstructorName (Map FieldName (Edit EditExpr)) + | EditRec ConstructorName (OMap FieldName (Edit EditExpr)) | EditLst [Edit EditExpr] | EditExp Expr -- ^ unchanged tree deriving Show + +instance NFData EditExpr where + rnf (EditApp n es) = rnf n `seq` rnf es + rnf (EditRec n fs) = rnf n `seq` rnf fs + rnf (EditLst es) = rnf es + rnf (EditExp e) = rnf e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Golden.hs new/tree-diff-0.2/src/Data/TreeDiff/Golden.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Golden.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Golden.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,7 @@ -- | "Golden tests" using 'ediff' comparison. module Data.TreeDiff.Golden ( ediffGolden, - ) where +) where import Data.TreeDiff import Prelude () @@ -10,9 +10,10 @@ import Text.Parsec (eof, parse) import Text.Parsec.Text () -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Text.PrettyPrint.ANSI.Leijen as WL -- | Make a golden tests. -- @@ -47,11 +48,14 @@ actual = fmap toExpr x expect = do contents <- BS.readFile fp - case parse (exprParser <* eof) fp $ T.decodeUtf8 contents of + case parse (exprParser <* eof) fp $ TE.decodeUtf8 contents of Left err -> print err >> fail "parse error" Right r -> return r cmp a b | a == b = return Nothing | otherwise = return $ Just $ - setSGRCode [Reset] ++ show (ansiWlEditExprCompact $ ediff a b) - wrt expr = BS.writeFile fp $ T.encodeUtf8 $ T.pack $ show (prettyExpr expr) ++ "\n" + setSGRCode [Reset] ++ showWL (ansiWlEditExprCompact $ ediff a b) + wrt expr = BS.writeFile fp $ TE.encodeUtf8 $ T.pack $ showWL (WL.plain (ansiWlExpr expr)) ++ "\n" + +showWL :: WL.Doc -> String +showWL doc = WL.displayS (WL.renderSmart 0.4 80 doc) "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/List.hs new/tree-diff-0.2/src/Data/TreeDiff/List.hs --- old/tree-diff-0.1/src/Data/TreeDiff/List.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/List.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,9 +1,17 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -- | A list diff. -module Data.TreeDiff.List (diffBy, Edit (..)) where +module Data.TreeDiff.List ( + diffBy, + Edit (..), +) where -import Data.List.Compat (sortOn) -import qualified Data.Vector as V +import Control.DeepSeq (NFData (..)) +import Control.Monad.ST (ST, runST) + +import qualified Data.Primitive as P + +-- import Debug.Trace -- | List edit operations -- @@ -14,7 +22,13 @@ | Del a -- ^ delete | Cpy a -- ^ copy unchanged | Swp a a -- ^ swap, i.e. delete + insert - deriving Show + deriving (Eq, Show) + +instance NFData a => NFData (Edit a) where + rnf (Ins x) = rnf x + rnf (Del x) = rnf x + rnf (Cpy x) = rnf x + rnf (Swp x y) = rnf x `seq` rnf y -- | List difference. -- @@ -27,47 +41,116 @@ -- prop> \xs ys -> length (diffBy (==) xs ys) >= max (length xs) (length (ys :: String)) -- prop> \xs ys -> length (diffBy (==) xs ys) <= length xs + length (ys :: String) -- --- /Note:/ currently this has O(n*m) memory requirements, for the sake --- 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 :: forall a. Show a => (a -> a -> Bool) -> [a] -> [a] -> [Edit a] +diffBy _ [] [] = [] +diffBy _ [] ys' = map Ins ys' +diffBy _ xs' [] = map Del xs' +diffBy eq xs' ys' + | otherwise = reverse (getCell lcs) where - xn = V.length xs - yn = V.length ys + xn = length xs' + yn = length ys' + + xs = P.arrayFromListN xn xs' + ys = P.arrayFromListN yn ys' - xs = V.fromList xs' - ys = V.fromList ys' + lcs :: Cell [Edit a] + lcs = runST $ do + -- traceShowM ("sizes", xn, yn) + + -- create two buffers. + buf1 <- P.newArray yn (Cell 0 []) + buf2 <- P.newArray yn (Cell 0 []) + + -- fill the first row + -- 0,0 case is filled already + yLoop (Cell 0 []) $ \m (Cell w edit) -> do + let cell = Cell (w + 1) (Ins (P.indexArray ys m) : edit) + P.writeArray buf1 m cell + P.writeArray buf2 m cell + -- traceShowM ("init", m, cell) + return cell + + -- following rows + -- + -- cellC cellT + -- cellL cellX + (buf1final, _, _) <- xLoop (buf1, buf2, Cell 0 []) $ \n (prev, curr, cellC) -> do + -- prevZ <- P.unsafeFreezeArray prev + -- currZ <- P.unsafeFreezeArray prev + -- traceShowM ("prev", n, prevZ) + -- traceShowM ("curr", n, currZ) + + let cellL :: Cell [Edit a] + cellL = case cellC of (Cell w edit) -> Cell (w + 1) (Del (P.indexArray xs n) : edit) + + -- traceShowM ("cellC, cellL", n, cellC, cellL) + + yLoop (cellC, cellL) $ \m (cellC', cellL') -> do + -- traceShowM ("inner loop", n, m) + cellT <- P.readArray prev m + + -- traceShowM ("cellT", n, m, cellT) + + let x, y :: a + x = P.indexArray xs n + y = P.indexArray ys m + + -- from diagonal + let cellX1 :: Cell [Edit a] + cellX1 + | eq x y = bimap id (Cpy x :) cellC' + | otherwise = bimap (+1) (Swp x y :) cellC' + + -- from left + let cellX2 :: Cell [Edit a] + cellX2 = bimap (+1) (Ins y :) cellL' + + -- from top + let cellX3 :: Cell [Edit a] + cellX3 = bimap (+1) (Del x :) cellT + + -- the actual cell is best of three + let cellX :: Cell [Edit a] + cellX = bestOfThree cellX1 cellX2 cellX3 + + -- traceShowM ("cellX", n, m, cellX) + + -- memoize + P.writeArray curr m cellX + + return (cellT, cellX) + + return (curr, prev, cellL) + + P.readArray buf1final (yn - 1) + + xLoop :: acc -> (Int -> acc -> ST s acc) -> ST s acc + xLoop !acc0 f = go acc0 0 where + go !acc !n | n < xn = do + acc' <- f n acc + go acc' (n + 1) + go !acc _ = return acc + + yLoop :: acc -> (Int -> acc -> ST s acc) -> ST s () + yLoop !acc0 f = go acc0 0 where + go !acc !m | m < yn = do + acc' <- f m acc + go acc' (m + 1) + go _ _ = return () + +data Cell a = Cell !Int !a deriving Show + +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 - memo :: V.Vector (Int, [Edit a]) - memo = V.fromList - [ impl xi yi - | xi <- [0 .. xn] - , yi <- [0 .. yn] - ] - - lcs :: Int -> Int -> (Int, [Edit a]) - lcs xi yi = memo V.! (yi + xi * (yn + 1)) - - impl :: Int -> Int -> (Int, [Edit a]) - impl 0 0 = (0, []) - impl 0 m = case lcs 0 (m-1) of - (w, edit) -> (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) - - impl n m = head $ sortOn fst - [ 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) - - edit - | eq x y = bimap id (Cpy x :) (lcs (n - 1) (m - 1)) - | otherwise = bimap (+1) (Swp x y :) (lcs (n -1 ) (m - 1)) + | otherwise + = if j <= k then b else c -bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d) -bimap f g (x, y) = (f x, g y) +bimap :: (Int -> Int) -> (a -> b) -> Cell a -> Cell b +bimap f g (Cell i x) = Cell (f i) (g x) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/OMap.hs new/tree-diff-0.2/src/Data/TreeDiff/OMap.hs --- old/tree-diff-0.1/src/Data/TreeDiff/OMap.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tree-diff-0.2/src/Data/TreeDiff/OMap.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,158 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} +-- | Map which remembers the 'fromList' order. +-- This module is minimal on purpose. +module Data.TreeDiff.OMap ( + -- * Ordered map + OMap, + -- * Conversions + toAscList, + toList, + fromList, + -- * Construction + empty, + -- * Query + elems, +) where + +import Data.List (sortBy) +import Data.Ord (comparing) +import Data.Semialign (Semialign (..)) +import Data.These (These (..)) +import Control.DeepSeq (NFData (..)) + +#if MIN_VERSION_containers(0,5,0) +import qualified Data.Map.Strict as Map +#else +import qualified Data.Map as Map +#endif + +import qualified Test.QuickCheck as QC + +-- $setup +-- >>> import Data.Semialign (alignWith) + +------------------------------------------------------------------------------- +-- Types +------------------------------------------------------------------------------- + +newtype OMap k v = OMap (Map.Map k (Val v)) + deriving (Functor) + +-- Value with its index +data Val v = Val !Int v + deriving (Functor) + +-- | Note: The instance uses 'toList', so 'Eq'ual 'OMap's can be shown differently. +instance (Show k, Show v) => Show (OMap k v) where + showsPrec d m = showParen (d > 10) + $ showString "fromList " + . showsPrec d (toList m) + +-- | +-- +-- >>> xs = toAscList $ fromList [('a', "alpha"), ('b', "beta"), ('g', "gamma")] +-- >>> ys = toAscList $ fromList [('g', "gamma"), ('b', "beta"), ('a', "alpha")] +-- >>> xs == ys +-- True +-- +-- >>> zs = toAscList $ fromList [('d', "delta"), ('b', "beta"), ('a', "alpha")] +-- >>> xs == zs +-- False +-- +instance (Eq k, Eq v) => Eq (OMap k v) where + xs == ys = go (toAscList xs) (toAscList ys) where + go [] [] = True + go _ [] = False + go [] _ = False + go ((k1, v1) : kvs1) ((k2, v2) : kvs2) = + k1 == k2 && v1 == v2 && go kvs1 kvs2 + +------------------------------------------------------------------------------- +-- deepseq +------------------------------------------------------------------------------- + +instance NFData v => NFData (Val v) where + rnf (Val _ v) = rnf v + +instance (NFData k, NFData v) => NFData (OMap k v) where + rnf (OMap m) = rnf m + +------------------------------------------------------------------------------- +-- QuickCheck +------------------------------------------------------------------------------- + +instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (OMap k v) where + arbitrary = QC.arbitrary1 + shrink = QC.shrink1 + +instance (Ord k, QC.Arbitrary k) => QC.Arbitrary1 (OMap k) where + liftArbitrary arb = fmap fromList $ QC.liftArbitrary (QC.liftArbitrary arb) + liftShrink shr m = fmap fromList $ QC.liftShrink (QC.liftShrink shr) $ toList m + +------------------------------------------------------------------------------- +-- Combinators +------------------------------------------------------------------------------- + +-- | +-- +-- >>> empty :: OMap String Integer +-- fromList [] +-- +empty :: OMap k v +empty = OMap Map.empty + +-- | Elements in key ascending order. +elems :: OMap k v -> [v] +elems (OMap m) = map (snd . getVal) $ Map.toAscList m + +-- | +-- +-- >>> toAscList $ fromList [('a', "alpha"), ('b', "beta"), ('g', "gamma")] +-- [('a',"alpha"),('b',"beta"),('g',"gamma")] +-- +-- >>> toAscList $ fromList [('g', "gamma"), ('b', "beta"), ('a', "alpha")] +-- [('a',"alpha"),('b',"beta"),('g',"gamma")] +-- +toAscList :: OMap k v -> [(k, v)] +toAscList (OMap m) = map getVal $ Map.toAscList m + +-- | /O(n log n)/. List in creation order. +-- Doesn't respect 'Eq' instance. +-- +-- >>> toList $ fromList [('a', "alpha"), ('b', "beta"), ('g', "gamma")] +-- [('a',"alpha"),('b',"beta"),('g',"gamma")] +-- +-- >>> toList $ fromList [('g', "gamma"), ('b', "beta"), ('a', "alpha")] +-- [('g',"gamma"),('b',"beta"),('a',"alpha")] +-- +toList :: OMap k v -> [(k, v)] +toList (OMap m) = map getVal $ sortBy (comparing getIdx) $ Map.toList m + +getIdx :: (k, Val v) -> Int +getIdx (_, Val i _) = i + +getVal :: (k, Val v) -> (k, v) +getVal (k, Val _ v) = (k, v) + +-- | +-- +-- >>> fromList [('g', "gamma"), ('b', "beta"), ('a', "alpha")] +-- fromList [('g',"gamma"),('b',"beta"),('a',"alpha")] +-- +fromList :: Ord k => [(k, v)] -> OMap k v +fromList kvs = OMap (Map.fromList (zipWith p [0..] kvs)) where + p i (k, v) = (k, Val i v) + +-- | +-- +-- >>> let xs = fromList [('a', "alpha"), ('b', "beta")] +-- >>> let ys = fromList [('c', 3 :: Int), ('b', 2)] +-- >>> alignWith id xs ys +-- fromList [('a',This "alpha"),('c',That 3),('b',These "beta" 2)] +-- +instance Ord k => Semialign (OMap k) where + alignWith f (OMap xs) (OMap ys) = OMap (alignWith g xs ys) where + g (This (Val i x)) = Val i (f (This x)) + g (That (Val j y)) = Val j (f (That y)) + g (These (Val i x) (Val j y)) = Val (min i j) (f (These x y)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Parser.hs new/tree-diff-0.2/src/Data/TreeDiff/Parser.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Parser.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Parser.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,7 +18,7 @@ import Data.TreeDiff.Expr -import qualified Data.Map as Map +import qualified Data.TreeDiff.OMap as OMap -- | Parsers for 'Expr' using @parsers@ type-classes. -- @@ -47,7 +47,7 @@ recP :: forall m. (Monad m, TokenParsing m) => m (Either String Expr) recP = mk <$> litP <*> optional (braces (commaSep fieldP)) where mk n Nothing = Left n - mk n (Just fs) = Right (Rec n (Map.fromList fs)) + mk n (Just fs) = Right (Rec n (OMap.fromList fs)) litP' :: forall m. (Monad m, TokenParsing m) => m Expr litP' = mk <$> recP <|> parens exprParser <|> lstP diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Pretty.hs new/tree-diff-0.2/src/Data/TreeDiff/Pretty.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 @@ -22,7 +22,7 @@ ansiWlBgEditExprCompact, -- * Utilities escapeName, - ) where +) where import Data.Char (isAlphaNum, isPunctuation, isSymbol, ord) import Data.Either (partitionEithers) @@ -30,23 +30,27 @@ import Numeric (showHex) import Text.Read.Compat (readMaybe) - -import qualified Data.Map as Map +import qualified Data.TreeDiff.OMap as OMap import qualified Text.PrettyPrint as HJ import qualified Text.PrettyPrint.ANSI.Leijen as WL +-- $setup +-- >>> import qualified Data.TreeDiff.OMap as OMap +-- >>> import Data.TreeDiff.Expr + -- | Because we don't want to commit to single pretty printing library, -- we use explicit dictionary. data Pretty doc = Pretty - { ppCon :: ConstructorName -> doc - , ppRec :: [(FieldName, doc)] -> doc - , ppLst :: [doc] -> doc - , ppCpy :: doc -> doc - , ppIns :: doc -> doc - , ppDel :: doc -> doc - , ppSep :: [doc] -> doc - , ppParens :: doc -> doc - , ppHang :: doc -> doc -> doc + { ppCon :: ConstructorName -> doc -- ^ Display 'ConstructorName' + , ppApp :: doc -> [doc] -> doc -- ^ Display 'App' + , ppRec :: doc -> [(FieldName, doc)] -> doc -- ^ Display 'Rec' + , ppLst :: [doc] -> doc -- ^ Display 'Lst' + , ppCpy :: doc -> doc -- ^ Display unchanged parts + , ppIns :: doc -> doc -- ^ Display added parts + , ppDel :: doc -> doc -- ^ Display removed parts + , ppEdits :: [doc] -> doc -- ^ Combined edits (usually some @sep@ combinator) + , ppEllip :: doc -- ^ Ellipsis + , ppParens :: doc -> doc -- ^ Parens an expression } -- | Escape field or constructor name @@ -112,10 +116,9 @@ ppExpr' :: Pretty doc -> Bool -> Expr -> doc ppExpr' p = impl where impl _ (App x []) = ppCon p (escapeName x) - impl b (App x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $ - ppSep p $ map (impl True) xs - impl _ (Rec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $ - map ppField' $ Map.toList xs + impl b (App x xs) = ppParens' b $ ppApp p (ppCon p (escapeName x)) (map (impl True) xs) + impl _ (Rec x xs) = ppRec p (ppCon p (escapeName x)) $ + map ppField' $ OMap.toList xs impl _ (Lst xs) = ppLst p (map (impl False) xs) ppField' (n, e) = (escapeName n, impl False e) @@ -132,8 +135,10 @@ ppEditExprCompact = ppEditExpr' True ppEditExpr' :: Bool -> Pretty doc -> Edit EditExpr -> doc -ppEditExpr' compact p = ppSep p . ppEdit False +ppEditExpr' compact p = go where + go = ppEdits p . ppEdit False + ppEdit b (Cpy (EditExp expr)) = [ ppCpy p $ ppExpr' p b expr ] ppEdit b (Cpy expr) = [ ppEExpr b expr ] ppEdit b (Ins expr) = [ ppIns p (ppEExpr b expr) ] @@ -144,19 +149,18 @@ ] ppEExpr _ (EditApp x []) = ppCon p (escapeName x) - ppEExpr b (EditApp x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $ - ppSep p $ concatMap (ppEdit True) xs - ppEExpr _ (EditRec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $ - justs ++ [ (n, ppCon p "...") | n <- take 1 nothings ] + ppEExpr b (EditApp x xs) = ppParens' b $ ppApp p (ppCon p (escapeName x)) (concatMap (ppEdit True) xs) + ppEExpr _ (EditRec x xs) = ppRec p (ppCon p (escapeName x)) $ + justs ++ [ (n, ppEllip p) | n <- take 1 nothings ] where - xs' = map ppField' $ Map.toList xs + xs' = map ppField' $ OMap.toList xs (nothings, justs) = partitionEithers xs' ppEExpr _ (EditLst xs) = ppLst p (concatMap (ppEdit False) xs) ppEExpr b (EditExp x) = ppExpr' p b x ppField' (n, Cpy (EditExp e)) | compact, not (isScalar e) = Left n - ppField' (n, e) = Right (escapeName n, ppSep p $ ppEdit False e) + ppField' (n, e) = Right (escapeName n, go e) ppParens' True = ppParens p ppParens' False = id @@ -172,20 +176,29 @@ prettyPretty :: Pretty HJ.Doc prettyPretty = Pretty { ppCon = HJ.text - , ppRec = HJ.braces . HJ.sep . HJ.punctuate HJ.comma - . map (\(fn, d) -> HJ.text fn HJ.<+> HJ.equals HJ.<+> d) - , ppLst = HJ.brackets . HJ.sep . HJ.punctuate HJ.comma + , ppRec = \c xs -> prettyGroup (c HJ.<+> HJ.char '{') (HJ.char '}') + $ map (\(fn, d) -> HJ.sep [HJ.text fn HJ.<+> HJ.equals, d]) xs + , ppLst = prettyGroup (HJ.char '[') (HJ.char ']') , ppCpy = id , ppIns = \d -> HJ.char '+' HJ.<> d , ppDel = \d -> HJ.char '-' HJ.<> d - , ppSep = HJ.sep + , ppEdits = HJ.sep + , ppEllip = HJ.text "..." + , ppApp = \f xs -> HJ.sep [ f, HJ.nest 2 $ HJ.sep xs ] , ppParens = HJ.parens - , ppHang = \d1 d2 -> HJ.hang d1 2 d2 } +prettyGroup :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> HJ.Doc +prettyGroup l r xs = HJ.cat [l, HJ.sep (map (HJ.nest 2) (prettyPunct (HJ.char ',') r xs))] + +prettyPunct :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> [HJ.Doc] +prettyPunct _ end [] = [end] +prettyPunct _ end [x] = [x HJ.<> end] +prettyPunct sep end (x:xs) = (x HJ.<> sep) : prettyPunct sep end xs + -- | Pretty print 'Expr' using @pretty@. -- --- >>> prettyExpr $ Rec "ex" (Map.fromList [("[]", App "bar" [])]) +-- >>> prettyExpr $ Rec "ex" (OMap.fromList [("[]", App "bar" [])]) -- ex {`[]` = bar} prettyExpr :: Expr -> HJ.Doc prettyExpr = ppExpr prettyPretty @@ -206,17 +219,21 @@ ansiWlPretty :: Pretty WL.Doc ansiWlPretty = Pretty { ppCon = WL.text - , ppRec = WL.encloseSep WL.lbrace WL.rbrace WL.comma - . map (\(fn, d) -> WL.text fn WL.<+> WL.equals WL.</> d) - , ppLst = WL.list + , ppRec = \c xs -> ansiGroup (c WL.<+> WL.lbrace) WL.rbrace + $ map (\(fn, d) -> WL.text fn WL.<+> WL.equals WL.</> d) xs + , ppLst = ansiGroup WL.lbracket WL.rbracket , ppCpy = WL.dullwhite , ppIns = \d -> WL.green $ WL.plain $ WL.char '+' WL.<> d , ppDel = \d -> WL.red $ WL.plain $ WL.char '-' WL.<> d - , ppSep = WL.sep + , ppApp = \f xs -> WL.group $ WL.nest 2 $ f WL.<$> WL.vsep xs + , ppEdits = WL.sep + , ppEllip = WL.text "..." , ppParens = WL.parens - , ppHang = \d1 d2 -> WL.hang 2 (d1 WL.</> d2) } +ansiGroup :: WL.Doc -> WL.Doc -> [WL.Doc] -> WL.Doc +ansiGroup l r xs = WL.group $ WL.nest 2 (l WL.<$$> WL.vsep (WL.punctuate WL.comma xs) WL.<> r) + -- | Pretty print 'Expr' using @ansi-wl-pprint@. ansiWlExpr :: Expr -> WL.Doc ansiWlExpr = ppExpr ansiWlPretty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff/Tree.hs new/tree-diff-0.2/src/Data/TreeDiff/Tree.hs --- old/tree-diff-0.1/src/Data/TreeDiff/Tree.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff/Tree.hs 2001-09-09 03:46:40.000000000 +0200 @@ -5,9 +5,30 @@ import Data.Tree (Tree (..)) import Data.TreeDiff.List -#ifdef __DOCTEST__ -import qualified Text.PrettyPrint as PP -#endif +-- $setup +-- >>> import Data.Tree (Tree (..)) +-- >>> import qualified Text.PrettyPrint as PP +-- >>> :{ +-- ppTree :: (a -> PP.Doc) -> Tree a -> PP.Doc +-- ppTree pp = ppT +-- where +-- ppT (Node x []) = pp x +-- ppT (Node x xs) = PP.parens $ PP.hang (pp x) 2 $ +-- PP.sep $ map ppT xs +-- ppEditTree :: (a -> PP.Doc) -> Edit (EditTree a) -> PP.Doc +-- ppEditTree pp = PP.sep . ppEdit +-- where +-- ppEdit (Cpy tree) = [ ppTree tree ] +-- ppEdit (Ins tree) = [ PP.char '+' PP.<> ppTree tree ] +-- ppEdit (Del tree) = [ PP.char '-' PP.<> ppTree tree ] +-- ppEdit (Swp a b) = +-- [ PP.char '-' PP.<> ppTree a +-- , PP.char '+' PP.<> ppTree b +-- ] +-- ppTree (EditNode x []) = pp x +-- ppTree (EditNode x xs) = PP.parens $ PP.hang (pp x) 2 $ +-- PP.sep $ concatMap ppEdit xs +-- :} -- | A breadth-traversal diff. -- @@ -51,7 +72,7 @@ -- >>> ppEditTree PP.char (treeDiff x w) -- (a b (c d +x e) f) -- -treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a) +treeDiff :: (Show a, Eq a) => Tree a -> Tree a -> Edit (EditTree a) treeDiff ta@(Node a as) tb@(Node b bs) | a == b = Cpy $ EditNode a (map rec (diffBy (==) as bs)) | otherwise = Swp (treeToEdit ta) (treeToEdit tb) @@ -72,27 +93,3 @@ treeToEdit :: Tree a -> EditTree a treeToEdit = go where go (Node x xs) = EditNode x (map (Cpy . go) xs) - -#ifdef __DOCTEST__ -ppTree :: (a -> PP.Doc) -> Tree a -> PP.Doc -ppTree pp = ppT - where - ppT (Node x []) = pp x - ppT (Node x xs) = PP.parens $ PP.hang (pp x) 2 $ - PP.sep $ map ppT xs - -ppEditTree :: (a -> PP.Doc) -> Edit (EditTree a) -> PP.Doc -ppEditTree pp = PP.sep . ppEdit - where - ppEdit (Cpy tree) = [ ppTree tree ] - ppEdit (Ins tree) = [ PP.char '+' PP.<> ppTree tree ] - ppEdit (Del tree) = [ PP.char '-' PP.<> ppTree tree ] - ppEdit (Swp a b) = - [ PP.char '-' PP.<> ppTree a - , PP.char '+' PP.<> ppTree b - ] - - ppTree (EditNode x []) = pp x - ppTree (EditNode x xs) = PP.parens $ PP.hang (pp x) 2 $ - PP.sep $ concatMap ppEdit xs -#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src/Data/TreeDiff.hs new/tree-diff-0.2/src/Data/TreeDiff.hs --- old/tree-diff-0.1/src/Data/TreeDiff.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/src/Data/TreeDiff.hs 2001-09-09 03:46:40.000000000 +0200 @@ -21,7 +21,7 @@ module Data.TreeDiff.Parser, ) where -import Data.TreeDiff.Expr import Data.TreeDiff.Class -import Data.TreeDiff.Pretty +import Data.TreeDiff.Expr import Data.TreeDiff.Parser +import Data.TreeDiff.Pretty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/src-diff/RefDiffBy.hs new/tree-diff-0.2/src-diff/RefDiffBy.hs --- old/tree-diff-0.1/src-diff/RefDiffBy.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tree-diff-0.2/src-diff/RefDiffBy.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,60 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module RefDiffBy (diffBy) where + +import Data.TreeDiff.List (Edit (..)) + +import qualified Data.Primitive as P + +diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a] +diffBy eq xs' ys' = reverse (getCell (lcs xn yn)) + where + xn = length xs' + yn = length ys' + + xs = P.arrayFromListN xn xs' + ys = P.arrayFromListN yn ys' + + memo :: P.Array (Cell [Edit a]) + memo = P.arrayFromListN ((xn + 1) * (yn + 1)) + [ impl xi yi + | xi <- [0 .. xn] + , yi <- [0 .. yn] + ] + + lcs :: Int -> Int -> Cell [Edit a] + lcs xi yi = P.indexArray memo (yi + xi * (yn + 1)) + + impl :: Int -> Int -> Cell [Edit a] + impl 0 0 = Cell 0 [] + impl 0 m = case lcs 0 (m - 1) of + Cell w edit -> Cell (w + 1) (Ins (P.indexArray ys (m - 1)) : edit) + impl n 0 = case lcs (n - 1) 0 of + Cell w edit -> Cell (w + 1) (Del (P.indexArray xs (n - 1)) : edit) + + impl n m = bestOfThree + edit + (bimap (+1) (Ins y :) (lcs n (m - 1))) + (bimap (+1) (Del x :) (lcs (n - 1) m)) + where + x = P.indexArray xs (n - 1) + y = P.indexArray ys (m - 1) + + edit + | eq x y = bimap id (Cpy x :) (lcs (n - 1) (m - 1)) + | otherwise = bimap (+1) (Swp x y :) (lcs (n - 1) (m - 1)) + +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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/tests/Tests.hs new/tree-diff-0.2/tests/Tests.hs --- old/tree-diff-0.1/tests/Tests.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/tests/Tests.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,14 +1,12 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} module Main (main) where import Data.Proxy (Proxy (..)) -import Data.TreeDiff -import Data.TreeDiff.Golden -import Data.TreeDiff.QuickCheck +import Data.Word (Word8) import GHC.Generics (Generic) import Prelude () import Prelude.Compat -import Test.QuickCheck (Property, counterexample) +import Test.QuickCheck (Property, counterexample, (===)) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.QuickCheck (testProperty) @@ -18,15 +16,32 @@ 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.List +import Data.TreeDiff.QuickCheck + +import qualified RefDiffBy + main :: IO () main = defaultMain $ testGroup "tests" [ testProperty "trifecta-pretty roundtrip" roundtripTrifectaPretty , testProperty "parsec-ansi-wl-pprint roundtrip" roundtripParsecAnsiWl + , testProperty "diffBy example1" $ diffByModel [7,1,6,0,0] [0,0,6,7,1,0,0] + , testProperty "diffBy model" diffByModel , goldenTests ] ------------------------------------------------------------------------------- --- QuickCheck: ediffEq +-- diffBy +------------------------------------------------------------------------------- + +diffByModel :: [Word8] -> [Word8] -> Property +diffByModel xs ys = + diffBy (==) xs ys === RefDiffBy.diffBy (==) xs ys + +------------------------------------------------------------------------------- +-- Roundtrip ------------------------------------------------------------------------------- -- | This property tests that we can parse pretty printed 'Expr'. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tree-diff-0.1/tree-diff.cabal new/tree-diff-0.2/tree-diff.cabal --- old/tree-diff-0.1/tree-diff.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/tree-diff-0.2/tree-diff.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: 2.2 name: tree-diff -version: 0.1 +version: 0.2 synopsis: Diffing of (expression) trees. category: Data, Testing description: @@ -37,14 +37,25 @@ license-file: LICENSE author: Oleg Grenrus <[email protected]> maintainer: Oleg.Grenrus <[email protected]> -copyright: (c) 2017-2019 Oleg Grenrus +copyright: (c) 2017-2021 Oleg Grenrus build-type: Simple extra-source-files: - README.md ChangeLog.md + README.md tested-with: - GHC ==8.8.1 || ==8.6.5 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 || ==7.6.3 || ==7.4.2 + GHC ==7.4.2 + || ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.4 + || ==9.0.1 + , GHCJS ==8.4 extra-source-files: fixtures/exfoo.expr @@ -64,6 +75,7 @@ Data.TreeDiff.Expr Data.TreeDiff.Golden Data.TreeDiff.List + Data.TreeDiff.OMap Data.TreeDiff.Parser Data.TreeDiff.Pretty Data.TreeDiff.QuickCheck @@ -71,25 +83,30 @@ -- GHC boot libraries build-depends: - , base >=4.5 && <4.13 - , bytestring ^>=0.9.2.1 || ^>=0.10.0.2 + , base >=4.5 && <4.16 + , bytestring ^>=0.9.2.1 || ^>=0.10.0.2 || ^>=0.11.0.0 , containers ^>=0.4.2.1 || ^>=0.5.0.0 || ^>=0.6.0.1 + , deepseq ^>=1.3.0.0 || ^>=1.4.0.0 , parsec ^>=3.1.13.0 , pretty ^>=1.1.1.0 , text ^>=1.2.3.0 - , time ^>=1.4 || ^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.8.0.2 + , time ^>=1.4 || ^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.8.0.2 || ^>=1.9.3 build-depends: - , aeson ^>=1.4.0.0 - , ansi-terminal ^>=0.8.2 || ^>=0.9.1 + , aeson ^>=1.4.6.0 || ^>=1.5.6.0 + , ansi-terminal >=0.10 && <0.12 , ansi-wl-pprint ^>=0.6.8.2 - , base-compat ^>=0.10.5 + , base-compat ^>=0.10.5 || ^>=0.11.0 , bytestring-builder ^>=0.10.8.2.0 , hashable ^>=1.2.7.0 || ^>=1.3.0.0 , parsers ^>=0.12.10 - , QuickCheck ^>=2.12.6.1 || ^>=2.13.1 + , primitive ^>=0.7.1.0 + , QuickCheck ^>=2.14.2 , scientific ^>=0.3.6.2 + , semialign >=1.1 && <1.3 + , strict ^>=0.4.0.1 , tagged ^>=0.8.6 + , these ^>=1.1.1.1 , unordered-containers ^>=0.2.8.0 , uuid-types ^>=1.0.3 , vector ^>=0.12 @@ -98,10 +115,10 @@ build-depends: ghc-prim if !impl(ghc >=8.0) - build-depends: semigroups >=0.18.5 && <0.20 + build-depends: semigroups ^>=0.19.1 if !impl(ghc >=7.8) - build-depends: generic-deriving ^>=1.12.4 + build-depends: generic-deriving >=1.13.1 && <1.15 if !impl(ghc >=7.10) build-depends: @@ -122,25 +139,50 @@ hs-source-dirs: src default-language: Haskell2010 -test-suite test +test-suite tree-diff-test default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Tests.hs - hs-source-dirs: tests + hs-source-dirs: tests src-diff ghc-options: -Wall -threaded + other-modules: RefDiffBy + + -- dependencies from library build-depends: , ansi-terminal , ansi-wl-pprint , base , base-compat , parsec + , primitive , QuickCheck - , tasty ^>=1.2 - , tasty-golden ^>=2.3.1.1 - , tasty-quickcheck ^>=0.10.1 , tagged , tree-diff - , trifecta ^>=2 if impl(ghc <7.5) build-depends: ghc-prim + + -- extra dependencies + build-depends: + , tasty ^>=1.2 || ^>=1.3.1 + , tasty-golden ^>=2.3.1.1 + , tasty-quickcheck ^>=0.10.1 + , trifecta >=2 && <2.2 + +benchmark tree-diff-bench + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: tree-diff-bench.hs + hs-source-dirs: bench + ghc-options: -Wall -threaded + + -- dependencies from library + build-depends: + , base + , deepseq + , tree-diff + + -- extra dependencies + build-depends: + , criterion ^>=1.5.9.0 + , Diff ^>=0.4.0
