Source file types.ml

(*********************************************************************************)
(*                OCaml-LDP                                                      *)
(*                                                                               *)
(*    Copyright (C) 2016-2023 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** *)

open Cohttp


type meta =
  { iri : Iri.t ;
    acl : Iri.t option ;
    meta: Iri.t option ;
    user: string option ;
    websocket: Iri.t option ;
    editable : Code.meth list ;
    exists: bool ;
    info: Response.t * Cohttp_lwt.Body.t ;
  }

let meta ?acl ?meta ?user ?websocket ?(editable=[]) ?(exists=true) resp body iri =
  { iri ; acl ; meta ; user ; websocket ; editable ; exists ; info = (resp, body) }

let string_of_meta m =
  let b = Buffer.create 256 in
  let p = Printf.bprintf b in
  p "meta.iri=%s\n" (Iri.to_string m.iri) ;
  Option.iter (p "meta.acl=%s\n") (Option.map Iri.to_string m.acl);
  Option.iter (p "meta.meta=%s\n") (Option.map Iri.to_string m.meta);
  Option.iter (p "meta.user=%s\n") m.user;
  Option.iter (p "meta.websocket=%s\n") (Option.map Iri.to_string m.websocket);
  Buffer.contents b

type rdf_resource =
  { meta : meta ;
    graph: Rdf.Graph.graph ;
    ct: Ct.t ;
    contents: string ;
  }

type non_rdf_resource =
  { meta : meta ;
    ct: Ct.t ;
    contents: string ;
  }

type resource =
| Container of rdf_resource
| Rdf of rdf_resource
| Non_rdf of non_rdf_resource

let container_children g =
  let sub = Rdf.Term.Iri (g.Rdf.Graph.name()) in
  let pred = Rdf.Ldp.contains in
  Rdf.Graph.iri_objects_of ~sub ~pred g

type error = ..
exception Error of error
let error e = raise (Error e)
let fail e = Lwt.fail (Error e)

let ref_string_of_error = ref (function _ -> "Unknown error")
let string_of_error e = !ref_string_of_error e
let register_string_of_error f =
  let g = !ref_string_of_error in
  ref_string_of_error := f g

let () = Printexc.register_printer
  (function Error e -> Some (string_of_error e) | _ -> None)

let content_type_of_string ?(fail=true) s =
  match Ct.of_string s with
  | Ok ct -> ct
  | Error e ->
      if fail then
        let msg = Ct.string_of_error e in
        failwith msg
      else
        Ct.default

type error +=
| Invalid_method of string
| Missing_pred of Iri.t * Iri.t
| Missing_pred_iri of Iri.t * Iri.t
| Request_error of Iri.t * string
| Parse_error of Iri.t * exn
| Unsupported_format of Iri.t * Ct.mime
| Other of exn

let () = register_string_of_error
  (fun fallback -> function
     | Invalid_method str -> Printf.sprintf "Invalid method %S" str
     | Missing_pred (sub, pred) ->
         Printf.sprintf "%s has no relation with predicate %s"
           (Iri.to_string sub) (Iri.to_string pred)
     | Missing_pred_iri (sub, pred) ->
         Printf.sprintf "%s has no relation to an IRI with predicate %s"
           (Iri.to_string sub) (Iri.to_string pred)
     | Request_error (iri, msg) ->
         Printf.sprintf "%s: %s"
           (Iri.to_string iri) msg
     | Parse_error (iri, exn) ->
         Printf.sprintf "%s: %s"
           (Iri.to_string iri) (Printexc.to_string exn)
     | Unsupported_format (iri, mime) ->
         Printf.sprintf "%s: unsupported format %s"
           (Iri.to_string iri) (Ct.mime_to_string mime)
     | Other e -> Printexc.to_string e
     | e -> fallback e
  )

(*c==v=[String.split_string]=1.2====*)
let split_string ?(keep_empty=false) s chars =
  let len = String.length s in
  let rec iter acc pos =
    if pos >= len then
      match acc with
        "" -> if keep_empty then [""] else []
      | _ -> [acc]
    else
      if List.mem s.[pos] chars then
        match acc with
          "" ->
            if keep_empty then
              "" :: iter "" (pos + 1)
            else
              iter "" (pos + 1)
        | _ -> acc :: (iter "" (pos + 1))
      else
        iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
  in
  iter "" 0
(*/c==v=[String.split_string]=1.2====*)

(*c==v=[String.no_blanks]=1.0====*)
let no_blanks s =
  let len = String.length s in
  let buf = Buffer.create len in
  for i = 0 to len - 1 do
    match s.[i] with
      ' ' | '\n' | '\t' | '\r' -> ()
    | c -> Buffer.add_char buf c
  done;
  Buffer.contents buf
(*/c==v=[String.no_blanks]=1.0====*)

let methods_of_string =
  let f acc m =
    try (Code.method_of_string m) :: acc
    with _ -> acc
  in
  fun str ->
    List.fold_left f [] (split_string str [',';' ';'\t'])