Permalink
Browse files

Merge pull request #588 from zshipko/fix-json-compare

Fix json comparison using Irmin.Type.equal
  • Loading branch information...
samoht committed Nov 8, 2018
2 parents 2ba1ca1 + e3a919a commit ffe7859a15248b03a4b033a8e333e213748b669f
Showing with 42 additions and 15 deletions.
  1. +38 −14 src/irmin/contents.ml
  2. +4 −1 test/irmin/test.ml
View
@@ -16,18 +16,6 @@
open Lwt.Infix
module String = struct
type t = string
let t = Type.string
let merge = Merge.idempotent Type.(option string)
end
module Bytes = struct
type t = bytes
let t = Type.bytes
let merge = Merge.idempotent Type.(option t)
end
let lexeme e x = ignore (Jsonm.encode e (`Lexeme x))
let rec encode_json e = function
@@ -121,7 +109,28 @@ module Json_value = struct
|~ case1 "array" (list ty) (fun arr -> `A arr)
|> sealv)
let t = Type.like' ~cli:(pp, of_string) t
let rec equal a b =
match a, b with
| `Null, `Null -> true
| `Bool a, `Bool b -> Type.(equal bool) a b
| `String a, `String b -> String.equal a b
| `Float a, `Float b -> Type.(equal float) a b
| `A a, `A b ->
(try
List.for_all2 (fun a' b' ->
equal a' b') a b
with Invalid_argument _ -> false)
| `O a, `O b ->
let compare_fst (a, _) (b, _) = compare a b in
(try
List.for_all2 (fun (k, v) (k', v') ->
k = k' && equal v v') (List.sort compare_fst a) (List.sort compare_fst b)
with Invalid_argument _ -> false)
| _, _ ->
false
let t = Type.like' ~equal ~cli:(pp, of_string) t
let rec merge_object ~old x y =
let open Merge.Infix in
@@ -186,8 +195,11 @@ module Json = struct
| Ok _ -> Error (`Msg "Irmin JSON values must be objects")
| Error _ as err -> err
let equal a b =
Json_value.equal (`O a) (`O b)
let t = Type.(list (pair string Json_value.t))
let t = Type.like' ~cli:(pp, of_string) t
let t = Type.like' ~equal ~cli:(pp, of_string) t
let merge =
Merge.(option (alist Type.string Json_value.t (fun _ -> Json_value.merge)))
@@ -241,6 +253,18 @@ module Json_tree(Store: S.STORE with type contents = json) = struct
get_tree tree Store.Key.empty
end
module String = struct
type t = string
let t = Type.string
let merge = Merge.idempotent Type.(option string)
end
module Bytes = struct
type t = bytes
let t = Type.bytes
let merge = Merge.idempotent Type.(option t)
end
module Store
(S: sig
include S.AO
View
@@ -113,7 +113,10 @@ let test_equal () =
Alcotest.(check int) "eq" (T.compare x 1 2) (compare 1 2);
Alcotest.(check int) "eq" (T.compare x 3 1) (compare 3 1);
Alcotest.(check bool) "eq" (T.equal x 3 1) true;
Alcotest.(check bool) "eq" (T.equal x 0 0) false
Alcotest.(check bool) "eq" (T.equal x 0 0) false;
let a = `O ["b", `Float 2.; "c", `A [`String "test"]; "a", `Bool true] in
let b = `O ["a", `Bool true; "b", `Float 2.; "c", `A [`String "test"]] in
Alcotest.(check bool) "json eq" (T.equal Irmin.Contents.Json_value.t a b) true
let suite = [
"type", [

0 comments on commit ffe7859

Please sign in to comment.