362 lines
10 KiB
OCaml
362 lines
10 KiB
OCaml
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 [] 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 *)
|
|
El.div
|
|
~at:[ class' "new-thread-view" ]
|
|
[ El.div
|
|
~at:[ class' "form-box" ]
|
|
[ h2 "New thread"
|
|
; El.span
|
|
~at:[ class' "new-thread-info" ]
|
|
[ el_txt "Click the map and make a new thread:" ]
|
|
; El.div
|
|
~at:[ class' "new-thread-form-div" ]
|
|
[ Html_form.new_thread_el t_s ]
|
|
]
|
|
]
|
|
in
|
|
let thread_view = Html_thread.f t_s in
|
|
let return_link = El.a ~at:[ href (to_path Home) ] [ el_txt "Return" ] in
|
|
def_visibility_when_page [ New_thread ] `On new_thread_view t_s;
|
|
def_visibility_when_page [ Thread ] `On thread_view t_s;
|
|
def_visibility_when_page [ New_thread ] `On return_link t_s;
|
|
let el =
|
|
El.div ~at:[ class' "home-left" ] [ 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_visibility_when_page [ Home; New_thread; Thread ] `On el t_s;
|
|
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 = [ 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 = [ 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 =
|
|
El.div ~at:[ class' "form-box-list" ] (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 =
|
|
El.div ~at:[ class' "form-box-list" ] (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 ->
|
|
[ Html_util.mk_image ~is_small:true (Avatar (user.user_id, info)) ]
|
|
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);
|
|
let is_error = S.map (fun t -> Option.is_some t.error) t_s in
|
|
def_visibility `On is_error el;
|
|
el
|
|
end
|
|
|
|
module Image_overlay = struct
|
|
let mk opt =
|
|
match opt with
|
|
| None -> []
|
|
| Some img ->
|
|
let el = mk_image ~is_small:false img in
|
|
[ el ]
|
|
|
|
let f t_s =
|
|
let el = El.div ~at:[ class' "image-overlay" ] [] in
|
|
def_visibility `On (S.map (fun t -> Option.is_some t.opened_image) t_s) el;
|
|
Elr.def_children el (S.map (fun t -> mk t.opened_image) t_s);
|
|
(* on overlay click (that should cover whole screen) send action to close overlay *)
|
|
hold_on el Ev.click (fun _ev -> Events.send_action (Image_change None));
|
|
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
|
|
; Image_overlay.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 ]
|