Permalink
Browse files

Improve equality test for TextOperation

The new implementation of (==) from Eq normalizes the operations before
comparing them. This makes (==) return True iff two operations have the
same effect on every input document.
  • Loading branch information...
1 parent b33016b commit e794fd8b22f39567885bb60c42922dfce6b7292f @timjb timjb committed Mar 4, 2013
@@ -55,7 +55,7 @@ instance FromJSON Action where
-- that change the document at the current cursor position or advance the
-- cursor. After applying all actions, the cursor must be at the end of the
-- document.
-newtype TextOperation = TextOperation [Action] deriving (Eq, Read, Show, Binary, Typeable, FromJSON, ToJSON)
+newtype TextOperation = TextOperation [Action] deriving (Read, Show, Binary, Typeable, FromJSON, ToJSON)
addRetain :: Int -> [Action] -> [Action]
addRetain n (Retain m : xs) = Retain (n+m) : xs
@@ -70,6 +70,28 @@ addDelete :: Int -> [Action] -> [Action]
addDelete n (Delete m : xs) = Delete (n+m) : xs
addDelete n xs = Delete n : xs
+-- | Merges actions, removes empty ops and makes insert ops come before delete
+-- ops. Propertys:
+--
+-- * Idempotence: @canonicalize op = canonicalize (canonicalize op)@
+--
+-- * Preserves the effect under apply: @apply op doc = apply (canonicalize op) doc@
+canonicalize :: TextOperation -> TextOperation
+canonicalize (TextOperation ops) = TextOperation $ reverse $ loop [] $ reverse ops
+ where
+ loop as [] = as
+ loop as (Retain n : bs) | n <= 0 = loop as bs
+ | True = loop (addRetain n as) bs
+ loop as (Insert i : bs) | i == "" = loop as bs
+ | True = loop (addInsert i as) bs
+ loop as (Delete d : bs) | d <= 0 = loop as bs
+ | True = loop (addDelete d as) bs
+
+instance Eq TextOperation where
+ a == b = opsa == opsb
+ where TextOperation opsa = canonicalize a
+ TextOperation opsb = canonicalize b
+
instance OTOperation TextOperation where
transform (TextOperation o1) (TextOperation o2) = both (TextOperation . reverse) `fmap` loop o1 o2 [] []
where
@@ -132,7 +132,7 @@ testComposeAugmented = ab @=? ab'
where
a = AugmentedTextOperation (Cursor 11 11) (TextOperation [Retain 5, Insert " Ipsum"])
b = AugmentedTextOperation (Cursor 0 1) (TextOperation [Insert "L", Delete 1, Retain 10])
- ab = AugmentedTextOperation (Cursor 0 1) (TextOperation [Insert "L", Delete 1, Retain 4, Insert " Ipsum"])
+ ab = AugmentedTextOperation (Cursor 0 1) (TextOperation [Delete 1, Insert "L", Retain 4, Insert " Ipsum"])
Right ab' = a `compose` b
testApplyAugmented :: Assertion

0 comments on commit e794fd8

Please sign in to comment.