From a2561981c3d4bc0fe3db5746d6235fdd0d57712e Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Wed, 9 Nov 2016 03:47:25 +0800 Subject: [PATCH 1/7] initial recent activity page --- canopy_article.ml | 9 +++++++++ canopy_dispatch.ml | 12 ++++++++---- canopy_main.ml | 3 ++- canopy_store.ml | 28 ++++++++++++++++++++++++++++ 4 files changed, 47 insertions(+), 5 deletions(-) diff --git a/canopy_article.ml b/canopy_article.ml index 0f8a99f..b9331f6 100644 --- a/canopy_article.ml +++ b/canopy_article.ml @@ -52,6 +52,15 @@ let to_tyxml article = Tyxml.Html.article [Unsafe.data article.content] ]] +let to_tyxml_history cache = + let activity_list = KeyMap.fold (fun k v list -> v :: list) cache [] in + let format_activity activity = + li ~a:[] [pcdata activity] + in + let activity_list_html = List.map format_activity activity_list in + [div + [ul ~a:[] activity_list_html]] + let to_tyxml_listing_entry article = let author = "Written by " ^ article.author in let abstract = match article.abstract with diff --git a/canopy_dispatch.ml b/canopy_dispatch.ml index a260ae8..dd58ae3 100644 --- a/canopy_dispatch.ml +++ b/canopy_dispatch.ml @@ -16,7 +16,7 @@ module Make (S: Cohttp_lwt.Server) = struct let headers = Cohttp.Header.init_with "location" (Uri.to_string uri) in S.respond ~headers ~status:`Moved_permanently ~body:`Empty () - let rec dispatcher headers store atom cache uri etag = + let rec dispatcher headers store atom cache history_cache uri etag = let open Canopy_utils in let respond_not_found () = S.respond_string ~headers ~status:`Not_found ~body:"Not found" () @@ -38,7 +38,7 @@ module Make (S: Cohttp_lwt.Server) = struct match Re_str.split (Re_str.regexp "/") (Uri.pct_decode uri) with | [] -> let index_page = Canopy_config.index_page !cache in - dispatcher headers store atom cache index_page etag + dispatcher headers store atom cache history_cache index_page etag | "atom" :: [] -> atom () >>= fun body -> store.last_commit () >>= fun updated -> @@ -70,6 +70,10 @@ module Make (S: Cohttp_lwt.Server) = struct let title = Canopy_config.blog_name !cache in respond_html ~headers ~title ~content ~updated ) + | "recent_activity" :: [] -> + let content = Canopy_article.to_tyxml_history history_cache in + store.last_commit () >>= fun updated -> + respond_html ~headers ~title:"Recent activity" ~content ~updated | key -> begin match KeyMap.find_opt !cache key with @@ -130,11 +134,11 @@ module Make (S: Cohttp_lwt.Server) = struct moved_permanently redirect >|= fun (res, body) -> log request res ; (res, body)) - | `Dispatch (headers, store, atom, content) -> + | `Dispatch (headers, store, atom, content, history_cache) -> (fun _ request _ -> let uri = Cohttp.Request.uri request in let etag = Cohttp.Header.get Cohttp.Request.(request.headers) "if-none-match" in - dispatcher headers store atom content (Uri.path uri) etag >|= fun (res, body) -> + dispatcher headers store atom content history_cache (Uri.path uri) etag >|= fun (res, body) -> log request res ; (res, body)) in diff --git a/canopy_main.ml b/canopy_main.ml index a15d73b..ce38431 100644 --- a/canopy_main.ml +++ b/canopy_main.ml @@ -48,6 +48,7 @@ module Main (S: STACKV4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) (CLOCK: V Store.pull () >>= fun () -> Store.base_uuid () >>= fun uuid -> Store.fill_cache uuid >>= fun new_cache -> + Store.fill_history_cache () >>= fun history_cache -> let cache = ref (new_cache) in let update_atom, atom = Canopy_syndic.atom uuid Store.last_commit_date cache @@ -64,7 +65,7 @@ module Main (S: STACKV4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) (CLOCK: V last_commit = Store.last_commit_date ; } in update_atom () >>= fun () -> - let disp hdr = `Dispatch (hdr, store_ops, atom, cache) in + let disp hdr = `Dispatch (hdr, store_ops, atom, cache, history_cache) in (match Canopy_config.tls_port () with | Some tls_port -> let redir uri = diff --git a/canopy_store.ml b/canopy_store.ml index a9ee0c1..9c63e13 100644 --- a/canopy_store.ml +++ b/canopy_store.ml @@ -77,6 +77,34 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct in Topological.fold aux history (Lwt.return (commit, commit, None)) + let fill_history_cache () = + new_task () >>= fun t -> + repo () >>= fun repo -> + Store.history (t "Reading history") >>= fun history -> + let fn key value cache = + value () >>= fun value -> + match key_type key with + | `Article -> ( + let uri = String.concat "/" key in + match KeyMap.find_opt cache key with + | None -> + let create_event = Printf.sprintf "Article added: %s" uri in + KeyMap.add key create_event cache |> Lwt.return + | Some old_value -> + if old_value = value then Lwt.return cache + else + let update_event = Printf.sprintf "Article modified: %s" uri in + KeyMap.add key update_event cache |> Lwt.return + ) + | `Static | `Config -> Lwt.return cache + in + let aux commit_id acc = + Store.of_commit_id (Irmin.Task.none) commit_id repo >>= fun store -> + acc >>= fun acc -> + fold (store ()) fn acc + in + Topological.fold aux history (Lwt.return KeyMap.empty) + let date_updated_created key = new_task () >>= fun t -> repo () >>= fun repo -> From a8ad4347090e75bef0fabf8637d3d3456f9752c4 Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Thu, 17 Nov 2016 03:15:33 +0800 Subject: [PATCH 2/7] getting diffs via View.diff for recent_activity page --- canopy_article.ml | 9 ++++----- canopy_content.ml | 12 ++++++++++++ canopy_store.ml | 44 ++++++++++++++++++++++++-------------------- 3 files changed, 40 insertions(+), 25 deletions(-) diff --git a/canopy_article.ml b/canopy_article.ml index b9331f6..2a2e36c 100644 --- a/canopy_article.ml +++ b/canopy_article.ml @@ -52,12 +52,11 @@ let to_tyxml article = Tyxml.Html.article [Unsafe.data article.content] ]] -let to_tyxml_history cache = - let activity_list = KeyMap.fold (fun k v list -> v :: list) cache [] in - let format_activity activity = - li ~a:[] [pcdata activity] +let to_tyxml_history history_cache = + let format_activity history = + li ~a:[] [pcdata history] in - let activity_list_html = List.map format_activity activity_list in + let activity_list_html = List.map format_activity history_cache in [div [ul ~a:[] activity_list_html]] diff --git a/canopy_content.ml b/canopy_content.ml index 45cf386..d59b650 100644 --- a/canopy_content.ml +++ b/canopy_content.ml @@ -8,6 +8,18 @@ type error_t = | Error of string | Ok of content_t +let of_c_history timestamp diffs = + List.map (fun diff -> + let date = match timestamp with + | None -> "" + | Some timestamp -> ptime_to_pretty_date timestamp + in + match diff with + | _, `Added value -> Printf.sprintf "+ : %s %s" value date + | _, `Removed value -> Printf.sprintf "- : %s %s" value date + | _, `Updated (removed, added) -> Printf.sprintf "* : %s and %s %s" removed added date + ) diffs + let meta_assoc str = Re_str.split (Re_str.regexp "\n") str |> List.map (fun meta -> diff --git a/canopy_store.ml b/canopy_store.ml index 9c63e13..4bc8b66 100644 --- a/canopy_store.ml +++ b/canopy_store.ml @@ -2,6 +2,7 @@ open Lwt.Infix open Canopy_config open Canopy_utils + module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct module Hash = Irmin.Hash.SHA1 @@ -9,6 +10,7 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct module Store = Mirage_git_memory(Irmin.Contents.String)(Irmin.Ref.String)(Hash) module Sync = Irmin.Sync(Store) module Topological = Graph.Topological.Make(Store.History) + module View = Irmin.View(Store) let src = Logs.Src.create "canopy-store" ~doc:"Canopy store logger" module Log = (val Logs.src_log src : Logs.LOG) @@ -77,33 +79,35 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct in Topological.fold aux history (Lwt.return (commit, commit, None)) + let set_diffs repo c1 c2 = + let view_of_commit repo commit_id = + Store.of_commit_id task commit_id repo >>= fun t -> + View.of_path (t "view") [] + in + view_of_commit repo c1 >>= fun v1 -> + view_of_commit repo c2 >>= fun v2 -> + View.diff v1 v2 >|= fun diffs -> + diffs + let fill_history_cache () = new_task () >>= fun t -> repo () >>= fun repo -> Store.history (t "Reading history") >>= fun history -> - let fn key value cache = - value () >>= fun value -> - match key_type key with - | `Article -> ( - let uri = String.concat "/" key in - match KeyMap.find_opt cache key with - | None -> - let create_event = Printf.sprintf "Article added: %s" uri in - KeyMap.add key create_event cache |> Lwt.return - | Some old_value -> - if old_value = value then Lwt.return cache - else - let update_event = Printf.sprintf "Article modified: %s" uri in - KeyMap.add key update_event cache |> Lwt.return - ) - | `Static | `Config -> Lwt.return cache - in let aux commit_id acc = - Store.of_commit_id (Irmin.Task.none) commit_id repo >>= fun store -> acc >>= fun acc -> - fold (store ()) fn acc + match acc with + | None, acc_list -> + (Some commit_id, acc_list) |> Lwt.return + | Some prev_commit_id, acc_list -> + Store.Repo.task_of_commit_id repo commit_id >>= fun task -> + let timestamp = Irmin.Task.date task |> Int64.to_float |> Ptime.of_float_s in + set_diffs repo prev_commit_id commit_id >|= fun diffs -> + let c_history = Canopy_content.of_c_history timestamp diffs in + let acc_list = List.append acc_list c_history in + (Some commit_id, acc_list) in - Topological.fold aux history (Lwt.return KeyMap.empty) + Topological.fold aux history (Lwt.return (None, [])) >|= fun (_, diffs) -> + diffs let date_updated_created key = new_task () >>= fun t -> From f4291f7c77c5cff5811f3c970f2978ec4fc1db47 Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Fri, 18 Nov 2016 00:59:58 +0800 Subject: [PATCH 3/7] filter out non-article files in recent activity page content --- canopy_store.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/canopy_store.ml b/canopy_store.ml index 4bc8b66..4e87c77 100644 --- a/canopy_store.ml +++ b/canopy_store.ml @@ -87,7 +87,12 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct view_of_commit repo c1 >>= fun v1 -> view_of_commit repo c2 >>= fun v2 -> View.diff v1 v2 >|= fun diffs -> - diffs + List.filter ( + fun (key, _) -> + match key_type key with + | `Article -> true + | _ -> false + ) diffs let fill_history_cache () = new_task () >>= fun t -> From 5b698bae073b69f927e416cec69ad7e5132bd6dc Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Fri, 18 Nov 2016 01:00:45 +0800 Subject: [PATCH 4/7] use clearer names --- canopy_article.ml | 6 +++--- canopy_content.ml | 17 +++++++++++------ canopy_dispatch.ml | 10 +++++----- canopy_main.ml | 4 ++-- canopy_store.ml | 10 +++++----- 5 files changed, 26 insertions(+), 21 deletions(-) diff --git a/canopy_article.ml b/canopy_article.ml index 2a2e36c..38d2dfd 100644 --- a/canopy_article.ml +++ b/canopy_article.ml @@ -52,12 +52,12 @@ let to_tyxml article = Tyxml.Html.article [Unsafe.data article.content] ]] -let to_tyxml_history history_cache = +let to_tyxml_activity diffs = let format_activity history = li ~a:[] [pcdata history] in - let activity_list_html = List.map format_activity history_cache in - [div + let activity_list_html = List.map format_activity (List.rev diffs) in + [div ~a:[a_class ["post"]] [ul ~a:[] activity_list_html]] let to_tyxml_listing_entry article = diff --git a/canopy_content.ml b/canopy_content.ml index d59b650..c84172a 100644 --- a/canopy_content.ml +++ b/canopy_content.ml @@ -8,17 +8,22 @@ type error_t = | Error of string | Ok of content_t -let of_c_history timestamp diffs = - List.map (fun diff -> +let of_diffs timestamp diffs = + let fn (key, diff) = let date = match timestamp with | None -> "" | Some timestamp -> ptime_to_pretty_date timestamp in + let file = String.concat "/" key in match diff with - | _, `Added value -> Printf.sprintf "+ : %s %s" value date - | _, `Removed value -> Printf.sprintf "- : %s %s" value date - | _, `Updated (removed, added) -> Printf.sprintf "* : %s and %s %s" removed added date - ) diffs + | `Added value -> + Printf.sprintf "Added %s on %s : \n%s" file date value + | `Removed value -> + Printf.sprintf "Removed %s on %s : \n%s" file date value + | `Updated (new_value, old_value) -> + Printf.sprintf "Modified %s on %s : \n%s\n%s" file date new_value old_value + in + List.map fn diffs let meta_assoc str = Re_str.split (Re_str.regexp "\n") str |> diff --git a/canopy_dispatch.ml b/canopy_dispatch.ml index dd58ae3..a60865a 100644 --- a/canopy_dispatch.ml +++ b/canopy_dispatch.ml @@ -16,7 +16,7 @@ module Make (S: Cohttp_lwt.Server) = struct let headers = Cohttp.Header.init_with "location" (Uri.to_string uri) in S.respond ~headers ~status:`Moved_permanently ~body:`Empty () - let rec dispatcher headers store atom cache history_cache uri etag = + let rec dispatcher headers store atom cache diffs uri etag = let open Canopy_utils in let respond_not_found () = S.respond_string ~headers ~status:`Not_found ~body:"Not found" () @@ -38,7 +38,7 @@ module Make (S: Cohttp_lwt.Server) = struct match Re_str.split (Re_str.regexp "/") (Uri.pct_decode uri) with | [] -> let index_page = Canopy_config.index_page !cache in - dispatcher headers store atom cache history_cache index_page etag + dispatcher headers store atom cache diffs index_page etag | "atom" :: [] -> atom () >>= fun body -> store.last_commit () >>= fun updated -> @@ -71,7 +71,7 @@ module Make (S: Cohttp_lwt.Server) = struct respond_html ~headers ~title ~content ~updated ) | "recent_activity" :: [] -> - let content = Canopy_article.to_tyxml_history history_cache in + let content = Canopy_article.to_tyxml_activity diffs in store.last_commit () >>= fun updated -> respond_html ~headers ~title:"Recent activity" ~content ~updated | key -> @@ -134,11 +134,11 @@ module Make (S: Cohttp_lwt.Server) = struct moved_permanently redirect >|= fun (res, body) -> log request res ; (res, body)) - | `Dispatch (headers, store, atom, content, history_cache) -> + | `Dispatch (headers, store, atom, content, diffs) -> (fun _ request _ -> let uri = Cohttp.Request.uri request in let etag = Cohttp.Header.get Cohttp.Request.(request.headers) "if-none-match" in - dispatcher headers store atom content history_cache (Uri.path uri) etag >|= fun (res, body) -> + dispatcher headers store atom content diffs (Uri.path uri) etag >|= fun (res, body) -> log request res ; (res, body)) in diff --git a/canopy_main.ml b/canopy_main.ml index ce38431..b397550 100644 --- a/canopy_main.ml +++ b/canopy_main.ml @@ -48,7 +48,7 @@ module Main (S: STACKV4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) (CLOCK: V Store.pull () >>= fun () -> Store.base_uuid () >>= fun uuid -> Store.fill_cache uuid >>= fun new_cache -> - Store.fill_history_cache () >>= fun history_cache -> + Store.fill_diffs () >>= fun diffs -> let cache = ref (new_cache) in let update_atom, atom = Canopy_syndic.atom uuid Store.last_commit_date cache @@ -65,7 +65,7 @@ module Main (S: STACKV4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) (CLOCK: V last_commit = Store.last_commit_date ; } in update_atom () >>= fun () -> - let disp hdr = `Dispatch (hdr, store_ops, atom, cache, history_cache) in + let disp hdr = `Dispatch (hdr, store_ops, atom, cache, diffs) in (match Canopy_config.tls_port () with | Some tls_port -> let redir uri = diff --git a/canopy_store.ml b/canopy_store.ml index 4e87c77..6d68a88 100644 --- a/canopy_store.ml +++ b/canopy_store.ml @@ -79,7 +79,7 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct in Topological.fold aux history (Lwt.return (commit, commit, None)) - let set_diffs repo c1 c2 = + let get_diffs repo c1 c2 = let view_of_commit repo commit_id = Store.of_commit_id task commit_id repo >>= fun t -> View.of_path (t "view") [] @@ -94,7 +94,7 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct | _ -> false ) diffs - let fill_history_cache () = + let fill_diffs () = new_task () >>= fun t -> repo () >>= fun repo -> Store.history (t "Reading history") >>= fun history -> @@ -106,9 +106,9 @@ module Store (CTX: Irmin_mirage.CONTEXT) (INFL: Git.Inflate.S) = struct | Some prev_commit_id, acc_list -> Store.Repo.task_of_commit_id repo commit_id >>= fun task -> let timestamp = Irmin.Task.date task |> Int64.to_float |> Ptime.of_float_s in - set_diffs repo prev_commit_id commit_id >|= fun diffs -> - let c_history = Canopy_content.of_c_history timestamp diffs in - let acc_list = List.append acc_list c_history in + get_diffs repo prev_commit_id commit_id >|= fun diffs -> + let diffs = Canopy_content.of_diffs timestamp diffs in + let acc_list = List.append acc_list diffs in (Some commit_id, acc_list) in Topological.fold aux history (Lwt.return (None, [])) >|= fun (_, diffs) -> From 9d81e33c79979d621a673803830d16cdb18d11a8 Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Fri, 18 Nov 2016 01:00:59 +0800 Subject: [PATCH 5/7] add recent activity link to navbar --- canopy_templates.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/canopy_templates.ml b/canopy_templates.ml index 65812cd..ce0aebd 100644 --- a/canopy_templates.ml +++ b/canopy_templates.ml @@ -16,13 +16,16 @@ let taglist tags = div ~a:[a_class ["tags"]] ([pcdata "Classified under: "] ++ tags) let links keys = + let recent_activity_link = + li [a ~a:[a_href "/recent_activity"] [span [pcdata "Recent Activity"]]] + in let paths = List.map (function | x::_ -> x | _ -> assert false ) keys |> List.sort_uniq (Pervasives.compare) in let format_link link = li [ a ~a:[a_href ("/" ^ link)] [span [pcdata link]]] in - List.map format_link paths + recent_activity_link :: (List.map format_link paths) let main ~cache ~content ~title ~keys = let links = links keys in From 59bc57a7fa82e18d35eab8ecabfeeafa5803a434 Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Fri, 9 Dec 2016 01:10:20 +0800 Subject: [PATCH 6/7] diffs for updated content in recent activity page --- canopy_article.ml | 16 ++++++-- canopy_content.ml | 99 +++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 108 insertions(+), 7 deletions(-) diff --git a/canopy_article.ml b/canopy_article.ml index 38d2dfd..2983e74 100644 --- a/canopy_article.ml +++ b/canopy_article.ml @@ -53,12 +53,20 @@ let to_tyxml article = ]] let to_tyxml_activity diffs = - let format_activity history = - li ~a:[] [pcdata history] + let format_activity (header, content) = + let paragraphs = + Printf.printf "Content: %s" content; + let lines = Re_str.split (Re_str.regexp "\n") content in + List.map (fun line -> p ~a:[a_class ["line"]] [pcdata line] ) lines + in + div ~a:[a_class ["list-group-item"]] [ + h5 ~a:[a_class ["list-group-item-heading"]] [pcdata header]; + div ~a:[a_class ["list-group-item-text"]] paragraphs + ] in let activity_list_html = List.map format_activity (List.rev diffs) in - [div ~a:[a_class ["post"]] - [ul ~a:[] activity_list_html]] + [div ~a:[a_class ["flex-container"]] + [div ~a:[a_class ["list-group"; "listing"]] activity_list_html]] let to_tyxml_listing_entry article = let author = "Written by " ^ article.author in diff --git a/canopy_content.ml b/canopy_content.ml index c84172a..42dc1a2 100644 --- a/canopy_content.ml +++ b/canopy_content.ml @@ -1,5 +1,6 @@ open Canopy_utils + type content_t = | Markdown of Canopy_article.t @@ -8,6 +9,95 @@ type error_t = | Error of string | Ok of content_t +type diff_lines_t = + | Deleted of string array + | Added of string array + | Equal of string array + + +let rec get_diff old_lines new_lines = + match (old_lines, new_lines) with + | ([||], [||]) -> [] + | _ -> + let old_index_map = Hashtbl.create 3000 in + + for i = 0 to Array.length old_lines - 1 do + let line = old_lines.(i) in + if Hashtbl.mem old_index_map line then + let old_val = Hashtbl.find old_index_map line in + Hashtbl.replace old_index_map line (Array.append old_val [|i|]); + else + Hashtbl.add old_index_map line [|i|]; + done; + + let overlap = ref (Hashtbl.create 0) in + let sub_start_old = ref 0 in + let sub_start_new = ref 0 in + let longest_subsequence = ref 0 in + + for new_index = 0 to Array.length new_lines - 1 do + let new_overlap = Hashtbl.create 3000 in + let indices = try Hashtbl.find old_index_map new_lines.(new_index) with + | Not_found -> [||] + in + for i = 0 to Array.length indices - 1 do + let old_index = indices.(i) in + let new_subsequence = (try Hashtbl.find !overlap (old_index - 1) with + | Not_found -> 0) + 1 + in + Hashtbl.add new_overlap old_index new_subsequence; + + if new_subsequence > !longest_subsequence then + let () = Printf.printf "new_index - %i; old_index - %i; sub_start_new: %i\n" new_index old_index !sub_start_new in + sub_start_old := old_index - new_subsequence + 1; + sub_start_new := new_index - new_subsequence + 1; + longest_subsequence := new_subsequence; + done; + overlap := new_overlap; + done; + + if !longest_subsequence == 0 then + [Deleted old_lines; Added new_lines] + else + let old_lines_length = Array.length old_lines in + let new_lines_length = Array.length new_lines in + let () = Printf.printf "old_lines_length: %i\n" old_lines_length in + let () = Printf.printf "new_lines_length: %i\n" new_lines_length in + Printf.printf "sub_start_old: %i\n" !sub_start_old; + Printf.printf "sub_start_new: %i\n" !sub_start_new; + let old_lines_presubseq = Array.sub old_lines 0 !sub_start_old in + let new_lines_presubseq = Array.sub new_lines 0 !sub_start_new in + Printf.printf "old_subsequence: %i\n" (!sub_start_old + !longest_subsequence); + Printf.printf "new_subsequence: %i\n" (!sub_start_new + !longest_subsequence); + let old_lines_postsubseq = + let starting_index = !sub_start_old + !longest_subsequence in + Array.sub old_lines starting_index (old_lines_length - starting_index) + in + Printf.printf "new_lines\n"; + let new_lines_postsubseq = + let starting_index = !sub_start_new + !longest_subsequence in + Array.sub new_lines starting_index (new_lines_length - starting_index) + in + let unchanged_lines = Array.sub new_lines !sub_start_new !longest_subsequence in + get_diff old_lines_presubseq new_lines_presubseq @ + [Equal unchanged_lines] @ + get_diff old_lines_postsubseq new_lines_postsubseq + + +let string_of_diff diffs = + let concat symbol lines = + let lines = List.map (fun line -> symbol ^ " " ^ line) (Array.to_list lines) in + String.concat "\n" lines + in + let stringify str diff = + match diff with + | Added lines -> str ^ concat "+" lines + | Deleted lines -> str ^ concat "-" lines + | Equal lines -> str + in + List.fold_left stringify "" diffs + + let of_diffs timestamp diffs = let fn (key, diff) = let date = match timestamp with @@ -17,11 +107,14 @@ let of_diffs timestamp diffs = let file = String.concat "/" key in match diff with | `Added value -> - Printf.sprintf "Added %s on %s : \n%s" file date value + (Printf.sprintf "%s : created (%s)" file date), value | `Removed value -> - Printf.sprintf "Removed %s on %s : \n%s" file date value + (Printf.sprintf "%s : deleted (%s)" file date), value | `Updated (new_value, old_value) -> - Printf.sprintf "Modified %s on %s : \n%s\n%s" file date new_value old_value + let new_lines = Re_str.split (Re_str.regexp "\n") new_value |> Array.of_list in + let old_lines = Re_str.split (Re_str.regexp "\n") old_value |> Array.of_list in + let content = get_diff old_lines new_lines |> string_of_diff in + (Printf.sprintf "%s : edited (%s)" file date), content in List.map fn diffs From bf02e64b188cdf4b439076eeb11d107e490f9081 Mon Sep 17 00:00:00 2001 From: Gabriel Jaldon Date: Mon, 6 Mar 2017 17:01:07 +0800 Subject: [PATCH 7/7] Use simplediff pkg for diffing --- canopy_content.ml | 87 ++++++----------------------------------------- config.ml | 4 ++- 2 files changed, 13 insertions(+), 78 deletions(-) diff --git a/canopy_content.ml b/canopy_content.ml index 42dc1a2..e40efc4 100644 --- a/canopy_content.ml +++ b/canopy_content.ml @@ -9,80 +9,8 @@ type error_t = | Error of string | Ok of content_t -type diff_lines_t = - | Deleted of string array - | Added of string array - | Equal of string array - - -let rec get_diff old_lines new_lines = - match (old_lines, new_lines) with - | ([||], [||]) -> [] - | _ -> - let old_index_map = Hashtbl.create 3000 in - - for i = 0 to Array.length old_lines - 1 do - let line = old_lines.(i) in - if Hashtbl.mem old_index_map line then - let old_val = Hashtbl.find old_index_map line in - Hashtbl.replace old_index_map line (Array.append old_val [|i|]); - else - Hashtbl.add old_index_map line [|i|]; - done; - - let overlap = ref (Hashtbl.create 0) in - let sub_start_old = ref 0 in - let sub_start_new = ref 0 in - let longest_subsequence = ref 0 in - - for new_index = 0 to Array.length new_lines - 1 do - let new_overlap = Hashtbl.create 3000 in - let indices = try Hashtbl.find old_index_map new_lines.(new_index) with - | Not_found -> [||] - in - for i = 0 to Array.length indices - 1 do - let old_index = indices.(i) in - let new_subsequence = (try Hashtbl.find !overlap (old_index - 1) with - | Not_found -> 0) + 1 - in - Hashtbl.add new_overlap old_index new_subsequence; - - if new_subsequence > !longest_subsequence then - let () = Printf.printf "new_index - %i; old_index - %i; sub_start_new: %i\n" new_index old_index !sub_start_new in - sub_start_old := old_index - new_subsequence + 1; - sub_start_new := new_index - new_subsequence + 1; - longest_subsequence := new_subsequence; - done; - overlap := new_overlap; - done; - - if !longest_subsequence == 0 then - [Deleted old_lines; Added new_lines] - else - let old_lines_length = Array.length old_lines in - let new_lines_length = Array.length new_lines in - let () = Printf.printf "old_lines_length: %i\n" old_lines_length in - let () = Printf.printf "new_lines_length: %i\n" new_lines_length in - Printf.printf "sub_start_old: %i\n" !sub_start_old; - Printf.printf "sub_start_new: %i\n" !sub_start_new; - let old_lines_presubseq = Array.sub old_lines 0 !sub_start_old in - let new_lines_presubseq = Array.sub new_lines 0 !sub_start_new in - Printf.printf "old_subsequence: %i\n" (!sub_start_old + !longest_subsequence); - Printf.printf "new_subsequence: %i\n" (!sub_start_new + !longest_subsequence); - let old_lines_postsubseq = - let starting_index = !sub_start_old + !longest_subsequence in - Array.sub old_lines starting_index (old_lines_length - starting_index) - in - Printf.printf "new_lines\n"; - let new_lines_postsubseq = - let starting_index = !sub_start_new + !longest_subsequence in - Array.sub new_lines starting_index (new_lines_length - starting_index) - in - let unchanged_lines = Array.sub new_lines !sub_start_new !longest_subsequence in - get_diff old_lines_presubseq new_lines_presubseq @ - [Equal unchanged_lines] @ - get_diff old_lines_postsubseq new_lines_postsubseq +module Canopy_diff = Simple_diff.Make(String) let string_of_diff diffs = let concat symbol lines = @@ -90,10 +18,11 @@ let string_of_diff diffs = String.concat "\n" lines in let stringify str diff = + let open Canopy_diff in match diff with | Added lines -> str ^ concat "+" lines - | Deleted lines -> str ^ concat "-" lines - | Equal lines -> str + | Deleted lines -> str ^ concat "-" lines + | Equal lines -> str in List.fold_left stringify "" diffs @@ -110,10 +39,14 @@ let of_diffs timestamp diffs = (Printf.sprintf "%s : created (%s)" file date), value | `Removed value -> (Printf.sprintf "%s : deleted (%s)" file date), value - | `Updated (new_value, old_value) -> + | `Updated (old_value, new_value) -> + Printf.printf "Date: %s\n" date; + Printf.printf "File: %s\n" file; + Printf.printf "Old_value: \n%s\n" old_value; + Printf.printf "New_value: \n%s\n" new_value; let new_lines = Re_str.split (Re_str.regexp "\n") new_value |> Array.of_list in let old_lines = Re_str.split (Re_str.regexp "\n") old_value |> Array.of_list in - let content = get_diff old_lines new_lines |> string_of_diff in + let content = Canopy_diff.get_diff old_lines new_lines |> string_of_diff in (Printf.sprintf "%s : edited (%s)" file date), content in List.map fn diffs diff --git a/config.ml b/config.ml index 63596b8..00abf77 100644 --- a/config.ml +++ b/config.ml @@ -35,6 +35,7 @@ let libraries = [ "syndic"; "uuidm"; "logs"; + "simple-diff" ] let packages = [ @@ -54,7 +55,8 @@ let packages = [ "syndic"; "magic-mime"; "uuidm"; - "logs" + "logs"; + "simple-diff" ]