:- module(
  graph_editor,
  [
    new_graph/0,
    delete_graph/1,
    set_graph_name/1,
    list_graphs/0,
    select_graph/1,
    add_vertex/1,
    delete_vertex/1,
    edge/1,
    add_edge/1,
    delete_edge/1,
    list_edges/0,
    list_isolated_vertices/0,
    list_graph_objects/0,
    graph_object/1,
    attribute/1,
    set_attribute/2,
    delete_attribute/2,
    list_attributes/1,
    place/1,
    transition/1,
    get_current_graph/1,
    set_current_graph/1,
    get_graph_name/2,
    get_attribute/2
  ]
).


:- devdoc('\\section{Commands}').


new_graph :-
  biocham_command,
  doc('Creates a new graph.'),
  add_item([kind: graph, key: new_graph, id: Id]),
  set_current_graph(Id).


delete_graph(Name) :-
  biocham_command,
  type(Name, name),
  doc('Deletes a graph.'),
  delete_items([kind: graph, key: Name]).


set_graph_name(Name) :-
  biocham_command,
  type(Name, name),
  doc('Sets the name of the current graph.'),
  get_current_graph(Id),
  replace_item(Id, graph, Name, Name).


list_graphs :-
  biocham_command,
  doc('Lists the graph of the current model.'),
  list_items([kind: graph]).


select_graph(Name) :-
  biocham_command,
  type(Name, name),
  doc('Selects a graph'),
  find_item([kind: graph, key: Name, id: Id]),
  set_current_graph(Id).


add_vertex(NameList) :-
  biocham_command(*),
  type(NameList, '*'(name)),
  doc('Adds new vertices to the current graph.'),
  \+ (
    member(Name, NameList),
    \+ (
      add_vertex(Name, _VertexId)
    )
  ).


delete_vertex(NameList) :-
  biocham_command(*),
  type(NameList, '*'(name)),
  doc('Deletes a set of vertices from the current graph.'),
  get_current_graph(GraphId),
  \+ (
    member(Name, NameList),
    \+ (
      delete_item([parent: GraphId, kind: vertex, key: Name])
    )
  ).


:- grammar(edge).


edge(From -> To) :-
  name(From),
  name(To).


add_edge(EdgeList) :-
  biocham_command(*),
  type(EdgeList, '*'(edge)),
  doc('
    Adds the given set of edges to the current graph.
    The vertices are added if needed.
  '),
  \+ (
    member(Edge, EdgeList),
    \+ (
      add_edge(Edge, _EdgeId)
    )
  ).


delete_edge(EdgeList) :-
  biocham_command(*),
  type(EdgeList, '*'(edge)),
  doc('Deletes a set of edges from the current graph.'),
  get_current_graph(GraphId),
  \+ (
    member(Edge, EdgeList),
    \+ (
      delete_item([parent: GraphId, kind: edge, key: Edge])
    )
  ).


list_edges :-
  biocham_command,
  doc('Lists the edges of the current graph.'),
  get_current_graph(GraphId),
  list_items([parent: GraphId, kind: edge]).


list_isolated_vertices :-
  biocham_command,
  doc('Lists the isolated vertices of the current graph.'),
  get_current_graph(GraphId),
  isolated_vertices(GraphId, VerticeIds),
  list_ids(VerticeIds).


list_graph_objects :-
  biocham_command,
  doc('
    Lists the edges and the isolated vertices of the current graph,
    and their attributes if any.
  '),
  get_current_graph(GraphId),
  all_ids([parent: GraphId, kind: edge], EdgeIds),
  isolated_or_attributed_vertices(GraphId, VerticeIds),
  append(EdgeIds, VerticeIds, AllIds),
  list_ids([recursive, kind: attribute], AllIds).


:- grammar(graph_object).


graph_object(Edge) :-
  edge(Edge).

graph_object(Name) :-
  name(Name).


:- grammar(attribute).


attribute(Key: Value) :-
  name(Key),
  term(Value).

attribute(Name) :-
  name(Name).


set_attribute(GraphObjectSet, Attribute) :-
  biocham_command,
  type(GraphObjectSet, {graph_object}),
  type(Attribute, attribute),
  doc('
    Adds an attribute to every vertex or edge in the given set.
    The vertices and the edges are added if needed.
  '),
  \+ (
    member(GraphObject, GraphObjectSet),
    \+ (
      add_graph_object(GraphObject, Id),
      (
        Attribute = Key: _Value
      ->
        true
      ;
        Key = Attribute
      ),
      (
        item(
          [parent: Id, kind: attribute, key: Key, item: Item, id: AttributeId]
        )
      ->
        (
          Item = Attribute
        ->
          true
        ;
          replace_item(AttributeId, attribute, Key, Attribute)
        )
      ;
        add_item([parent: Id, kind: attribute, key: Key, item: Attribute])
      )
    )
  ).


place(NameList) :-
  biocham_command(*),
  type(NameList, '*'(name)),
  doc('
    Sets that the vertices \\argument{NameList} are places.
  '),
  add_vertex(NameList),
  set_attribute(NameList, kind: place).



transition(NameList) :-
  biocham_command(*),
  type(NameList, '*'(name)),
  doc('
    Sets that the vertices \\argument{NameList} are transitions.
  '),
  add_vertex(NameList),
  set_attribute(NameList, kind: transition).


delete_attribute(GraphObject, Attribute) :-
  biocham_command,
  type(GraphObject, graph_object),
  type(Attribute, name),
  doc('Removes an attribute from \\argument{GraphObject}.'),
  find_graph_object(GraphObject, Id),
  delete_item([parent: Id, kind: attribute, key: Attribute]).


list_attributes(GraphObject) :-
  biocham_command,
  type(GraphObject, graph_object),
  doc('List the attributes of \\argument{GraphObject}.'),
  find_graph_object(GraphObject, Id),
  list_items([parent: Id, kind: attribute]).


:- devdoc('\\section{Public API}').


get_current_graph(Id) :-
  find_item([kind: current_graph, item: Id]).


set_current_graph(Id) :-
  deselect_graph,
  add_item([kind: current_graph, item: Id, id: CurrentGraphId]),
  add_dependency(CurrentGraphId, Id).


get_graph_name(Id, Name) :-
  find_item([id: Id, item: Name]).


get_attribute(Id, Attribute) :-
  integer(Id),
  !,
  (
    Attribute = Key: _Value
  ->
    true
  ;
    Key = Attribute
  ),
  item([parent: Id, kind: attribute, key: Key, item: Attribute]).


get_attribute(GraphObject, Attribute) :-
  find_graph_object(GraphObject, Id),
  get_attribute(Id, Attribute).


:- devdoc('\\section{Private predicates}').


find_vertex(Name, Id) :-
  get_current_graph(GraphId),
  find_item([parent: GraphId, kind: vertex, key: Name, id: Id]).


find_edge(Edge, Id) :-
  get_current_graph(GraphId),
  find_item([parent: GraphId, kind: edge, key: Edge, id: Id]).


find_graph_object(GraphObject, Id) :-
  (
    GraphObject = (_From->_To)
  ->
    find_edge(GraphObject, Id)
  ;
    find_vertex(GraphObject, Id)
  ).


add_graph_object(GraphObject, Id) :-
  (
    GraphObject = (_From->_To)
  ->
    add_edge(GraphObject, Id)
  ;
    add_vertex(GraphObject, Id)
  ).


deselect_graph :-
  delete_items([kind: current_graph]).


isolated_vertices(GraphId, VerticesId) :-
  findall(
    VertexId,
    (
      item([parent: GraphId, kind: vertex, id: VertexId, item: Vertex]),
      \+ item([parent: GraphId, kind: edge, item: (Vertex -> _)]),
      \+ item([parent: GraphId, kind: edge, item: (_ -> Vertex)])
    ),
    VerticesId
  ).

isolated_or_attributed_vertices(GraphId, VerticesId) :-
  findall(
    VertexId,
    (
      item([parent: GraphId, kind: vertex, id: VertexId, item: Vertex]),
      (
        \+ item([parent: GraphId, kind: edge, item: (Vertex -> _)]),
        \+ item([parent: GraphId, kind: edge, item: (_ -> Vertex)])
      ->
        true
      ;
        once(item([parent: VertexId, kind: attribute]))
      )
    ),
    VerticesId
  ).


add_vertex(Name, VertexId) :-
  get_current_graph(GraphId),
  (
    item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
  ->
    true
  ;
    add_item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
  ).


add_edge(Edge, EdgeId) :-
  get_current_graph(GraphId),
  Edge = (From -> To),
  add_vertex(From, FromId),
  add_vertex(To, ToId),
  (
    item([parent: GraphId, kind: edge, key: Edge, id: EdgeId])
  ->
    true
  ;
    add_item([parent: GraphId, kind: edge, key: Edge, id: EdgeId]),
    add_dependency(EdgeId, FromId),
    add_dependency(EdgeId, ToId)
  ).