Commits

Kakadu committed 4c2f7ce

Preparing to neo4j migration

Comments (0)

Files changed (11)

 _deps
 *.swp
 local
+.\#*
 
-PKG core_kernel lwt eliom pgocaml
-PKG eliom.server eliom-base-app
+PKG lwt pgocaml netclient yojson
+PKG eliom.server eliom-base-app eliom
 S .
 B _server
 EXT lwt
 (* Service handler for adding new events.
  * TODO: refactor code to allow editing of events
  *)
-open Printf
 
 {shared{
+open Printf
 open Types
 open Eliom_content.Html5
 open Eliom_content.Html5.F
 }}
 
 {client{
-open Printf
 open Helpers
 open ClientHelpers
 open Ojquery
        Events_db.insert_after ~text ~link ~title ~datetime_str ~parentId)
 
 let add_node_handler userId (eventId: int64) () : _ Lwt.t =
+  (*
   lwt parent_event = Events_db.get_by_id eventId in
   let tlsort = timeline_of_id parent_event.Event.timelineId in
   lwt next_event = Events_db.get_by_pos Int64.(add 1L parent_event.Event.position) tlsort in
     ; form
     ]
   in
-
+  *)
+  let content_div = div [pcdata "not implemented"] in
   Lwt.return (Ukraine_container.page [
     content_div
   ])
 
 let event_of_db o =
   Event.({id      = o#!id;       title=o#!title; text = o#!text; datetime = o#!datetime;
-          position= o#!position; link = o#?link; timelineId = o#!timelineId })
+(*          position= o#!position; *) link = o#?link; timelineId = o#!timelineId })
 
 let event_by_id id : Event.t Lwt.t =
   (*printf "get_event_by_id %Ld\n%!" id;*)
   lwt () = full_transaction_block (fun dbh -> Lwt_Query.query dbh st) in
   Lwt.return true
 
-
+(*
 let event_chain ?(n=3) startId =
   let rec loop dbh n acc nextPos =
     if n=0 then Lwt.return acc else begin
     lwt xs = loop dbh n [startEvent] Int64.(add 1L startEvent.Event.position) in
     Lwt.return @@ List.rev xs
   )
-
+  *)
 
 let by_date tlsort ~yy ~dd ~mm =
   (* FIXME: don't use +1 for day *)
       let position = Int64.of_string _pos in
       let datetime = Types.calendar_of_dbstring _cal in
       (*printf "ID=%Ld, title='%s'\n%!" id title;*)
-      Some Event.({ id; position; title; text; link; datetime; timelineId })
+      Some Event.({ id; (*position;*) title; text; link; datetime; timelineId })
     | _  -> failwith @@ sprintf "Internal error while getting events by date %d/%d/%d" dd mm yy
   )
   )
       let id = Int64.of_string _id in
       let datetime = Types.calendar_of_dbstring _datetime in
       let position = Int64.of_string _pos in
-      Types.Event.({id; datetime; position; text; title; link; timelineId })
+      Types.Event.({id; datetime; (* position; *)  text; title; link; timelineId })
     | xs ->
       List.to_string xs ~f:(function Some x -> "'"^x^"'" | None  -> "NULL") |> print_endline;
       print_endline "===========";
 let string_of_char c = let ans = " " in ans.[0]<-c; ans
 let failwiths fmt = failwith (sprintf fmt)
 
+module Result = Result
+
 module Option = struct
   let map ~f = function Some x -> Some (f x) | None -> None
   let value ~f ~default = function Some x -> f x | None -> default
 
 module List = struct
   include ListLabels
+  module Assoc = struct
+    let find_exn x xs = assoc xs x
+  end
   let hd_exn = function
     | x::_ -> x
     | [] -> failwith "Bad argument of hd_exn"
   include StringLabels
   let split ~on s = Str.(split (regexp @@ string_of_char on) s)
   let split_s ~on s = Str.(split (regexp on) s)
-
+  let rsplit ~by s =
+    try
+      let i = rindex s by in
+      sub s ~pos:(i+1) ~len:(String.length s - i)
+    with Not_found -> s
 end
 
 module Int = struct
+open Neorest
+open Helpers
+open Printf
+
+let ukr_start_node () =
+  let cmd = "match (n{title: 'Crysis starts'}) return id(n);" in
+  let j = to_json @@ post_cypher cmd in
+  (*print_endline @@ Yojson.Safe.to_string j; *)
+  match j with
+  | `Assoc [_; ("data", `List[`List[`Int n]])] -> `Ok n
+  | _ -> `Error "JSON match failure"
+
+
+let event_of_json j date_str  = object
+  method id : int =
+    match List.assoc "self" j with
+    | `String s -> int_of_string @@ String.rsplit s ~by:'/'
+    | _ -> failwith "Wrong json"
+  method json = j
+  method data = List.assoc "data" j
+  method when_ = match List.assoc "data" j with
+    | `Assoc xs -> List.assoc "when" xs |> (function `String s -> s | _ -> assert false)
+    | _ -> assert false
+end
+
+
+let event_by_id id =
+  let cmd = sprintf "START x=node(%Ld) MATCH d<-[:WHEN]-x RETURN d;" id in
+  let ans = post_cypher cmd in
+  ()
+
+
+
-(*
-#require "yojson";;
-#require "netclient";;
-*)
 open Printf
+open Helpers
 open Http_client.Convenience
-open Batteries
+open Result
 
 let http_get  = Http_client.Convenience.http_get
 let http_post = Http_client.Convenience.http_post
   let drop_assoc = function `Assoc xs -> xs | _ -> failwith "Bad argument"
 end
 
-type ('a, 'b) result = [ `OK of 'a | `Error of 'b ]
-let (>>=) x f = match x with
-  | `OK a -> f a
-  | `Error b -> `Error b
-
-let (>>>) x f = match x with `OK a -> `OK (f a) | `Error b -> `Error b
-
 type options = {
   server: string;
   port : int;
 (*
 let () http_verbose ~verbose_request_header:false ~verbose_response_header:false () *)
 
-let make_empty_node () : (_,_) result =
+let make_empty_node () : (_,_) Result.t =
   let url = sprintf "http://%s:%d/db/data/node/" !options.server !options.port in
   let node_properties : (string*string) list = [] in
   let s = (http_post_message url node_properties)#get_resp_body () in
   (match to_json s with
-  | `Assoc xs -> `OK (List.assoc "self" xs)
+  | `Assoc xs -> `OK (List.Assoc.find_exn xs "self")
   | _ -> `Error ()) >>= fun url ->
-   `OK (int_of_string @@ snd @@ String.rsplit (Yojson.Safe.to_string url) ~by:"/"  )
+   `OK (int_of_string @@ String.rsplit (Yojson.Safe.to_string url) ~by:'/'  )
 
 
 
   req#get_resp_body ()
 
 
-let remove_all () : (_,_) result =
+let remove_all () : (_,_) Result.t =
   let good_r = `Assoc [("columns", `List []); ("data", `List [])] in
   let j2 = to_json @@ post_cypher "START r=rel(*)  DELETE r;" in
   let j1 = to_json @@ post_cypher "START n=node(*) DELETE n;" in
 	 set k: TIMELINE_ITEM
 	" id1
   in
-  print_endline (String.nreplace ~str:cmd ~sub:"\n" ~by:" ");
+  print_endline (Str.global_replace (Str.regexp "\n") cmd " ");
   post_cypher cmd
 
-let ukr_start_node () =
-  let cmd = "match (n{title: 'Crysis starts'}) return id(n);" in
-  let j = to_json @@ post_cypher cmd in
-  print_endline @@ Yojson.Safe.to_string j;
-  match j with
-  | `Assoc [_; ("data", `List[`List[`Int n]])] -> `OK n
-  | _ -> `Error "JSON match failure"
-
 
 class node_of_json (j: (string * Yojson.Safe.json) list) = object
   method id : int =
     match List.assoc "self" j with
-    | `String s -> int_of_string @@ snd @@ String.rsplit s ~by:"/"
+    | `String s -> int_of_string @@ String.rsplit s ~by:'/'
     | _ -> failwith "Wrong json"
   method json = j
   method data = List.assoc "data" j
 class date_of_json (j: (string * Yojson.Safe.json) list) = object
   method id : int =
     match List.assoc "self" j with
-    | `String s -> int_of_string @@ snd @@ String.rsplit s ~by:"/"
+    | `String s -> int_of_string @@ String.rsplit s ~by:'/'
     | _ -> failwith "Wrong json"
   method json = j
   method data = List.assoc "data" j
 class question_of_json (j: (string * Yojson.Safe.json) list) = object(self)
   method id : int =
     match List.assoc "self" j with
-    | `String s -> int_of_string @@ snd @@ String.rsplit s ~by:"/"
+    | `String s -> int_of_string @@ String.rsplit s ~by:'/'
     | _ -> failwith "Wrong json"
   method json = j
   method data = List.assoc "data" j
     | _ -> assert false
   method text = self#prop "text"
 end
-
+(*
 let get_start_day () =
   ukr_start_node () >>= fun start_node_id ->
   let cmd = sprintf
   match to_json ans with
   | `Assoc [_; ("data",`List [`List [`Assoc xs]])] -> `OK (new date_of_json xs)
   |  _ -> `Error "JSON match failure"
-
+ *)
 let get_questions nodeid =
   let cmd = sprintf "START x=node(%d)
                      MATCH x-[:HAS_QUESTION]->y RETURN y" nodeid in
+type ('a,'b) t = [ `OK of 'a | `Error of 'b ]
+
+let (>>=) x f = match x with
+  | `OK a -> f a
+  | `Error b -> `Error b
+
+let (>>>) x f = match x with `OK a -> `OK (f a) | `Error b -> `Error b
+
 }}
 
 let tree_view_handler userId startEventId () =
-  lwt nodes = Events_db.event_chain startEventId in
-
+  (*lwt nodes = Events_db.event_chain startEventId in *)
+  (* We disable tree view during migration to Neo4j *)
+  let nodes = [] in
   let cell_width = 230 in
   let make_cell o x y =
     div ~a:[ a_style @@ sprintf "top: %dpx; left: %dpx;" (cell_width*y) (cell_width*x)
   let write b x : unit = Buffer.add_string b (string_of_calendar x)
   let read lexbuf = Deriving_Json_lexer.read_string lexbuf |> calendar_of_string
 end
+
 module Event = struct
   type t =
     { id   : int64
     ; title: string
     ; text : string
     ; link : string option
-    ; position: int64
     ; timelineId : int32
     ; datetime: calendar
     } deriving (Json)
 
 let handler mode (eventId: eventId_t) () =
   let ismoderator = match mode with `Moderator _ -> true | _ -> false in
-  lwt event = Events_db.get_by_id eventId  in
+  lwt event = Events_db.event_by_id eventId in
   let tlsort = timeline_of_id event.Event.timelineId in
   let date = CalendarLib.Calendar.(to_date event.Event.datetime) in
   let dd = CalendarLib.Date.(day_of_month date) in
   lwt events = Events_db.by_date tlsort ~yy ~dd ~mm in
 
   (* next two ids are used to make navigation links (back/forward) *)
+  let nextEventId,prevEventId = None,None in
+  (*
   lwt (nextEventId,prevEventId) =
     match events with
     | [] -> Lwt.return (None,None)
             >|= Helpers.Option.map ~f:(fun x -> x.Event.id)
       in
       Lwt.return (next,prev)
-  in
+    in *)
 
   let comments_holder =
     let node_comments_real_holder =