open Db module Q = struct let create_plant_user_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS plant_user (plant_id TEXT, nick TEXT, \ PRIMARY KEY(plant_id), FOREIGN KEY(nick) REFERENCES user(nick));" let create_plant_image_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS plant_image ( plant_id TEXT, image TEXT,id \ INTEGER, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));" let create_plant_tag_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS plant_tag (plant_id TEXT, tag TEXT, FOREIGN \ KEY(plant_id) REFERENCES plant_user(plant_id));" let create_plant_gps_table = Caqti_request.exec Caqti_type.unit "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat FLOAT,lng \ FLOAT, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));" let upload_plant_id = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO plant_user VALUES (?,?);" let upload_plant_tag = Caqti_request.exec Caqti_type.(tup2 string string) "INSERT INTO plant_tag VALUES (?,?);" let upload_plant_gps = Caqti_request.exec Caqti_type.(tup3 string float float) "INSERT INTO plant_gps VALUES (?,?,?);" let upload_plant_image = Caqti_request.exec Caqti_type.(tup3 string string int) "INSERT INTO plant_image VALUES (?,?,?);" let get_user_plants = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT plant_id FROM plant_user WHERE nick=?;" let list_plant_ids = Caqti_request.collect Caqti_type.unit Caqti_type.string "SELECT plant_id FROM plant_user;" let count_plant_image = Caqti_request.find_opt Caqti_type.string Caqti_type.int "SELECT COUNT(*) FROM plant_image WHERE plant_id=?;" let get_plant_image = Caqti_request.find_opt Caqti_type.(tup2 string int) Caqti_type.string "SELECT image FROM plant_image WHERE plant_id=? AND id=?;" let get_plant_tags = Caqti_request.collect Caqti_type.string Caqti_type.string "SELECT tag FROM plant_tag WHERE plant_id=?;" let get_plant_gps = Caqti_request.find_opt Caqti_type.string Caqti_type.(tup2 float float) "SELECT lat, lng FROM plant_gps WHERE plant_id=?;" end let () = let tables = [ Q.create_plant_user_table ; Q.create_plant_image_table ; Q.create_plant_tag_table ; Q.create_plant_gps_table ] in if List.exists Result.is_error (List.map (fun query -> Db.exec query ()) tables) then Dream.warning (fun log -> log "can't create table") let view_plant plant_id = let count = Db.find_opt Q.count_plant_image plant_id in match count with | Ok count -> ( match count with | Some count -> ( let gps = match Db.find_opt Q.get_plant_gps plant_id with | Ok (Some (lat, lng)) -> Float.to_string lat ^ " " ^ Float.to_string lng | Ok None -> "" | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) in let images = String.concat "\n" (List.map (Format.sprintf {|
  • |} plant_id ) (List.init count (fun i -> i)) ) in let tags = Db.fold Q.get_plant_tags (fun tag acc -> tag :: acc) plant_id [] in match tags with | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) | Ok tags -> let tags = String.concat " " tags in (* TODO add link to gps/map too *) images ^ tags ^ gps ) | None -> "db error" ) | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) let marker_list () = let plant_id_list = Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () [] 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 = List.map (fun plant_id -> match Db.find_opt Q.get_plant_gps plant_id with | Ok (Some (lat, lng)) -> let content = view_plant plant_id in Ok (lat, lng, content) | Ok None -> Error "latlng not found" | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) ) plant_id_list in let markers = List.map (fun res -> match res with | Ok res -> res | Error _ -> assert false ) (List.filter Result.is_ok markers_res) in Ok markers let marker_to_geojson marker = match marker with | lat, lng, content -> Format.sprintf {| { "type": "Feature", "geometry": { "type": "Point", "coordinates": [%s,%s] }, "properties": { "content": "%s" } } |} (*TODO escape in content ?? *) (* geojson use lng lat, and not lat lng*) (Float.to_string lng) (Float.to_string lat) (String.escaped content) let view_user_plant_list nick = let plant_id_list = Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick [] in match plant_id_list with | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) | Ok plant_id_list -> let plants = List.map view_plant plant_id_list in String.concat "\n" plants let get_plant_image plant_id nb = let res = Db.find_opt Q.get_plant_image (plant_id, nb) in match res with | 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)) let add_plant (lat, lng) tags files nick = let tags_len = String.length tags in if tags_len > 1000 then Error "tags too long" else let tag_list = Str.split (Str.regexp " +") tags in (* id for plant*) let ok_list = List.map (fun (_, content) -> is_valid_image content) files in let valid_files = List.for_all (fun valid -> valid) ok_list in if not valid_files then Error "Invalid image" else (* add plant to db *) let plant_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in (* add to plant_id <-> user*) let res_plant = Db.exec Q.upload_plant_id (plant_id, nick) in match res_plant with | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) | Ok _ -> ( (* add to plant_id <-> gps table*) (*TODO check if valid latlng *) let res_gps = Db.exec Q.upload_plant_gps (plant_id, lat, lng) in match res_gps with | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) | Ok _ -> ( (* add to plant_id <-> tag table*) let res_tags = List.map (fun tag -> Db.exec Q.upload_plant_tag (plant_id, tag)) tag_list in if List.exists Result.is_error res_tags then Error (Format.sprintf "db error") else (* add to plant_id <-> image*) let res_images = List.find_opt Result.is_error (List.mapi (fun nb (_, content) -> Db.exec Q.upload_plant_image (plant_id, content, nb) ) files ) in match res_images with | Some (Error e) -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) | Some (Ok _) -> assert false | None -> Ok () ) )