swrup/geochan
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

use let* to clean code

Browse source
This commit is contained in:
Swrup 2022-01-12 15:38:30 +01:00
parent d540e25746
commit 8e44a11067
3 changed files with 171 additions and 252 deletions
Download patch file Download diff file Expand all files Collapse all files

182
src/babillard.ml
View file

@ -32,6 +32,19 @@ type post =
| Op of op | Op of op
| Reply of reply | Reply of reply
(* ('a option, string) result *)
let ( let** ) o f =
match o with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok None -> Error (Format.sprintf "db error: value not found")
| Ok (Some x) -> f x
(* ('a, string) result *)
let ( let* ) o f =
match o with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok x -> f x
module Q = struct module Q = struct
let create_post_user_table = let create_post_user_table =
Caqti_request.exec Caqti_type.unit Caqti_request.exec Caqti_type.unit
@ -242,72 +255,20 @@ let parse_comment comment =
(comment, cited_posts) (comment, cited_posts)
let view_post post_id = let view_post post_id =
let res_nick = Db.find Q.get_post_nick post_id in let* nick = Db.find Q.get_post_nick post_id in
let res_comment = Db.find Q.get_post_comment post_id in let* comment = Db.find Q.get_post_comment post_id in
let res_date = Db.find Q.get_post_date post_id in let* date = Db.find Q.get_post_date post_id in
let res_image_name = Db.find_opt Q.get_post_image_name post_id in let* image_name = Db.find_opt Q.get_post_image_name post_id in
let res_tags = let* _tags = Db.fold Q.get_post_tags (fun tag acc -> tag :: acc) post_id [] in
Db.fold Q.get_post_tags (fun tag acc -> tag :: acc) post_id [] let* replies =
in
let res_replies =
Db.fold Q.get_post_replies (fun reply_id acc -> reply_id :: acc) post_id [] Db.fold Q.get_post_replies (fun reply_id acc -> reply_id :: acc) post_id []
in in
(* get more stuff for OP *) (* TODO special stuff for OP
let res_subject = Db.find_opt Q.get_post_subject post_id in let* _subject = Db.find_opt Q.get_post_subject post_id in
let res_latlng = Db.find_opt Q.get_post_gps post_id in let* _latlng = Db.find_opt Q.get_post_gps post_id in
*)
(* TODO clean taht idk urghh.. *)
let res0 =
match List.find_opt Result.is_error [ res_nick; res_comment ] with
| Some (Error e) -> Error e
| Some (Ok _) -> assert false
| None -> Ok ()
in
let res1 =
match List.find_opt Result.is_error [ res_image_name; res_subject ] with
| Some (Error e) -> Error e
| Some (Ok _) -> assert false
| None -> Ok ()
in
let res2 =
match res_latlng with
| Ok _ -> Ok ()
| Error e -> Error e
in
let res3 =
match List.find_opt Result.is_error [ res_tags; res_replies ] with
| Some (Error e) -> Error e
| Some (Ok _) -> assert false
| None -> Ok ()
in
let res4jpp =
match res_date with
| Ok _ -> Ok ()
| Error e -> Error e
in
match List.find_opt Result.is_error [ res0; res1; res2; res3; res4jpp ] with
| Some (Error e) -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| None -> (
match
( res_nick
, res_comment
, res_image_name
, res_date
, res_subject
, res_latlng
, res_tags
, res_replies )
with
| ( Ok nick
, Ok comment
, Ok image_name
, Ok date
, Ok _subject
, Ok _latlng
, Ok _tags
, Ok replies ) ->
let image_view = let image_view =
match image_name with match image_name with
| Some image_name -> | Some image_name ->
@ -348,9 +309,8 @@ let view_post post_id =
</div>|} </div>|}
nick date post_id post_id post_id replies_view nick date post_id post_id post_id replies_view
in in
let post_view =
Ok Format.sprintf
(Format.sprintf
{| {|
<div class="container"> <div class="container">
<div class="post" id="%s"> <div class="post" id="%s">
@ -360,32 +320,22 @@ let view_post post_id =
</div> </div>
</div> </div>
|} |}
post_id post_info_view image_view comment ) post_id post_info_view image_view comment
| _ -> assert false ) in
| _ -> assert false Ok post_view
let view_thread thread_id = let view_thread thread_id =
let res = Db.find_opt Q.is_thread thread_id in let** _ = Db.find_opt Q.is_thread thread_id in
match res with let* thread_posts =
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) Db.fold Q.get_thread_posts (fun post_id acc -> post_id :: acc) thread_id []
| Ok None -> Error "Not a thread"
| Ok (Some _) -> (
let thread_posts =
Db.fold Q.get_thread_posts
(fun post_id acc -> post_id :: acc)
thread_id []
in in
match thread_posts with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok thread_posts -> (
(*order by date *) (*order by date *)
(*TODO do this more clean *) (*TODO do this more clean *)
let dates = let dates =
List.map (fun post_id -> Db.find Q.get_post_date post_id) thread_posts List.map (fun post_id -> Db.find Q.get_post_date post_id) thread_posts
in in
match List.find_opt Result.is_error dates with match List.find_opt Result.is_error dates with
| Some (Error e) -> | Some (Error e) -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Some (Ok _) -> assert false | Some (Ok _) -> assert false
| None -> | None ->
let dates = let dates =
@ -409,7 +359,7 @@ let view_thread thread_id =
| Error _ -> assert false ) | Error _ -> assert false )
(List.filter Result.is_ok view_posts) (List.filter Result.is_ok view_posts)
in in
Ok (String.concat "\n\r" view_posts) ) ) Ok (String.concat "\n\r" view_posts)
let upload_post post = let upload_post post =
let post_id, parent_id, date, nick, comment, image, tags, citations, op_data = let post_id, parent_id, date, nick, comment, image, tags, citations, op_data =
@ -442,18 +392,18 @@ let upload_post post =
} -> } ->
(id, parent_id, date, nick, comment, image, tags, citations, None) (id, parent_id, date, nick, comment, image, tags, citations, None)
in in
let res_post_id = Db.exec Q.upload_post_id (post_id, nick) in let* _res_post_id = Db.exec Q.upload_post_id (post_id, nick) in
let res_comment = Db.exec Q.upload_post_comment (post_id, comment) in let* _res_comment = Db.exec Q.upload_post_comment (post_id, comment) in
let res_date = Db.exec Q.upload_post_date (post_id, date) in let* _res_date = Db.exec Q.upload_post_date (post_id, date) in
let res_thread = Db.exec Q.upload_to_thread (parent_id, post_id) in let* _res_thread = Db.exec Q.upload_to_thread (parent_id, post_id) in
let res_image = let* _res_image =
match image with match image with
| None -> Ok () | None -> Ok ()
| Some (image_name, image_content) -> | Some (image_name, image_content) ->
Db.exec Q.upload_post_image (post_id, image_name, image_content) Db.exec Q.upload_post_image (post_id, image_name, image_content)
in in
let res_parent = Db.exec Q.upload_post_parent (post_id, parent_id) in let* _res_parent = Db.exec Q.upload_post_parent (post_id, parent_id) in
let res_tags = let* _res_tags =
match match
List.find_opt Result.is_error List.find_opt Result.is_error
(List.map (fun tag -> Db.exec Q.upload_post_tag (post_id, tag)) tags) (List.map (fun tag -> Db.exec Q.upload_post_tag (post_id, tag)) tags)
@ -462,7 +412,7 @@ let upload_post post =
| Some _ -> assert false | Some _ -> assert false
| None -> Ok () | None -> Ok ()
in in
let res_citations = let* _res_citations =
match match
List.find_opt Result.is_error List.find_opt Result.is_error
(List.map (List.map
@ -473,36 +423,12 @@ let upload_post post =
| Some _ -> assert false | Some _ -> assert false
| None -> Ok () | None -> Ok ()
in in
let res =
List.find_opt Result.is_error
[ res_post_id
; res_comment
; res_image
; res_tags
; res_date
; res_parent
; res_citations
; res_thread
]
in
match res with
| Some (Error e) ->
(* TODO try to remove post_id from post_user to clean db*)
Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Some _ -> assert false
| None -> (
match op_data with match op_data with
| None -> Ok post_id | None -> Ok post_id
| Some (subject, lng, lat) -> ( | Some (subject, lng, lat) ->
let res_gps = Db.exec Q.upload_post_gps (post_id, lat, lng) in let* _res_gps = Db.exec Q.upload_post_gps (post_id, lat, lng) in
let res_subject = Db.exec Q.upload_post_subject (post_id, subject) in let* _res_subject = Db.exec Q.upload_post_subject (post_id, subject) in
let res = List.find_opt Result.is_error [ res_gps; res_subject ] in Ok post_id
match res with
| Some (Error e) ->
(* TODO try to remove post_id from post_user *)
Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Some _ -> assert false
| None -> Ok post_id ) )
let make_reply ~comment ?image ~tags ~parent_id nick = let make_reply ~comment ?image ~tags ~parent_id nick =
if String.length comment > 10000 then if String.length comment > 10000 then
@ -598,12 +524,9 @@ let make_op ~comment ~image ~tags ~subject ~lat ~lng nick =
(* TODO make this return geojson directly *) (* TODO make this return geojson directly *)
let marker_list () = let marker_list () =
let thread_id_list = let* thread_id_list =
Db.fold Q.list_thread_ids (fun thread_id acc -> thread_id :: acc) () [] Db.fold Q.list_thread_ids (fun thread_id acc -> thread_id :: acc) () []
in in
match thread_id_list with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok thread_id_list ->
let markers_res = let markers_res =
List.map List.map
(fun thread_id -> (fun thread_id ->
@ -616,8 +539,8 @@ let marker_list () =
in in
Ok (lat, lng, content, thread_id) Ok (lat, lng, content, thread_id)
| Ok None -> Error "latlng not found" | Ok None -> Error "latlng not found"
| Error e -> | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
Error (Format.sprintf "db error: %s" (Caqti_error.show e)) ) )
thread_id_list thread_id_list
in in
let markers = let markers =
@ -651,10 +574,5 @@ let marker_to_geojson marker =
(Float.to_string lat) (String.escaped content) thread_id (Float.to_string lat) (String.escaped content) thread_id
let get_post_image post_id = let get_post_image post_id =
let res = Db.find_opt Q.get_post_image_content post_id in let** content = Db.find_opt Q.get_post_image_content post_id in
match res with Ok content
| Ok content -> (
match content with
| Some content -> Ok (Some content)
| None -> Error "Image not found" )
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))

