little fix
This commit is contained in:
parent
19e4a36c99
commit
31615b8db3
5 changed files with 36 additions and 40 deletions
|
|
@ -29,7 +29,7 @@ let unwrap_list f ids =
|
|||
match res with
|
||||
| None -> Ok (List.map Result.get_ok l)
|
||||
| Some (Ok _) -> assert false
|
||||
| Some (Error e) -> Error e
|
||||
| Some (Error _e as error) -> error
|
||||
|
||||
module Q = struct
|
||||
let create_post_user_table =
|
||||
|
|
@ -48,25 +48,21 @@ module Q = struct
|
|||
(* 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) ON \
|
||||
DELETE CASCADE,\n\
|
||||
\ FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE);"
|
||||
"CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \
|
||||
FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_post_replies_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_replies (post_id TEXT, reply_id TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE,\n\
|
||||
\ FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE \
|
||||
CASCADE);"
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||
FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_post_citations_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_citations (post_id TEXT, cited_id TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE,\n\
|
||||
\ FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE \
|
||||
CASCADE);"
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||
FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_post_date_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
|
|
@ -338,8 +334,10 @@ let upload_post ?image_content post =
|
|||
( Db.exec Q.upload_image_info (id, name, alt)
|
||||
, Db.exec Q.upload_image_content (id, content) ) )
|
||||
in
|
||||
let^ _ = unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags in
|
||||
let^ _ =
|
||||
let^ _unit_list =
|
||||
unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags
|
||||
in
|
||||
let^ _unit_list =
|
||||
unwrap_list
|
||||
(fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id))
|
||||
citations
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ let () =
|
|||
Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON;"
|
||||
in
|
||||
if Result.is_error (Db.exec set_foreign_keys_on ()) then
|
||||
Dream.error (fun log -> log "can't et foreign_keys on")
|
||||
Dream.error (fun log -> log "can't set foreign_keys on")
|
||||
|
||||
(* TODO do image validation: length and MIME types with conan*)
|
||||
(* TODO do the same for text input: check length, forbidden chars and have a forbidden words filter*)
|
||||
|
|
|
|||
30
src/dune
30
src/dune
|
|
@ -4,11 +4,11 @@
|
|||
app
|
||||
babillard
|
||||
babillard_page
|
||||
catalog_page
|
||||
delete_page
|
||||
bindings
|
||||
catalog_page
|
||||
content
|
||||
db
|
||||
delete_page
|
||||
login
|
||||
newthread_page
|
||||
permap
|
||||
|
|
@ -37,6 +37,12 @@
|
|||
(preprocess
|
||||
(pps lwt_ppx)))
|
||||
|
||||
(rule
|
||||
(targets babillard_page.ml)
|
||||
(deps babillard_page.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets catalog_page.ml)
|
||||
(deps catalog_page.eml.html)
|
||||
|
|
@ -50,14 +56,14 @@
|
|||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets template.ml)
|
||||
(deps template.eml.html)
|
||||
(targets login.ml)
|
||||
(deps login.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets login.ml)
|
||||
(deps login.eml.html)
|
||||
(targets newthread_page.ml)
|
||||
(deps newthread_page.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
|
|
@ -68,8 +74,8 @@
|
|||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets babillard_page.ml)
|
||||
(deps babillard_page.eml.html)
|
||||
(targets template.ml)
|
||||
(deps template.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
|
|
@ -79,12 +85,6 @@
|
|||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets newthread_page.ml)
|
||||
(deps newthread_page.eml.html)
|
||||
(action
|
||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||
|
||||
(rule
|
||||
(targets user_profile.ml)
|
||||
(deps user_profile.eml.html)
|
||||
|
|
@ -95,8 +95,8 @@
|
|||
(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_catalog.js)
|
||||
(file content/assets/js/js_newthread.js)
|
||||
(file content/assets/js/js_thread.js))
|
||||
(action
|
||||
|
|
|
|||
|
|
@ -276,6 +276,9 @@ let routes =
|
|||
[ get_ "/" babillard_get
|
||||
; get_ "/about" about
|
||||
; get_ "/assets/**" (Dream.static ~loader:asset_loader "")
|
||||
; get_ "/catalog" catalog
|
||||
; get_ "/delete/:post_id" delete_get
|
||||
; post "/delete/:post_id" delete_post
|
||||
; get_ "/img/:post_id" post_image
|
||||
; get_ "/login" login_get
|
||||
; post "/login" login_post
|
||||
|
|
@ -286,14 +289,11 @@ let routes =
|
|||
; get_ "/post_pic/:post_id" post_image
|
||||
; get_ "/profile" profile_get
|
||||
; post "/profile" profile_post
|
||||
; get_ "/thread/:thread_id" thread_get
|
||||
; post "/thread/:thread_id" reply_post
|
||||
; get_ "/user" user
|
||||
; get_ "/user/:user" user_profile
|
||||
; get_ "/user/:user/avatar" avatar_image
|
||||
; get_ "/thread/:thread_id" thread_get
|
||||
; post "/thread/:thread_id" reply_post
|
||||
; get_ "/catalog" catalog
|
||||
; get_ "/delete/:post_id" delete_get
|
||||
; post "/delete/:post_id" delete_post
|
||||
]
|
||||
@
|
||||
if App.open_registration then
|
||||
|
|
|
|||
|
|
@ -143,12 +143,10 @@ let pp_thread_preview fmt op =
|
|||
let catalog_content () =
|
||||
let^ ids = Db.collect_list Q.get_threads () in
|
||||
let* ops = get_ops ids in
|
||||
let previews = List.map (Format.asprintf "%a" pp_thread_preview) ops in
|
||||
Ok
|
||||
(Format.asprintf "%a"
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space
|
||||
Format.pp_print_string )
|
||||
previews )
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_thread_preview)
|
||||
ops )
|
||||
|
||||
let pp_thread fmt op posts =
|
||||
let thread_data, _post = op in
|
||||
|
|
@ -210,7 +208,7 @@ let get_markers () =
|
|||
Format.asprintf "[%a]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
|
||||
(fun fmt op -> pp_marker fmt op) )
|
||||
pp_marker )
|
||||
ops
|
||||
in
|
||||
Ok markers
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue