Source file profile.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                                          *)
(*                                                                               *)
(*********************************************************************************)

module H = Ldp.Http
module Foaf = Rdf.Foaf
module G = Rdf.Graph
open Lwt.Infix

type profile = G.graph

type workspace = {
  ws_title : string ;
  ws_iri : Iri.t ;
  ws_triples : Rdf.Term.triple list ;
}

module type S =
  sig
    val get_profile : Iri.t -> profile Lwt.t
    val webid : profile -> Iri.t
    val inbox : profile -> Iri.t option
    val workspaces : ?typ:Iri.t -> profile -> workspace list
    val storages : profile -> Iri.t list
    val name : profile -> string
    val pim : profile -> Rdf.Pim.from
    val preferences_ws : profile -> workspace list
    val private_ws : profile -> workspace list
    val public_ws : profile -> workspace list
    val shared_ws : profile -> workspace list
    val master_ws : profile -> workspace list
  end

module Make (H: Ldp.Http.Http) =
  struct
    let primary_topic profile =
      let iri = profile.G.name() in
      match G.iri_objects_of profile
        ~sub: (Rdf.Term.Iri iri)
        ~pred: Foaf.primaryTopic
      with
        [] ->
          Ldp.Types.error
            (Ldp.Types.Missing_pred_iri (iri, Foaf.primaryTopic))
      | webid :: _ ->
          webid

    let webid = primary_topic

    let get_profile iri =
      H.get_rdf_graph iri >>= fun g ->
      let%lwt webid =
        try Lwt.return (primary_topic g)
        with e -> Lwt.fail e
      in
      let f sub acc pred =
        let sub = Rdf.Term.Iri sub in
        let objs = G.iri_objects_of g ~sub ~pred in
        objs @ acc
      in
      let to_load_preds =
        [ Rdf.Owl.sameAs ; Rdf.Rdfs.seeAlso ; Rdf.Pim.preferencesFile ]
      in
      let to_load = List.fold_left (f iri) [] to_load_preds in
      let to_load = List.fold_left (f webid) to_load to_load_preds in
      let load iri =
        let g = Rdf.Graph.open_graph iri in
        try%lwt H.get_rdf_graph ~g iri
        with Ldp.Types.Error e ->
            H.dbg (Ldp.Types.string_of_error e) >>= fun () ->
              Lwt.return g
      in
      let%lwt graphs = Lwt_list.map_p load to_load in
      List.iter (Rdf.Graph.merge g) graphs ;
      Lwt.return g

    let workspaces ?typ profile =
      let webid = primary_topic profile in
      let ws = G.iri_objects_of profile
        ~sub:(Rdf.Term.Iri webid) ~pred: Rdf.Pim.workspace
      in
      let ws =
        match typ with
          None -> ws
        | Some typ ->
            let pred ws =
              profile.G.exists ~sub: (Rdf.Term.Iri ws)
                ~pred:Rdf.Rdf_.type_ ~obj:(Rdf.Term.Iri typ) ()
            in
            List.filter pred ws
      in
      let f acc ws =
        match profile.G.objects_of
          ~sub: (Rdf.Term.Iri ws) ~pred: Rdf.Dc.title
        with
          (Rdf.Term.Literal lit) :: _ ->
            { ws_title = lit.Rdf.Term.lit_value ;
              ws_iri = ws ;
              ws_triples = profile.G.find ~sub: (Rdf.Term.Iri ws) () ;
            } :: acc
        | _ ->
            acc
      in
      List.fold_left f [] ws

    let inbox profile =
      let sub = Rdf.Term.Iri (primary_topic profile) in
      match Rdf.Graph.iri_objects_of profile
        ~sub ~pred: Rdf.Solid.inbox
      with
        [] -> None
      | iri :: _ -> Some iri

    let storages profile =
      let sub = Rdf.Term.Iri (primary_topic profile) in
      Rdf.Graph.iri_objects_of profile
        ~sub ~pred: Rdf.Pim.storage

    let name profile =
      let sub = Rdf.Term.Iri (primary_topic profile) in
      let l = profile.Rdf.Graph.objects_of
        ~sub ~pred: Rdf.Foaf.name
      in
      let rec iter = function
        [] -> Iri.to_string (profile.Rdf.Graph.name())
      | (Rdf.Term.Literal l) :: _ -> l.Rdf.Term.lit_value
      | _ :: q -> iter q
      in
      iter l

    let pim profile =
      let sub = Rdf.Term.Iri (primary_topic profile) in
      new Rdf.Pim.from ~sub profile

    let preferences_ws = workspaces ~typ: Rdf.Pim.c_PreferencesWorkspace
    let private_ws = workspaces ~typ: Rdf.Pim.c_PrivateWorkspace
    let public_ws = workspaces ~typ: Rdf.Pim.c_PublicWorkspace
    let shared_ws  = workspaces ~typ: Rdf.Pim.c_SharedWorkspace
    let master_ws  = workspaces ~typ: Rdf.Pim.c_MasterWorkspace
  end