rewrite attribute interface

cbits/bytestring.c

+#include "bytestring.h"
+#include <assert.h>
+#include <string.h>
+
+int bsvector_init(bsvector_t *sv, long int len) {
+  long int i;
+  sv->data=igraph_Calloc(len, bytestring_t*);
+  if (sv->data==0) {
+    IGRAPH_ERROR("bsvector init failed", IGRAPH_ENOMEM);
+  }
+  for (i=0; i<len; i++) {
+    sv->data[i]=new_bytestring(0);
+    if (sv->data[i]==0) {
+      bsvector_destroy(sv);
+      IGRAPH_ERROR("bsvector init failed", IGRAPH_ENOMEM);
+    }
+  }
+  sv->len=len;
+
+  return 0;
+}
+
+void bsvector_destroy(bsvector_t *sv) {
+  long int i;
+  assert(sv != 0);
+  if (sv->data != 0) {
+    for (i=0; i<sv->len; i++) {
+      if (sv->data[i] != 0) {
+        destroy_bytestring(sv->data[i]);
+      }
+    }
+    igraph_Free(sv->data);
+  }
+}
+
+void bsvector_get(const bsvector_t *sv, long int idx, bytestring_t **value) {
+  assert(sv != 0);
+  assert(sv->data != 0);
+  assert(sv->data[idx] != 0);
+  *value = sv->data[idx];
+}
+
+int bsvector_set(bsvector_t *sv, long int idx, const bytestring_t *value) {
+  assert(sv != 0);
+  assert(sv->data != 0);
+
+  if (sv->data[idx] != 0) {
+    //destroy_bytestring(sv->data[idx]);
+  }
+  sv->data[idx] = new_bytestring(value->len);
+
+  memcpy(sv->data[idx]->value, value->value, value->len * sizeof(char));
+
+  return 0;
+}
+
+void bsvector_remove_section(bsvector_t *v, long int from, long int to) {
+  long int i;
+
+  assert(v != 0);
+  assert(v->data != 0);
+
+  for (i=from; i<to; i++) {
+    if (v->data[i] != 0) {
+      destroy_bytestring(v->data[i]);
+    }
+  }
+  for (i=0; i<v->len-to; i++) {
+    v->data[from+i]=v->data[to+i];
+  }
+
+  v->len -= (to-from);
+}
+
+void bsvector_remove(bsvector_t *v, long int elem) {
+  assert(v != 0);
+  assert(v->data != 0);
+  bsvector_remove_section(v, elem, elem+1);
+}
+
+/*
+void bsvector_move_interval(bsvector_t *v, long int begin,
+				   long int end, long int to) {
+  long int i;
+  assert(v != 0);
+  assert(v->data != 0);
+  for (i=to; i<to+end-begin; i++) {
+    if (v->data[i] != 0) {
+      destroy_bytestring(v->data[i]);
+    }
+  }
+  for (i=0; i<end-begin; i++) {
+    if (v->data[begin+i] != 0) {
+      size_t len=strlen(v->data[begin+i])+1;
+      v->data[to+i]=igraph_Calloc(len, char);
+      memcpy(v->data[to+i], v->data[begin+i], sizeof(char)*len);
+    }
+  }
+}
+*/
+
+int bsvector_copy(bsvector_t *to, const bsvector_t *from) {
+  long int i;
+  bytestring_t *str;
+  assert(from != 0);
+/*   assert(from->data != 0); */
+  to->data=igraph_Calloc(from->len, bytestring_t*);
+  if (to->data==0) {
+    IGRAPH_ERROR("Cannot copy string vector", IGRAPH_ENOMEM);
+  }
+  to->len=from->len;
+
+  for (i=0; i<from->len; i++) {
+    int ret;
+    bsvector_get(from, i, &str);
+    ret=bsvector_set(to, i, str);
+    if (ret != 0) {
+      bsvector_destroy(to);
+      IGRAPH_ERROR("cannot copy string vector", ret);
+    }
+  }
+
+  return 0;
+}
+
+int bsvector_append(bsvector_t *to, const bsvector_t *from) {
+  long int len1=bsvector_size(to), len2=bsvector_size(from);
+  long int i;
+  igraph_bool_t error=0;
+  IGRAPH_CHECK(bsvector_resize(to, len1+len2));
+  for (i=0; i<len2; i++) {
+    if (from->data[i]->len > 0) {
+      bsvector_set(to, len1+i, from->data[i]);
+      if (!to->data[len1+i]) {
+        error=1;
+        break;
+      }
+    }
+  }
+  if (error) {
+    bsvector_resize(to, len1);
+    IGRAPH_ERROR("Cannot append string vector", IGRAPH_ENOMEM);
+  }
+  return 0;
+}
+
+void bsvector_clear(bsvector_t *sv) {
+  long int i, n=bsvector_size(sv);
+  bytestring_t **tmp;
+
+  for (i=0; i<n; i++) {
+    destroy_bytestring(sv->data[i]);
+  }
+  sv->len=0;
+  /* try to give back some memory */
+  tmp=igraph_Realloc(sv->data, 1, bytestring_t*);
+  if (tmp != 0) {
+    sv->data=tmp;
+  }
+}
+
+int bsvector_resize(bsvector_t* v, long int newsize) {
+  long int toadd = newsize - v->len, i, j;
+  bytestring_t **tmp;
+  long int reallocsize=newsize;
+  if (reallocsize==0) { reallocsize=1; }
+
+  assert(v != 0);
+  assert(v->data != 0);
+  if (newsize < v->len) {
+    for (i=newsize; i<v->len; i++) {
+      destroy_bytestring(v->data[i]);
+    }
+    /* try to give back some space */
+    tmp=igraph_Realloc(v->data, (size_t) reallocsize, bytestring_t*);
+    if (tmp != 0) {
+      v->data=tmp;
+    }
+  } else if (newsize > v->len) {
+    igraph_bool_t error=0;
+    tmp=igraph_Realloc(v->data, (size_t) reallocsize, bytestring_t*);
+    if (tmp==0) {
+      IGRAPH_ERROR("cannot resize string vector", IGRAPH_ENOMEM);
+    }
+    v->data = tmp;
+
+    for (i=0; i<toadd; i++) {
+      v->data[v->len+i] = new_bytestring(0);
+      if (v->data[v->len+i] == 0) {
+	       error=1;
+	       break;
+      }
+    }
+    if (error) {
+      /* There was an error, free everything we've allocated so far */
+      for (j=0; j<i; j++) {
+	       if (v->data[v->len+i] != 0) {
+	          destroy_bytestring(v->data[v->len+i]);
+	       }
+      }
+      /* Try to give back space */
+      tmp=igraph_Realloc(v->data, (size_t) (v->len), bytestring_t*);
+      if (tmp != 0) {
+	       v->data=tmp;
+      }
+      IGRAPH_ERROR("Cannot resize string vector", IGRAPH_ENOMEM);
+    }
+  }
+  v->len = newsize;
+
+  return 0;
+}
+
+int bsvector_add(bsvector_t *v, const bytestring_t *value) {
+  long int s=bsvector_size(v);
+  bytestring_t **tmp;
+  assert(v != 0);
+  assert(v->data != 0);
+  tmp=igraph_Realloc(v->data, (size_t) s+1, bytestring_t*);
+  if (tmp == 0) {
+    IGRAPH_ERROR("cannot add string to string vector", IGRAPH_ENOMEM);
+  }
+  v->data=tmp;
+  v->data[s]=new_bytestring(value->len);
+  if (v->data[s]==0) {
+    IGRAPH_ERROR("cannot add string to string vector", IGRAPH_ENOMEM);
+  }
+  bsvector_set(v, s, value);
+  v->len += 1;
+
+  return 0;
+}
+
+/**
+ * \ingroup strvector
+ * \function igraph_strvector_permdelete
+ * \brief Removes elements from a string vector (for internal use)
+ */
+
+void bsvector_permdelete(bsvector_t *v, const igraph_vector_t *index,
+				long int nremove) {
+  long int i;
+  bytestring_t **tmp;
+  assert(v != 0);
+  assert(v->data != 0);
+
+  for (i=0; i<bsvector_size(v); i++) {
+    if (VECTOR(*index)[i] != 0) {
+      v->data[ (long int) VECTOR(*index)[i]-1 ] = v->data[i];
+    } else {
+      destroy_bytestring(v->data[i]);
+    }
+  }
+  /* Try to make it shorter */
+  tmp=igraph_Realloc(v->data, v->len-nremove ?
+		     (size_t) (v->len-nremove) : 1, bytestring_t*);
+  if (tmp != 0) {
+    v->data=tmp;
+  }
+  v->len -= nremove;
+}
+
+/**
+ * \ingroup strvector
+ * \function igraph_strvector_remove_negidx
+ * \brief Removes elements from a string vector (for internal use)
+ */
+
+void bsvector_remove_negidx(bsvector_t *v, const igraph_vector_t *neg,
+				   long int nremove) {
+  long int i, idx=0;
+  bytestring_t **tmp;
+  assert(v != 0);
+  assert(v->data != 0);
+  for (i=0; i<bsvector_size(v); i++) {
+    if (VECTOR(*neg)[i] >= 0) {
+      v->data[idx++] = v->data[i];
+    } else {
+      destroy_bytestring(v->data[i]);
+    }
+  }
+  /* Try to give back some memory */
+  tmp=igraph_Realloc(v->data, v->len-nremove ?
+		     (size_t) (v->len-nremove) : 1, bytestring_t*);
+  if (tmp != 0) {
+    v->data=tmp;
+  }
+  v->len -= nremove;
+}
+
+int bsvector_index(const bsvector_t *v, bsvector_t *newv,
+                   const igraph_vector_t *idx) {
+  long int i, newlen=igraph_vector_size(idx);
+  IGRAPH_CHECK(bsvector_resize(newv, newlen));
+
+  for (i=0; i<newlen; i++) {
+    long int j=(long int) VECTOR(*idx)[i];
+    bytestring_t *str;
+    bsvector_get(v, j, &str);
+    bsvector_set(newv, i, str);
+  }
+
+  return 0;
+}
+
+long int bsvector_size(const bsvector_t *sv) {
+  assert(sv != 0);
+  assert(sv->data != 0);
+  return sv->len;
+}
+
+bytestring_t* new_bytestring(int n) {
+    bytestring_t *newstr = igraph_Calloc(1, bytestring_t);
+    char *str = igraph_Calloc(n, char);
+    newstr->len = n;
+    newstr->value = str;
+    return newstr;
+}
+
+void destroy_bytestring(bytestring_t* str) {
+  if (str != NULL) {
+    free(str->value);
+    free(str);
+  }
+}
+
+char* bytestring_to_char(bytestring_t* from) {
+  char *str = igraph_Calloc(from->len + sizeof(long int), char);
+  memcpy(str, &from->len, sizeof(long int));
+  memcpy(str + sizeof(long int), from->value, from->len);
+  return str;
+}
+
+bytestring_t* char_to_bytestring(char* from) {
+  unsigned long int *n;
+  memcpy(n, from, sizeof(long int));
+  bytestring_t *str = new_bytestring(*n);
+  memcpy(str->value, from+sizeof(long int), *n);
+  return str;
+}
+
+igraph_strvector_t* bsvector_to_strvector(bsvector_t* from) {
+  igraph_strvector_t *str;
+  size_t i;
+  igraph_strvector_init(str, from->len);
+  for (i = 0; i++; i < from->len) {
+    igraph_strvector_set(str, i, bytestring_to_char(from->data[i]));
+  }
+  return str;
+}
+
+bsvector_t* strvector_to_bsvector(igraph_strvector_t* from) {
+  bsvector_t *str;
+  size_t i;
+  bsvector_init(str, from->len);
+  for (i = 0; i++; i < from->len) {
+    bsvector_set(str, i, char_to_bytestring(from->data[i]));
+  }
+  return str;
+}

cbits/bytestring.h

+#ifndef HASKELL_IGRAPH_BYTESTRING
+#define HASKELL_IGRAPH_BYTESTRING
+
+#include <igraph/igraph.h>
+
+typedef struct bytestring_t {
+  unsigned long int len;
+  char *value;
+} bytestring_t;
+
+typedef struct bsvector_t {
+  bytestring_t **data;
+  long int len;
+} bsvector_t;
+
+#define BSVECTOR_INIT_FINALLY(v, size) \
+  do { IGRAPH_CHECK(bsvector_init(v, size)); \
+  IGRAPH_FINALLY( (igraph_finally_func_t*) bsvector_destroy, v); } while (0)
+
+/**
+ * \define STR
+ * Indexing string vectors
+ *
+ * This is a macro which allows to query the elements of a string vector in
+ * simpler way than \ref igraph_strvector_get(). Note this macro cannot be
+ * used to set an element, for that use \ref igraph_strvector_set().
+ * \param sv The string vector
+ * \param i The the index of the element.
+ * \return The element at position \p i.
+ *
+ * Time complexity: O(1).
+ */
+#define BS(sv,i) ((const bytestring_t *)((sv).data[(i)]))
+
+int bsvector_init(bsvector_t *sv, long int len);
+
+void bsvector_destroy(bsvector_t *sv);
+
+void bsvector_get(const bsvector_t *sv, long int idx, bytestring_t **value);
+
+int bsvector_set(bsvector_t *sv, long int idx, const bytestring_t *value);
+
+void bsvector_remove_section(bsvector_t *v, long int from, long int to);
+
+void bsvector_remove(bsvector_t *v, long int elem);
+
+/*
+void bsvector_move_interval(bsvector_t *v, long int begin,
+				   long int end, long int to) {
+  long int i;
+  assert(v != 0);
+  assert(v->data != 0);
+  for (i=to; i<to+end-begin; i++) {
+    if (v->data[i] != 0) {
+      destroy_bytestring(v->data[i]);
+    }
+  }
+  for (i=0; i<end-begin; i++) {
+    if (v->data[begin+i] != 0) {
+      size_t len=strlen(v->data[begin+i])+1;
+      v->data[to+i]=igraph_Calloc(len, char);
+      memcpy(v->data[to+i], v->data[begin+i], sizeof(char)*len);
+    }
+  }
+}
+*/
+
+int bsvector_copy(bsvector_t *to, const bsvector_t *from);
+
+int bsvector_append(bsvector_t *to, const bsvector_t *from);
+
+void bsvector_clear(bsvector_t *sv);
+
+int bsvector_resize(bsvector_t* v, long int newsize);
+
+/**
+ * \ingroup strvector
+ * \function igraph_strvector_permdelete
+ * \brief Removes elements from a string vector (for internal use)
+ */
+
+void bsvector_permdelete(bsvector_t *v, const igraph_vector_t *index,
+				long int nremove);
+
+/**
+ * \ingroup strvector
+ * \function igraph_strvector_remove_negidx
+ * \brief Removes elements from a string vector (for internal use)
+ */
+
+void bsvector_remove_negidx(bsvector_t *v, const igraph_vector_t *neg,
+				   long int nremove);
+
+int bsvector_index(const bsvector_t *v, bsvector_t *newv,
+                   const igraph_vector_t *idx);
+
+long int bsvector_size(const bsvector_t *sv);
+
+bytestring_t* new_bytestring(int n);
+
+void destroy_bytestring(bytestring_t* str);
+
+char* bytestring_to_char(bytestring_t* from);
+
+bytestring_t* char_to_bytestring(char* from);
+
+igraph_strvector_t* bsvector_to_strvector(bsvector_t* from);
+
+bsvector_t* strvector_to_bsvector(igraph_strvector_t* from);
+
+#endif

cbits/haskell_attributes.h

+#ifndef HASKELL_IGRAPH_ATTRIBUTE
+#define HASKELL_IGRAPH_ATTRIBUTE
+
+#include "igraph/igraph.h"
+#include "bytestring.h"
+
+#include <string.h>
+
+igraph_bool_t igraph_haskell_attribute_find(const igraph_vector_ptr_t *ptrvec,
+				       const char *name, long int *idx);
+
+typedef struct igraph_haskell_attributes_t {
+  igraph_vector_ptr_t gal;
+  igraph_vector_ptr_t val;
+  igraph_vector_ptr_t eal;
+} igraph_haskell_attributes_t;
+
+int igraph_haskell_attributes_copy_attribute_record(igraph_attribute_record_t **newrec,
+					       const igraph_attribute_record_t *rec);
+
+
+int igraph_haskell_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr);
+
+void igraph_haskell_attribute_destroy(igraph_t *graph);
+
+void igraph_haskell_attribute_copy_free(igraph_haskell_attributes_t *attr);
+
+int igraph_haskell_attribute_copy(igraph_t *to, const igraph_t *from,
+			     igraph_bool_t ga, igraph_bool_t va, igraph_bool_t ea);
+
+int igraph_haskell_attribute_add_vertices(igraph_t *graph, long int nv,
+				     igraph_vector_ptr_t *nattr);
+
+void igraph_haskell_attribute_permute_free(igraph_vector_ptr_t *v);
+
+int igraph_haskell_attribute_permute_vertices(const igraph_t *graph,
+					 igraph_t *newgraph,
+					 const igraph_vector_t *idx);
+
+int igraph_haskell_attribute_combine_vertices(const igraph_t *graph,
+			 igraph_t *newgraph,
+			 const igraph_vector_ptr_t *merges,
+			 const igraph_attribute_combination_t *comb);
+
+int igraph_haskell_attribute_add_edges(igraph_t *graph, const igraph_vector_t *edges,
+				 igraph_vector_ptr_t *nattr);
+
+int igraph_haskell_attribute_permute_edges(const igraph_t *graph,
+				      igraph_t *newgraph,
+				      const igraph_vector_t *idx);
+
+int igraph_haskell_attribute_combine_edges(const igraph_t *graph,
+			 igraph_t *newgraph,
+			 const igraph_vector_ptr_t *merges,
+			 const igraph_attribute_combination_t *comb);
+
+int igraph_haskell_attribute_get_info(const igraph_t *graph,
+				 igraph_strvector_t *gnames,
+				 igraph_vector_t *gtypes,
+				 igraph_strvector_t *vnames,
+				 igraph_vector_t *vtypes,
+				 igraph_strvector_t *enames,
+				 igraph_vector_t *etypes);
+
+igraph_bool_t igraph_haskell_attribute_has_attr(const igraph_t *graph,
+					 igraph_attribute_elemtype_t type,
+					 const char *name);
+
+int igraph_haskell_attribute_gettype(const igraph_t *graph,
+			      igraph_attribute_type_t *type,
+			      igraph_attribute_elemtype_t elemtype,
+			      const char *name);
+
+int igraph_haskell_attribute_get_numeric_graph_attr(const igraph_t *graph,
+					      const char *name,
+					      igraph_vector_t *value);
+
+int igraph_haskell_attribute_get_bool_graph_attr(const igraph_t *graph,
+					    const char *name,
+					    igraph_vector_bool_t *value);
+
+int igraph_haskell_attribute_get_string_graph_attr(const igraph_t *graph,
+					     const char *name,
+					     igraph_strvector_t *value_);
+
+int igraph_haskell_attribute_get_numeric_vertex_attr(const igraph_t *graph,
+					      const char *name,
+					      igraph_vs_t vs,
+					      igraph_vector_t *value);
+
+int igraph_haskell_attribute_get_bool_vertex_attr(const igraph_t *graph,
+					     const char *name,
+					     igraph_vs_t vs,
+					     igraph_vector_bool_t *value);
+
+int igraph_haskell_attribute_get_string_vertex_attr(const igraph_t *graph,
+					     const char *name,
+					     igraph_vs_t vs,
+					     igraph_strvector_t *value_);
+
+int igraph_haskell_attribute_get_numeric_edge_attr(const igraph_t *graph,
+					    const char *name,
+					    igraph_es_t es,
+					    igraph_vector_t *value);
+
+int igraph_haskell_attribute_get_string_edge_attr(const igraph_t *graph,
+					   const char *name,
+					   igraph_es_t es,
+					   igraph_strvector_t *value_);
+
+int igraph_haskell_attribute_get_bool_edge_attr(const igraph_t *graph,
+					   const char *name,
+					   igraph_es_t es,
+					   igraph_vector_bool_t *value);
+
+igraph_real_t igraph_haskell_attribute_GAN(const igraph_t *graph, const char *name);
+
+igraph_bool_t igraph_haskell_attribute_GAB(const igraph_t *graph, const char *name);
+
+const bytestring_t* igraph_haskell_attribute_GAS(const igraph_t *graph, const char *name);
+
+igraph_real_t igraph_haskell_attribute_VAN(const igraph_t *graph, const char *name,
+				      igraph_integer_t vid);
+
+igraph_bool_t igraph_haskell_attribute_VAB(const igraph_t *graph, const char *name,
+				    igraph_integer_t vid);
+
+const bytestring_t* igraph_haskell_attribute_VAS(const igraph_t *graph, const char *name,
+				    igraph_integer_t vid);
+
+igraph_real_t igraph_haskell_attribute_EAN(const igraph_t *graph, const char *name,
+				      igraph_integer_t eid);
+
+igraph_bool_t igraph_haskell_attribute_EAB(const igraph_t *graph, const char *name,
+				    igraph_integer_t eid);
+
+const bytestring_t* igraph_haskell_attribute_EAS(const igraph_t *graph, const char *name,
+				    igraph_integer_t eid);
+
+int igraph_haskell_attribute_VANV(const igraph_t *graph, const char *name,
+			   igraph_vs_t vids, igraph_vector_t *result);
+
+int igraph_haskell_attribute_VABV(const igraph_t *graph, const char *name,
+			   igraph_vs_t vids, igraph_vector_bool_t *result);
+
+int igraph_haskell_attribute_EANV(const igraph_t *graph, const char *name,
+			   igraph_es_t eids, igraph_vector_t *result);
+
+int igraph_haskell_attribute_EABV(const igraph_t *graph, const char *name,
+			   igraph_es_t eids, igraph_vector_bool_t *result);
+
+int igraph_haskell_attribute_VASV(const igraph_t *graph, const char *name,
+			   igraph_vs_t vids, igraph_strvector_t *result);
+
+int igraph_haskell_attribute_EASV(const igraph_t *graph, const char *name,
+			   igraph_es_t eids, igraph_strvector_t *result);
+
+int igraph_haskell_attribute_list(const igraph_t *graph,
+			   igraph_strvector_t *gnames, igraph_vector_t *gtypes,
+			   igraph_strvector_t *vnames, igraph_vector_t *vtypes,
+			   igraph_strvector_t *enames, igraph_vector_t *etypes);
+
+int igraph_haskell_attribute_GAN_set(igraph_t *graph, const char *name,
+			      igraph_real_t value);
+
+int igraph_haskell_attribute_GAB_set(igraph_t *graph, const char *name,
+			      igraph_bool_t value);
+
+int igraph_haskell_attribute_GAS_set(igraph_t *graph, const char *name,
+			      const bytestring_t *value);
+
+int igraph_haskell_attribute_VAN_set(igraph_t *graph, const char *name,
+			      igraph_integer_t vid, igraph_real_t value);
+
+int igraph_haskell_attribute_VAB_set(igraph_t *graph, const char *name,
+			      igraph_integer_t vid, igraph_bool_t value);
+
+int igraph_haskell_attribute_VAS_set(igraph_t *graph, const char *name,
+			      igraph_integer_t vid, const bytestring_t *value);
+
+int igraph_haskell_attribute_EAN_set(igraph_t *graph, const char *name,
+			      igraph_integer_t eid, igraph_real_t value);
+
+int igraph_haskell_attribute_EAB_set(igraph_t *graph, const char *name,
+			      igraph_integer_t eid, igraph_bool_t value);
+
+int igraph_haskell_attribute_EAS_set(igraph_t *graph, const char *name,
+			      igraph_integer_t eid, const bytestring_t *value);
+
+int igraph_haskell_attribute_VAN_setv(igraph_t *graph, const char *name,
+			       const igraph_vector_t *v);
+
+int igraph_haskell_attribute_VAB_setv(igraph_t *graph, const char *name,
+			       const igraph_vector_bool_t *v);
+
+int igraph_haskell_attribute_VAS_setv(igraph_t *graph, const char *name,
+			       const bsvector_t *sv);
+
+int igraph_haskell_attribute_EAN_setv(igraph_t *graph, const char *name,
+			       const igraph_vector_t *v);
+
+int igraph_haskell_attribute_EAB_setv(igraph_t *graph, const char *name,
+			       const igraph_vector_bool_t *v);
+
+int igraph_haskell_attribute_EAS_setv(igraph_t *graph, const char *name,
+			       const bsvector_t *sv);
+
+void igraph_haskell_attribute_free_rec(igraph_attribute_record_t *rec);
+
+void igraph_haskell_attribute_remove_g(igraph_t *graph, const char *name);
+
+void igraph_haskell_attribute_remove_v(igraph_t *graph, const char *name);
+
+void igraph_haskell_attribute_remove_e(igraph_t *graph, const char *name);
+
+void igraph_haskell_attribute_remove_all(igraph_t *graph, igraph_bool_t g,
+				  igraph_bool_t v, igraph_bool_t e);
+#endif