14
src/permap.ml
View file

@ -136,21 +136,15 @@ let plant_image request =
let nb = int_of_string (Dream.param "nb" request) in let nb = int_of_string (Dream.param "nb" request) in
let image = Plant.get_plant_image plant_id nb in let image = Plant.get_plant_image plant_id nb in
match image with match image with
| Ok (Some image) -> | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
Dream.respond ~headers:[ ("Content-Type", "image") ] image | Error _ -> Dream.empty `Not_Found
| Ok None
| Error _ ->
Dream.empty `Not_Found
let post_image request = let post_image request =
let post_id = Dream.param "post_id" request in let post_id = Dream.param "post_id" request in
let image = Babillard.get_post_image post_id in let image = Babillard.get_post_image post_id in
match image with match image with
| Ok (Some image) -> | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
Dream.respond ~headers:[ ("Content-Type", "image") ] image | Error _ -> Dream.empty `Not_Found
| Ok None
| Error _ ->
Dream.empty `Not_Found
let add_plant_get request = let add_plant_get request =
match Dream.session "nick" request with match Dream.session "nick" request with

33
src/plant.ml
View file

@ -1,5 +1,18 @@
open Db open Db
(* ('a option, string) result *)
let ( let** ) o f =
match o with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok None -> Error (Format.sprintf "db error: value not found")
| Ok (Some x) -> f x
(* ('a, string) result *)
let ( let* ) o f =
match o with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok x -> f x
module Q = struct module Q = struct
let create_plant_user_table = let create_plant_user_table =
Caqti_request.exec Caqti_type.unit Caqti_request.exec Caqti_type.unit
@ -118,12 +131,9 @@ let view_plant plant_id =
| Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
let marker_list () = let marker_list () =
let plant_id_list = let* plant_id_list =
Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () [] Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () []
in in
match plant_id_list with
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok plant_id_list ->
let markers_res = let markers_res =
List.map List.map
(fun plant_id -> (fun plant_id ->
@ -132,8 +142,8 @@ let marker_list () =
let content = view_plant plant_id in let content = view_plant plant_id in
Ok (lat, lng, content) Ok (lat, lng, content)
| Ok None -> Error "latlng not found" | Ok None -> Error "latlng not found"
| Error e -> | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
Error (Format.sprintf "db error: %s" (Caqti_error.show e)) ) )
plant_id_list plant_id_list
in in
let markers = let markers =
@ -167,6 +177,7 @@ let marker_to_geojson marker =
(Float.to_string lng) (Float.to_string lng)
(Float.to_string lat) (String.escaped content) (Float.to_string lat) (String.escaped content)
(* TODO return result *)
let view_user_plant_list nick = let view_user_plant_list nick =
let plant_id_list = let plant_id_list =
Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick [] Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick []
@ -178,14 +189,10 @@ let view_user_plant_list nick =
String.concat "\n" plants String.concat "\n" plants
let get_plant_image plant_id nb = let get_plant_image plant_id nb =
let res = Db.find_opt Q.get_plant_image (plant_id, nb) in let** content = Db.find_opt Q.get_plant_image (plant_id, nb) in
match res with Ok content
| Ok content -> (
match content with
| Some content -> Ok (Some content)
| None -> Error "Image not found" )
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
(*TODO split validation and uploading to db like for babillard *)
let add_plant (lat, lng) tags files nick = let add_plant (lat, lng) tags files nick =
if String.length tags > 1000 then if String.length tags > 1000 then
Error "tags too long" Error "tags too long"