change db: merge subject+latlng in thread_info; add catalog; fix get_markers hidding errors
This commit is contained in:
parent
419aaa7955
commit
258175565e
9 changed files with 138 additions and 91 deletions
|
|
@ -29,9 +29,17 @@ module Q = struct
|
|||
"CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, nick TEXT, PRIMARY \
|
||||
KEY(post_id), FOREIGN KEY(nick) REFERENCES user(nick));"
|
||||
|
||||
let create_thread_table =
|
||||
(* one row for each thread, with thread's data *)
|
||||
let create_thread_info_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS threads (thread_id TEXT, post_id TEXT,\n\
|
||||
"CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \
|
||||
lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
|
||||
post_user(post_id));"
|
||||
|
||||
(* map thread and reply to the thread *)
|
||||
let create_thread_post_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT,\n\
|
||||
\ FOREIGN KEY(thread_id) REFERENCES post_user(post_id),\n\
|
||||
\ FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
|
|
@ -67,16 +75,6 @@ module Q = struct
|
|||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT,image_content \
|
||||
TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
let create_post_gps_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_gps (post_id TEXT, lat FLOAT, lng FLOAT ,\n\
|
||||
\ FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
let create_post_subject_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_subject (post_id TEXT, subject TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
|
||||
|
||||
let create_post_tags_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
||||
|
|
@ -87,10 +85,15 @@ module Q = struct
|
|||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO post_user VALUES (?,?);"
|
||||
|
||||
let upload_post_gps =
|
||||
let upload_thread_info =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup3 string float float)
|
||||
"INSERT INTO post_gps VALUES (?,?,?);"
|
||||
Caqti_type.(tup4 string string float float)
|
||||
"INSERT INTO thread_info VALUES (?,?,?,?);"
|
||||
|
||||
let upload_thread_post =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO thread_post VALUES (?,?);"
|
||||
|
||||
let upload_image_info =
|
||||
Caqti_request.exec
|
||||
|
|
@ -112,11 +115,6 @@ module Q = struct
|
|||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO post_comment VALUES (?,?);"
|
||||
|
||||
let upload_post_subject =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO post_subject VALUES (?,?);"
|
||||
|
||||
let upload_post_tag =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
|
|
@ -127,16 +125,6 @@ module Q = struct
|
|||
Caqti_type.(tup2 string int)
|
||||
"INSERT INTO post_date VALUES (?,?);"
|
||||
|
||||
let upload_to_thread =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO threads VALUES (?,?);"
|
||||
|
||||
let upload_post_parent =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO post_parent VALUES (?,?);"
|
||||
|
||||
let get_post_nick =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT nick FROM post_user WHERE post_id=?;"
|
||||
|
|
@ -172,15 +160,15 @@ module Q = struct
|
|||
|
||||
let get_thread_posts =
|
||||
Caqti_request.collect Caqti_type.string Caqti_type.string
|
||||
"SELECT post_id FROM threads WHERE thread_id=?;"
|
||||
"SELECT post_id FROM thread_post WHERE thread_id=?;"
|
||||
|
||||
let count_thread_posts =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.int
|
||||
"SELECT COUNT(post_id) FROM threads WHERE thread_id=?;"
|
||||
"SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?;"
|
||||
|
||||
let get_is_thread =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT thread_id FROM threads WHERE thread_id=? LIMIT 1;"
|
||||
"SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1;"
|
||||
|
||||
let get_is_post =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
|
|
@ -188,34 +176,29 @@ module Q = struct
|
|||
|
||||
let get_post_thread =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT thread_id FROM threads WHERE post_id=? LIMIT 1;"
|
||||
"SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1;"
|
||||
|
||||
let get_post_subject =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT subject FROM post_subject WHERE post_id=?;"
|
||||
|
||||
let get_post_gps =
|
||||
Caqti_request.find_opt Caqti_type.string
|
||||
Caqti_type.(tup2 float float)
|
||||
"SELECT lat, lng FROM post_gps WHERE post_id=?;"
|
||||
let get_thread_info =
|
||||
Caqti_request.find Caqti_type.string
|
||||
Caqti_type.(tup3 string float float)
|
||||
"SELECT subject,lat,lng FROM thread_info WHERE thread_id=?;"
|
||||
|
||||
let get_threads =
|
||||
Caqti_request.collect Caqti_type.unit Caqti_type.string
|
||||
"SELECT thread_id FROM threads;"
|
||||
"SELECT thread_id FROM thread_info;"
|
||||
end
|
||||
|
||||
let () =
|
||||
let tables =
|
||||
[ Q.create_post_user_table
|
||||
; Q.create_thread_table
|
||||
; Q.create_thread_info_table
|
||||
; Q.create_thread_post_table
|
||||
; Q.create_post_replies_table
|
||||
; Q.create_post_citations_table
|
||||
; Q.create_post_date_table
|
||||
; Q.create_post_comment_table
|
||||
; Q.create_image_info_table
|
||||
; Q.create_image_content_table
|
||||
; Q.create_post_gps_table
|
||||
; Q.create_post_subject_table
|
||||
; Q.create_post_tags_table
|
||||
]
|
||||
in
|
||||
|
|
@ -325,7 +308,7 @@ let upload_post ?image_content post =
|
|||
let^ () = Db.exec Q.upload_post_id (id, nick) in
|
||||
let^ () = Db.exec Q.upload_post_comment (id, comment) in
|
||||
let^ () = Db.exec Q.upload_post_date (id, date) in
|
||||
let^ () = Db.exec Q.upload_to_thread (parent_id, id) in
|
||||
let^ () = Db.exec Q.upload_thread_post (parent_id, id) in
|
||||
let _res_image_info, _res_image_content =
|
||||
match image_info with
|
||||
| None -> (Ok (), Ok ())
|
||||
|
|
@ -336,8 +319,6 @@ let upload_post ?image_content post =
|
|||
( Db.exec Q.upload_image_info (id, name, alt)
|
||||
, Db.exec Q.upload_image_content (id, content) ) )
|
||||
in
|
||||
(* what is parent and why do i need it again? TODO TODO *)
|
||||
let^ () = Db.exec Q.upload_post_parent (id, parent_id) in
|
||||
let^ () =
|
||||
match
|
||||
List.find_opt Result.is_error
|
||||
|
|
@ -361,8 +342,7 @@ let upload_post ?image_content post =
|
|||
match thread_data with
|
||||
| None -> Ok id
|
||||
| Some { subject; lng; lat } ->
|
||||
let^ () = Db.exec Q.upload_post_gps (id, lat, lng) in
|
||||
let^ () = Db.exec Q.upload_post_subject (id, subject) in
|
||||
let^ () = Db.exec Q.upload_thread_info (id, subject, lat, lng) in
|
||||
Ok id
|
||||
|
||||
let build_reply ~comment ?image ~tags ?parent_id nick =
|
||||
|
|
|
|||
8
src/catalog_page.eml.html
Normal file
8
src/catalog_page.eml.html
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
let f content =
|
||||
|
||||
<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
|
||||
<h1>Catalog:</h1>
|
||||
<br />
|
||||
<div class="row mb-3">
|
||||
<%s! content %>
|
||||
</div>
|
||||
|
|
@ -1,3 +1,12 @@
|
|||
(rule
|
||||
(target js_catalog.js)
|
||||
(deps
|
||||
(file ../../../js/js_catalog.bc.js))
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{target}
|
||||
(cat ../../../js/js_catalog.bc.js))))
|
||||
|
||||
(rule
|
||||
(target js_babillard.js)
|
||||
(deps
|
||||
|
|
|
|||
8
src/dune
8
src/dune
|
|
@ -4,6 +4,7 @@
|
|||
app
|
||||
babillard
|
||||
babillard_page
|
||||
catalog_page
|
||||
bindings
|
||||
content
|
||||
db
|
||||
|
|
@ -35,6 +36,12 @@
|
|||
(preprocess
|
||||
(pps lwt_ppx)))
|
||||
|
||||
(rule
|
||||
(targets catalog_page.ml)
|
||||
(deps catalog_page.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets template.ml)
|
||||
(deps template.eml.html)
|
||||
|
|
@ -81,6 +88,7 @@
|
|||
(target content.ml)
|
||||
(deps
|
||||
(source_tree content)
|
||||
(file content/assets/js/js_catalog.js)
|
||||
(file content/assets/js/js_babillard.js)
|
||||
(file content/assets/js/js_newthread.js)
|
||||
(file content/assets/js/js_thread.js))
|
||||
|
|
|
|||
|
|
@ -21,6 +21,14 @@
|
|||
(preprocess
|
||||
(pps js_of_ocaml-ppx)))
|
||||
|
||||
(executable
|
||||
(name js_catalog)
|
||||
(modules js_catalog)
|
||||
(libraries js_of_ocaml brr js_pretty_post)
|
||||
(modes js)
|
||||
(preprocess
|
||||
(pps js_of_ocaml-ppx)))
|
||||
|
||||
(executable
|
||||
(name js_babillard)
|
||||
(modules js_babillard)
|
||||
|
|
|
|||
1
src/js/js_catalog.ml
Normal file
1
src/js/js_catalog.ml
Normal file
|
|
@ -0,0 +1 @@
|
|||
include Js_pretty_post
|
||||
|
|
@ -64,6 +64,12 @@ let login_post request =
|
|||
| `Wrong_session _ | `Expired _ | `Wrong_content_type ->
|
||||
Dream.empty `Bad_Request
|
||||
|
||||
let catalog request =
|
||||
let catalog_content =
|
||||
Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.catalog_content ())
|
||||
in
|
||||
render_unsafe (Catalog_page.f catalog_content) request
|
||||
|
||||
let user request =
|
||||
render_unsafe (Result.fold ~ok:Fun.id ~error:Fun.id (User.list ())) request
|
||||
|
||||
|
|
@ -266,6 +272,7 @@ let routes =
|
|||
; get_ "/user/:user/avatar" avatar_image
|
||||
; get_ "/thread/:thread_id" thread_get
|
||||
; post "/thread/:thread_id" reply_post
|
||||
; get_ "/catalog" catalog
|
||||
]
|
||||
@
|
||||
if App.open_registration then
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@ let view_post ?is_thread_preview id =
|
|||
|
||||
let preview_thread thread_id =
|
||||
let* post = view_post ~is_thread_preview:() thread_id in
|
||||
let^? subject = Db.find_opt Q.get_post_subject thread_id in
|
||||
let^? subject, _lat, _lng = Db.find_opt Q.get_thread_info thread_id in
|
||||
let thread_preview =
|
||||
Format.sprintf
|
||||
{|
|
||||
|
|
@ -128,9 +128,23 @@ let preview_thread thread_id =
|
|||
in
|
||||
Ok thread_preview
|
||||
|
||||
let catalog_content () =
|
||||
Format.printf "catalog_content@.";
|
||||
let^ threads = Db.collect_list Q.get_threads () in
|
||||
let res_previews = List.map preview_thread threads in
|
||||
let res_opt = List.find_opt Result.is_error res_previews in
|
||||
if Option.is_some res_opt then Option.get res_opt
|
||||
else
|
||||
let previews = List.map Result.get_ok res_previews in
|
||||
Ok
|
||||
(Format.asprintf "%a"
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space
|
||||
Format.pp_print_string )
|
||||
previews )
|
||||
|
||||
let view_thread thread_id =
|
||||
let^ _is_thread = Db.find Q.get_is_thread thread_id in
|
||||
let^? subject = Db.find_opt Q.get_post_subject thread_id in
|
||||
let^? subject, _lat, _lng = Db.find_opt Q.get_thread_info thread_id in
|
||||
let^ thread_posts = Db.collect_list Q.get_thread_posts thread_id in
|
||||
(*order by date *)
|
||||
let dates = List.map (Db.find Q.get_post_date) thread_posts in
|
||||
|
|
@ -177,19 +191,25 @@ let view_thread thread_id =
|
|||
Ok thread_view )
|
||||
|
||||
let get_markers () =
|
||||
let^ thread_id_list = Db.collect_list Q.get_threads () in
|
||||
let markers_res =
|
||||
List.map
|
||||
(fun thread_id ->
|
||||
let^? lat, lng = Db.find_opt Q.get_post_gps thread_id in
|
||||
match preview_thread thread_id with
|
||||
| Ok content -> Ok (lat, lng, content, thread_id)
|
||||
| Error e -> Error e )
|
||||
thread_id_list
|
||||
in
|
||||
let markers = List.map Result.get_ok (List.filter Result.is_ok markers_res) in
|
||||
let^ threads = Db.collect_list Q.get_threads () in
|
||||
let res_previews = List.map preview_thread threads in
|
||||
let res_infos = List.map (Db.find Q.get_thread_info) threads in
|
||||
|
||||
let pp_marker fmt (lat, lng, content, thread_id) =
|
||||
let res_previews_opt = List.find_opt Result.is_error res_previews in
|
||||
let res_info_opt = List.find_opt Result.is_error res_infos in
|
||||
if Option.is_some res_previews_opt then Option.get res_previews_opt
|
||||
else if Option.is_some res_info_opt then
|
||||
Error
|
||||
(Result.fold
|
||||
~ok:(assert false)
|
||||
~error:Caqti_error.show (Option.get res_info_opt) )
|
||||
else
|
||||
let previews = List.map Result.get_ok res_previews in
|
||||
let infos = List.map Result.get_ok res_infos in
|
||||
let previews_infos = List.combine previews infos in
|
||||
let previews_infos_ids = List.combine previews_infos threads in
|
||||
|
||||
let pp_marker fmt lat lng content thread_id =
|
||||
(* geojson use lng lat, and not lat lng*)
|
||||
let json =
|
||||
`Assoc
|
||||
|
|
@ -201,17 +221,20 @@ let get_markers () =
|
|||
] )
|
||||
; ( "properties"
|
||||
, `Assoc
|
||||
[ ("content", `String content); ("thread_id", `String thread_id) ]
|
||||
)
|
||||
[ ("content", `String content)
|
||||
; ("thread_id", `String thread_id)
|
||||
] )
|
||||
]
|
||||
in
|
||||
Yojson.pretty_print fmt json
|
||||
in
|
||||
|
||||
let markers =
|
||||
Format.asprintf "[%a]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
|
||||
pp_marker )
|
||||
markers
|
||||
(fun fmt ((preview, (_sub, lat, lng)), id) ->
|
||||
pp_marker fmt lat lng preview id ) )
|
||||
previews_infos_ids
|
||||
in
|
||||
Ok markers
|
||||
|
|
|
|||
|
|
@ -21,6 +21,9 @@ let render_unsafe ~title ~content request =
|
|||
<li class="nav-item">
|
||||
<a class="nav-link" href="/">Babillard</a>
|
||||
</li>
|
||||
<li class="nav-item">
|
||||
<a class="nav-link" href="/catalog">Catalog</a>
|
||||
</li>
|
||||
<li class="nav-item">
|
||||
<a class="nav-link" href="/user">Discover users</a>
|
||||
</li>
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue