Operational Transformation in Haskell, Part 2

Or, Thank You (Re)based God

In my previous article I outlined a project to implement operational transformation in Haskell. I defined a domain specific language for operations on documents - insert, delete, and retain (skip) - and built an interpreter it which would correctly apply operations to a “document,” in this case a run-of-the-mill String.

For convenience here is an example of the DSL in action:

opA :: Operation
opA = do
    delete 1
    insert "H"
    retain 10

editor_test :: IO ()
editor_test = do
    let doc = "hello world"
    let (result_length doc') = edit doc opA
    putStrLn doc'
    -- prints "Hello world"

Here we define a series of edits we wish to make to a String as a value and then use it to transform a String.

Armed with the ability to see what the fuck we’re doing I can now move on to actually implementing the interesting parts of OT.

As with last time, the code is available for you to play along at home.

1 What OT really is

OT is used to implement real-time collaboration services which coordinate multiple authors working on a single document in a way which ensures consistency among the different authors.

An actual full-fledged OT service is out of the scope of this article. At its core, though, OT solves the following problem basic problem: if two users make different edits to the same document and send them to one another, how can each change each others’ edits in a way that they’ll both end up with the same document after applying them?

That is, if User A and User B create edits a and b, respectively, is there a way to create edits a’ and b’ so that A can apply ab’ and B can apply ba’ and wind up with the same document?

2 Yup

Okay, cool, thanks for reading the article. Just kidding I’m going to drone on forever with this.

The operation we’re searching for is often called transform (hence, “operational transformation”). Given a pair of edits which were ostensibly made to the same document it can generate the pair of new edits we seek.

Before we define transform, though, let’s define something useful we’ll need as a prerequisite: composition.

3 I <3 Monoids

Operations form a monoid: there is a default “empty” value and a “combiner” function that can take two of them to produce a third; if either argument is our “empty” value then it is ignored.

So let’s define a Monoid instance for Operation:

instance Monoid (Free OperationGrammar k) where
    mempty = return ()
    mappend = (>>)

Turns out that the monad “then” operator, (>>), already does what we want. And the value returned by return () can be treated as an identity for mappend. If we import Data.Monoid we can get access to the (<>) operator, which is an infix shorthand for mappend. Glad we got that sorted out.

Now we will define transform!

4 Why couldn’t I be good at something that lets me go outside more?

In Haskell recursion isn’t the terrible idea it is in some other languages so we are going to construct our response recursively, starting with a pair of “empty” operations.

Recall that operations may be composed together so an Operation is essentially a sequence of tagged values indicating which operation should be performed followed by either another value or the end of the sequence.

It’s important to keep our goal in mind: we want to create two new Operations a' and b' such thata <> b’and b <> a’` result in the same new document. So some of our logic may be a little weird. I’ll type slowly.

xform :: Operation -> Operation -> (Operation, Operation)
xform a b = go a b (return (), return ()) where

The go function will actually handle the construction of our two result Operations. return () is a little ugly but, in the context of our operation language, it simply means “do nothing.” (See the Monoid instance above).

4.1 Case 1: We’re finished

go (Pure ()) (Pure ()) result = result

Since I used the free library, the value created by return () is Pure () (if you want to know why, feel free to email me). So in our first case we check to see if the two Operation arguments are essentially finished. If so, well, whatever result we have constructed thus far is the final one.

4.2 Case 2: Insertions

go (Free (Insert s k)) b (a', b') =
    go k b (a' <> insert s, b' <> retain (length s))

go a (Free (Insert s k)) (a', b') =
    go a k (a' <> retain (length s), b' <> insert s)

We’re going to be biased toward the first Operation argument. If it is an Insert command, then we want our first transformed command to be that insertion, and the second command will skip over that many characters.

If we exhaust all the inserts from the first command then we do the same exact thing for the second command.

Why do we do this? We are trying to create versions of our edits that allow us to end up with the same document. If the left one has an insert, all we know is that wherever we are in the document, the right-hand operation needs to move whatever it was going to do until after the inserted text (or vice versa).

4.3 Cases 3-6

With insert out of the way we have only delete and retain with which to contend. insert changes the cursor position and the document; delete changes only the document and retain changes only the cursor position.

We are going to pair up our arguments and look at these four combinations case-by-case:

go a b (a', b') = case (a, b) of

4.3.1 Case 3: Retain / Retain

(Free (Retain n1 k1), Free (Retain n2 k2)) ->
    let ops minl = (a' <> retain minl, b' <> retain minl)
    in  case compare n1 n2 of
        EQ -> go k1 k2 (ops n2)
        GT -> go (Free (Retain (n1 - n2) k1)) k2 (ops n2)
        LT -> go k1 (Free (Retain (n2 - n1) k2)) (ops n1)

There’s a lot going on here. The left-hand operation retains n1 characters while the right-hand retains n2 characters. Our strategy will be to determine which of the two retained the least, call that number minl, and add retain minl to both of our result Operations. The larger of the two operations, if any, will have more characters to retain so we essentially replace it with a retain (larger - smaller).

The compare function, as well as the values EQ, GT, and LT are from the Data.Ord package.

4.3.2 Case 4: Delete / Delete

(Free (Delete n1 k1), Free (Delete n2 k2)) ->
    case compare n1 n2 of
        EQ -> go k1 k2 (a', b')
        GT -> go (Free (Delete (n1 - n2) k1)) k2 (a', b')
        LT -> go k1 (Free (Delete (n2 - n1) k2)) (a', b')

This case is even simpler! If both operations delete the same document at the same place then we don’t need to change the operations at all, we just need to handle the two cases where one deleted more than the other.

Remember, we’re thinking of ways to change one operation to have come after another operation which it didn’t know about. If both operations deleted then we care about handling the difference in how much was deleted.

4.3.3 Case 5: Delete / Retain

(Free (Delete n1 k1), Free (Retain n2 k2)) ->
    let ops minl = (a' <> delete minl, b')
    in  case compare n1 n2 of
        EQ -> go k1 k2 (ops n2)
        GT -> go (Free (Delete (n1 - n2) k1)) k2 (ops n2)
        LT -> go k1 (Free (Retain (n2 - n1) k2)) (ops n1)

If the left-hand operation deleted more text than the right side skipped, then we just ignore the right-hand operation and continue with a delete (larger - smaller) command, which should be familiar by now. If we deleted less than we skipped, then we retain (larger - smaller).

4.3.4 Case 6: Retain / Delete

(Free (Retain n1 k1), Free (Delete n2 k2)) ->
    let ops minl = (a', b' <> delete minl)
    in  case compare n1 n2 of
        EQ -> go k1 k2 (ops n2)
        GT -> go (Free (Retain (n1 - n2) k1)) k2 (ops n2)
        LT -> go k1 (Free (Delete (n2 - n1) k2)) (ops n1)

This is fundamentally the reverse of the previous case.

5 And the result?

Let’s find out!

a, b :: Operation
a = do
    retain 2
    insert "t"

b = do
    retain 2
    insert "a"

test1 :: IO ()
test1 = do
    let (b', a') = xform b a
    let (_, go_a) = edit go_doc a
    let (_, go_b) = edit go_doc b
    putStrLn . show $ edit go_a b' -- "goat"
    putStrLn . show $ edit go_b a' -- "goat"

op1, op2 :: Operation
op1 = do
    retain 11
    insert " dolor"

op2 = do
    delete 6
    retain 5

doc :: Document
doc = "lorem ipsum"

test2 :: IO ()
test2 = do
    let (_, doc_op1) = edit doc op1
    let (_, doc_op2) = edit doc op2
    let (op2', op1') = xform op2 op1
    putStrLn . show $ edit doc_op1 op2' -- (11, "ipsum dolor")
    putStrLn . show $ edit doc_op2 op1' -- (11, "ipsum dolor")

While far from a comprehensive test, this suggests we are more or less correct.

6 What did all of this mean?

Ultimately, nothing, the Sun will still engulf the Earth when it finally dies. However, for the time being, we have shown how to

  1. Implement a system for describing, composing, and applying text operations to documents; and

  2. Transform concurrent edits so that multiple parties may arrive at consistent document states after applying one another’s work.

This article may get more elaboration in the future. Feel free to shoot me an email in the meantime.