refactoring

haskell-igraph.cabal

@@ -27,7 +27,6 @@ library
   exposed-modules:
     IGraph.Internal.Initialization
     IGraph.Internal.Constants
-    IGraph.Internal.Types
     IGraph.Internal
     IGraph
     IGraph.Types
@@ -59,12 +58,13 @@ library
     , cereal-conduit
     , colour
     , conduit >= 1.3.0
+    , data-ordlist
+    , data-default-class
     , primitive
     , unordered-containers
     , hashable
     , hxt
     , split
-    , data-default-class
 
   extra-libraries:     igraph
   hs-source-dirs:      src

src/IGraph.hs

 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
 module IGraph
     ( Graph(..)
     , LGraph(..)
     , U
     , D
-    , decodeC
     , empty
     , mkGraph
     , fromLabeledEdges
@@ -32,7 +32,6 @@ import           Control.Arrow             ((&&&))
 import           Control.Monad             (forM, forM_, liftM, replicateM)
 import           Control.Monad.Primitive
 import           Control.Monad.ST          (runST)
-import qualified Data.ByteString           as B
 import           Data.Conduit.Cereal
 import           Data.Either               (fromRight)
 import           Data.Hashable             (Hashable)
@@ -41,7 +40,7 @@ import qualified Data.HashSet              as S
 import           Data.List                 (sortBy)
 import           Data.Ord                  (comparing)
 import           Data.Serialize
-import           Foreign                   (castPtr)
+import           Foreign                   (castPtr, Ptr)
 import           System.IO.Unsafe          (unsafePerformIO)
 
 import           IGraph.Internal
@@ -92,7 +91,7 @@ class MGraph d => Graph d where
     -- | Return the label of given node.
     nodeLab :: Serialize v => LGraph d v e -> Node -> v
     nodeLab (LGraph g _) i = unsafePerformIO $
-        igraphHaskellAttributeVAS g vertexAttr i >>= bsToByteString >>=
+        igraphHaskellAttributeVAS g vertexAttr i >>= toByteString >>=
             return . fromRight (error "decode failed") . decode
     {-# INLINE nodeLab #-}
 
@@ -105,7 +104,7 @@ class MGraph d => Graph d where
     edgeLab :: Serialize e => LGraph d v e -> Edge -> e
     edgeLab (LGraph g _) (fr,to) = unsafePerformIO $
         igraphGetEid g fr to True True >>=
-            igraphHaskellAttributeEAS g edgeAttr >>= bsToByteString >>=
+            igraphHaskellAttributeEAS g edgeAttr >>= toByteString >>=
                 return . fromRight (error "decode failed") . decode
     {-# INLINE edgeLab #-}
 
@@ -117,7 +116,7 @@ class MGraph d => Graph d where
     -- | Find the edge label by edge ID.
     getEdgeLabByEid :: Serialize e => LGraph d v e -> Int -> e
     getEdgeLabByEid (LGraph g _) i = unsafePerformIO $
-        igraphHaskellAttributeEAS g edgeAttr i >>= bsToByteString >>=
+        igraphHaskellAttributeEAS g edgeAttr i >>= toByteString >>=
             return . fromRight (error "decode failed") . decode
     {-# INLINE getEdgeLabByEid #-}
 
@@ -152,17 +151,6 @@ instance (Graph d, Serialize v, Serialize e, Hashable v, Eq v)
             es <- replicateM ne get
             return $ mkGraph nds es
 
--- | Decode a graph from a stream of inputs. This may be more memory efficient
--- than standard @decode@ function.
-decodeC :: ( PrimMonad m, MonadThrow m, Graph d
-           , Serialize v, Serialize e, Hashable v, Eq v )
-        => ConduitT B.ByteString o m (LGraph d v e)
-decodeC = do
-    nn <- sinkGet get
-    nds <- replicateM nn $ sinkGet get
-    ne <- sinkGet get
-    conduitGet2 get .| deserializeGraph nds ne
-
 -- | Create a empty graph.
 empty :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
       => LGraph d v e
@@ -190,17 +178,18 @@ fromLabeledEdges es = mkGraph labels es'
     labelToId = M.fromList $ zip labels [0..]
 
 -- | Create a graph from a stream of labeled edges.
-fromLabeledEdges' :: (PrimMonad m, Graph d, Hashable v, Serialize v, Eq v, Serialize e)
+fromLabeledEdges' :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
                   => a    -- ^ Input, usually a file
-                  -> (a -> ConduitT () ((v, v), e) m ())  -- ^ deserialize the input into a stream of edges
-                  -> m (LGraph d v e)
+                  -> (a -> ConduitT () ((v, v), e) IO ())  -- ^ deserialize the input into a stream of edges
+                  -> IO (LGraph d v e)
 fromLabeledEdges' input mkConduit = do
     (labelToId, _, ne) <- runConduit $ mkConduit input .|
         foldlC f (M.empty, 0::Int, 0::Int)
+    allocaVectorN (2*ne) $ \evec -> allocaBSVectorN ne $ \bsvec -> do
         let getId x = M.lookupDefault undefined x labelToId
         runConduit $ mkConduit input .|
             mapC (\((v1, v2), e) -> ((getId v1, getId v2), e)) .|
-        deserializeGraph (fst $ unzip $ sortBy (comparing snd) $ M.toList labelToId) ne
+            deserializeGraph (fst $ unzip $ sortBy (comparing snd) $ M.toList labelToId) evec bsvec
   where
     f (vs, nn, ne) ((v1, v2), _) =
         let (vs', nn') = add v1 $ add v2 (vs, nn)
@@ -210,25 +199,24 @@ fromLabeledEdges' input mkConduit = do
             then (m, i)
             else (M.insert v i m, i + 1)
 
-deserializeGraph :: ( PrimMonad m, Graph d, Hashable v, Serialize v
+deserializeGraph :: ( Graph d, Hashable v, Serialize v
                     , Eq v, Serialize e )
                  => [v]
-                 -> Int   -- ^ The number of edges
-                 -> ConduitT (LEdge e) o m (LGraph d v e)
-deserializeGraph nds ne = do
-    evec <- unsafePrimToPrim $ igraphVectorNew $ 2 * ne
-    bsvec <- unsafePrimToPrim $ bsvectorNew ne
-    let f i ((fr, to), attr) = unsafePrimToPrim $ do
+                 -> Ptr Vector  -- ^ a vector that is sufficient to hold all edges
+                 -> Ptr BSVector
+                 -> ConduitT (LEdge e) o IO (LGraph d v e)
+deserializeGraph nds evec bsvec = do
+    let f i ((fr, to), attr) = liftIO $ do
             igraphVectorSet evec (i*2) $ fromIntegral fr
             igraphVectorSet evec (i*2+1) $ fromIntegral to
             bsvectorSet bsvec i $ encode attr
             return $ i + 1
     _ <- foldMC f 0
     gr@(MLGraph g) <- new 0
+    liftIO $ do
         addLNodes nds gr
-    unsafePrimToPrim $ withAttr edgeAttr bsvec $ \ptr -> do
-            vptr <- fromPtrs [castPtr ptr]
-            withVectorPtr vptr (igraphAddEdges g evec . castPtr)
+        withBSAttr edgeAttr bsvec $ \ptr ->
+            withPtrs [ptr] (igraphAddEdges g evec . castPtr)
         unsafeFreeze gr
 {-# INLINE deserializeGraph #-}
 
@@ -246,7 +234,7 @@ unsafeFreeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
 unsafeFreeze (MLGraph g) = unsafePrimToPrim $ do
     nV <- igraphVcount g
     labels <- forM [0 .. nV - 1] $ \i ->
-        igraphHaskellAttributeVAS g vertexAttr i >>= bsToByteString >>=
+        igraphHaskellAttributeVAS g vertexAttr i >>= toByteString >>=
             return . fromRight (error "decode failed") . decode
     return $ LGraph g $ M.fromListWith (++) $ zip labels $ map return [0..nV-1]
   where
@@ -261,24 +249,18 @@ unsafeThaw (LGraph g _) = return $ MLGraph g
 
 -- | Find all neighbors of the given node.
 neighbors :: LGraph d v e -> Node -> [Node]
-neighbors gr i = unsafePerformIO $ do
-    vs <- igraphVsAdj i IgraphAll
-    vit <- igraphVitNew (_graph gr) vs
-    vitToList vit
+neighbors gr i = unsafePerformIO $ withVerticesAdj i IgraphAll $ \vs ->
+    iterateVerticesC (_graph gr) vs $ \source -> runConduit $ source .| sinkList
 
 -- | Find all nodes that have a link from the given node.
 suc :: LGraph D v e -> Node -> [Node]
-suc gr i = unsafePerformIO $ do
-    vs <- igraphVsAdj i IgraphOut
-    vit <- igraphVitNew (_graph gr) vs
-    vitToList vit
+suc gr i = unsafePerformIO $ withVerticesAdj i IgraphOut $ \vs ->
+    iterateVerticesC (_graph gr) vs $ \source -> runConduit $ source .| sinkList
 
 -- | Find all nodes that link to to the given node.
 pre :: LGraph D v e -> Node -> [Node]
-pre gr i = unsafePerformIO $ do
-    vs <- igraphVsAdj i IgraphIn
-    vit <- igraphVitNew (_graph gr) vs
-    vitToList vit
+pre gr i = unsafePerformIO $ withVerticesAdj i IgraphIn $ \vs ->
+    iterateVerticesC (_graph gr) vs $ \source -> runConduit $ source .| sinkList
 
 -- | Apply a function to change nodes' labels.
 nmap :: (Graph d, Serialize v1, Serialize v2, Hashable v2, Eq v2)

src/IGraph/Clique.chs

@@ -8,6 +8,7 @@ import Control.Applicative ((<$>))
 import System.IO.Unsafe (unsafePerformIO)
 
 import qualified Foreign.Ptr as C2HSImp
+import Foreign
 
 import IGraph
 {#import IGraph.Internal #}
@@ -18,18 +19,16 @@ cliques :: LGraph d v e
         -> (Int, Int)  -- ^ Minimum and maximum size of the cliques to be returned.
                        -- No bound will be used if negative or zero
         -> [[Int]]     -- ^ cliques represented by node ids
-cliques gr (lo, hi) = unsafePerformIO $ do
-    vpptr <- igraphVectorPtrNew 0
-    _ <- igraphCliques (_graph gr) vpptr lo hi
+cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
+    igraphCliques (_graph gr) vpptr lo hi
     (map.map) truncate <$> toLists vpptr
-{#fun igraph_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
+{#fun igraph_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}
 
 maximalCliques :: LGraph d v e
                -> (Int, Int)  -- ^ Minimum and maximum size of the cliques to be returned.
                               -- No bound will be used if negative or zero
                -> [[Int]]     -- ^ cliques represented by node ids
-maximalCliques gr (lo, hi) = unsafePerformIO $ do
-    vpptr <- igraphVectorPtrNew 0
-    _ <- igraphMaximalCliques (_graph gr) vpptr lo hi
+maximalCliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
+    igraphMaximalCliques (_graph gr) vpptr lo hi
     (map.map) truncate <$> toLists vpptr
-{#fun igraph_maximal_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
+{#fun igraph_maximal_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}

src/IGraph/Community.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE RecordWildCards #-}
 module IGraph.Community
-    ( CommunityOpt(..)
-    , CommunityMethod(..)
+    ( modularity
     , findCommunity
+    , CommunityMethod(..)
+    , defaultLeadingEigenvector
+    , defaultSpinglass
     ) where
 
 import           Data.Default.Class
 import           Data.Function             (on)
 import           Data.List (sortBy, groupBy)
+import Data.List.Ordered (nubSortBy)
 import           Data.Ord (comparing)
 import           System.IO.Unsafe          (unsafePerformIO)
 
@@ -15,99 +19,116 @@ import           Foreign
 import           Foreign.C.Types
 
 import           IGraph
+import IGraph.Internal.C2HS
 {#import IGraph.Internal #}
 {#import IGraph.Internal.Constants #}
 
 #include "haskell_igraph.h"
 
-data CommunityOpt = CommunityOpt
-    { _method    :: CommunityMethod
-    , _weights   :: Maybe [Double]
-    , _nIter     :: Int  -- ^ [LeadingEigenvector] number of iterations, default is 10000
-    , _nSpins    :: Int  -- ^ [Spinglass] number of spins, default is 25
-    , _startTemp :: Double  -- ^ [Spinglass] the temperature at the start
-    , _stopTemp  :: Double  -- ^ [Spinglass] the algorithm stops at this temperature
-    , _coolFact  :: Double  -- ^ [Spinglass] the cooling factor for the simulated annealing
-    , _gamma     :: Double  -- ^ [Spinglass] the gamma parameter of the algorithm.
-    }
+modularity :: Graph d
+           => LGraph d v e
+           -> [[Int]]   -- ^ Communities.
+           -> Maybe [Double] -- ^ Weights
+           -> Double
+modularity gr clusters ws
+    | length nds /= length (concat clusters) = error "Duplicated nodes"
+    | nds /= nodes gr = error "Some nodes were not given community assignments"
+    | otherwise = unsafePerformIO $ withList membership $ \membership' ->
+        withListMaybe ws (igraphModularity (_graph gr) membership')
+  where
+    (membership, nds) = unzip $ nubSortBy (comparing snd) $ concat $
+        zipWith f [0 :: Int ..] clusters
+      where
+        f i xs = zip (repeat i) xs
+{#fun igraph_modularity as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+	, alloca- `Double' peekFloatConv*
+	, castPtr `Ptr Vector'
+    } -> `CInt' void- #}
 
-data CommunityMethod = LeadingEigenvector
+data CommunityMethod =
+      LeadingEigenvector
+        { _nIter     :: Int  -- ^ number of iterations, default is 10000
+        }
     | Spinglass
+        { _nSpins    :: Int  -- ^ number of spins, default is 25
+        , _startTemp :: Double  -- ^ the temperature at the start
+        , _stopTemp  :: Double  -- ^ the algorithm stops at this temperature
+        , _coolFact  :: Double  -- ^ the cooling factor for the simulated annealing
+        , _gamma     :: Double  -- ^ the gamma parameter of the algorithm.
+        }
 
-instance Default CommunityOpt where
-    def = CommunityOpt
-        { _method = LeadingEigenvector
-        , _weights = Nothing
-        , _nIter = 10000
-        , _nSpins = 25
+defaultLeadingEigenvector :: CommunityMethod
+defaultLeadingEigenvector = LeadingEigenvector 10000
+
+defaultSpinglass :: CommunityMethod
+defaultSpinglass = Spinglass
+    { _nSpins = 25
     , _startTemp = 1.0
     , _stopTemp = 0.01
     , _coolFact = 0.99
-        , _gamma = 1.0
-        }
+    , _gamma = 1.0 }
 
-findCommunity :: LGraph U v e -> CommunityOpt -> [[Int]]
-findCommunity gr opt = unsafePerformIO $ do
-    result <- igraphVectorNew 0
-    ws <- case _weights opt of
-        Just w -> fromList w
-        _      -> fmap Vector $ newForeignPtr_ $ castPtr nullPtr
-
-    _ <- case _method opt of
-        LeadingEigenvector -> do
-            ap <- igraphArpackNew
-            igraphCommunityLeadingEigenvector (_graph gr) ws nullPtr result
-                                              (_nIter opt) ap nullPtr False
+findCommunity :: LGraph U v e
+              -> Maybe [Double]   -- ^ node weights
+              -> CommunityMethod  -- ^ Community finding algorithms
+              -> [[Int]]
+findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result ->
+    withListMaybe ws $ \ws' -> do
+        case method of
+            LeadingEigenvector n -> allocaArpackOpt $ \arpack ->
+                igraphCommunityLeadingEigenvector (_graph gr) ws' nullPtr result
+                                                  n arpack nullPtr False
                                                   nullPtr nullPtr nullPtr
                                                   nullFunPtr nullPtr
-        Spinglass ->
-            igraphCommunitySpinglass (_graph gr) ws nullPtr nullPtr result
-                                     nullPtr (_nSpins opt) False (_startTemp opt)
-                                     (_stopTemp opt) (_coolFact opt)
-                                     IgraphSpincommUpdateConfig (_gamma opt)
+            Spinglass{..} -> igraphCommunitySpinglass (_graph gr) ws' nullPtr nullPtr result
+                                     nullPtr _nSpins False _startTemp
+                                     _stopTemp _coolFact
+                                     IgraphSpincommUpdateConfig _gamma
                                      IgraphSpincommImpOrig 1.0
 
         fmap ( map (fst . unzip) . groupBy ((==) `on` snd)
               . sortBy (comparing snd) . zip [0..] ) $ toList result
 
 {#fun igraph_community_spinglass as ^
-{ `IGraph'
-, `Vector'
-, id `Ptr CDouble'
-, id `Ptr CDouble'
-, `Vector'
-, id `Ptr Vector'
-, `Int'
-, `Bool'
-, `Double'
-, `Double'
-, `Double'
-, `SpincommUpdate'
-, `Double'
-, `SpinglassImplementation'
-, `Double'
-} -> `Int' #}
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , id `Ptr CDouble'
+    , id `Ptr CDouble'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Vector'
+    , `Int'
+    , `Bool'
+    , `Double'
+    , `Double'
+    , `Double'
+    , `SpincommUpdate'
+    , `Double'
+    , `SpinglassImplementation'
+    , `Double'
+    } -> `CInt' void- #}
 
 {#fun igraph_community_leading_eigenvector as ^
-{ `IGraph'
-, `Vector'
-, id `Ptr Matrix'
-, `Vector'
-, `Int'
-, `ArpackOpt'
-, id `Ptr CDouble'
-, `Bool'
-, id `Ptr Vector'
-, id `Ptr VectorPtr'
-, id `Ptr Vector'
-, id `T'
-, id `Ptr ()'
-} -> `Int' #}
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Matrix'
+    , castPtr `Ptr Vector'
+    , `Int'
+    , castPtr `Ptr ArpackOpt'
+    , id `Ptr CDouble'
+    , `Bool'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr VectorPtr'
+    , castPtr `Ptr Vector'
+    , id `T'
+    , id `Ptr ()'
+    } -> `CInt' void- #}
 
-type T = FunPtr ( Ptr Vector
+type T = FunPtr ( Ptr ()
                 -> CLong
                 -> CDouble
-                -> Ptr Vector
+                -> Ptr ()
                 -> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
                 -> Ptr ()
                 -> Ptr ()

src/IGraph/Generators.chs

@@ -12,6 +12,7 @@ import           Data.Hashable                  (Hashable)
 import           Data.Serialize                 (Serialize)
 
 import qualified Foreign.Ptr as C2HSImp
+import Foreign
 
 import           IGraph
 import           IGraph.Mutable
@@ -50,14 +51,13 @@ erdosRenyiGame (GNM n m) d self = do
 degreeSequenceGame :: [Int]   -- ^ Out degree
                    -> [Int]   -- ^ In degree
                    -> IO (LGraph D () ())
-degreeSequenceGame out_deg in_deg = do
-    out_deg' <- fromList $ map fromIntegral out_deg
-    in_deg' <- fromList $ map fromIntegral in_deg
+degreeSequenceGame out_deg in_deg = withList out_deg $ \out_deg' ->
+    withList in_deg $ \in_deg' -> do
         gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
         unsafeFreeze $ MLGraph gp
 {#fun igraph_degree_sequence_game as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
-    , `Vector', `Vector', `Degseq'
+    , castPtr `Ptr Vector', castPtr `Ptr Vector', `Degseq'
     } -> `CInt' void- #}
 
 -- | Randomly rewires a graph while preserving the degree distribution.

src/IGraph/Internal/Types.chs

-{-# LANGUAGE ForeignFunctionInterface #-}
-module IGraph.Internal.Types
-    ( -- * Vector type and basic operations
-      Vector(..)
-    , withVector
-    , allocaVector
-    , addVectorFinalizer
-
-    -- * Pointer vector
-    , VectorPtr(..)
-    , withVectorPtr
-    , allocaVectorPtr
-    , addVectorPtrFinalizer
-
-    -- * String vector
-    , StrVector(..)
-    , withStrVector
-    , allocaStrVector
-    , addStrVectorFinalizer
-
-    -- * Bytestring
-    , BSLen(..)
-    , withBSLen
-
-    -- * Bytestring vector
-    , BSVector(..)
-    , withBSVector
-    , allocaBSVector
-    , addBSVectorFinalizer
-
-    -- * Igraph matrix type
-    , Matrix(..)
-    , withMatrix
-    , allocaMatrix
-    , addMatrixFinalizer
-
-    -- * Igraph vertex selector
-    , IGraphVs(..)
-    , withIGraphVs
-    , allocaVs
-    , addVsFinalizer
-
-    -- * Igraph vertex iterator
-    , IGraphVit(..)
-    , withIGraphVit
-    , allocaVit
-    , addVitFinalizer
-
-    -- * Igraph edge Selector
-    , IGraphEs
-    , withIGraphEs
-    , allocaEs
-    , addEsFinalizer
-
-    -- * Igraph edge iterator
-    , IGraphEit(..)
-    , withIGraphEit
-    , allocaEit
-    , addEitFinalizer
-
-    -- * IGraph type and basic operations
-    , IGraph(..)
-    , withIGraph
-    , allocaIGraph
-    , addIGraphFinalizer
-
-    -- * Igraph attribute record
-    , AttributeRecord(..)
-    , withAttributeRecord
-
-    -- * Igraph arpack options type
-    , ArpackOpt(..)
-    , withArpackOpt
-    , igraphArpackNew
-    ) where
-
-import Foreign
-
-#include "haskell_attributes.h"
-#include "haskell_igraph.h"
-
---------------------------------------------------------------------------------
--- Igraph vector
---------------------------------------------------------------------------------
-
-{#pointer *igraph_vector_t as Vector foreign finalizer
-    igraph_vector_destroy newtype#}
-
--- Construtors and destructors
-
-allocaVector :: (Ptr Vector -> IO a) -> IO a
-allocaVector f = mallocBytes {# sizeof igraph_vector_t #} >>= f
-{-# INLINE allocaVector #-}
-
-addVectorFinalizer :: Ptr Vector -> IO Vector
-addVectorFinalizer ptr = do
-    vec <- newForeignPtr igraph_vector_destroy ptr
-    return $ Vector vec
-{-# INLINE addVectorFinalizer #-}
-
-
-{#pointer *igraph_vector_ptr_t as VectorPtr foreign finalizer
-    igraph_vector_ptr_destroy newtype#}
-
-allocaVectorPtr :: (Ptr VectorPtr -> IO a) -> IO a
-allocaVectorPtr f = mallocBytes {# sizeof igraph_vector_ptr_t #} >>= f
-{-# INLINE allocaVectorPtr #-}
-
-addVectorPtrFinalizer :: Ptr VectorPtr -> IO VectorPtr
-addVectorPtrFinalizer ptr = do
-    vec <- newForeignPtr igraph_vector_ptr_destroy ptr
-    return $ VectorPtr vec
-{-# INLINE addVectorPtrFinalizer #-}
-
---------------------------------------------------------------------------------
--- Igraph string vector
---------------------------------------------------------------------------------
-
-{#pointer *igraph_strvector_t as StrVector foreign finalizer igraph_strvector_destroy newtype#}
-
-allocaStrVector :: (Ptr StrVector -> IO a) -> IO a
-allocaStrVector f = mallocBytes {# sizeof igraph_strvector_t #} >>= f
-{-# INLINE allocaStrVector #-}
-
-addStrVectorFinalizer :: Ptr StrVector -> IO StrVector
-addStrVectorFinalizer ptr = do
-    vec <- newForeignPtr igraph_strvector_destroy ptr
-    return $ StrVector vec
-{-# INLINE addStrVectorFinalizer #-}
-
-
---------------------------------------------------------------------------------
--- Customized string vector
---------------------------------------------------------------------------------
-
-{#pointer *bytestring_t as BSLen foreign newtype#}
-
-{#pointer *bsvector_t as BSVector foreign finalizer bsvector_destroy newtype#}
-
-allocaBSVector :: (Ptr BSVector -> IO a) -> IO a
-allocaBSVector f = mallocBytes {# sizeof bsvector_t #} >>= f
-{-# INLINE allocaBSVector #-}
-
-addBSVectorFinalizer :: Ptr BSVector -> IO BSVector
-addBSVectorFinalizer ptr = do
-    vec <- newForeignPtr bsvector_destroy ptr
-    return $ BSVector vec
-{-# INLINE addBSVectorFinalizer #-}
-
-{#pointer *igraph_matrix_t as Matrix foreign finalizer igraph_matrix_destroy newtype#}
-
-allocaMatrix :: (Ptr Matrix -> IO a) -> IO a
-allocaMatrix f = mallocBytes {# sizeof igraph_matrix_t #} >>= f
-{-# INLINE allocaMatrix #-}
-
-addMatrixFinalizer :: Ptr Matrix -> IO Matrix
-addMatrixFinalizer ptr = do
-    vec <- newForeignPtr igraph_matrix_destroy ptr
-    return $ Matrix vec
-{-# INLINE addMatrixFinalizer #-}
-
-
-{#pointer *igraph_vs_t as IGraphVs foreign finalizer igraph_vs_destroy newtype #}
-
-allocaVs :: (Ptr IGraphVs -> IO a) -> IO a
-allocaVs f = mallocBytes {# sizeof igraph_vs_t #} >>= f
-{-# INLINE allocaVs #-}
-
-addVsFinalizer :: Ptr IGraphVs -> IO IGraphVs
-addVsFinalizer ptr = newForeignPtr igraph_vs_destroy ptr >>= return . IGraphVs
-{-# INLINE addVsFinalizer #-}
-
-
--- Vertex iterator
-{#pointer *igraph_vit_t as IGraphVit foreign finalizer igraph_vit_destroy newtype #}
-
-allocaVit :: (Ptr IGraphVit -> IO a) -> IO a
-allocaVit f = mallocBytes {# sizeof igraph_vit_t #} >>= f
-{-# INLINE allocaVit #-}
-
-addVitFinalizer :: Ptr IGraphVit -> IO IGraphVit
-addVitFinalizer ptr = newForeignPtr igraph_vit_destroy ptr >>= return . IGraphVit
-{-# INLINE addVitFinalizer #-}
-
--- Edge Selector
-
-{#pointer *igraph_es_t as IGraphEs foreign finalizer igraph_es_destroy newtype #}
-
-allocaEs :: (Ptr IGraphEs -> IO a) -> IO a
-allocaEs f = mallocBytes {# sizeof igraph_es_t #} >>= f
-{-# INLINE allocaEs #-}
-
-addEsFinalizer :: Ptr IGraphEs -> IO IGraphEs
-addEsFinalizer ptr = newForeignPtr igraph_es_destroy ptr >>= return . IGraphEs
-{-# INLINE addEsFinalizer #-}
-
--- Edge iterator
-
-{#pointer *igraph_eit_t as IGraphEit foreign finalizer igraph_eit_destroy newtype #}
-
-allocaEit :: (Ptr IGraphEit -> IO a) -> IO a
-allocaEit f = mallocBytes {# sizeof igraph_eit_t #} >>= f
-{-# INLINE allocaEit #-}
-
-addEitFinalizer :: Ptr IGraphEit -> IO IGraphEit
-addEitFinalizer ptr = newForeignPtr igraph_eit_destroy ptr >>= return . IGraphEit
-{-# INLINE addEitFinalizer #-}
-
-
---------------------------------------------------------------------------------
--- Graph Constructors and Destructors
---------------------------------------------------------------------------------
-
-{#pointer *igraph_t as IGraph foreign finalizer igraph_destroy newtype#}
-
-allocaIGraph :: (Ptr IGraph -> IO a) -> IO a
-allocaIGraph f = mallocBytes {# sizeof igraph_t #} >>= f
-{-# INLINE allocaIGraph #-}
-
-addIGraphFinalizer :: Ptr IGraph -> IO IGraph
-addIGraphFinalizer ptr = do
-    vec <- newForeignPtr igraph_destroy ptr
-    return $ IGraph vec
-{-# INLINE addIGraphFinalizer #-}
-
-{#pointer *igraph_attribute_record_t as AttributeRecord foreign newtype#}
-
-{#pointer *igraph_arpack_options_t as ArpackOpt foreign newtype#}
-
-{#fun igraph_arpack_options_init as igraphArpackNew
-    { + } -> `ArpackOpt' #}

src/IGraph/Isomorphism.chs

@@ -23,8 +23,7 @@ getSubisomorphisms :: Graph d
                    => LGraph d v1 e1  -- ^ graph to be searched in
                    -> LGraph d v2 e2   -- ^ smaller graph
                    -> [[Int]]
-getSubisomorphisms g1 g2 = unsafePerformIO $ do
-    vpptr <- igraphVectorPtrNew 0
+getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
     igraphGetSubisomorphismsVf2 gptr1 gptr2 nullPtr nullPtr nullPtr nullPtr vpptr
         nullFunPtr nullFunPtr nullPtr
     (map.map) truncate <$> toLists vpptr
@@ -39,7 +38,7 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ do
     , id `Ptr ()'
     , id `Ptr ()'
     , id `Ptr ()'
-    , `VectorPtr'
+    , castPtr `Ptr VectorPtr'
     , id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)'
     , id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)'
     , id `Ptr ()'

src/IGraph/Layout.chs

@@ -62,25 +62,25 @@ defaultLGL = LGL
     area x = fromIntegral $ x^2
 
 getLayout :: Graph d => LGraph d v e -> LayoutMethod -> IO [(Double, Double)]
-getLayout gr method = do
-    case method of
-        KamadaKawai seed niter sigma initemp coolexp kkconst -> do
-            mptr <- case seed of
-                Nothing -> igraphMatrixNew 0 0
+getLayout gr method = case method of
+    KamadaKawai seed niter sigma initemp coolexp kkconst -> case seed of
+        Nothing -> allocaMatrix $ \mat -> do
+            igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
+                (kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
+            [x, y] <- toColumnLists mat
+            return $ zip x y
         Just xs -> if length xs /= nNodes gr
             then error "Seed error: incorrect size"
-                               else fromRowLists $ (\(x,y) -> [x,y]) $ unzip xs
-
-            igraphLayoutKamadaKawai gptr mptr niter (sigma n) initemp coolexp
+            else withRowLists ((\(x,y) -> [x,y]) (unzip xs)) $ \mat -> do
+                igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
                     (kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
-            [x, y] <- toColumnLists mptr
+                [x, y] <- toColumnLists mat
                 return $ zip x y
 
-        LGL niter delta area coolexp repulserad cellsize -> do
-            mptr <- igraphMatrixNew 0 0
-            igraphLayoutLgl gptr mptr niter (delta n) (area n) coolexp
+    LGL niter delta area coolexp repulserad cellsize -> allocaMatrix $ \mat -> do
+        igraphLayoutLgl gptr mat niter (delta n) (area n) coolexp
             (repulserad n) (cellsize n) (-1)
-            [x, y] <- toColumnLists mptr
+        [x, y] <- toColumnLists mat
         return $ zip x y
   where
     n = nNodes gr
@@ -88,22 +88,22 @@ getLayout gr method = do
 
 {#fun igraph_layout_kamada_kawai as ^
     { `IGraph'
-    , `Matrix'
+    , castPtr `Ptr Matrix'
     , `Int'
     , `Double'
     , `Double'
     , `Double'
     , `Double'
     , `Bool'
-    , id `Ptr Vector'
-    , id `Ptr Vector'
-    , id `Ptr Vector'
-    , id `Ptr Vector'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Vector'
     } -> `CInt' void- #}
 
 {# fun igraph_layout_lgl as ^
     { `IGraph'
-    , `Matrix'
+    , castPtr `Ptr Matrix'
     , `Int'
     , `Double'
     , `Double'

src/IGraph/Motif.chs

@@ -7,6 +7,7 @@ module IGraph.Motif
 import Data.Hashable (Hashable)
 import System.IO.Unsafe (unsafePerformIO)
 
+import Foreign
 import qualified Foreign.Ptr as C2HSImp
 
 import IGraph
@@ -56,15 +57,14 @@ triad = map make edgeList
     make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
 
 triadCensus :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int]
-triadCensus gr = unsafePerformIO $ do
-    vptr <- igraphVectorNew 0
-    igraphTriadCensus (_graph gr) vptr
-    map truncate <$> toList vptr
+triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
+    igraphTriadCensus (_graph gr) result
+    map truncate <$> toList result
 
 -- motifsRandesu
 
 {#fun igraph_triad_census as ^ { `IGraph'
-                               , `Vector' } -> `CInt' void- #}
+                               , castPtr `Ptr Vector' } -> `CInt' void- #}
 
-{#fun igraph_motifs_randesu as ^ { `IGraph', `Vector', `Int'
-                                 , `Vector' } -> `CInt' void- #}
+{#fun igraph_motifs_randesu as ^ { `IGraph', castPtr `Ptr Vector', `Int'
+                                 , castPtr `Ptr Vector' } -> `CInt' void- #}

src/IGraph/Mutable.hs

@@ -32,40 +32,31 @@ class MGraph d where
     addLNodes :: (Serialize v, PrimMonad m)
               => [v]  -- ^ vertices' labels
               -> MLGraph (PrimState m) d v e -> m ()
-    addLNodes labels (MLGraph g) = unsafePrimToPrim $ do
-        bsvec <- toBSVector $ map encode labels
-        withAttr vertexAttr bsvec $ \attr -> do
-            vptr <- fromPtrs [castPtr attr]
-            withVectorPtr vptr (igraphAddVertices g n . castPtr)
+    addLNodes labels (MLGraph g) = unsafePrimToPrim $
+        withAttr vertexAttr labels $ \attr ->
+            withPtrs [attr] (igraphAddVertices g n . castPtr)
       where
         n = length labels
 
     -- | Delete nodes from the graph.
     delNodes :: PrimMonad m => [Int] -> MLGraph (PrimState m) d v e -> m ()
-    delNodes ns (MLGraph g) = unsafePrimToPrim $ do
-        vptr <- fromList $ map fromIntegral ns
-        vsptr <- igraphVsVector vptr
-        _ <- igraphDeleteVertices g vsptr
-        return ()
+    delNodes ns (MLGraph g) = unsafePrimToPrim $ withVerticesList ns $ \vs ->
+        igraphDeleteVertices g vs
 
     -- | Add edges to the graph.
     addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
-    addEdges es (MLGraph g) = unsafePrimToPrim $ do
-        vec <- fromList xs
+    addEdges es (MLGraph g) = unsafePrimToPrim $ withList xs $ \vec ->
         igraphAddEdges g vec nullPtr
       where
-        xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es
+        xs = concatMap ( \(a,b) -> [a, b] ) es
 
     -- | Add edges with labels to the graph.
     addLEdges :: (PrimMonad m, Serialize e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
-    addLEdges es (MLGraph g) = unsafePrimToPrim $ do
-        bsvec <- toBSVector $ map encode vs
-        withAttr edgeAttr bsvec $ \attr -> do
-            vec <- fromList $ concat xs
-            vptr <- fromPtrs [castPtr attr]
-            withVectorPtr vptr (igraphAddEdges g vec . castPtr)
+    addLEdges es (MLGraph g) = unsafePrimToPrim $
+        withAttr edgeAttr vs $ \attr -> withList (concat xs) $ \vec ->
+            withPtrs [attr] (igraphAddEdges g vec . castPtr)
       where
-        (xs, vs) = unzip $ map ( \((a,b),v) -> ([fromIntegral a, fromIntegral b], v) ) es
+        (xs, vs) = unzip $ map ( \((a,b),v) -> ([a, b], v) ) es
 
     -- | Delete edges from the graph.
     delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
@@ -75,20 +66,14 @@ instance MGraph U where
 
     delEdges es (MLGraph g) = unsafePrimToPrim $ do
         eids <- forM es $ \(fr, to) -> igraphGetEid g fr to False True
-        vptr <- fromList $ map fromIntegral eids
-        esptr <- igraphEsVector vptr
-        _ <- igraphDeleteEdges g esptr
-        return ()
+        withEdgesList eids (igraphDeleteEdges g)
 
 instance MGraph D where
     new n = unsafePrimToPrim $ igraphInit >>= igraphNew n True >>= return . MLGraph
 
     delEdges es (MLGraph g) = unsafePrimToPrim $ do
         eids <- forM es $ \(fr, to) -> igraphGetEid g fr to True True
-        vptr <- fromList $ map fromIntegral eids
-        esptr <- igraphEsVector vptr
-        igraphDeleteEdges g esptr
-        return ()
+        withEdgesList eids (igraphDeleteEdges g)
 
 -- | Set node attribute.
 setNodeAttr :: (PrimMonad m, Serialize v)
@@ -96,7 +81,8 @@ setNodeAttr :: (PrimMonad m, Serialize v)
             -> v
             -> MLGraph (PrimState m) d v e
             -> m ()
-setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $ asBS (encode x) $ \bs -> do
+setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $
+    withByteString (encode x) $ \bs -> do
         err <- igraphHaskellAttributeVASSet gr vertexAttr nodeId bs
         when (err /= 0) $ error "Fail to set node attribute!"
 
@@ -106,6 +92,7 @@ setEdgeAttr :: (PrimMonad m, Serialize e)
             -> e
             -> MLGraph (PrimState m) d v e
             -> m ()
-setEdgeAttr edgeId x (MLGraph gr) = unsafePrimToPrim $ asBS (encode x) $ \bs -> do
+setEdgeAttr edgeId x (MLGraph gr) = unsafePrimToPrim $
+    withByteString (encode x) $ \bs -> do
         err <- igraphHaskellAttributeEASSet gr edgeAttr edgeId bs
         when (err /= 0) $ error "Fail to set edge attribute!"

src/IGraph/Structure.chs

@@ -14,6 +14,7 @@ import           Data.Hashable             (Hashable)
 import qualified Data.HashMap.Strict       as M
 import           Data.Serialize            (Serialize, decode)
 import           System.IO.Unsafe          (unsafePerformIO)
+import Data.Maybe
 
 import Foreign
 import Foreign.C.Types
@@ -26,10 +27,8 @@ import           IGraph.Mutable
 #include "igraph/igraph.h"
 
 inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
-inducedSubgraph gr vs = unsafePerformIO $ do
-    vs' <- fromList $ map fromIntegral vs
-    vsptr <- igraphVsVector vs'
-    igraphInducedSubgraph (_graph gr) vsptr IgraphSubgraphCreateFromScratch >>=
+inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
+    igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
         unsafeFreeze . MLGraph
 
 -- | Closeness centrality
@@ -39,43 +38,29 @@ closeness :: [Int]  -- ^ vertices
           -> Neimode
           -> Bool   -- ^ whether to normalize
           -> [Double]
-closeness vs gr ws mode normal = unsafePerformIO $ do
-    vs' <- fromList $ map fromIntegral vs
-    vsptr <- igraphVsVector vs'
-    vptr <- igraphVectorNew 0
-    ws' <- case ws of
-        Just w -> fromList w
-        _      -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
-    igraphCloseness (_graph gr) vptr vsptr mode ws' normal
-    toList vptr
+closeness nds gr ws mode normal = unsafePerformIO $ allocaVector $ \result ->
+    withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
+        igraphCloseness (_graph gr) result vs mode ws' normal
+        toList result
 
 -- | Betweenness centrality
 betweenness :: [Int]
             -> LGraph d v e
             -> Maybe [Double]
             -> [Double]
-betweenness vs gr ws = unsafePerformIO $ do
-    vs' <- fromList $ map fromIntegral vs
-    vsptr <- igraphVsVector vs'
-    vptr <- igraphVectorNew 0
-    ws' <- case ws of
-        Just w -> fromList w
-        _      -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
-    igraphBetweenness (_graph gr) vptr vsptr True ws' False
-    toList vptr
+betweenness nds gr ws = unsafePerformIO $ allocaVector $ \result ->
+    withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
+        igraphBetweenness (_graph gr) result vs True ws' False
+        toList result
 
 -- | Eigenvector centrality
 eigenvectorCentrality :: LGraph d v e
                       -> Maybe [Double]
                       -> [Double]
-eigenvectorCentrality gr ws = unsafePerformIO $ do
-    vptr <- igraphVectorNew 0
-    ws' <- case ws of
-        Just w -> fromList w
-        _      -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
-    arparck <- igraphArpackNew
-    igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck
-    toList vptr
+eigenvectorCentrality gr ws = unsafePerformIO $ allocaArpackOpt $ \arparck ->
+    allocaVector $ \result -> withListMaybe ws $ \ws' -> do
+        igraphEigenvectorCentrality (_graph gr) result nullPtr True True ws' arparck
+        toList result
 
 -- | Google's PageRank
 pagerank :: Graph d
@@ -85,17 +70,12 @@ pagerank :: Graph d
          -> [Double]
 pagerank gr ws d
     | n == 0 = []
-    | otherwise = unsafePerformIO $ alloca $ \p -> do
-        vptr <- igraphVectorNew 0
-        vsptr <- igraphVsAll
-        ws' <- case ws of
-            Just w -> if length w /= m
-                then error "pagerank: incorrect length of edge weight vector"
-                else fromList w
-            _ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
-        igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
+    | isJust ws && length (fromJust ws) /= m = error "incorrect length of edge weight vector"
+    | otherwise = unsafePerformIO $ alloca $ \p -> allocaVector $ \result ->
+        withVerticesAll $ \vs -> withListMaybe ws $ \ws' -> do
+            igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack result p vs
                 (isDirected gr) d ws' nullPtr
-        toList vptr
+            toList result
   where
     n = nNodes gr
     m = nEdges gr
@@ -109,19 +89,13 @@ personalizedPagerank :: Graph d
                      -> [Double]
 personalizedPagerank gr reset ws d
     | n == 0 = []
-    | length reset /= n = error "personalizedPagerank: incorrect length of reset vector"
-    | otherwise = unsafePerformIO $ alloca $ \p -> do
-        vptr <- igraphVectorNew 0
-        vsptr <- igraphVsAll
-        ws' <- case ws of
-            Just w -> if length w /= m
-                then error "pagerank: incorrect length of edge weight vector"
-                else fromList w
-            _ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
-        reset' <- fromList reset
-        igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
+    | length reset /= n = error "incorrect length of reset vector"
+    | isJust ws && length (fromJust ws) /= m = error "incorrect length of edge weight vector"
+    | otherwise = unsafePerformIO $ alloca $ \p -> allocaVector $ \result ->
+        withList reset $ \reset' -> withVerticesAll $ \vs -> withListMaybe ws $ \ws' -> do
+            igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack result p vs
                 (isDirected gr) d reset' ws' nullPtr
-        toList vptr
+            toList result
   where
     n = nNodes gr
     m = nEdges gr
@@ -129,53 +103,56 @@ personalizedPagerank gr reset ws d
 {#fun igraph_induced_subgraph as ^
     { `IGraph'
     , allocaIGraph- `IGraph' addIGraphFinalizer*
-    , %`IGraphVs'
+    , castPtr %`Ptr VertexSelector'
     , `SubgraphImplementation'
     } -> `CInt' void- #}
 
-{#fun igraph_closeness as ^ { `IGraph'
-                            , `Vector'
-                            , %`IGraphVs'
+{#fun igraph_closeness as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr %`Ptr VertexSelector'
     , `Neimode'
-                            , `Vector'
+    , castPtr `Ptr Vector'
     , `Bool' } -> `CInt' void- #}
 
-{#fun igraph_betweenness as ^ { `IGraph'
-                              , `Vector'
-                              , %`IGraphVs'
+{#fun igraph_betweenness as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr %`Ptr VertexSelector'
     , `Bool'
-                              , `Vector'
+    , castPtr `Ptr Vector'
     , `Bool' } -> `CInt' void- #}
 
-{#fun igraph_eigenvector_centrality as ^ { `IGraph'
-                                         , `Vector'
+{#fun igraph_eigenvector_centrality as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
     , id `Ptr CDouble'
     , `Bool'
     , `Bool'
-                                         , `Vector'
-                                         , `ArpackOpt' } -> `CInt' void- #}
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr ArpackOpt' } -> `CInt' void- #}
 
 {#fun igraph_pagerank as ^
     { `IGraph'
     , `PagerankAlgo'
-    , `Vector'
+    , castPtr `Ptr Vector'
     , id `Ptr CDouble'
-    , %`IGraphVs'
+    , castPtr %`Ptr VertexSelector'
     , `Bool'
     , `Double'
-    , `Vector'
+    , castPtr `Ptr Vector'
     , id `Ptr ()'
     } -> `CInt' void- #}
 
 {#fun igraph_personalized_pagerank as ^
     { `IGraph'
     , `PagerankAlgo'
-    , `Vector'
+    , castPtr `Ptr Vector'
     , id `Ptr CDouble'
-    , %`IGraphVs'
+    , castPtr %`Ptr VertexSelector'
     , `Bool'
     , `Double'
-    , `Vector'
-    , `Vector'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr Vector'
     , id `Ptr ()'
     } -> `CInt' void- #}

tests/Test/Attributes.hs

@@ -54,7 +54,4 @@ serializeTest = testCase "serialize test" $ do
             Left msg -> error msg
             Right r  -> r
         es' = map (\(a,b) -> ((nodeLab gr' a, nodeLab gr' b), edgeLab gr' (a,b))) $ edges gr'
-    gr'' <- runConduit $ (yield $ encode gr) .| decodeC :: IO (LGraph D NodeAttr EdgeAttr)
-    let es'' = map (\(a,b) -> ((nodeLab gr'' a, nodeLab gr'' b), edgeLab gr'' (a,b))) $ edges gr''
-    assertBool "" $ sort (map show es) == sort (map show es') &&
-        sort (map show es) == sort (map show es'')
+    assertBool "" $ sort (map show es) == sort (map show es')

tests/Test/Basic.hs

@@ -50,7 +50,7 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
     n = length $ nubSort $ concatMap (\((a,b),_) -> [a,b]) edgeList
     m = length edgeList
     gr = fromLabeledEdges edgeList :: LGraph D String Int
-    gr' = runST $ fromLabeledEdges' edgeList yieldMany :: LGraph D String Int
+    gr' = unsafePerformIO $ fromLabeledEdges' edgeList yieldMany :: LGraph D String Int
 
 graphEdit :: TestTree
 graphEdit = testGroup "Graph editing"