Initial commit

LICENSE

+Copyright (c) 2015 Kai Zhang
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Setup.hs

+import Distribution.Simple
+main = defaultMain

cbits/igraph.c

+#include <igraph/igraph.h>
+
+igraph_vector_t* igraph_vector_new(long int size)
+{
+  igraph_vector_t* vector = (igraph_vector_t*) malloc (sizeof (igraph_vector_t));
+  igraph_vector_init(vector, size);
+  return vector;
+}
+
+igraph_vector_ptr_t* igraph_vector_ptr_new(long int size)
+{
+  igraph_vector_ptr_t* vptr = (igraph_vector_ptr_t*) malloc (sizeof (igraph_vector_ptr_t));
+  igraph_vector_ptr_init(vptr, size);
+  return vptr;
+}
+
+igraph_strvector_t* igraph_strvector_new(long int size)
+{
+  igraph_strvector_t* vector = (igraph_strvector_t*) malloc (sizeof (igraph_strvector_t));
+  igraph_strvector_init(vector, size);
+  return vector;
+}
+
+char** igraph_strvector_get_(igraph_strvector_t* s, long int i)
+{
+  char** x = (char**) malloc (sizeof(char*));
+  igraph_strvector_get(s, i, x);
+  return x;
+}
+
+igraph_matrix_t* igraph_matrix_new(long int nrow, long int ncol)
+{
+  igraph_matrix_t* matrix = (igraph_matrix_t*) malloc (sizeof (igraph_matrix_t));
+  igraph_matrix_init(matrix, nrow, ncol);
+  return matrix;
+}
+
+igraph_t* igraph_new(igraph_integer_t n, igraph_bool_t directed)
+{
+  igraph_t* graph = (igraph_t*) malloc (sizeof (igraph_t));
+  igraph_empty(graph, n, directed);
+  return graph;
+}
+
+igraph_t* igraph_full_(igraph_integer_t n, igraph_bool_t directed, igraph_bool_t loops)
+{
+  igraph_t* graph = (igraph_t*) malloc (sizeof (igraph_t));
+  igraph_full(graph, n, directed, loops);
+  return graph;
+}
+
+void haskelligraph_init()
+{
+  /* attach attribute table */
+  igraph_i_set_attribute_table(&igraph_cattribute_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.1.0
+-- synopsis:            
+-- description:         
+license:             MIT
+license-file:        LICENSE
+author:              Kai Zhang
+maintainer:          kai@kzhang.org
+-- copyright:           
+category:            Math
+build-type:          Simple
+extra-source-files:  cbits
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     
+    IGraph
+    IGraph.Internal.Initialization
+    IGraph.Internal.Data
+    IGraph.Internal.Graph
+    IGraph.Internal.Attribute
+    IGraph.Internal.Generator
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:
+      base >=4.0 && <5.0
+    , bytestring >=0.9
+    , cereal
+
+  extra-libraries:     igraph
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  build-tools:         c2hs
+  C-Sources:
+    cbits/igraph.c

src/IGraph.hs

+{-# LANGUAGE MultiParamTypeClasses #-}
+module IGraph where
+
+import qualified Data.ByteString.Char8 as B
+import Foreign (nullPtr)
+
+import IGraph.Internal.Graph
+import IGraph.Internal.Initialization
+import IGraph.Internal.Data
+import IGraph.Internal.Attribute
+import System.IO.Unsafe (unsafePerformIO)
+
+data U
+data D
+
+-- | graph with labeled nodes and edges
+data LGraph d v e = LGraph
+    { _graph :: IGraphPtr }
+
+class Graph gr d where
+    empty :: gr d v e
+    empty = new 0
+
+    new :: Int -> gr d v e
+
+    addEdge :: (Int, Int) -> gr d v e -> IO ()
+
+    addLEdges :: Show e => String -> [(Int, Int, e)] -> gr d v e -> IO ()
+
+
+instance Graph LGraph U where
+    new n = unsafePerformIO $ igraphInit >>= igraphNew n False >>= return . LGraph
+
+    addEdge (fr,to) (LGraph g) = igraphAddEdge g fr to
+
+    addLEdges name es (LGraph g) = do
+        vec <- listToVector $ concat xs
+        igraphAddEdges g vec nullPtr
+        value <- listToStrVector $ map (B.pack . show) vs
+        igraphCattributeEASSetv g name value
+        return ()
+      where
+        (xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es
+

src/IGraph/Internal/Attribute.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Attribute where
+
+import Data.Serialize (Serialize, encode)
+import Control.Monad
+import Control.Applicative
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+import System.IO.Unsafe (unsafePerformIO)
+
+{#import IGraph.Internal.Graph #}
+{#import IGraph.Internal.Data #}
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+makeAttributeRecord :: Serialize a => String -> [a] -> AttributeRecord
+makeAttributeRecord name xs = AttributeRecord name 2 value
+  where
+    value = unsafePerformIO $ listToStrVector $ map encode xs
+
+data AttributeRecord = AttributeRecord String Int StrVectorPtr
+
+instance Storable AttributeRecord where
+    sizeOf _ = {#sizeof igraph_attribute_record_t #}
+    alignment _ = {#alignof igraph_attribute_record_t #}
+    peek p = AttributeRecord
+        <$> (({#get igraph_attribute_record_t->name #} p) >>= peekCString)
+        <*> liftM fromIntegral ({#get igraph_attribute_record_t->type #} p)
+        <*> liftM castPtr ({#get igraph_attribute_record_t->value #} p)
+    poke p (AttributeRecord name t vptr) = do
+        liftM ({#set igraph_attribute_record_t.name #} p) $ newCString name
+        {#set igraph_attribute_record_t.type #} p $ fromIntegral t
+        {#set igraph_attribute_record_t.value #} p $ castPtr vptr
+
+{#fun pure igraph_cattribute_has_attr as ^ { `IGraphPtr', `Int', `String' } -> `Bool' #}
+
+{#fun igraph_cattribute_GAN_set as ^ { `IGraphPtr', `String', `Double' } -> `Int' #}
+
+{#fun pure igraph_cattribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
+
+{#fun pure igraph_cattribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
+
+{#fun pure igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}
+
+{#fun igraph_cattribute_EAS_setv as ^ { `IGraphPtr', `String', `StrVectorPtr' } -> `Int' #}
+
+

src/IGraph/Internal/Data.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Data where
+
+import qualified Data.ByteString.Char8 as B
+import Control.Monad (forM_)
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+import System.IO.Unsafe (unsafePerformIO)
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+data Vector
+{#pointer *igraph_vector_t as VectorPtr -> Vector #}
+
+-- Construtors and destructors
+
+{#fun igraph_vector_new as ^ { `Int' } -> `VectorPtr' #}
+
+{#fun igraph_vector_destroy as ^ { `VectorPtr' } -> `()' #}
+
+listToVector :: [Double] -> IO VectorPtr
+listToVector xs = do
+    vec <- igraphVectorNew n
+    forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorSet vec i x
+    return vec
+  where
+    n = length xs
+
+
+-- Initializing elements
+
+{#fun igraph_vector_null as ^ { `VectorPtr' } -> `()' #}
+
+{#fun igraph_vector_fill as ^ { `VectorPtr', `Double' } -> `()' #}
+
+
+-- Accessing elements
+
+{#fun pure igraph_vector_e as ^ { `VectorPtr', `Int' } -> `Double' #}
+
+{#fun igraph_vector_set as ^ { `VectorPtr', `Int', `Double' } -> `()' #}
+
+{#fun pure igraph_vector_tail as ^ { `VectorPtr' } -> `Double' #}
+
+
+data VectorP
+{#pointer *igraph_vector_ptr_t as VectorPPtr -> VectorP #}
+
+{#fun igraph_vector_ptr_new as ^ { `Int' } -> `VectorPPtr' #}
+
+{#fun igraph_vector_ptr_destroy as ^ { `VectorPPtr' } -> `()' #}
+{#fun igraph_vector_ptr_destroy_all as ^ { `VectorPPtr' } -> `()' #}
+
+{#fun igraph_vector_ptr_set as ^ { `VectorPPtr', `Int', id `Ptr ()' } -> `()' #}
+
+listToVectorP :: [Ptr ()] -> IO VectorPPtr
+listToVectorP xs = do
+    vptr <- igraphVectorPtrNew n
+    forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorPtrSet vptr i x
+    return vptr
+  where
+    n = length xs
+
+data StrVector
+{#pointer *igraph_strvector_t as StrVectorPtr -> StrVector #}
+
+{#fun igraph_strvector_new as ^ { `Int' } -> `StrVectorPtr' #}
+
+{#fun igraph_strvector_destroy as ^ { `StrVectorPtr' } -> `()' #}
+
+{#fun igraph_strvector_get_ as igraphStrvectorGet' { `StrVectorPtr', `Int' } -> `Ptr CString' id #}
+
+igraphStrvectorGet :: StrVectorPtr -> Int -> String
+igraphStrvectorGet vec i = unsafePerformIO $ do
+    ptr <- igraphStrvectorGet' vec i
+    peek ptr >>= peekCString
+
+{#fun igraph_strvector_set as ^ { `StrVectorPtr', `Int', id `CString'} -> `()' #}
+{#fun igraph_strvector_set2 as ^ { `StrVectorPtr', `Int', id `CString', `Int'} -> `()' #}
+
+listToStrVector :: [B.ByteString] -> IO StrVectorPtr
+listToStrVector xs = do
+    vec <- igraphStrvectorNew n
+    forM_ (zip [0..] xs) $ \(i,x) -> B.useAsCString x (igraphStrvectorSet vec i)
+    return vec
+  where
+    n = length xs
+
+
+data Matrix
+{#pointer *igraph_matrix_t as MatrixPtr -> Matrix #}
+
+{#fun igraph_matrix_new as ^ { `Int', `Int' } -> `MatrixPtr' #}
+
+{#fun igraph_matrix_destroy as ^ { `MatrixPtr' } -> `()' #}
+
+{#fun igraph_matrix_null as ^ { `MatrixPtr' } -> `()' #}
+
+{#fun igraph_matrix_fill as ^ { `MatrixPtr', `Double' } -> `()' #}
+
+{#fun pure igraph_matrix_e as ^ { `MatrixPtr', `Int', `Int' } -> `Double' #}
+
+{#fun pure igraph_matrix_set as ^ { `MatrixPtr', `Int', `Int', `Double' } -> `()' #}

src/IGraph/Internal/Generator.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Generator where
+
+import Foreign
+import Foreign.C.Types
+
+{#import IGraph.Internal.Graph #}
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+-- Deterministic Graph Generators
+
+{#fun igraph_full_ as igraphFull { `Int', `Bool', `Bool' } -> `IGraphPtr' #}

src/IGraph/Internal/Graph.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Graph where
+
+import Foreign
+import Foreign.C.Types
+
+{# import IGraph.Internal.Initialization #}
+{# import IGraph.Internal.Data #}
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+data IGraph
+{#pointer *igraph_t as IGraphPtr -> IGraph #}
+
+-- Graph Constructors and Destructors
+
+igraphNew :: Int -> Bool -> HasInit -> IO IGraphPtr
+igraphNew n directed _ = igraphNew' n directed
+
+{#fun igraph_new as igraphNew' { `Int', `Bool' } -> `IGraphPtr' #}
+
+{#fun igraph_destroy as ^ { `IGraphPtr' } -> `()' #}
+
+-- Basic Query Operations
+
+{#fun pure igraph_vcount as ^ { `IGraphPtr' } -> `Int' #}
+
+{#fun pure igraph_ecount as ^ { `IGraphPtr' } -> `Int' #}
+
+-- Adding and Deleting Vertices and Edges
+
+{# fun igraph_add_edge as ^ { `IGraphPtr', `Int', `Int' } -> `()' #}
+
+{# fun igraph_add_edges as ^ { `IGraphPtr', `VectorPtr', id `Ptr ()' } -> `()' #}

src/IGraph/Internal/Initialization.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Initialization where
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+data HasInit
+
+igraphInit :: IO HasInit
+igraphInit = do haskelligraphInit
+                return undefined
+
+{#fun haskelligraph_init as ^ {} -> `()' #}

test.hs

+import Foreign hiding (new)
+import Control.Monad
+import Data.Serialize
+import qualified Data.ByteString.Internal as B
+import IGraph
+import IGraph.Internal.Graph
+import IGraph.Internal.Generator
+import IGraph.Internal.Attribute
+import IGraph.Internal.Initialization
+import Foreign.Ptr
+
+main = do
+    let g = new 5 :: LGraph U String Double
+    addLEdges "weight" [(1,2,1.1234),(3,4,pi)] g
+    print $ igraphCattributeHasAttr (_graph g) 2 "weight"
+    let s = igraphCattributeEAS (_graph g) "weight" 1
+    print $ (read s :: Double)