geochan/src/plant.ml

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
  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
  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)

(* TODO return result *)
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** content = Db.find_opt Q.get_plant_image (plant_id, nb) in
  Ok content

(*TODO split validation and uploading to db like for babillard *)
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 () ) ) )