cbits/haskelligraph.c → cbits/haskell_igraph.c

 #include <igraph/igraph.h>
+#include "haskell_attributes.h"
 
 igraph_integer_t igraph_get_eid_(igraph_t* graph, igraph_integer_t pfrom, igraph_integer_t pto,
            igraph_bool_t directed, igraph_bool_t error)
@@ -29,8 +30,28 @@ void igraph_arpack_destroy(igraph_arpack_options_t* arpack)
   arpack = NULL;
 }
 
+const igraph_attribute_table_t igraph_haskell_attribute_table={
+  &igraph_haskell_attribute_init, &igraph_haskell_attribute_destroy,
+  &igraph_haskell_attribute_copy, &igraph_haskell_attribute_add_vertices,
+  &igraph_haskell_attribute_permute_vertices,
+  &igraph_haskell_attribute_combine_vertices, &igraph_haskell_attribute_add_edges,
+  &igraph_haskell_attribute_permute_edges,
+  &igraph_haskell_attribute_combine_edges,
+  &igraph_haskell_attribute_get_info,
+  &igraph_haskell_attribute_has_attr, &igraph_haskell_attribute_gettype,
+  &igraph_haskell_attribute_get_numeric_graph_attr,
+  &igraph_haskell_attribute_get_string_graph_attr,
+  &igraph_haskell_attribute_get_bool_graph_attr,
+  &igraph_haskell_attribute_get_numeric_vertex_attr,
+  &igraph_haskell_attribute_get_string_vertex_attr,
+  &igraph_haskell_attribute_get_bool_vertex_attr,
+  &igraph_haskell_attribute_get_numeric_edge_attr,
+  &igraph_haskell_attribute_get_string_edge_attr,
+  &igraph_haskell_attribute_get_bool_edge_attr
+};
+
 void haskelligraph_init()
 {
   /* attach attribute table */
-  igraph_i_set_attribute_table(&igraph_cattribute_table);
+  igraph_i_set_attribute_table(&igraph_haskell_attribute_table);
 }

haskell-igraph.cabal

--- Initial igraph-bindings.cabal generated by cabal init.  For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
 name:                haskell-igraph
-version:             0.3.1-dev
+version:             0.4.0-dev
 synopsis:            Imcomplete igraph bindings
 description:         This is an attempt to create a complete bindings for the
                      igraph<"http://igraph.org/c/"> library.
@@ -14,7 +11,10 @@ copyright:           (c) 2016-2017 Kai Zhang
 category:            Math
 build-type:          Simple
 cabal-version:       >=1.24
-extra-source-files:  cbits/haskelligraph.h
+extra-source-files:
+  cbits/haskell_igraph.h
+  cbits/bytestring.h
+  cbits/haskell_attributes.h
 
 Flag graphics
   Description: Enable graphics output
@@ -55,9 +55,9 @@ library
 
   build-depends:
       base >=4.0 && <5.0
-    , binary
     , bytestring >=0.9
     , bytestring-lexing >=0.5
+    , cereal
     , colour
     , primitive
     , unordered-containers
@@ -70,7 +70,10 @@ library
   hs-source-dirs:      src
   default-language:    Haskell2010
   build-tools:         c2hs >=0.25.0
-  c-sources:           cbits/haskelligraph.c
+  c-sources:
+    cbits/haskell_igraph.c
+    cbits/haskell_attributes.c
+    cbits/bytestring.c
   include-dirs:        cbits
 
 test-suite tests
@@ -79,6 +82,7 @@ test-suite tests
   main-is: test.hs
   other-modules:
     Test.Basic
+    Test.Attributes
     Test.Structure
     Test.Isomorphism
     Test.Motif

src/IGraph.hs

@@ -28,14 +28,15 @@ module IGraph
     ) where
 
 import           Control.Arrow             ((***))
-import           Control.Monad             (forM_, liftM)
+import           Control.Monad             (forM, forM_, liftM)
 import           Control.Monad.Primitive
 import           Control.Monad.ST          (runST)
-import           Data.Binary
 import           Data.Hashable             (Hashable)
 import qualified Data.HashMap.Strict       as M
-import qualified Data.HashSet as S
+import qualified Data.HashSet              as S
 import           Data.Maybe
+import           Data.Serialize
+import           Foreign                   (with)
 import           System.IO.Unsafe          (unsafePerformIO)
 
 import           IGraph.Internal.Attribute
@@ -53,22 +54,6 @@ data LGraph d v e = LGraph
     , _labelToNode :: M.HashMap v [Node]
     }
 
-instance ( Binary v, Hashable v, Read v, Show v, Eq v
-         , Binary e, Read e, Show e, Graph d) => Binary (LGraph d v e) where
-    put gr = do
-        put nlabs
-        put es
-        put elabs
-      where
-        nlabs = map (nodeLab gr) $ nodes gr
-        es = edges gr
-        elabs = map (edgeLab gr) es
-    get = do
-        nlabs <- get
-        es <- get
-        elabs <- get
-        return $ mkGraph nlabs $ zip es elabs
-
 class MGraph d => Graph d where
     isDirected :: LGraph d v e -> Bool
     isD :: d -> Bool
@@ -97,13 +82,14 @@ class MGraph d => Graph d where
         | otherwise = True
     {-# INLINE hasEdge #-}
 
-    nodeLab :: Read v => LGraph d v e -> Node -> v
-    nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i
+    nodeLab :: Serialize v => LGraph d v e -> Node -> v
+    nodeLab (LGraph g _) i = unsafePerformIO $
+        igraphHaskellAttributeVAS g vertexAttr i >>= fromBS
     {-# INLINE nodeLab #-}
 
-    nodeLabMaybe :: Read v => LGraph d v e -> Node -> Maybe v
+    nodeLabMaybe :: Serialize v => LGraph d v e -> Node -> Maybe v
     nodeLabMaybe gr@(LGraph g _) i =
-        if igraphCattributeHasAttr g IgraphAttributeVertex vertexAttr
+        if igraphHaskellAttributeHasAttr g IgraphAttributeVertex vertexAttr
             then Just $ nodeLab gr i
             else Nothing
     {-# INLINE nodeLabMaybe #-}
@@ -112,20 +98,22 @@ class MGraph d => Graph d where
     getNodes gr x = M.lookupDefault [] x $ _labelToNode gr
     {-# INLINE getNodes #-}
 
-    edgeLab :: Read e => LGraph d v e -> Edge -> e
-    edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $
-                                   igraphGetEid g fr to True True
+    edgeLab :: Serialize e => LGraph d v e -> Edge -> e
+    edgeLab (LGraph g _) (fr,to) = unsafePerformIO $
+        igraphHaskellAttributeEAS g edgeAttr (igraphGetEid g fr to True True) >>=
+            fromBS
     {-# INLINE edgeLab #-}
 
-    edgeLabMaybe :: Read e => LGraph d v e -> Edge -> Maybe e
+    edgeLabMaybe :: Serialize e => LGraph d v e -> Edge -> Maybe e
     edgeLabMaybe gr@(LGraph g _) i =
-        if igraphCattributeHasAttr g IgraphAttributeEdge edgeAttr
+        if igraphHaskellAttributeHasAttr g IgraphAttributeEdge edgeAttr
             then Just $ edgeLab gr i
             else Nothing
     {-# INLINE edgeLabMaybe #-}
 
-    edgeLabByEid :: Read e => LGraph d v e -> Int -> e
-    edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i
+    edgeLabByEid :: Serialize e => LGraph d v e -> Int -> e
+    edgeLabByEid (LGraph g _) i = unsafePerformIO $
+        igraphHaskellAttributeEAS g edgeAttr i >>= fromBS
     {-# INLINE edgeLabByEid #-}
 
 
@@ -137,11 +125,11 @@ instance Graph D where
     isDirected = const True
     isD = const True
 
-empty :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)
+empty :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
       => LGraph d v e
 empty = runST $ new 0 >>= unsafeFreeze
 
-mkGraph :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)
+mkGraph :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
         => [v] -> [(Edge, e)] -> LGraph d v e
 mkGraph vattr es = runST $ do
     g <- new 0
@@ -151,7 +139,7 @@ mkGraph vattr es = runST $ do
   where
     n = length vattr
 
-fromLabeledEdges :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)
+fromLabeledEdges :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
                  => [((v, v), e)] -> LGraph d v e
 fromLabeledEdges es = mkGraph labels es'
   where
@@ -160,14 +148,17 @@ fromLabeledEdges es = mkGraph labels es'
     labels = S.toList $ S.fromList $ concat [ [a,b] | ((a,b),_) <- es ]
     labelToId = M.fromList $ zip labels [0..]
 
-unsafeFreeze :: (Hashable v, Eq v, Read v, PrimMonad m) => MLGraph (PrimState m) d v e -> m (LGraph d v e)
+unsafeFreeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
+             => MLGraph (PrimState m) d v e -> m (LGraph d v e)
 unsafeFreeze (MLGraph g) = return $ LGraph g labToId
   where
     labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]
     nV = igraphVcount g
-    labels = map (read . igraphCattributeVAS g vertexAttr) [0 .. nV-1]
+    labels = unsafePerformIO $ forM [0 .. nV - 1] $ \i ->
+        igraphHaskellAttributeVAS g vertexAttr i >>= fromBS
 
-freeze :: (Hashable v, Eq v, Read v, PrimMonad m) => MLGraph (PrimState m) d v e -> m (LGraph d v e)
+freeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
+       => MLGraph (PrimState m) d v e -> m (LGraph d v e)
 freeze (MLGraph g) = do
     g' <- unsafePrimToPrim $ igraphCopy g
     unsafeFreeze (MLGraph g')
@@ -200,7 +191,7 @@ pre gr i = unsafePerformIO $ do
     vitToList vit
 
 -- | Keep nodes that satisfy the constraint
-filterNodes :: (Hashable v, Eq v, Read v, Graph d)
+filterNodes :: (Hashable v, Eq v, Serialize v, Graph d)
             => (LGraph d v e -> Node -> Bool) -> LGraph d v e -> LGraph d v e
 filterNodes f gr = runST $ do
     let deleted = filter (not . f gr) $ nodes gr
@@ -209,7 +200,7 @@ filterNodes f gr = runST $ do
     unsafeFreeze gr'
 
 -- | Apply a function to change nodes' labels.
-mapNodes :: (Graph d, Read v1, Show v2, Hashable v2, Eq v2, Read v2)
+mapNodes :: (Graph d, Serialize v1, Serialize v2, Hashable v2, Eq v2)
          => (Node -> v1 -> v2) -> LGraph d v1 e -> LGraph d v2 e
 mapNodes f gr = runST $ do
     (MLGraph gptr) <- thaw gr
@@ -218,7 +209,7 @@ mapNodes f gr = runST $ do
     unsafeFreeze gr'
 
 -- | Apply a function to change edges' labels.
-mapEdges :: (Graph d, Read e1, Show e2, Hashable v, Eq v, Read v)
+mapEdges :: (Graph d, Serialize e1, Serialize e2, Hashable v, Eq v, Serialize v)
          => (Edge -> e1 -> e2) -> LGraph d v e1 -> LGraph d v e2
 mapEdges f gr = runST $ do
     (MLGraph gptr) <- thaw gr
@@ -230,7 +221,7 @@ mapEdges f gr = runST $ do
 
 
 -- | Keep nodes that satisfy the constraint
-filterEdges :: (Hashable v, Eq v, Read v, Graph d)
+filterEdges :: (Hashable v, Eq v, Serialize v, Graph d)
             => (LGraph d v e -> Edge -> Bool) -> LGraph d v e -> LGraph d v e
 filterEdges f gr = runST $ do
     let deleted = filter (not . f gr) $ edges gr
@@ -239,22 +230,24 @@ filterEdges f gr = runST $ do
     unsafeFreeze gr'
 
 -- | Map a function over the node labels in a graph
-nmap :: (Graph d, Read v, Hashable u, Read u, Eq u, Show u)
+nmap :: (Graph d, Serialize v, Hashable u, Serialize u, Eq u)
      => ((Node, v) -> u) -> LGraph d v e -> LGraph d u e
 nmap fn gr = unsafePerformIO $ do
     (MLGraph g) <- thaw gr
     forM_ (nodes gr) $ \i -> do
         let label = fn (i, nodeLab gr i)
-        igraphCattributeVASSet g vertexAttr i (show label)
+        bs <- unsafeToBS label
+        with bs (igraphHaskellAttributeVASSet g vertexAttr i)
     unsafeFreeze (MLGraph g)
 
 -- | Map a function over the edge labels in a graph
-emap :: (Graph d, Read v, Hashable v, Eq v, Read e1, Show e2)
+emap :: (Graph d, Serialize v, Hashable v, Eq v, Serialize e1, Serialize e2)
      => ((Edge, e1) -> e2) -> LGraph d v e1 -> LGraph d v e2
 emap fn gr = unsafePerformIO $ do
     (MLGraph g) <- thaw gr
     forM_ (edges gr) $ \(fr, to) -> do
         let label = fn ((fr,to), edgeLabByEid gr i)
             i = igraphGetEid g fr to True True
-        igraphCattributeEASSet g edgeAttr i (show label)
+        bs <- unsafeToBS label
+        with bs (igraphHaskellAttributeEASSet g edgeAttr i)
     unsafeFreeze (MLGraph g)

src/IGraph/Exporter/GEXF.hs

+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleInstances #-}
 module IGraph.Exporter.GEXF
     ( NodeAttr(..)
     , defaultNodeAttributes
@@ -7,22 +9,34 @@ module IGraph.Exporter.GEXF
     , writeGEXF
     ) where
 
-import Data.Hashable
-import Data.Colour (AlphaColour, black, over, alphaChannel, opaque)
-import Data.Colour.SRGB (toSRGB24, channelRed, channelBlue, channelGreen)
-import Text.XML.HXT.Core
-import Data.Tree.NTree.TypeDefs
-import Text.XML.HXT.DOM.TypeDefs
-import IGraph
+import           Data.Colour               (AlphaColour, alphaChannel, black,
+                                            opaque, over)
+import           Data.Colour.SRGB          (channelBlue, channelGreen,
+                                            channelRed, toSRGB24)
+import           Data.Hashable
+import           Data.Serialize
+import           Data.Tree.NTree.TypeDefs
+import           GHC.Generics
+import           IGraph
+import           Text.XML.HXT.Core
+import           Text.XML.HXT.DOM.TypeDefs
+
+instance Serialize (AlphaColour Double) where
+    get = do
+        x <- get
+        return $ read x
+    put x = put $ show x
 
 data NodeAttr = NodeAttr
-    { _size :: Double
+    { _size       :: Double
     , _nodeColour :: AlphaColour Double
-    , _nodeLabel :: String
-    , _positionX :: Double
-    , _positionY :: Double
+    , _nodeLabel  :: String
+    , _positionX  :: Double
+    , _positionY  :: Double
     , _nodeZindex :: Int
-    } deriving (Show, Read, Eq)
+    } deriving (Show, Read, Eq, Generic)
+
+instance Serialize NodeAttr
 
 instance Hashable NodeAttr where
     hashWithSalt salt at = hashWithSalt salt $ _nodeLabel at
@@ -38,12 +52,14 @@ defaultNodeAttributes = NodeAttr
     }
 
 data EdgeAttr = EdgeAttr
-    { _edgeLabel :: String
-    , _edgeColour :: AlphaColour Double
-    , _edgeWeight :: Double
+    { _edgeLabel       :: String
+    , _edgeColour      :: AlphaColour Double
+    , _edgeWeight      :: Double
     , _edgeArrowLength :: Double
-    , _edgeZindex :: Int
-    } deriving (Show, Read, Eq)
+    , _edgeZindex      :: Int
+    } deriving (Show, Read, Eq, Generic)
+
+instance Serialize EdgeAttr
 
 instance Hashable EdgeAttr where
     hashWithSalt salt at = hashWithSalt salt $ _edgeLabel at

src/IGraph/Generators.hs

@@ -7,6 +7,7 @@ module IGraph.Generators
 
 import           Control.Monad                  (when)
 import           Data.Hashable                  (Hashable)
+import           Data.Serialize                 (Serialize)
 
 import           IGraph
 import           IGraph.Internal.Constants
@@ -42,7 +43,7 @@ degreeSequenceGame out_deg in_deg = do
     unsafeFreeze $ MLGraph gp
 
 -- | Randomly rewires a graph while preserving the degree distribution.
-rewire :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)
+rewire :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
        => Int    -- ^ Number of rewiring trials to perform.
        -> LGraph d v e
        -> IO (LGraph d v e)

src/IGraph/Internal/Arpack.chs

@@ -5,7 +5,7 @@ import Control.Monad
 import Foreign
 import Foreign.C.Types
 
-#include "haskelligraph.h"
+#include "haskell_igraph.h"
 
 {#pointer *igraph_arpack_options_t as ArpackOptPtr foreign finalizer igraph_arpack_destroy newtype#}
 

src/IGraph/Internal/Attribute.chs

@@ -2,8 +2,10 @@
 module IGraph.Internal.Attribute where
 
 import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Unsafe
 import Control.Monad
 import Control.Applicative
+import Data.Serialize (Serialize, decode, encode)
 import Foreign
 import Foreign.C.Types
 import Foreign.C.String
@@ -14,17 +16,39 @@ import System.IO.Unsafe (unsafePerformIO)
 {#import IGraph.Internal.Constants #}
 
 #include "igraph/igraph.h"
+#include "haskell_attributes.h"
 
-makeAttributeRecord :: Show a
+-- The returned object will not be trackced by Haskell's GC. It should be freed
+-- by foreign codes.
+unsafeToBS :: Serialize a => a -> IO BSLen
+unsafeToBS x = unsafeUseAsCStringLen bs $ \(ptr, n) -> do
+    newPtr <- mallocBytes n
+    copyBytes newPtr ptr n
+    return $ BSLen (newPtr, n)
+  where
+    bs = encode x
+{-# INLINE unsafeToBS #-}
+
+fromBS :: Serialize a => Ptr BSLen -> IO a
+fromBS ptr = do
+    BSLen x <- peek ptr
+    result <- decode <$> unsafePackCStringLen x
+    case result of
+        Left msg -> error msg
+        Right r -> return r
+{-# INLINE fromBS #-}
+
+makeAttributeRecord :: Serialize a
                     => String    -- ^ name of the attribute
                     -> [a]       -- ^ values of the attribute
                     -> AttributeRecord
 makeAttributeRecord name xs = unsafePerformIO $ do
     ptr <- newCAString name
-    value <- listToStrVector $ map (B.pack . show) xs
+    value <- mapM unsafeToBS xs >>= listToBSVector
     return $ AttributeRecord ptr 2 value
+{-# INLINE makeAttributeRecord #-}
 
-data AttributeRecord = AttributeRecord CString Int StrVectorPtr
+data AttributeRecord = AttributeRecord CString Int BSVectorPtr
 
 instance Storable AttributeRecord where
     sizeOf _ = {#sizeof igraph_attribute_record_t #}
@@ -34,27 +58,27 @@ instance Storable AttributeRecord where
         <*> liftM fromIntegral ({#get igraph_attribute_record_t->type #} p)
         <*> ( do ptr <- {#get igraph_attribute_record_t->value #} p
                  fptr <- newForeignPtr_ . castPtr $ ptr
-                 return $ StrVectorPtr fptr )
+                 return $ BSVectorPtr fptr )
     poke p (AttributeRecord name t vptr) = do
         {#set igraph_attribute_record_t.name #} p name
         {#set igraph_attribute_record_t.type #} p $ fromIntegral t
-        withStrVectorPtr vptr $ \ptr ->
+        withBSVectorPtr vptr $ \ptr ->
             {#set igraph_attribute_record_t.value #} p $ castPtr ptr
 
-{#fun pure igraph_cattribute_has_attr as ^ { `IGraphPtr', `AttributeElemtype', `String' } -> `Bool' #}
+{#fun pure igraph_haskell_attribute_has_attr as ^ { `IGraphPtr', `AttributeElemtype', `String' } -> `Bool' #}
 
-{#fun igraph_cattribute_GAN_set as ^ { `IGraphPtr', `String', `Double' } -> `Int' #}
+{#fun igraph_haskell_attribute_GAN_set as ^ { `IGraphPtr', `String', `Double' } -> `Int' #}
 
-{#fun pure igraph_cattribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
+{#fun pure igraph_haskell_attribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
 
-{#fun pure igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}
+{#fun igraph_haskell_attribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `Ptr BSLen' castPtr #}
 
-{#fun pure igraph_cattribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
+{#fun pure igraph_haskell_attribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
 
-{#fun pure igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}
+{#fun igraph_haskell_attribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `Ptr BSLen' castPtr #}
 
-{#fun igraph_cattribute_EAS_setv as ^ { `IGraphPtr', `String', `StrVectorPtr' } -> `Int' #}
+{#fun igraph_haskell_attribute_EAS_setv as ^ { `IGraphPtr', `String', `BSVectorPtr' } -> `Int' #}
 
-{#fun igraph_cattribute_VAS_set as ^ { `IGraphPtr', `String', `Int', `String' } -> `Int' #}
+{#fun igraph_haskell_attribute_VAS_set as ^ { `IGraphPtr', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
 
-{#fun igraph_cattribute_EAS_set as ^ { `IGraphPtr', `String', `Int', `String' } -> `Int' #}
+{#fun igraph_haskell_attribute_EAS_set as ^ { `IGraphPtr', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}

src/IGraph/Internal/Data.chs

@@ -10,7 +10,12 @@ import System.IO.Unsafe (unsafePerformIO)
 import Data.List (transpose)
 import Data.List.Split (chunksOf)
 
-#include "haskelligraph.h"
+#include "haskell_igraph.h"
+#include "bytestring.h"
+
+--------------------------------------------------------------------------------
+-- Igraph vector
+--------------------------------------------------------------------------------
 
 {#pointer *igraph_vector_t as VectorPtr foreign finalizer igraph_vector_destroy newtype#}
 
@@ -82,6 +87,10 @@ vectorPPtrToList vpptr = do
         vectorPtrToList $ VectorPtr fptr
 
 
+--------------------------------------------------------------------------------
+-- Igraph string vector
+--------------------------------------------------------------------------------
+
 {#pointer *igraph_strvector_t as StrVectorPtr foreign finalizer igraph_strvector_destroy newtype#}
 
 {#fun igraph_strvector_init as igraphStrvectorNew { +, `Int' } -> `StrVectorPtr' #}
@@ -105,6 +114,46 @@ listToStrVector xs = do
     n = length xs
 
 
+--------------------------------------------------------------------------------
+-- Customized string vector
+--------------------------------------------------------------------------------
+
+newtype BSLen = BSLen CStringLen
+
+instance Storable BSLen where
+    sizeOf _ = {#sizeof bytestring_t #}
+    alignment _ = {#alignof bytestring_t #}
+    peek p = do
+        n <- ({#get bytestring_t->len #} p)
+        ptr <- {#get bytestring_t->value #} p
+        return $ BSLen (ptr, fromIntegral n)
+    poke p (BSLen (ptr, n)) = {#set bytestring_t.len #} p (fromIntegral n) >>
+        {#set bytestring_t.value #} p ptr
+
+{#pointer *bsvector_t as BSVectorPtr foreign finalizer bsvector_destroy newtype#}
+
+{#fun bsvector_init as bsvectorNew { +, `Int' } -> `BSVectorPtr' #}
+
+--{#fun bsvector_get as bsVectorGet { `BSVectorPtr', `Int', + } -> `Ptr (Ptr BSLen)' id #}
+
+{-
+bsVectorGet :: BSVectorPtr -> Int -> BSLen
+bsVectorGet vec i = unsafePerformIO $ do
+    ptrptr <- bsVectorGet vec i
+    peek ptrptr >>= peek
+    -}
+
+{#fun bsvector_set as ^ { `BSVectorPtr', `Int', `Ptr ()'} -> `()' #}
+
+listToBSVector :: [BSLen] -> IO BSVectorPtr
+listToBSVector xs = do
+    vec <- bsvectorNew n
+    forM_ (zip [0..] xs) $ \(i, x) -> with x $ \ptr -> bsvectorSet vec i $ castPtr ptr
+    return vec
+  where
+    n = length xs
+
+
 {#pointer *igraph_matrix_t as MatrixPtr foreign finalizer igraph_matrix_destroy newtype#}
 
 {#fun igraph_matrix_init as igraphMatrixNew { +, `Int', `Int' } -> `MatrixPtr' #}

src/IGraph/Internal/Graph.chs

@@ -10,7 +10,7 @@ import System.IO.Unsafe (unsafePerformIO)
 {#import IGraph.Internal.Data #}
 {#import IGraph.Internal.Constants #}
 
-#include "haskelligraph.h"
+#include "haskell_igraph.h"
 
 {#pointer *igraph_t as IGraphPtr foreign finalizer igraph_destroy newtype#}
 

src/IGraph/Internal/Initialization.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
 module IGraph.Internal.Initialization where
 
-#include "haskelligraph.h"
+#include "haskell_igraph.h"
 
 data HasInit
 

src/IGraph/Mutable.hs

@@ -4,6 +4,7 @@ module IGraph.Mutable where
 import           Control.Monad                  (when)
 import           Control.Monad.Primitive
 import qualified Data.ByteString.Char8          as B
+import           Data.Serialize                 (Serialize)
 import           Foreign
 
 import           IGraph.Internal.Attribute
@@ -30,16 +31,14 @@ class MGraph d where
     addNodes :: PrimMonad m => Int -> MLGraph(PrimState m) d v e -> m ()
     addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
 
-    addLNodes :: (Show v, PrimMonad m)
-                 => Int  -- ^ the number of new vertices add to the graph
-                 -> [v]  -- ^ vertices' labels
-                 -> MLGraph (PrimState m) d v e -> m ()
+    addLNodes :: (Serialize v, PrimMonad m)
+              => Int  -- ^ the number of new vertices add to the graph
+              -> [v]  -- ^ vertices' labels
+              -> MLGraph (PrimState m) d v e -> m ()
     addLNodes n labels (MLGraph g)
         | n /= length labels = error "addLVertices: incorrect number of labels"
         | otherwise = unsafePrimToPrim $ do
-            let attr = makeAttributeRecord vertexAttr labels
-            alloca $ \ptr -> do
-                poke ptr attr
+            with (makeAttributeRecord vertexAttr labels) $ \ptr -> do
                 vptr <- listToVectorP [castPtr ptr]
                 withVectorPPtr vptr $ \p -> igraphAddVertices g n $ castPtr p
 
@@ -52,7 +51,7 @@ class MGraph d where
 
     addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
 
-    addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
+    addLEdges :: (PrimMonad m, Serialize e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
 
     delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
 
@@ -113,20 +112,24 @@ instance MGraph D where
       where
         eids = flip map es $ \(fr, to) -> igraphGetEid g fr to True True
 
-setNodeAttr :: (PrimMonad m, Show v)
+setNodeAttr :: (PrimMonad m, Serialize v)
             => Int   -- ^ Node id
             -> v
             -> MLGraph (PrimState m) d v e
             -> m ()
 setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $ do
-    err <- igraphCattributeVASSet gr vertexAttr nodeId $ show x
-    when (err /= 0) $ error "Fail to set node attribute!"
+    v <- unsafeToBS x
+    with v $ \vptr -> do
+        err <- igraphHaskellAttributeVASSet gr vertexAttr nodeId vptr
+        when (err /= 0) $ error "Fail to set node attribute!"
 
-setEdgeAttr :: (PrimMonad m, Show v)
+setEdgeAttr :: (PrimMonad m, Serialize v)
             => Int   -- ^ Edge id
             -> v
             -> MLGraph (PrimState m) d v e
             -> m ()
 setEdgeAttr edgeId x (MLGraph gr) = unsafePrimToPrim $ do
-    err <- igraphCattributeEASSet gr edgeAttr edgeId $ show x
-    when (err /= 0) $ error "Fail to set edge attribute!"
+    v <- unsafeToBS x
+    with v $ \vptr -> do
+        err <- igraphHaskellAttributeEASSet gr edgeAttr edgeId vptr
+        when (err /= 0) $ error "Fail to set edge attribute!"

src/IGraph/Structure.hs

@@ -7,24 +7,25 @@ module IGraph.Structure
     , personalizedPagerank
     ) where
 
-import Control.Monad
-import Foreign
-import Foreign.C.Types
-import System.IO.Unsafe (unsafePerformIO)
-import qualified Data.HashMap.Strict as M
-import Data.Hashable (Hashable)
+import           Control.Monad
+import           Data.Hashable             (Hashable)
+import qualified Data.HashMap.Strict       as M
+import           Data.Serialize            (Serialize)
+import           Foreign
+import           Foreign.C.Types
+import           System.IO.Unsafe          (unsafePerformIO)
 
-import IGraph
-import IGraph.Mutable
-import IGraph.Internal.Graph
-import IGraph.Internal.Data
-import IGraph.Internal.Selector
-import IGraph.Internal.Structure
-import IGraph.Internal.Arpack
-import IGraph.Internal.Constants
-import IGraph.Internal.Attribute
+import           IGraph
+import           IGraph.Internal.Arpack
+import           IGraph.Internal.Attribute
+import           IGraph.Internal.Constants
+import           IGraph.Internal.Data
+import           IGraph.Internal.Graph
+import           IGraph.Internal.Selector
+import           IGraph.Internal.Structure
+import           IGraph.Mutable
 
-inducedSubgraph :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int] -> LGraph d v e
+inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
 inducedSubgraph gr vs = unsafePerformIO $ do
     vs' <- listToVector $ map fromIntegral vs
     vsptr <- igraphVsVector vs'
@@ -33,7 +34,8 @@ inducedSubgraph gr vs = unsafePerformIO $ do
         let g' = IGraphPtr gptr
             labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]
             nV = igraphVcount g'
-            labels = map (read . igraphCattributeVAS g' vertexAttr) [0 .. nV-1]
+            labels = unsafePerformIO $ forM [0 .. nV - 1] $ \i ->
+                igraphHaskellAttributeVAS g' vertexAttr i >>= fromBS
         return $ LGraph g' labToId
 
 -- | closeness centrality
@@ -49,7 +51,7 @@ closeness vs gr ws mode normal = unsafePerformIO $ do
     vptr <- igraphVectorNew 0
     ws' <- case ws of
         Just w -> listToVector w
-        _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
+        _      -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
     igraphCloseness (_graph gr) vptr vsptr mode ws' normal
     vectorPtrToList vptr
 
@@ -64,7 +66,7 @@ betweenness vs gr ws = unsafePerformIO $ do
     vptr <- igraphVectorNew 0
     ws' <- case ws of
         Just w -> listToVector w
-        _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
+        _      -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
     igraphBetweenness (_graph gr) vptr vsptr True ws' False
     vectorPtrToList vptr
 
@@ -76,7 +78,7 @@ eigenvectorCentrality gr ws = unsafePerformIO $ do
     vptr <- igraphVectorNew 0
     ws' <- case ws of
         Just w -> listToVector w
-        _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
+        _      -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
     arparck <- igraphArpackNew
     igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck
     vectorPtrToList vptr

stack.yaml

@@ -7,4 +7,4 @@ packages:
 
 extra-deps: []
 
-resolver: lts-8.17
+resolver: lts-10.10

tests/Test/Attributes.hs

+module Test.Attributes
+    ( tests
+    ) where
+
+import           Control.Monad
+import           Control.Monad.ST
+import           Data.List
+import           Data.List.Ordered         (nubSort)
+import           Data.Maybe
+import           Foreign
+import           System.IO.Unsafe
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           Test.Utils
+
+import           IGraph
+import           IGraph.Internal.Attribute
+import           IGraph.Mutable
+import           IGraph.Structure
+
+tests :: TestTree
+tests = testGroup "Attribute tests"
+    [ bsTest
+    , nodeLabelTest
+    , labelTest
+    ]
+
+bsTest :: TestTree
+bsTest = testCase "BS" $ do
+    let values = [1..10000] :: [Int]
+    bs <- mapM unsafeToBS values
+    values' <- forM bs $ \b -> with b $ \ptr -> fromBS ptr
+    assertBool "" $ values == values'
+
+nodeLabelTest :: TestTree
+nodeLabelTest = testCase "node label test" $ do
+    let ns = sort $ map show [38..7000]
+        gr = mkGraph ns [] :: LGraph D String ()
+    assertBool "" $ sort (map (nodeLab gr) $ nodes gr) == ns
+
+labelTest :: TestTree
+labelTest = testCase "edge label test" $ do
+    dat <- randEdges 1000 10000
+    let es = sort $ zipWith (\a b -> (a,b)) dat $ map show [1..]
+        gr = fromLabeledEdges es :: LGraph D Int String
+        es' = sort $ map (\(a,b) -> ((nodeLab gr a, nodeLab gr b), edgeLab gr (a,b))) $ edges gr
+    assertBool "" $ es == es'

tests/Test/Basic.hs

@@ -42,12 +42,12 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
         (nodeLab gr fr, nodeLab gr to)) $ edges gr)
     ]
   where
-    edgeList = sort $ map (\(a,b) -> (show a, show b)) $ unsafePerformIO $ randEdges 10000 1000
+    edgeList = sort $ map (\(a,b) -> (show a, show b)) $ unsafePerformIO $
+        randEdges 10000 1000
     n = length $ nubSort $ concatMap (\(a,b) -> [a,b]) edgeList
     m = length edgeList
     gr = fromLabeledEdges $ zip edgeList $ repeat () :: LGraph D String ()
 
-
 graphEdit :: TestTree
 graphEdit = testGroup "Graph editing"
     [ testCase "" $ [(1,2)] @=? (sort $ edges simple') ]

tests/test.hs

@@ -2,6 +2,7 @@ import qualified Test.Basic       as Basic
 import qualified Test.Isomorphism as Isomorphism
 import qualified Test.Motif       as Motif
 import qualified Test.Structure   as Structure
+import qualified Test.Attributes as Attributes
 import           Test.Tasty
 
 main :: IO ()
@@ -10,4 +11,5 @@ main = defaultMain $ testGroup "Haskell-igraph Tests"
     , Structure.tests
     , Motif.tests
     , Isomorphism.tests
+    , Attributes.tests
     ]