diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9b6c75c --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +node_modules +lib +_build +.merlin +.jenga +*.bs.js +.bsb.lock \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..cac0e10 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "editor.formatOnSave": true +} \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..a2482c7 --- /dev/null +++ b/README.md @@ -0,0 +1,25 @@ +# bs-automerge + +Binding to `automerge` library and attempt to do a pure functional Reason rewrite. + +# Build + +``` +npm run build +``` + +# Build + Watch + +``` +npm run start +``` + +# Run + +``` +node src/Test.bs.js +``` + +# Editor + +If you use `vscode`, Press `Windows + Shift + B` it will build automatically diff --git a/bsconfig.json b/bsconfig.json new file mode 100644 index 0000000..5ce4ba5 --- /dev/null +++ b/bsconfig.json @@ -0,0 +1,18 @@ +{ + "name": "bs-automerge", + "version": "0.1.0", + "sources": { + "dir": "src", + "subdirs": true + }, + "package-specs": { + "module": "commonjs", + "in-source": true + }, + "suffix": ".bs.js", + "bs-dependencies": ["bs-immutablejs", "rex-json"], + "warnings": { + "error": "+101" + }, + "refmt": 3 +} diff --git a/package-lock.json b/package-lock.json new file mode 100644 index 0000000..28f58bc --- /dev/null +++ b/package-lock.json @@ -0,0 +1,48 @@ +{ + "name": "bs-automerge", + "version": "0.1.0", + "lockfileVersion": 1, + "requires": true, + "dependencies": { + "automerge": { + "version": "0.8.0", + "resolved": "https://registry.npmjs.org/automerge/-/automerge-0.8.0.tgz", + "integrity": "sha512-TB+b+N/VATzQH3hQrzAmTvfyyo04SNUer9ml4M1PRSQ4Bq0OYgclqi3hdYlNG4d/rSWKq897nbkg7gbni7CV2w==", + "requires": { + "immutable": "^3.8.2", + "transit-immutable-js": "^0.7.0", + "transit-js": "^0.8.861", + "uuid": "3.1.0" + } + }, + "bs-immutablejs": { + "version": "github:reasonml-community/bs-immutablejs#5d770f09d33c3fa294f2a098b3cff9776edec841", + "from": "github:reasonml-community/bs-immutablejs" + }, + "immutable": { + "version": "3.8.2", + "resolved": "https://registry.npmjs.org/immutable/-/immutable-3.8.2.tgz", + "integrity": "sha1-wkOZUUVbs5kT2vKBN28VMOEErfM=" + }, + "rex-json": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/rex-json/-/rex-json-1.4.0.tgz", + "integrity": "sha512-bG3byyGHk8+5frVPFu7qXkx+7qgycv0r6rD17JXw7XYqyd5eekcpsodR7/zk2u/jBqsjt5HHisND23Kx74PZkw==" + }, + "transit-immutable-js": { + "version": "0.7.0", + "resolved": "https://registry.npmjs.org/transit-immutable-js/-/transit-immutable-js-0.7.0.tgz", + "integrity": "sha1-mT4lCJtjEf9AIUD1VidtbSUwBdk=" + }, + "transit-js": { + "version": "0.8.861", + "resolved": "https://registry.npmjs.org/transit-js/-/transit-js-0.8.861.tgz", + "integrity": "sha512-4O9OrYPZw6C0M5gMTvaeOp+xYz6EF79JsyxIvqXHlt+pisSrioJWFOE80N8aCPoJLcNaXF442RZrVtdmd4wkDQ==" + }, + "uuid": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/uuid/-/uuid-3.1.0.tgz", + "integrity": "sha512-DIWtzUkw04M4k3bf1IcpS2tngXEL26YUD2M0tMDUpnUrz2hgzUBlD55a4FjdLGPvfHxS6uluGWvaVEqgBcVa+g==" + } + } +} diff --git a/package.json b/package.json new file mode 100644 index 0000000..01b1fb2 --- /dev/null +++ b/package.json @@ -0,0 +1,32 @@ +{ + "name": "bs-automerge", + "version": "0.1.0", + "description": "Reason + BuckleScript bindings to Automerge", + "main": "index.js", + "scripts": { + "build": "bsb -make-world", + "start": "bsb -make-world -w", + "clean": "bsb -clean-world", + "prepare": "npm link bs-platform" + }, + "repository": { + "type": "git", + "url": "https://github.com/jhrdina/bs-automerge.git" + }, + "homepage": "https://github.com/jhrdina/bs-automerge#readme", + "bugs": "https://github.com/jhrdina/bs-automerge/issues", + "keywords": [ + "reason", + "bucklescript", + "crdt", + "data structures", + "replication" + ], + "author": "", + "license": "MIT", + "dependencies": { + "automerge": "^0.8.0", + "bs-immutablejs": "github:reasonml-community/bs-immutablejs", + "rex-json": "^1.4.0" + } +} diff --git a/src/Automerge.re b/src/Automerge.re new file mode 100644 index 0000000..20d3ce8 --- /dev/null +++ b/src/Automerge.re @@ -0,0 +1,214 @@ +module type DocType = {type t;}; + +type uuid = string; +type op; +/* + { + obj: uuid + action: link | ins | insert | set | remove | makeMap | makeText | makeList + + key: // nekdy u map, tez _head, nekdy tez elemId, napr. aaa:1 + index: int // nekdy u list + value: // hodnota, na kterou se to meni + + type: list | map // nekdy + path: array(string??) // nekdy + + elem: int + actor: uuid + seq: int + } + */ + +[@bs.deriving abstract] +type change = { + actor: uuid, + seq: int, + /* deps: { + [actorId]: int + } */ + message: string, + ops: array(op), +}; + +/* actorId -> suggested value */ +type conflict = Js.Dict.t(Js.Json.t); +/* fieldName -> actorId -> suggested value */ +type objectConflicts = Js.Dict.t(conflict); +/* index -> actorId -> suggested value */ +type arrayConflicts = array(conflict); + +[@bs.get] +external getArrayConflicts: array('a) => arrayConflicts = "_conflicts"; + +type changeSet = array(change); + +module Make = (Doc: DocType) => { + /* + pole obcas indexovane jako [actorId]:[index], napr. + "aaa:2" + - mozna se tomu rika elemId + - elemId = timestamp operace vytvoreni daneho prvku + + type elemId = { + actorId: uuid, + index: int + }; + + type arrayObj = { + _init: op, // operace, ktera ten objekt vytvorila (asi) + _inbound: Set>, + _elemIds: SkipList, + + + + _following: { + [key]: List, napr. + _head: List> + }, + _maxElem: int, + _insertion: { + [elemId]: op + }, + [elemId]: List> + } + + type mapObj = { + // operace, ktera ten objekt vytvorila (asi) + // [u rootu chybi] + _init: op, + // operace, ktere zpusobily vlozeni tohoto objektu do jineho + // (do List nebo do Map) + // [u rootu chybi] + _inbound: Set>, + [key]: List>, + } + */ + + type clock; + /* = { + [actorId]: int + } + */ + + type opSet; + /* = { + states: { + // Asi vsechny zmeny daneho actora + [actorId]: [ + { + change: change + allDeps: { + [actorId]: int + } + } + ] + }, + history: changeSet, + byObject: { + // ROOT ma vetsinou 000000-0000... + [objectId]: arrayObj | mapObj, + }, + clock: clock, + deps: { + [actorId]: int + }, + local: [], + queue: [], + cache: { + [objectId]: object | list + }, + + + undoPos: 0, + undoLocal: [], + undoStack: [], + redoStack: [], + } */ + + [@bs.deriving abstract] + type docState = { + /* actorId: UUID? */ + opSet, + }; + /* + + type object = { + _conflicts: arrayConflicts, + _objectId: uuid, + [key]: whatever + } + + type list = { + _conflicts: arrayConflicts, + _objectId: uuid, + [index]: whatever + } + */ + + type t = Doc.t; + /* + { + _actorId: UUID, // ID uzlu + _state: docState, + _objectId: UUID, + _conflicts + } + */ + + /* [@bs.module "automerge"] external init: unit => t = "initImmutable"; */ + [@bs.module "automerge"] external init: (~actorId: uuid=?, unit) => t = ""; + [@bs.module "automerge"] external change: (t, string, t => unit) => t = ""; + + /* From automerge/auto_api */ + [@bs.module "automerge"] external merge: (t, t) => t = ""; + [@bs.module "automerge"] external getChanges: (t, t) => changeSet = ""; + [@bs.module "automerge"] external diff: (t, t) => array(op) = ""; + + [@bs.module "automerge"] external save: t => string = ""; + [@bs.module "automerge"] + external load: (string, ~actorId: uuid=?) => string = ""; + [@bs.module "automerge"] + external _getMissingChanges: (opSet, clock) => changeSet = + "getMissingChanges"; + let _getOpSet: t => opSet = [%raw doc => "{return doc._state.get('opSet')}"]; + let getMissingChanges: (t, clock) => changeSet = + (doc, clock) => doc->_getOpSet->_getMissingChanges(clock); + + [@bs.module "automerge"] external applyChanges: (t, changeSet) => t = ""; + + [@bs.module "automerge"] + external getConflicts: (t, ImmJsRe.List.t(change)) => objectConflicts = ""; + + let getClock: t => clock = [%raw + doc => "{return doc._state.get('opSet').get('clock')}" + ]; + /* + [@bs.module "automerge"] external canUndo: t => bool = ""; + [@bs.module "automerge"] external undo: (t, string) => t = ""; + [@bs.module "automerge"] external canRedo: t => bool = ""; + [@bs.module "automerge"] external redo: (t, string) => t = ""; */ +}; + +/* + + DREAM API + + + let schema = Automerge.Schema.( + object([ + required("description", string), + optionalWithConflictRes( + "items", + list(object([ + required("sss", int), + optional("boooo", bool) + ])), + atomic + ) + ]) + ); + + Conflict resolution */ + +/* solve = (resolve) */ \ No newline at end of file diff --git a/src/internals/AMPure.re b/src/internals/AMPure.re new file mode 100644 index 0000000..a2ce09b --- /dev/null +++ b/src/internals/AMPure.re @@ -0,0 +1,598 @@ +type replicaId = string; +type timestamp = (int, replicaId); +let encodeTimestamp = ((i, rep)) => + "TS(" ++ string_of_int(i) ++ ", r" ++ rep ++ ")"; + +module Timestamp = { + type t = timestamp; + let compare = (a, b) => compare(a, b); +}; +module TimestampMap = Map.Make(Timestamp); +/* VAL */ +type value = + | String(string) + | Int(int) + | Float(float) + | Bool(bool) + | Null + | EmptyObject + | EmptyArray; +let encodeValue = + fun + | String(v) => "String(" ++ v ++ ")" + | Int(v) => "Int(" ++ string_of_int(v) ++ ")" + | Float(v) => "Float(" ++ string_of_float(v) ++ ")" + | Bool(v) => "Bool(" ++ string_of_bool(v) ++ ")" + | Null => "Null" + | EmptyObject => "EmptyObject" + | EmptyArray => "EmptyArray"; + +type mut = + | Assign(value) + | Insert(value) + | Delete; +let encodeMut = + fun + | Assign(v) => "Assign(" ++ encodeValue(v) ++ ")" + | Insert(v) => "Insert(" ++ encodeValue(v) ++ ")" + | Delete => "Delete"; + +type cursorItem = + | Doc + /* !! Custom */ + | Str(string) + /* Inside list */ + | Head + | Tail + | Timestamp(timestamp); +let encodeCursorItem = + fun + | Doc => "Doc" + | Str(s) => "Str('" ++ s ++ "')" + | Head => "Head" + | Tail => "Tail" + | Timestamp(t) => t |> encodeTimestamp; + +module CursorItem = { + type t = cursorItem; + let compare = (a, b) => + switch (a, b) { + | (Timestamp(aT), Timestamp(bT)) => compare(aT, bT) + | (a, b) => compare(a, b) + }; +}; +module CursorItemMap = Map.Make(CursorItem); +module CursorItemSet = Set.Make(CursorItem); + +type typedKey = + | MapT(cursorItem) + | ListT(cursorItem) + | RegT(cursorItem); +let encodeTypedKey = + fun + | MapT(ci) => "Map(" ++ encodeCursorItem(ci) ++ ")" + | ListT(ci) => "List(" ++ encodeCursorItem(ci) ++ ")" + | RegT(ci) => "Reg(" ++ encodeCursorItem(ci) ++ ")"; + +module TypedKey = { + type t = typedKey; + let typedKeyToInt = + fun + | MapT(_) => 0 + | ListT(_) => 1 + | RegT(_) => 2; + let compare = (a, b) => + if (compare(typedKeyToInt(a), typedKeyToInt(b)) === 0) { + 0; + } else { + let MapT(aT) | ListT(aT) | RegT(aT) = a; + let MapT(bT) | ListT(bT) | RegT(bT) = b; + /* TODO: Check timestamp comparison */ + compare(aT, bT); + }; +}; + +module TypedKeyMap = Map.Make(TypedKey); + +type cursor = + | Cursor(list(typedKey), cursorItem); +let encodeCursor = (Cursor(items, kn)) => + "Cursor(" + ++ String.concat(" -> ", items |> List.map(encodeTypedKey)) + ++ ", " + ++ encodeCursorItem(kn) + ++ ")"; + +type op = { + id: timestamp, + /* Set of causal dependencies: + all operations from any replica that had been applied on this replica before this operation */ + deps: list(timestamp), + cur: cursor, + mut, +}; + +let encodeOp = op => + Json.Object([ + ("id", Json.String(op.id |> encodeTimestamp)), + ( + "deps", + Json.Array( + op.deps |> List.map(ts => Json.String(encodeTimestamp(ts))), + ), + ), + ("cur", Json.String(op.cur |> encodeCursor)), + ("mut", Json.String(op.mut |> encodeMut)), + ]); + +type ctx = { + items: TypedKeyMap.t(ctx), + next: CursorItemMap.t(cursorItem), + /* Presence set: set of all operations that have asserted the existence of + this list element + + Note: In Automerge called '_inbound' in opSet.byObject[id] + */ + /* TODO: check type, maybe cursorItem */ + pres: CursorItemMap.t(list(timestamp)), + values: TimestampMap.t(value), +}; +let rec encodeCtx = ({items, next, pres, values}) => { + let encodeItems = items => + Json.Object( + TypedKeyMap.fold( + (typedKey, ctx, acc) => [ + (typedKey |> encodeTypedKey, ctx |> encodeCtx), + ...acc, + ], + items, + [], + ), + ); + let encodeNext = next => + Json.Object( + CursorItemMap.fold( + (cursorItemA, cursorItemB, acc) => [ + ( + cursorItemA |> encodeCursorItem, + Json.String(cursorItemB |> encodeCursorItem), + ), + ...acc, + ], + next, + [], + ), + ); + let encodePres = pres => + Json.Object( + CursorItemMap.fold( + (ci, tss, acc) => [ + ( + ci |> encodeCursorItem, + Json.Array( + tss |> List.map(ts => Json.String(encodeTimestamp(ts))), + ), + ), + ...acc, + ], + pres, + [], + ), + ); + let encodeValues = values => + Json.Object( + TimestampMap.fold( + (ts, value, acc) => [ + (ts |> encodeTimestamp, Json.String(encodeValue(value))), + ...acc, + ], + values, + [], + ), + ); + Json.Object([ + ("items", items |> encodeItems), + ("next", next |> encodeNext), + ("pres", pres |> encodePres), + ("values", values |> encodeValues), + ]); +}; + +let emptyCtx = { + items: TypedKeyMap.empty, + next: CursorItemMap.empty, + pres: CursorItemMap.empty, + values: TimestampMap.empty, +}; + +/* TODO: Convert to an actual Set */ +type opSet = list(op); +type state = { + replicaId, + queue: opSet, + ops: list(timestamp), + ctx, + recv: opSet, +}; + +let encodeState = ({queue, ops, ctx}) => + Json.Object([ + ("queue", Json.Array(queue |> List.map(encodeOp))), + ( + "ops", + Json.Array(ops |> List.map(ts => Json.String(encodeTimestamp(ts)))), + ), + ("ctx", ctx |> encodeCtx), + ]); + +/* type ctxVal = + | Term + | Nonterm(ctxVal); */ + +/* ======================================= */ +/* helpers */ + +/* ======================================= */ +/* let _exprToCursor = (expr) => */ +/* EXPR */ +let doc = Cursor([], Doc); +let get = (cur, key) => { + let Cursor(tail, head) = cur; + switch (head) { + | Head => raise(Not_found) + | others => Cursor(List.append(tail, [MapT(others)]), Str(key)) + }; +}; + +let idx = (cur, state, i) => { + let rec idx_i = (cur, ctx: ctx, i) => + switch (cur) { + /* IDX2 */ + | Cursor([k1, ...tail], kn) => + let Cursor(_, kn_new) = + idx_i(Cursor(tail, kn), ctx.items |> TypedKeyMap.find(k1), i); + Cursor([k1, ...tail], kn_new); + | Cursor([], k) => + if (i === 0) { + /* IDX5 */ + Cursor([], k); + } else if (i > 0) { + let k_new = ctx.next |> CursorItemMap.find(k); + if (k_new != Tail) { + if (ctx.pres |> CursorItemMap.find(k_new) != []) { + /* IDX3 */ + idx_i(Cursor([], k_new), ctx, i - 1); + } else { + /* IDX4 */ + idx_i(Cursor([], k_new), ctx, i); + }; + } else { + raise(Not_found); + }; + } else { + raise(Not_found); + } + }; + /* IDX1 */ + let Cursor(tail, kn) = cur; + Cursor(List.append(tail, [ListT(kn)]), Head)->idx_i(state.ctx, i); +}; + +/* keys */ +let keysOfContext = ctx => + TypedKeyMap.fold( + (MapT(k) | ListT(k) | RegT(k), _v, acc) => [k, ...acc], + ctx.items, + [], + ); + +let keys = (cur, state) => { + let rec keys_i = (ctx: ctx) => + fun + /* KEYS3 */ + | Cursor([k1, ...tail], kn) when ctx.items |> TypedKeyMap.mem(k1) => + keys_i(ctx.items |> TypedKeyMap.find(k1), Cursor(tail, kn)) + | Cursor([_, ..._], _) => raise(Not_found) + /* KEYS2 */ + | Cursor([], k) => { + let map = ctx.items |> TypedKeyMap.find(MapT(k)); + keysOfContext(map) + |> List.filter(k => map.pres |> CursorItemMap.find(k) != []); + }; + /* KEYS1 */ + keys_i(state.ctx, cur); +}; + +/* ???? */ +let range = ctx => ctx.values; + +let val_ = (cur, state) => { + let rec val_i = ctx => + fun + /* VAL3 */ + | Cursor([k1, ...tail], kn) when ctx.items |> TypedKeyMap.mem(k1) => + val_i(ctx.items |> TypedKeyMap.find(k1), Cursor(tail, kn)) + | Cursor([_, ..._], _) => raise(Not_found) + /* VAL2 */ + | Cursor([], k) => range(ctx.items |> TypedKeyMap.find(RegT(k))); + /* VAL1 */ + val_i(state.ctx, cur); +}; + +/* Operations */ + +type addId = + | AddId(typedKey, timestamp, mut); + +let presence = (ctx, k) => + switch (ctx.pres |> CursorItemMap.find(k)) { + /* PRESENCE1 */ + | value => value + /* PRESENCE2 */ + | exception Not_found => [] + }; + +let addId = ctx => + fun + | AddId(_kTag, _id, Delete) => ctx + | AddId(MapT(k) | ListT(k) | RegT(k), id, _mut) => { + ...ctx, + pres: ctx.pres |> CursorItemMap.add(k, [id, ...presence(ctx, k)]), + }; + +let child = ctx => + fun + /* CHILD-GET */ + | k when ctx.items |> TypedKeyMap.mem(k) => + ctx.items |> TypedKeyMap.find(k) + /* CHILD-MAP */ + | MapT(_k) => emptyCtx + /* CHILD-LIST */ + | ListT(_k) => { + ...emptyCtx, + next: emptyCtx.next |> CursorItemMap.add(Head, Tail), + } + /* CHILD-REG */ + | RegT(_k) => emptyCtx; + +let rec clearAny = (ctx, deps, k) => { + let (ctx1, pres1) = clear(ctx, deps, MapT(k)); + let (ctx2, pres2) = clear(ctx1, deps, ListT(k)); + let (ctx3, pres3) = clear(ctx2, deps, RegT(k)); + (ctx3, List.concat([pres1, pres2, pres3])); +} +and clearElem = (ctx, deps, k) => { + let (ctx', pres1) = clearAny(ctx, deps, k); + let pres2 = presence(ctx', k); + let pres3 = + List.append(pres1, pres2) |> List.filter(i => !List.mem(i, deps)); + ({...ctx', pres: ctx'.pres |> CursorItemMap.add(k, pres3)}, pres3); +} +and clearMap = (ctx, deps, _done) => { + /* !! Customized */ + let rec clearMap_i = (ctx, deps) => + fun + /* CLEAR-MAP2 */ + | [k, ...tail] => { + let (ctx', pres1) = clearElem(ctx, deps, k); + let (ctx'', pres2) = clearMap_i(ctx', deps, tail); + (ctx'', List.append(pres1, pres2)); + } + | [] => (ctx, [] /* set */); + clearMap_i(ctx, deps, keysOfContext(ctx)); +} +and clearList = (ctx, deps) => + fun + /* CLEAR-LIST2 */ + | k when k !== Tail => { + let next = ctx.next |> CursorItemMap.find(k); + let (ctx', pres1) = clearElem(ctx, deps, k); + let (ctx'', pres2) = clearList(ctx', deps, next); + (ctx'', List.append(pres1, pres2)); + } + /* CLEAR-LIST3 */ + | _ => (ctx, [] /* set */) +and clear = (ctx, deps) => + fun + /* CLEAR-NONE */ + | k when !(ctx.items |> TypedKeyMap.mem(k)) => (ctx, []) + /* CLEAR-REG */ + | RegT(k) => { + let concurrent = { + ...emptyCtx, + values: + (ctx.items |> TypedKeyMap.find(RegT(k))).values + |> TimestampMap.filter((id, _v) => !List.mem(id, deps)), + }; + ( + {...ctx, items: ctx.items |> TypedKeyMap.add(RegT(k), concurrent)}, + TimestampMap.fold( + (id, _v, pres) => [id, ...pres], + concurrent.values, + [], + ), + ); + } + /* CLEAR-MAP1 */ + | MapT(k) => { + /* TODO: Really []? */ + let (cleared, pres) = + clearMap( + ctx.items |> TypedKeyMap.find(MapT(k)), + deps, + [] /* set */, + ); + ( + {...ctx, items: ctx.items |> TypedKeyMap.add(MapT(k), cleared)}, + pres, + ); + } + /* CLEAR-LIST1 */ + | ListT(k) => { + let (cleared, pres) = + clearList(ctx.items |> TypedKeyMap.find(ListT(k)), deps, Head); + ( + {...ctx, items: ctx.items |> TypedKeyMap.add(ListT(k), cleared)}, + pres, + ); + }; + +let rec _applyOp = ctx => + fun + /* DESCEND */ + | {id, deps, cur: Cursor([k1, ...tail], kn), mut} => { + let child = child(ctx, k1); + let child' = _applyOp(child, {id, deps, cur: Cursor(tail, kn), mut}); + let ctx' = addId(ctx, AddId(k1, id, mut)); + {...ctx', items: ctx'.items |> TypedKeyMap.add(k1, child')}; + } + /* ASSIGN */ + | {id, deps, cur: Cursor([], k), mut: Assign(value)} + when value !== EmptyArray && value !== EmptyObject => { + let (ctx', _pres) = clear(ctx, deps, RegT(k)); + let ctx'' = addId(ctx', AddId(RegT(k), id, Assign(value))); + let child = child(ctx'', RegT(k)); + { + ...ctx'', + items: + ctx''.items + |> TypedKeyMap.add( + RegT(k), + { + ...child, + values: child.values |> TimestampMap.add(id, value), + }, + ), + }; + } + /* EMPTY-MAP */ + | {id, deps, cur: Cursor([], k), mut: Assign(value)} + when value === EmptyObject => { + let (ctx', _pres) = clearElem(ctx, deps, k); + let ctx'' = addId(ctx', AddId(MapT(k), id, Assign(value))); + let child = child(ctx'', MapT(k)); + {...ctx'', items: ctx''.items |> TypedKeyMap.add(MapT(k), child)}; + } + /* EMPTY-LIST */ + | {id, deps, cur: Cursor([], k), mut: Assign(value)} + when value === EmptyArray => { + let (ctx', _pres) = clearElem(ctx, deps, k); + let ctx'' = addId(ctx', AddId(ListT(k), id, Assign(value))); + let child = child(ctx'', ListT(k)); + {...ctx'', items: ctx''.items |> TypedKeyMap.add(ListT(k), child)}; + } + | {id, deps, cur: Cursor([], prev), mut: Insert(value)} => { + let next = ctx.next |> CursorItemMap.find(prev); + if (switch (next) { + | Timestamp(n) when n < id => true + | Tail => true + | _ => false + }) { + /* INSERT1 */ + let ctx' = + _applyOp( + ctx, + {id, deps, cur: Cursor([], Timestamp(id)), mut: Assign(value)}, + ); + { + ...ctx', + next: + ctx'.next + |> CursorItemMap.add(prev, Timestamp(id)) + |> CursorItemMap.add(Timestamp(id), next), + }; + } else if (switch (next) { + | Timestamp(n) when id < n => true + | _ => false + }) { + /* INSERT2 */ + _applyOp( + ctx, + {id, deps, cur: Cursor([], Timestamp(id)), mut: Insert(value)}, + ); + } else { + raise(Not_found); + }; + } + | {id: _, deps, cur: Cursor([], k), mut: Delete} => + clearElem(ctx, deps, k) |> fst + | {cur: Cursor([], _), mut: Assign(_), _} => raise(Not_found); + +/* APPLY-LOCAL */ +let apply = (state, op) => { + ...state, + ctx: _applyOp(state.ctx, op), + queue: [op, ...state.queue], + ops: [op.id, ...state.ops], +}; + +let listFindOpt = (f, l) => + switch (List.find(f, l)) { + | a => Some(a) + | exception Not_found => None + }; + +/* APPLY-REMOTE */ +let recv = (state, ops) => { + let opHasFulfilledDeps = (state, op) => + listFindOpt(dep => !List.mem(dep, state.ops), op.deps) == None; + + let state = {...state, recv: state.recv |> List.append(ops)}; + + /* TODO: Throw away + - ops with ids that I already have + - ops with my replicaId + */ + let rec inter = state => { + let maybeOp = + state.recv + |> listFindOpt(op => + !List.mem(op.id, state.ops) && opHasFulfilledDeps(state, op) + ); + + switch (maybeOp) { + | Some(op) => + inter({ + ...state, + ctx: _applyOp(state.ctx, op), + ops: [op.id, ...state.ops], + recv: state.recv |> List.filter(oldOp => oldOp.id != op.id), + }) + | None => state + }; + }; + inter(state); +}; + +/* TODO: Allow getting ops only from certain timestamp */ +let send = state => state.queue; + +let makeOp = (state, cur, mut) => { + /* TODO: do something */ + let p = state.replicaId; + let ctr = + state.ops + |> List.map(((c, _)) => c) + |> List.fold_left( + (max, i) => + if (i > max) { + i; + } else { + max; + }, + 0, + ); + apply(state, {id: (ctr + 1, p), deps: state.ops, cur, mut}); +}; + +let makeAssign = (cur, state, value) => makeOp(state, cur, Assign(value)); +let makeInsert = (cur, state, value) => makeOp(state, cur, Insert(value)); +let makeDelete = (cur, state) => makeOp(state, cur, Delete); + +let make = replicaId => { + replicaId, + queue: [], + ops: [], + ctx: emptyCtx, + recv: [], +}; \ No newline at end of file diff --git a/src/internals/AMPure.rei b/src/internals/AMPure.rei new file mode 100644 index 0000000..bbe91c0 --- /dev/null +++ b/src/internals/AMPure.rei @@ -0,0 +1,107 @@ +type replicaId = string; +type timestamp = (int, replicaId); +let encodeTimestamp: ((int, string)) => string; +module Timestamp: { + type t = timestamp; + let compare: ('a, 'a) => int; +}; +module TimestampMap: { + type key = Timestamp.t; + type t('a) = Map.Make(Timestamp).t('a); + let empty: t('a); + let is_empty: t('a) => bool; + let mem: (key, t('a)) => bool; + let add: (key, 'a, t('a)) => t('a); + let singleton: (key, 'a) => t('a); + let remove: (key, t('a)) => t('a); + let merge: + ((key, option('a), option('b)) => option('c), t('a), t('b)) => t('c); + let compare: (('a, 'a) => int, t('a), t('a)) => int; + let equal: (('a, 'a) => bool, t('a), t('a)) => bool; + let iter: ((key, 'a) => unit, t('a)) => unit; + let fold: ((key, 'a, 'b) => 'b, t('a), 'b) => 'b; + let for_all: ((key, 'a) => bool, t('a)) => bool; + let exists: ((key, 'a) => bool, t('a)) => bool; + let filter: ((key, 'a) => bool, t('a)) => t('a); + let partition: ((key, 'a) => bool, t('a)) => (t('a), t('a)); + let cardinal: t('a) => int; + let bindings: t('a) => list((key, 'a)); + let min_binding: t('a) => (key, 'a); + let max_binding: t('a) => (key, 'a); + let choose: t('a) => (key, 'a); + let split: (key, t('a)) => (t('a), option('a), t('a)); + let find: (key, t('a)) => 'a; + let map: ('a => 'b, t('a)) => t('b); + let mapi: ((key, 'a) => 'b, t('a)) => t('b); +}; +type value = + | String(string) + | Int(int) + | Float(float) + | Bool(bool) + | Null + | EmptyObject + | EmptyArray; +let encodeValue: value => string; +type mut = + | Assign(value) + | Insert(value) + | Delete; +let encodeMut: mut => string; +type cursorItem = + | Doc + | Str(string) + | Head + | Tail + | Timestamp(timestamp); +module CursorItem: { + type t = cursorItem; + let compare: (cursorItem, cursorItem) => int; +}; +module CursorItemMap: { + type key = CursorItem.t; + type t('a) = Map.Make(CursorItem).t('a); + let empty: t('a); + let is_empty: t('a) => bool; + let mem: (key, t('a)) => bool; + let add: (key, 'a, t('a)) => t('a); + let singleton: (key, 'a) => t('a); + let remove: (key, t('a)) => t('a); + let merge: + ((key, option('a), option('b)) => option('c), t('a), t('b)) => t('c); + let compare: (('a, 'a) => int, t('a), t('a)) => int; + let equal: (('a, 'a) => bool, t('a), t('a)) => bool; + let iter: ((key, 'a) => unit, t('a)) => unit; + let fold: ((key, 'a, 'b) => 'b, t('a), 'b) => 'b; + let for_all: ((key, 'a) => bool, t('a)) => bool; + let exists: ((key, 'a) => bool, t('a)) => bool; + let filter: ((key, 'a) => bool, t('a)) => t('a); + let partition: ((key, 'a) => bool, t('a)) => (t('a), t('a)); + let cardinal: t('a) => int; + let bindings: t('a) => list((key, 'a)); + let min_binding: t('a) => (key, 'a); + let max_binding: t('a) => (key, 'a); + let choose: t('a) => (key, 'a); + let split: (key, t('a)) => (t('a), option('a), t('a)); + let find: (key, t('a)) => 'a; + let map: ('a => 'b, t('a)) => t('b); + let mapi: ((key, 'a) => 'b, t('a)) => t('b); +}; +type cursor; +let encodeCursor: cursor => string; +type state; +let encodeState: state => Json.t; +let doc: cursor; +let get: (cursor, string) => cursor; +let idx: (cursor, state, int) => cursor; +let keys: (cursor, state) => list(CursorItemMap.key); +let val_: (cursor, state) => TimestampMap.t(value); +let makeOp: (state, cursor, mut) => state; +let makeAssign: (cursor, state, value) => state; +let makeInsert: (cursor, state, value) => state; +let makeDelete: (cursor, state) => state; +let make: replicaId => state; + +type opSet; +let recv: (state, opSet) => state; +let send: state => opSet; \ No newline at end of file diff --git a/src/internals/MapBenchmark.re b/src/internals/MapBenchmark.re new file mode 100644 index 0000000..07a8ca8 --- /dev/null +++ b/src/internals/MapBenchmark.re @@ -0,0 +1,33 @@ +module StringMap = Map.Make(String); + +let gen_passwd = { + let alphanum = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; + let len = String.length(alphanum); + fun + | n => { + let str = Bytes.create(n); + for (i in 0 to pred(n)) { + Bytes.set(str, i, alphanum.[Random.int(len)]); + }; + Bytes.to_string(str); + }; +}; + +let createTestMap = count => { + let rec createTestMapF = + fun + | (0, result) => result + | (remaining, result) => { + let key = gen_passwd(10); + let value = gen_passwd(20); + createTestMapF((remaining - 1, result |> StringMap.add(key, value))); + }; + createTestMapF((count, StringMap.empty)); +}; + +Js.log("started"); +let x = createTestMap(100000) |> StringMap.add("repesyasdf", "asdf"); +Js.log("created"); +let y = x |> StringMap.add("repes", "asdf"); +Js.log(x == y); +Js.log(x |> StringMap.find("repesyasdf")); \ No newline at end of file diff --git a/src/internals/Test.re b/src/internals/Test.re new file mode 100644 index 0000000..7b31050 --- /dev/null +++ b/src/internals/Test.re @@ -0,0 +1,116 @@ +module Doc = { + [@bs.deriving abstract] + type t = { + _conflicts: Automerge.objectConflicts, + mutable asdf: string, + mutable ufoo: array(int), + }; +}; + +module DocA = Automerge.Make(Doc); + +let d1 = + DocA.( + init(~actorId="aaaaaaaa", ()) + ->change("test", d => { + d->Doc.ufooSet([|42, 20, 11, 19|]); + d->Doc.asdfSet("asdf"); + }) + ); + +let d2a = + DocA.( + init(~actorId="bbbbbbbb", ()) + ->merge(d1) + ->change("get crazy", d => { + d->Doc.asdfSet("paulus"); + d->Doc.ufooGet[2] = 15; + }) + ); + +let d2b = + DocA.( + d1->change("get dizzy", d => { + d->Doc.asdfSet("omangus"); + d->Doc.ufooGet[2] = 9; + }) + ); + +let merged = DocA.merge(d2a, d2b); + +let clockForRemote = d2a->DocA.getClock; +let changesFromRemote = d2b->DocA.getMissingChanges(clockForRemote); +let merged2 = d2a->DocA.applyChanges(changesFromRemote); + +let conflicts = merged->Doc.ufooGet->Automerge.getArrayConflicts; +Js.log(merged); +Js.log("==========="); +Js.log(merged2); +/* Js.log(DocA.getClock(d1)); */ + +/* Js.log( + { + switch (conflicts->Js.Dict.get("asdf")) { + | Some(conf) => + switch (Js.Dict.get(conf, "aaaaaaaa")) { + | Some(valu) => + switch (Js.Json.classify(valu)) { + | Js.Json.JSONString(str) => str + | _ => "omg, not string..." + } + | None => "omg, no aaaaa" + } + | None => "omg, no asdf conflict" + }; + }, + ); */ + +/* DREAM API */ + +type inbound = {guvno: int}; + +type doc = { + a: string, + b: int, + c: inbound, +}; + +type t = {sdf: string}; + +type someType = + | SomeType('t): someType; +type db = {a: int}; +type local = {b: int}; +module StrMap = Map.Make(String); +let mm = + StrMap.( + empty |> add("db", SomeType({a: 1})) |> add("local", SomeType({b: 2})) + ); + +/* ====================================== */ +/* Dream API */ +/* ====================================== */ + +/* AM = Automerge */ +/* type d = AM.init(); + d->AM.change("Something", d => {...d, a: "aval"}); */ + +Js.log("==========="); +let logState = s => { + let reformat: string => string = [%bs.raw + s => "return JSON.stringify(JSON.parse(s), null, 3);" + ]; + Js.log(reformat(Json.stringify(AMPure.encodeState(s)))); +}; + +let s = AMPure.make("RRRR"); +logState(s); +/* let s = AMPure.(doc->makeAssign(s, EmptyArray)); + logState(s); + let s = AMPure.(doc->idx(s, 0)->makeInsert(s, EmptyArray)); + logState(s); */ +let s = AMPure.(doc->makeAssign(s, EmptyObject)); +let s = AMPure.(doc->get("AAA")->makeAssign(s, Int(1111))); +let s = AMPure.(doc->get("BBB")->makeAssign(s, Int(2222))); +let s = AMPure.(doc->get("AAA")->makeDelete(s)); +logState(s); \ No newline at end of file diff --git a/src/internals/immJsRe.re b/src/internals/immJsRe.re new file mode 100644 index 0000000..44dd8d2 --- /dev/null +++ b/src/internals/immJsRe.re @@ -0,0 +1,156 @@ +module OrderedMap = { + type t('key, 'value); + [@bs.send] [@bs.return nullable] + external get : (t('key, 'value), 'key) => option('value) = ""; + [@bs.send] + external set : (t('key, 'value), 'key, 'value) => t('key, 'value) = ""; + [@bs.send] + external filter : + (t('key, 'value), ('value, 'key, t('key, 'value)) => bool) => + t('key, 'value) = + ""; + [@bs.send] + external map : + (t('key, 'value), ('value, 'key, t('key, 'value)) => 'value2) => + t('key, 'value2) = + ""; + [@bs.send] + external forEach : + (t('key, 'value), ('value, 'key, t('key, 'value)) => unit) => unit = + ""; + [@bs.send] + external sort : + (t('key, 'value), ('value, 'value) => int) => t('key, 'value) = + ""; + [@bs.send] external has : (t('key, 'value), 'key) => bool = ""; + [@bs.send] + external reduce : + ( + t('key, 'value), + ('reduction, 'value, 'key, t('key, 'value)) => 'reduction, + 'reduction + ) => + 'reduction = + ""; + [@bs.send] + external every : + (t('key, 'value), ('value, 'key, t('key, 'value)) => bool) => bool = + ""; + [@bs.send] external toArray : t('key, 'value) => array('value) = ""; + [@bs.module "immutable"] + external fromArray : array(('key, 'value)) => t('key, 'value) = + "OrderedMap"; + [@bs.module "immutable"] + external fromDict : Js.Dict.t('value) => t(string, 'value) = "OrderedMap"; + [@bs.module "immutable"] + external empty : unit => t('key, 'value) = "OrderedMap"; + [@bs.send] [@bs.return nullable] + external first : t('key, 'value) => option('value) = ""; + [@bs.send] external count : t('key, 'value) => int = ""; + [@bs.get] external size : t('key, 'value) => int = ""; + [@bs.send] external isEmpty : t('key, 'value) => bool = ""; +}; + +module Set = { + type t('value); + [@bs.send] external includes : (t('value), 'value) => bool = ""; + [@bs.send] external contains : (t('value), 'value) => bool = ""; + [@bs.module "immutable"] + external fromArray : array('value) => t('value) = "Set"; +}; + +module OrderedSet = { + type t('value); + [@bs.send] + external map : + (t('value), ('value, 'value, t('value)) => 'value2) => t('value2) = + ""; + [@bs.module "immutable"] + external fromArray : array('value) => t('value) = "OrderedSet"; + [@bs.send] external toArray : t('value) => array('value) = ""; + [@bs.send] external add : (t('value), 'value) => t('value) = ""; + [@bs.send] external remove : (t('value), 'value) => t('value) = ""; + [@bs.send] external has : (t('value), 'value) => bool = ""; + [@bs.get] external size : t('value) => int = ""; + [@bs.send] external first : t('value) => 'value = ""; +}; + +module List = { + type t('value); + [@bs.send] external filter : (t('value), 'value => bool) => t('value) = ""; + [@bs.send] + external forEach : (t('value), ('value, int, t('value)) => bool) => int = + ""; + [@bs.send] external toArray : t('value) => array('value) = ""; + [@bs.module "immutable"] + external fromArray : array('value) => t('value) = "List"; + [@bs.send] [@bs.return nullable] + external first : t('value) => option('value) = ""; + [@bs.send] external count : t('value) => int = ""; + [@bs.send] external push : (t('value), 'value) => t('value) = ""; + [@bs.send] external isEmpty : t('value) => bool = ""; + [@bs.send] + external map : + (t('value), ('value, int, t('value)) => 'value2) => t('value2) = + ""; +}; + +module Seq = { + type t('value); + [@bs.send] external filter : (t('value), 'value => bool) => t('value) = ""; + [@bs.send] external toArray : t('value) => array('value) = ""; + [@bs.send] external isEmpty : t('value) => bool = ""; + [@bs.send] external count : t('value) => int = ""; + [@bs.send] + external sort : (t('value), ('value, 'value) => int) => t('value) = ""; + [@bs.module "immutable"] + external fromArray : array('value) => t('value) = "Seq"; + [@bs.module "immutable"] + external fromList : List.t('value) => t('value) = "Seq"; + [@bs.send] + external slice : + (t('value), ~begin_: int=?, ~end_: int=?, unit) => t('value) = + ""; + [@bs.send] external join : (t('value), string) => string = ""; + [@bs.send] external take : (t('value), int) => t('value) = ""; + [@bs.send] + external map : + (t('value1), ('value, int, t('value)) => 'value2) => t('value2) = + ""; +}; + +module Map = { + type t('key, 'value); + [@bs.send] + external forEach : + (t('key, 'value), ('value, 'key, t('key, 'value)) => unit) => unit = + ""; + [@bs.send] [@bs.return nullable] + external get : (t('key, 'value), 'key) => option('value) = ""; + [@bs.send] + external filter : + (t('key, 'value), ('value, 'key, t('key, 'value)) => bool) => + t('key, 'value) = + ""; + [@bs.send] + external map : + (t('key, 'value), ('value, 'key, t('key, 'value)) => 'value2) => + t('key, 'value2) = + ""; + [@bs.send] external count : t('key, 'value) => int = ""; + [@bs.get] external size : t('key, 'value) => int = ""; + [@bs.send] + external reduce : + ( + t('key, 'value), + ('reduction, 'value, 'key, t('key, 'value)) => 'reduction, + 'reduction + ) => + 'reduction = + ""; + [@bs.send] + external sort : + (t('key, 'value), ('value, 'value) => int) => t('key, 'value) = + ""; + [@bs.send] external valueSeq : t('key, 'value) => Seq.t('value) = ""; +};