open Brr open Note open Note_brr open Types open Client_types open Page open Model open Util open Html_util module Header = struct let mk t_s = let left = El.div ~at:[ class' "nav-left" ] [ mk_page_link Home ] in let right session = let dropmenu user = let class_prefix = "settings" in let label = user.user_nick in let at_title = "Settings" in let mk_content () = [ mk_page_link Profile ; mk_page_link Account ; Html_form.mk_logout () ; mk_page_link About ] in mk_dropdown_menu ~class_prefix ~label ~at_title ~placeholder:true mk_content in let l = match Option.map user_private_to_public session.user_private with | None -> List.map mk_page_link [ About; Register; Login ] | Some u when u.user_is_admin -> [ mk_page_link (Admin (Loading ())); dropmenu u ] | Some u -> [ dropmenu u ] in El.div ~at:[ class' "nav-right" ] l in let children = S.map (fun t -> [ left; right t.session ]) t_s in let el = El.nav ~at:[ id "top" ] [] in Elr.def_children el children; el let f t_s = let header = El.header [ mk t_s ] in header end module Home = struct let left t_s = let new_thread_view = (* TODO try to find better class names *) let new_thread_form_div = El.div ~at:[ class' "new-thread-form-div" ] [ Html_form.new_thread_el t_s ] in El.div ~at:[ class' "new-thread-view" ] [ h2 "New thread" ; El.span ~at:[ class' "new-thread-info" ] [ el_txt "Click the map and make a new thread:" ] ; new_thread_form_div ] in let thread_view = Html_thread.f t_s in let new_thread_link = Html_thread.new_thread_link_el t_s in let return_link = El.a ~at:[ href (to_path Home) ] [ el_txt "Return" ] in let navigation_div = El.div ~at:[ class' "home-left-navigation-div" ] [ new_thread_link; return_link ] in let mode k = S.map (is_page_kind k) t_s in def_on (mode New_thread) new_thread_view; def_off (mode Thread) navigation_div; def_on (mode Thread) thread_view; def_off (mode New_thread) new_thread_link; def_on (mode New_thread) return_link; let el = El.div ~at:[ class' "home-left" ] [ navigation_div; new_thread_view; thread_view ] in el let f t_s = let left_el = left t_s in let right_el = Leaflet_map.f t_s in let el = El.div ~at:[ class' "home-page" ] [ left_el; right_el ] in def_on (S.map (fun t -> is_page_kind Home t || is_page_kind New_thread t || is_page_kind Thread t ) t_s ) el; el end module About = struct let f t_s = let l = [ h1 "TODO about page" ] in let el = mk_page About t_s l in el end module Register = struct let f t_s = let l = [ h1 "Register"; Html_form.mk_register () ] in let el = mk_page Register t_s l in el end module Login = struct let f t_s = let l = [ h1 "Login"; Html_form.mk_login () ] in let el = mk_page Login t_s l in el end module Admin = struct let mk t_s t = match get_user_admin t with | None -> [] | Some _user -> ( match t.page with | Home | New_thread | Thread _ | About | Register | Login | Profile | Account | Delete _ | Report _ | User _ -> [] | Admin (Loading ()) -> loading_el | Admin (Not_found ()) -> not_found_el | Admin (Ready reports) -> let forms = match reports with | [] -> [ el_txt "Report list is empty!~" ; El.br () ; el_txt "good job! ( ๑>ᴗ<๑ )" ] | reports -> (* TODO add reported_post_parent_t_id to report type? *) List.map (fun report -> let post = report.reported_post in let post_view = Html_post.post_view t_s post in let span_info_on_report = let s = Fmt.str "From: %s, Reason: %s" report.reporter_nick report.reason in El.span [ el_txt s ] in let forms = El.div Html_form. [ admin_ignore post.id ; admin_delete post.id ; admin_banish post.poster_id ] in El.div ~at:[ class' "report" ] [ post_view; span_info_on_report; forms ] ) reports in let reports_div = El.div ~at:[ class' "reports-div" ] forms in [ h1 "Administration board"; reports_div ] ) let f t_s = let el = mk_page Admin t_s [] in Elr.def_children el (S.map (mk t_s) t_s); el end module Profile = struct let mk t = match get_user t with | None -> [] | Some user -> let public_profile_link = El.p [ el_txt "Check your " ; mk_page_link ~label:"public profile" (User (Loading user.user_id)) ] in let forms = Html_form.profile user in [ h1 "Profile settings"; public_profile_link ] @ forms let f t_s = let el = mk_page Profile t_s [] in Elr.def_children el (S.map mk t_s); el end module Account = struct let mk t = match get_user_private t with | None -> [] | Some user_private -> let forms = Html_form.account user_private in h1 "Account settings" :: forms let f t_s = let el = mk_page Account t_s [] in Elr.def_children el (S.map mk t_s); el end module User = struct let mk t = match t.page with | Home | New_thread | Thread _ | About | Register | Login | Admin _ | Profile | Account | Delete _ | Report _ -> [] | User (Loading _user_id) -> loading_el | User (Not_found _user_id) -> not_found_el | User (Ready user) -> let bio = El.div [ El.blockquote (Html_util.insert_br user.bio) ] in let img = match user.avatar_info with | None -> [] | Some info -> let alt_at = if String.equal "" info.alt then [] else [ alt info.alt; name info.name; title info.alt ] in let at = [ Fmt.kstr src "/user/%s/avatar" user.user_id ; class' "img-thumbnail" ] @ alt_at in [ El.img ~at () ] in h1 user.user_nick :: bio :: img let f t_s = let el = mk_page User t_s [] in Elr.def_children el (S.map mk t_s); el end module Delete = struct let mk t_s t = match get_user t with | None -> [] | Some user -> ( match t.page with | Home | New_thread | Thread _ | About | Register | Login | Admin _ | Profile | Account | Report _ | User _ -> [] | Delete (Loading _id) -> loading_el | Delete (Not_found _id) -> not_found_el | Delete (Ready post) -> ( match String.equal post.poster_id user.user_id with | false -> (* TODO error can not delete other's posts *) [] | true -> let post_view = Html_post.post_view t_s post in let form = Html_form.delete post in [ post_view; form ] ) ) let f t_s = let el = mk_page Delete t_s [] in Elr.def_children el (S.map (mk t_s) t_s); el end module Report = struct let mk t_s t = match get_user t with | None -> [] | Some _user -> ( match t.page with | Home | New_thread | Thread _ | About | Register | Login | Admin _ | Profile | Account | Delete _ | User _ -> [] | Report (Loading _id) -> loading_el | Report (Not_found _id) -> not_found_el | Report (Ready post) -> let post_view = Html_post.post_view t_s post in let form = Html_form.report post in [ post_view; form ] ) let f t_s = let el = mk_page Report t_s [] in Elr.def_children el (S.map (mk t_s) t_s); el end module Error_popup = struct let mk container_el opt = match opt with | None -> [] | Some error -> let dragzone = let close_btn = El.button ~at:[ class' "close-error-popup-btn" ] [ el_txt "X" ] in hold_on close_btn Ev.click (fun _ev -> Events.send_action Clear_error); El.div ~at:[ class' "error-popup-dragzone" ] [ close_btn ] in Html_form.Dragzone.f ~dragzone container_el; let content = El.div ~at:[ class' "error-popup-content" ] [ El.span [ el_txt (Fmt.str "%a" Client_types.pp_error error) ] ] in [ dragzone; content ] let f t_s = let el = El.div ~at:[ class' "error-popup" ] [] in Elr.def_children el (S.map (fun t -> mk el t.error) t_s); def_off (S.map (fun t -> Option.is_none t.error) t_s) el; el end module Main = struct let f t_s = let l = List.map (fun f -> f t_s) [ Home.f ; About.f ; Register.f ; Login.f ; Admin.f ; Profile.f ; Account.f ; User.f ; Delete.f ; Report.f ; Error_popup.f ] in let main = El.v (str "main") l in main end let def_page_title t_s = let set_title page = let s = match page with | Thread (Loading _) | User (Loading _) -> "loading" | Thread (Not_found _) | User (Not_found _) -> "not found" | Thread (Ready v) -> v.subject | User (Ready u) -> u.user_nick | page -> ( match to_kind page with | New_thread -> "new thread" | kind -> Kind.to_string kind ) in Fmt.str "%s | Geochan" s |> String.capitalize_ascii |> Jstr.v |> Document.set_title G.document in S.map (fun t -> t.page) t_s |> S.changes |> hold_endless set_title; (* init *) let k = (S.value t_s).page in set_title k; () let f t_s = let header_el = Header.f t_s in let main_el = Main.f t_s in def_page_title t_s; [ header_el; main_el ]