cleanup user.ml, add plant.ml
This commit is contained in:
parent
ff248feeba
commit
c13b231b9c
6 changed files with 255 additions and 234 deletions
233
src/user.ml
233
src/user.ml
|
|
@ -1,3 +1,5 @@
|
|||
open Db
|
||||
|
||||
type t =
|
||||
{ nick : string
|
||||
; password : string
|
||||
|
|
@ -17,21 +19,6 @@ module Q = struct
|
|||
"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 get_password =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT password FROM user WHERE nick=?;"
|
||||
|
|
@ -73,70 +60,10 @@ module Q = struct
|
|||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"UPDATE user SET avatar=? WHERE nick=?;"
|
||||
|
||||
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_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
|
||||
|
||||
module Db =
|
||||
( val Caqti_blocking.connect (Uri.of_string (Filename.concat "sqlite3://" Db.db))
|
||||
|> Caqti_blocking.or_fail )
|
||||
|
||||
let random_state = Random.State.make_self_init ()
|
||||
|
||||
let () =
|
||||
let tables =
|
||||
[ Q.create_user_table
|
||||
; Q.create_plant_user_table
|
||||
; Q.create_plant_image_table
|
||||
; Q.create_plant_tag_table
|
||||
; Q.create_plant_gps_table
|
||||
]
|
||||
in
|
||||
let tables = [ Q.create_user_table ] in
|
||||
if
|
||||
List.exists Result.is_error
|
||||
(List.map (fun query -> Db.exec query ()) tables)
|
||||
|
|
@ -204,97 +131,6 @@ let register ~email ~nick ~password =
|
|||
| None -> Error "db error" )
|
||||
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
|
||||
|
||||
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_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 list () =
|
||||
let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in
|
||||
match users with
|
||||
|
|
@ -313,7 +149,7 @@ let public_profile request =
|
|||
| Ok user -> (
|
||||
match user with
|
||||
| Some (nick, password, email, (bio, _)) ->
|
||||
let plants = view_user_plant_list nick in
|
||||
let plants = Plant.view_user_plant_list nick in
|
||||
let user_info =
|
||||
Format.sprintf
|
||||
{|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
|
||||
|
|
@ -362,15 +198,6 @@ let get_avatar nick =
|
|||
| None -> Error "db error:" )
|
||||
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
|
||||
|
||||
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 upload_avatar files nick =
|
||||
match files with
|
||||
| [] -> Error "No file provided"
|
||||
|
|
@ -384,55 +211,3 @@ let upload_avatar files nick =
|
|||
| Ok _ -> Ok ()
|
||||
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
|
||||
| _files -> Error "More than one file provided"
|
||||
|
||||
(* 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*)
|
||||
let is_valid_image _content = true
|
||||
|
||||
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 () ) )
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue