Commits

Kakadu  committed d69e816

fixed getting events for this date

  • Participants
  • Parent commits 131f1ad
  • Branches neo

Comments (0)

Files changed (6)

 
 .PHONY: test.byte test.opt
 test.byte: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(DIST_FILES))
+	@echo "STARTING SERVER"
 	$(OCSIGENSERVER) $(RUN_DEBUG) -c $<
 test.opt: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(patsubst %.cma,%.cmxs, $(DIST_FILES)))
 	$(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c $<
 	$(ELIOMOPT) -shared -linkall -o $@ $(GENERATE_DEBUG) $<
 
 ${ELIOM_SERVER_DIR}/%.cmi: %.mli
-	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 
 ${ELIOM_SERVER_DIR}/%.cmi: %.eliomi
-	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 
 ${ELIOM_SERVER_DIR}/%.cmo: %.ml
-	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 ${ELIOM_SERVER_DIR}/%.cmo: %.eliom
-	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 
 ${ELIOM_SERVER_DIR}/%.cmx: %.ml
-	${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 ${ELIOM_SERVER_DIR}/%.cmx: %.eliom
-	${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
+	${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $(COMP_SWITCHES) $<
 
 
 ##----------------------------------------------------------------------

File Makefile.options

 
 # OCamlfind packages for the server (for modules which defines services)
 SERVER_ELIOM_PACKAGES := eliom-base-app.server
-# OCamlfind packages for the server 
+# OCamlfind packages for the server
 # space separated because this variable will be used to generate ocsigen.conf
 SERVER_PACKAGES := macaque.syntax pgocaml.syntax deriving.syntax netclient yojson
 # OCamlfind packages for the client
 # JavaScript, ocsigenserver
 DEBUG := yes
 
+COMP_SWITCHES=-w +6
 # User to run server with (make run.*)
 WWWUSER := www-data
 WWWGROUP := www-data
 
 // Beginning of Ukranian timeline
 create (_d20140220 :DATE_ITEM {when: '2014-02-20'} )
-  create (_5 :TIMELINE_ITEM :UKRAINE_TL {title:'Crysis starts', time:'20:24:00'})
+  create (_5 :TIMELINE_ITEM :UKRAINE_TL {title:'Crysis starts'})
   create _5-[:WHEN]->_d20140220
-  create (_6 :TIMELINE_ITEM :UKRAINE_TL {title:"Guns on Institutskaya street"})
+  create (_6 :TIMELINE_ITEM :UKRAINE_TL {title:"Guns on Institutskaya street", time:'20:24:00'})
   create _6-[:WHEN]->_d20140220
   // questions
   create (_q0220_1 :QUESTION_ITEM{text: 'Who commanded to open fire?'})<-[:HAS_QUESTION]-_6
 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
   | _ -> `Error "JSON match failure"
 
 
-let event_of_json dj ej =
+let event_of_json ~dj ej =
   let data = List.Assoc.find_exn ej "data" |> YoUtil.drop_assoc in
   let data_date = List.Assoc.find_exn dj "data" |> YoUtil.drop_assoc in
 
     | `String s -> Int64.of_string @@ String.rsplit s ~by:'/'
     | _ -> failwith "Wrong json"
   in
+
   let title = List.Assoc.(find_exn data "title") |> YoUtil.drop_string in
   let text  = List.Assoc.(find     data "text")
               |> Option.map ~f:YoUtil.drop_string |> Option.get ~default:"" in
 let event_by_id id =
   let cmd = sprintf "START x=node(%Ld) MATCH d<-[:WHEN]-x RETURN d,x;" id in
   let j = to_json @@ post_cypher cmd in
-  Yojson.Safe.pretty_to_channel stdout j;
+  (*Yojson.Safe.pretty_to_channel stdout j;*)
   match j with
-  | `Assoc [_;("data",`List [`List [`Assoc ds; `Assoc es]])] -> Lwt.return @@ event_of_json ds es
+  | `Assoc [_;("data",`List [`List [`Assoc dj; `Assoc ej]])] -> Lwt.return @@ event_of_json ~dj ej
   | _ -> failwith "Wrong JSON format"
 
 
   print_endline ans;
   match to_json ans with
   | `Assoc [_;("data",`List [`List [`Assoc dj; `List nodes ]])] ->
-     Lwt.return @@ List.map ~f:(function `Assoc x -> event_of_json dj x | _ -> assert false) nodes
+     Lwt.return @@ List.map ~f:(function `Assoc x -> event_of_json ~dj x | _ -> assert false) nodes
   | _ -> failwith "Wrong JSON format"
 
 let day_by_eventid id =
-  print_endline "day_by_eventid";
-  let cmd = sprintf "START event=node(%Ld) MATCH (d)<-[:WHEN]-(event) MATCH (d)<-[:WHEN]-(l), (d)<-[:WHEN]-(f)
-                     MATCH path=(f)-[:FOLLOWED_BY*0..]->(l)
-                     OPTIONAL MATCH (prevd)<-[:WHEN]-(prev)-[:FOLLOWED_BY]->(f)
-                     OPTIONAL MATCH (l)-[:FOLLOWED_BY]->(next)-[:WHEN]->(nextd)
-                     RETURN d, nodes(path), prev, prevd, next, nextd;" id in
+  let cmd1 = sprintf "
+              START event=node(%Ld)
+              MATCH (curd)<-[:WHEN]-(event)
+              MATCH (curd)<-[:WHEN]-(x)
+              RETURN curd,event,count(x);" id
+  in
+  let ans = post_cypher cmd1 in
+  (*print_endline ans; *)
+  let (dj,cureventj,count) = match to_json ans with
+    | `Assoc [_; ("data", `List[`List[`Assoc dj; `Assoc ej; `Int count]])] -> (dj,ej,count)
+    | _ -> failwith "Wrong JSON format in day_by_eventid.cmd1"
+  in
+  let event = event_of_json ~dj cureventj in
+
+  let wrap_event (x,y) = (*
+    print_endline "wrap_event";
+    print_endline "dj";
+    Yojson.Safe.pretty_to_channel stdout x;
+    print_endline "ej";
+    Yojson.Safe.pretty_to_channel stdout y; *)
+    match (x,y) with
+    | `Assoc dj, `Assoc ej -> Some (event_of_json ~dj ej)
+    | `Null, `Null -> None
+    | _ -> failwith "Wrong JSON format in wrap function"
+  in
+
+  let (prev,next,events) = if count = 1 then begin
+    let cmd2 = sprintf "
+                START e=node(%Ld)
+                OPTIONAL MATCH pday<-[:WHEN]-p -[:FOLLOWED_BY]->e
+                OPTIONAL MATCH nday<-[:WHEN]-n<-[:FOLLOWED_BY]- e
+                RETURN pday, p, nday, n" event.Types.Event.id  in
+    let (p, n) = match to_json @@ post_cypher cmd2 |> YoUtil.unwrap_res with
+    | `List[`List[prevd; prev; nextd; next]] -> ((prevd,prev),(nextd,next))
+    | _ -> failwith "Wrong JSON format in day_by_eventid.cmd1"
+    in
+    (wrap_event p, wrap_event n, [event])
+  end else begin
+    let cmd2 = sprintf "
+START event=node(%Ld)
+MATCH (curd)<-[:WHEN]-(event)
+MATCH (curd)<-[:WHEN]-(l),(curd)<-[:WHEN]-(f), paths=(f)-[:FOLLOWED_BY*0..]->(l)
+WITH MAX(length(paths)) AS maxlen
+WITH last(Collect(maxlen)) AS maxlen WITH last(COLLECT(maxlen)) AS maxlen
+START event=node(%Ld)
+MATCH (curd)<-[:WHEN]-(event)
+MATCH (curd)<-[:WHEN]-(l),(curd)<-[:WHEN]-(f), paths=(f)-[:FOLLOWED_BY*0..]->(l)
+WITH maxlen, FILTER(path IN COLLECT(paths) WHERE length(path)= maxlen)[0] AS longest_path, event AS event
+WITH nodes(longest_path)AS longest_path2
+WITH longest_path2, HEAD(longest_path2) as f, last(longest_path2) as l
+OPTIONAL MATCH (prevd)<-[:WHEN]-(prev)-[:FOLLOWED_BY]->(f)
+OPTIONAL MATCH (l)-[:FOLLOWED_BY]->(next)-[:WHEN]->(nextd)
+RETURN longest_path2,prevd, prev, nextd, next;
+" event.Types.Event.id event.Types.Event.id in
+    let ans = post_cypher cmd2 in
+    let xxx = to_json ans |> YoUtil.unwrap_res in
+    (*print_endline ans;
+    Yojson.Safe.pretty_to_channel stdout xxx;*)
+    let (p,n,path) = match xxx with
+      | `List[`List[`List nodes; pdj; pd; ndj; nd]] -> ((pdj,pd),(ndj,nd),nodes)
+      | _ -> failwith "Wrong JSON format in day_by_eventid.cmd2"
+    in
+    (wrap_event p, wrap_event n, List.map path ~f:(function `Assoc xs -> event_of_json ~dj xs
+                                                          | _ -> failwith "can't construct nodes"))
+  end
+  in
+  (event,events,prev,next)
+(*
   let ans = post_cypher cmd in
   print_endline ans;
   match to_json ans with
-  | `Assoc [_;("data",`List [`List [`Assoc dj; `List nodes; prev; prevd; next; nextd ]])] ->
-    (dj,nodes,prev,next)
-  | _ -> failwith "Wrong JSON format"
+  | `Assoc [_;("data",`List[`List[`Assoc dj; `Assoc cur; `List nodes; prev; prevd; next; nextd ]])] ->
+     let wrap = function
+       | `Assoc p, `Assoc pd -> Some (event_of_json pd p)
+       | `Null, `Null -> None
+       | _ -> failwith "Wrong JSON format in wrap function"
+     in
+    (event_of_json dj cur,
+     List.map ~f:(function `Assoc d -> event_of_json dj d
+                         | _ -> failwith "Wrong JSON format during drop_assoc") nodes,
+     wrap (prev,prevd) ,wrap (next, nextd))
+  | _ -> failwith "Wrong JSON format in day_by_eventid"
 
 
+ *)
 module YoUtil = struct
   let drop_assoc = function `Assoc xs -> xs | _ -> failwith "Bad argument"
   let drop_string = function `String s -> s | _ -> failwith "Bad argument"
+  let unwrap_res x = x |> drop_assoc |> List.assoc "data"
 end
 
 type options = {
                (List.Labels.map params ~f:(fun (name,j) -> (name,Yojson.to_string j))) in
                                           *)
   (*printf "Args: %s\n%!" (Yojson.to_string args);*)
-  print_endline cypher;
+  print_endline @@ Str.global_replace (Str.regexp "\n") " " cypher;
   let req = new Http_client.post_raw url (Yojson.to_string args) in
   (*
   let req = new Http_client.post url
 
 let handler mode (eventId: eventId_t) () =
   let ismoderator = match mode with `Moderator _ -> true | _ -> false in
-  lwt event = Neo_db.event_by_id eventId in
-  print_endline "event is gotten";
+  let (event,events,prevEvent,nextEvent) = Neo_db.day_by_eventid 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
-  let mm = CalendarLib.Date.(int_of_month @@ month date) in
-  let yy = CalendarLib.Date.(year date) in
-  lwt events = Neo_db.by_date tlsort ~yy ~dd ~mm in
-
-  let (_,_,_,_) = Neo_db.day_by_eventid eventId 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)
-    | xs ->
-      let right = List.hd_exn events in (* Right on the top *)
-      lwt next =
-          Events_db.get_by_pos Int64.(add 1L right.Event.position) tlsort
-          >|= Helpers.Option.map ~f:(fun x -> x.Event.id)
-      in
-      (* Left event is drawn on the bottom *)
-      let left  = List.last_exn events in
-      lwt prev =
-        if left.Event.id = timeline_start_event tlsort then Lwt.return None
-        else
-            Events_db.get_by_pos Int64.(sub left.Event.position 1L) tlsort
-            >|= Helpers.Option.map ~f:(fun x -> x.Event.id)
-      in
-      Lwt.return (next,prev)
-    in *)
+  let nextEventId = Helpers.Option.map nextEvent ~f:(fun o -> o.Event.id) in
+  let prevEventId = Helpers.Option.map prevEvent ~f:(fun o -> o.Event.id) in
 
   let comments_holder =
     let node_comments_real_holder =
     let make_tooltips = {Dom_html.event Js.t-> unit{ fun _ ->
         Ojquery.(".need_tooltip" |> js_jQ |> jQelt |> jq_tooltip) }} in
     div ~a:[a_class ["event_buttons_bar"]; a_onload make_tooltips] @@
-    List.filter_map (fun f -> f ())
+    List.filter_map ~f:(fun f -> f ())
       [ begin fun () -> make_btn refresh_event_data_btn_clicked "refresh_event_data_btn" end
       ; begin fun () ->
         if ismoderator && eventId <> 1L
     | `Denied userId  -> handler (`User userId) eventId ()
   in
 
-  Ebapp.App.register Ukraine_services.view_event_service
+  Ebapp.App.register ~service:Ukraine_services.view_event_service
     (Ebapp.Page.how_connected_page ~allow:[Ukraine_groups.moderator_group] ~onerror handler')