238 lines
7.5 KiB
OCaml
238 lines
7.5 KiB
OCaml
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")
|
|
|
|
(* TODO make it return a Result? *)
|
|
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
|
|
{|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
|
|
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 =
|
|
if String.length tags > 1000 then
|
|
Error "tags too long"
|
|
else
|
|
let tag_list = Str.split (Str.regexp " +") tags in
|
|
let is_valid_list =
|
|
List.map (fun (_, content) -> is_valid_image content) files
|
|
in
|
|
let is_valid_files = List.for_all (fun valid -> valid) is_valid_list in
|
|
if not is_valid_files then
|
|
Error "Invalid image"
|
|
else
|
|
(* add plant to db *)
|
|
(* make id for plant*)
|
|
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
|
|
match List.find_opt Result.is_error res_tags with
|
|
| Some (Error e) ->
|
|
Error (Format.sprintf "db error: %s" (Caqti_error.show e))
|
|
| Some _ -> assert false
|
|
| None -> (
|
|
(* 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 () ) ) )
|