-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/IGraph/Internal.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal
    ( -- * Data structure library: vector, matrix, other data types
      -- ** Igraph vector type and basic operations
      Vector
    , allocaVector
    , allocaVectorN
    , withList
    , withListMaybe
    , toList
    , igraphVectorNull
    , igraphVectorFill
    , igraphVectorE
    , igraphVectorSet
    , igraphVectorTail
    , igraphVectorSize
    , igraphVectorCopyTo

    -- ** Igraph pointer vector
    , VectorPtr
    , allocaVectorPtr
    , allocaVectorPtrN
    , withPtrs
    , toLists
    , igraphVectorPtrSize
    , igraphVectorPtrE
    , igraphVectorPtrSet

      -- ** Customized bytestring for storing attributes
    , BSLen
    , withByteString
    , toByteString

      -- ** Customized bytestring vector
    , BSVector
    , allocaBSVectorN
    , withByteStrings
    , bsvectorSet

      -- ** Igraph matrix type
    , Matrix
    , allocaMatrix
    , allocaMatrixN
    , withRowLists
    , toRowLists
    , toColumnLists
    , igraphMatrixNull
    , igraphMatrixFill
    , igraphMatrixE
    , igraphMatrixSet
    , igraphMatrixCopyTo
    , igraphMatrixNrow
    , igraphMatrixNcol

      -- * Igraph type and constructors
    , IGraph
    , withIGraph
    , allocaIGraph
    , addIGraphFinalizer
    , mkLabelToId
    , initializeNullAttribute
    , igraphNew
    , igraphCreate
    , igraphIsSimple
    , igraphHasMultiple

      -- * Selector and iterator for edge and vertex
      -- ** Igraph vertex selector
    , VertexSelector
    , withVerticesAll
    , withVerticesAdj
    , withVerticesVector
    , withVerticesList

      -- ** Igraph vertex iterator
    , VertexIterator
    , iterateVertices
    , iterateVerticesC

      -- ** Igraph edge Selector
    , EdgeSelector
    , withEdgesAll
    , withEdgeIdsVector
    , withEdgeIdsList

      -- ** Igraph edge iterator
    , EdgeIterator
    , iterateEdges
    , iterateEdgesC

      -- * Basic graph operations
    , igraphCopy
    , igraphVcount
    , igraphEcount
    , igraphGetEid
    , igraphEdge
    , igraphAddVertices
    , igraphAddEdge
    , igraphAddEdges
    , igraphDeleteVertices
    , igraphDeleteEdges

      -- * Igraph attribute record
    , AttributeRecord
    , withAttr
    , withBSAttr
    , igraphHaskellAttributeHasAttr
    , igraphHaskellAttributeVAS
    , igraphHaskellAttributeEAS
    , igraphHaskellAttributeVASSet
    , igraphHaskellAttributeVASSetv
    , igraphHaskellAttributeEASSet
    , igraphHaskellAttributeEASSetv

      -- * Igraph arpack options type
    , ArpackOpt
    , allocaArpackOpt
    ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.List (transpose)
import qualified Data.Map.Strict as M
import           System.IO.Unsafe          (unsafePerformIO)
import Data.Either (fromRight)
import Data.List.Split (chunksOf)
import Data.Serialize (Serialize, decode, encode)
import           Control.Monad.Primitive
import Control.Exception (bracket_)
import Conduit (ConduitT, yield, liftIO)

import Foreign
import Foreign.C.Types
import Foreign.C.String
import IGraph.Internal.C2HS

import IGraph.Internal.Initialization
{-# LINE 139 "src/IGraph/Internal.chs" #-}

import IGraph.Internal.Constants
{-# LINE 140 "src/IGraph/Internal.chs" #-}

import IGraph.Types




--------------------------------------------------------------------------------
-- Igraph vector
--------------------------------------------------------------------------------

data Vector

-- | Allocate and initialize a vector.
allocaVector :: (Ptr Vector -> IO a) -> IO a
allocaVector fun = allocaBytes 24 $ \vec ->
    bracket_ (igraphVectorInit vec 0) (igraphVectorDestroy vec) (fun vec)
{-# INLINE allocaVector #-}

allocaVectorN :: Int -> (Ptr Vector -> IO a) -> IO a
allocaVectorN n fun = allocaBytes 24 $ \vec ->
    bracket_ (igraphVectorInit vec n) (igraphVectorDestroy vec) (fun vec)
{-# INLINE allocaVectorN #-}

igraphVectorInit :: (Ptr Vector) -> (Int) -> IO ()
igraphVectorInit a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  igraphVectorInit'_ a1' a2' >>= \res ->
  return ()

{-# LINE 163 "src/IGraph/Internal.chs" #-}

igraphVectorDestroy :: (Ptr Vector) -> IO ()
igraphVectorDestroy a1 =
  let {a1' = castPtr a1} in
  igraphVectorDestroy'_ a1' >>= \res ->
  return ()

{-# LINE 164 "src/IGraph/Internal.chs" #-}


withList :: Real a => [a] -> (Ptr Vector -> IO b) -> IO b
withList xs fun = withArrayLen (map realToFrac xs) $ \n ptr ->
    allocaBytes 24 $ \vec ->
        bracket_ (igraphVectorInitCopy vec ptr n) (igraphVectorDestroy vec) (fun vec)
{-# INLINE withList #-}
igraphVectorInitCopy :: (Ptr Vector) -> (Ptr CDouble) -> (Int) -> IO ()
igraphVectorInitCopy a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  igraphVectorInitCopy'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 173 "src/IGraph/Internal.chs" #-}


-- | Allocate a nullPtr if Nothing
withListMaybe :: Real a => Maybe [a] -> (Ptr Vector -> IO b) -> IO b
withListMaybe (Just xs) fun = withList xs fun
withListMaybe Nothing fun = fun $ castPtr nullPtr
{-# INLINE withListMaybe #-}


toList :: Ptr Vector -> IO [Double]
toList vec = do
    n <- igraphVectorSize vec
    allocaArray n $ \ptr -> do
        igraphVectorCopyTo vec ptr
        map realToFrac <$> peekArray n ptr
{-# INLINE toList #-}

igraphVectorCopyTo :: (Ptr Vector) -> (Ptr CDouble) -> IO ()
igraphVectorCopyTo a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = id a2} in
  igraphVectorCopyTo'_ a1' a2' >>
  return ()

{-# LINE 190 "src/IGraph/Internal.chs" #-}


-- Initializing elements

igraphVectorNull :: (Ptr Vector) -> IO ()
igraphVectorNull a1 =
  let {a1' = castPtr a1} in
  igraphVectorNull'_ a1' >>
  return ()

{-# LINE 194 "src/IGraph/Internal.chs" #-}


igraphVectorFill :: (Ptr Vector) -> (Double) -> IO ()
igraphVectorFill a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = realToFrac a2} in
  igraphVectorFill'_ a1' a2' >>
  return ()

{-# LINE 196 "src/IGraph/Internal.chs" #-}



-- Accessing elements

igraphVectorE :: (Ptr Vector) -> (Int) -> IO ((Double))
igraphVectorE a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  igraphVectorE'_ a1' a2' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 201 "src/IGraph/Internal.chs" #-}


igraphVectorSet :: (Ptr Vector) -> (Int) -> (Double) -> IO ()
igraphVectorSet a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = realToFrac a3} in
  igraphVectorSet'_ a1' a2' a3' >>
  return ()

{-# LINE 203 "src/IGraph/Internal.chs" #-}


igraphVectorTail :: (Ptr Vector) -> IO ((Double))
igraphVectorTail a1 =
  let {a1' = castPtr a1} in
  igraphVectorTail'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 205 "src/IGraph/Internal.chs" #-}



-- Vector properties
igraphVectorSize :: (Ptr Vector) -> IO ((Int))
igraphVectorSize a1 =
  let {a1' = castPtr a1} in
  igraphVectorSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 209 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Pointer Vector
--------------------------------------------------------------------------------

data VectorPtr

-- | Allocate and initialize a pointer vector.
allocaVectorPtr :: (Ptr VectorPtr -> IO a) -> IO a
allocaVectorPtr fun = allocaBytes 32 $ \ptr ->
    bracket_ (igraphVectorPtrInit ptr 0) (igraphVectorPtrDestroy ptr) (fun ptr)
{-# INLINE allocaVectorPtr #-}

allocaVectorPtrN :: Int -> (Ptr VectorPtr -> IO a) -> IO a
allocaVectorPtrN n fun = allocaBytes 32 $ \ptr ->
    bracket_ (igraphVectorPtrInit ptr n) (igraphVectorPtrDestroy ptr) (fun ptr)
{-# INLINE allocaVectorPtrN #-}

igraphVectorPtrInit :: (Ptr VectorPtr) -> (Int) -> IO ()
igraphVectorPtrInit a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  igraphVectorPtrInit'_ a1' a2' >>= \res ->
  return ()

{-# LINE 229 "src/IGraph/Internal.chs" #-}

igraphVectorPtrDestroy :: (Ptr VectorPtr) -> IO ()
igraphVectorPtrDestroy a1 =
  let {a1' = castPtr a1} in
  igraphVectorPtrDestroy'_ a1' >>
  return ()

{-# LINE 230 "src/IGraph/Internal.chs" #-}


withPtrs :: [Ptr a] -> (Ptr VectorPtr -> IO b) -> IO b
withPtrs xs fun = allocaVectorPtrN n $ \vptr -> do
    sequence_ $ zipWith (igraphVectorPtrSet vptr) [0..] $ map castPtr xs
    fun vptr
  where
    n = length xs
{-# INLINE withPtrs #-}

toLists :: Ptr VectorPtr -> IO [[Double]]
toLists vptr = do
    n <- igraphVectorPtrSize vptr
    forM [0..n-1] $ \i -> igraphVectorPtrE vptr i >>= toList . castPtr
{-# INLINE toLists #-}

igraphVectorPtrE :: (Ptr VectorPtr) -> (Int) -> IO ((Ptr ()))
igraphVectorPtrE a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  igraphVectorPtrE'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 246 "src/IGraph/Internal.chs" #-}

igraphVectorPtrSet :: (Ptr VectorPtr) -> (Int) -> (Ptr ()) -> IO ()
igraphVectorPtrSet a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  igraphVectorPtrSet'_ a1' a2' a3' >>
  return ()

{-# LINE 247 "src/IGraph/Internal.chs" #-}

igraphVectorPtrSize :: (Ptr VectorPtr) -> IO ((Int))
igraphVectorPtrSize a1 =
  let {a1' = castPtr a1} in
  igraphVectorPtrSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 248 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Customized string vector
--------------------------------------------------------------------------------

data BSLen

toByteString :: Ptr BSLen -> IO B.ByteString
toByteString ptr = do
    n <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) ptr
    str <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) ptr
    packCStringLen (str, fromIntegral n)
{-# INLINE toByteString #-}

withByteString :: B.ByteString -> (Ptr BSLen -> IO a) -> IO a
withByteString x f = unsafeUseAsCStringLen x $ \(str, n) ->
    allocaBytes 16 $ \ptr -> do
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CULong)}) ptr (fromIntegral n)
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) ptr str
        f ptr
{-# INLINE withByteString #-}

data BSVector

allocaBSVectorN :: Int -> (Ptr BSVector -> IO a) -> IO a
allocaBSVectorN n fun = allocaBytes 16 $ \ptr ->
    bracket_ (bsvectorInit ptr n) (bsvectorDestroy ptr) (fun ptr)
{-# INLINE allocaBSVectorN #-}

bsvectorInit :: (Ptr BSVector) -> (Int) -> IO ()
bsvectorInit a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  bsvectorInit'_ a1' a2' >>= \res ->
  return ()

{-# LINE 279 "src/IGraph/Internal.chs" #-}

bsvectorDestroy :: (Ptr BSVector) -> IO ()
bsvectorDestroy a1 =
  let {a1' = castPtr a1} in
  bsvectorDestroy'_ a1' >>
  return ()

{-# LINE 280 "src/IGraph/Internal.chs" #-}


withByteStrings :: [B.ByteString] -> (Ptr BSVector -> IO a) -> IO a
withByteStrings xs fun = allocaBSVectorN n $ \bsvec -> do
    foldM_ (\i x -> bsvectorSet bsvec i x >> return (i+1)) 0 xs
    fun bsvec
  where
    n = length xs
{-# INLINE withByteStrings #-}

bsvectorSet :: Ptr BSVector -> Int -> B.ByteString -> IO ()
bsvectorSet vec i bs = withByteString bs (bsvectorSet' vec i)
{-# INLINE bsvectorSet #-}
bsvectorSet' :: (Ptr BSVector) -> (Int) -> (Ptr BSLen) -> IO ()
bsvectorSet' a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = castPtr a3} in
  bsvectorSet''_ a1' a2' a3' >>
  return ()

{-# LINE 294 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Matrix
--------------------------------------------------------------------------------

data Matrix

allocaMatrix :: (Ptr Matrix -> IO a) -> IO a
allocaMatrix fun = allocaBytes 40 $ \mat ->
    bracket_ (igraphMatrixInit mat 0 0) (igraphMatrixDestroy mat) (fun mat)
{-# INLINE allocaMatrix #-}

allocaMatrixN :: Int   -- ^ Number of rows
              -> Int   -- ^ Number of columns
              -> (Ptr Matrix -> IO a) -> IO a
allocaMatrixN r c fun = allocaBytes 40 $ \mat ->
    bracket_ (igraphMatrixInit mat r c) (igraphMatrixDestroy mat) (fun mat)
{-# INLINE allocaMatrixN #-}

igraphMatrixInit :: (Ptr Matrix) -> (Int) -> (Int) -> IO ()
igraphMatrixInit a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  igraphMatrixInit'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 315 "src/IGraph/Internal.chs" #-}

igraphMatrixDestroy :: (Ptr Matrix) -> IO ()
igraphMatrixDestroy a1 =
  let {a1' = castPtr a1} in
  igraphMatrixDestroy'_ a1' >>
  return ()

{-# LINE 316 "src/IGraph/Internal.chs" #-}


-- row lists to matrix
withRowLists :: Real a => [[a]] -> (Ptr Matrix -> IO b) -> IO b
withRowLists xs fun
    | all (==c) $ map length xs = allocaMatrixN r c $ \mat -> do
        forM_ (zip [0..] xs) $ \(i, row) ->
            forM_ (zip [0..] row) $ \(j,v) ->
                igraphMatrixSet mat i j $ realToFrac v
        fun mat
    | otherwise = error "Not a matrix."
  where
    r = length xs
    c = length $ head xs
{-# INLINE withRowLists #-}

-- to row lists
toRowLists :: Ptr Matrix -> IO [[Double]]
toRowLists = fmap transpose . toColumnLists

toColumnLists :: Ptr Matrix -> IO [[Double]]
toColumnLists mptr = do
    r <- igraphMatrixNrow mptr
    c <- igraphMatrixNcol mptr
    xs <- allocaArray (r*c) $ \ptr -> do
        igraphMatrixCopyTo mptr ptr
        peekArray (r*c) ptr
    return $ chunksOf r $ map realToFrac xs

igraphMatrixNull :: (Ptr Matrix) -> IO ()
igraphMatrixNull a1 =
  let {a1' = castPtr a1} in
  igraphMatrixNull'_ a1' >>
  return ()

{-# LINE 345 "src/IGraph/Internal.chs" #-}


igraphMatrixFill :: (Ptr Matrix) -> (Double) -> IO ()
igraphMatrixFill a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = realToFrac a2} in
  igraphMatrixFill'_ a1' a2' >>
  return ()

{-# LINE 347 "src/IGraph/Internal.chs" #-}


igraphMatrixE :: (Ptr Matrix) -> (Int) -> (Int) -> IO ((Double))
igraphMatrixE a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  igraphMatrixE'_ a1' a2' a3' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 349 "src/IGraph/Internal.chs" #-}


igraphMatrixSet :: (Ptr Matrix) -> (Int) -> (Int) -> (Double) -> IO ()
igraphMatrixSet a1 a2 a3 a4 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = realToFrac a4} in
  igraphMatrixSet'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 351 "src/IGraph/Internal.chs" #-}


igraphMatrixCopyTo :: (Ptr Matrix) -> (Ptr CDouble) -> IO ()
igraphMatrixCopyTo a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = id a2} in
  igraphMatrixCopyTo'_ a1' a2' >>
  return ()

{-# LINE 353 "src/IGraph/Internal.chs" #-}


igraphMatrixNrow :: (Ptr Matrix) -> IO ((Int))
igraphMatrixNrow a1 =
  let {a1' = castPtr a1} in
  igraphMatrixNrow'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 355 "src/IGraph/Internal.chs" #-}


igraphMatrixNcol :: (Ptr Matrix) -> IO ((Int))
igraphMatrixNcol a1 =
  let {a1' = castPtr a1} in
  igraphMatrixNcol'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 357 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Graph Constructors and Destructors
--------------------------------------------------------------------------------

newtype IGraph = IGraph (C2HSImp.ForeignPtr (IGraph))
withIGraph :: IGraph -> (C2HSImp.Ptr IGraph -> IO b) -> IO b
withIGraph (IGraph fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 364 "src/IGraph/Internal.chs" #-}


allocaIGraph :: (Ptr IGraph -> IO a) -> IO a
allocaIGraph f = mallocBytes 160 >>= f
{-# INLINE allocaIGraph #-}

mkLabelToId :: (Ord v, Serialize v) => IGraph -> M.Map v [Int]
mkLabelToId gr = unsafePerformIO $ do
    n <- igraphVcount gr
    fmap (M.fromListWith (++)) $ forM [0..n-1] $ \i -> do
        l <- igraphHaskellAttributeVAS gr vertexAttr i >>= toByteString >>=
            return . fromRight (error "decode failed") . decode
        return (l, [i])
{-# INLINE mkLabelToId #-}

initializeNullAttribute :: PrimMonad m
                        => IGraph
                        -> m ()
initializeNullAttribute gr = unsafePrimToPrim $ do
    nn <- igraphVcount gr
    unsafePrimToPrim $ withByteStrings (map encode $ replicate nn ()) $
        igraphHaskellAttributeVASSetv gr vertexAttr
    ne <- igraphEcount gr
    unsafePrimToPrim $ withByteStrings (map encode $ replicate ne ()) $
        igraphHaskellAttributeEASSetv gr edgeAttr
{-# INLINE initializeNullAttribute #-}

addIGraphFinalizer :: Ptr IGraph -> IO IGraph
addIGraphFinalizer ptr = do
    vec <- newForeignPtr igraph_destroy ptr
    return $ IGraph vec
{-# INLINE addIGraphFinalizer #-}

-- | Create a igraph object and attach a finalizer
igraphNew :: Int -> Bool -> HasInit -> IO IGraph
igraphNew n directed _ = igraphNew' n directed
igraphNew' :: (Int) -> (Bool) -> IO ((IGraph))
igraphNew' a2 a3 =
  allocaIGraph $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = C2HSImp.fromBool a3} in
  igraphNew''_ a1' a2' a3' >>= \res ->
  addIGraphFinalizer  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 403 "src/IGraph/Internal.chs" #-}


igraphCopy :: (IGraph) -> IO ((IGraph))
igraphCopy a2 =
  allocaIGraph $ \a1' ->
  (withIGraph) a2 $ \a2' ->
  igraphCopy'_ a1' a2' >>= \res ->
  addIGraphFinalizer  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 408 "src/IGraph/Internal.chs" #-}


igraphCreate :: (Ptr Vector) -- ^ The edges to add, the first two elements are  the first edge, etc.
 -> (Int) -- ^ The number of vertices in the graph, if smaller or equal to  the highest vertex id in the edges vector it will be  increased automatically. So it is safe to give 0 here.
 -> (Bool) -- ^ Whether to create a directed graph or not. If yes,  then the first edge points from the first vertex id in edges  to the second, etc.
 -> IO ((IGraph))
igraphCreate a2 a3 a4 =
  allocaIGraph $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = C2HSImp.fromBool a4} in
  igraphCreate'_ a1' a2' a3' a4' >>= \res ->
  addIGraphFinalizer  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 420 "src/IGraph/Internal.chs" #-}


-- | A graph is a simple graph if it does not contain loop edges and multiple edges.
igraphIsSimple :: (IGraph) -> IO ((Bool))
igraphIsSimple a1 =
  (withIGraph) a1 $ \a1' ->
  alloca $ \a2' ->
  igraphIsSimple'_ a1' a2' >>= \res ->
  peekBool  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 426 "src/IGraph/Internal.chs" #-}


igraphHasMultiple :: (IGraph) -> IO ((Bool))
igraphHasMultiple a1 =
  (withIGraph) a1 $ \a1' ->
  alloca $ \a2' ->
  igraphHasMultiple'_ a1' a2' >>= \res ->
  peekBool  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 431 "src/IGraph/Internal.chs" #-}


igraphToDirected :: (IGraph) -- ^ The graph object to convert.
 -> (ToDirected) -- ^ Specifies the details of how exactly the conversion is  done. Possible values: IGRAPH_TO_DIRECTED_ARBITRARY:  the number of edges in the graph stays the same,  an arbitrarily directed edge is created for each  undirected edge; IGRAPH_TO_DIRECTED_MUTUAL: two directed  edges are created for each undirected edge, one in each direction.
 -> IO ()
igraphToDirected a1 a2 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  igraphToDirected'_ a1' a2' >>= \res ->
  return ()

{-# LINE 441 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Vertex selector
--------------------------------------------------------------------------------

data VertexSelector

allocaVertexSelector :: (Ptr VertexSelector -> IO a) -> IO a
allocaVertexSelector fun = allocaBytes 16 $ \vs -> do
    r <- fun vs
    igraphVsDestroy vs
    return r
{-# INLINE allocaVertexSelector #-}

igraphVsDestroy :: (Ptr VertexSelector) -> IO ()
igraphVsDestroy a1 =
  let {a1' = castPtr a1} in
  igraphVsDestroy'_ a1' >>
  return ()

{-# LINE 457 "src/IGraph/Internal.chs" #-}


withVerticesAll :: (Ptr VertexSelector -> IO a) -> IO a
withVerticesAll fun = allocaVertexSelector $ \vs -> igraphVsAll vs >> fun vs
{-# INLINE withVerticesAll #-}
igraphVsAll :: (Ptr VertexSelector) -> IO ()
igraphVsAll a1 =
  let {a1' = castPtr a1} in
  igraphVsAll'_ a1' >>= \res ->
  return ()

{-# LINE 462 "src/IGraph/Internal.chs" #-}


withVerticesAdj :: Int -> Neimode -> (Ptr VertexSelector -> IO a) -> IO a
withVerticesAdj i mode fun = allocaVertexSelector $ \vs -> igraphVsAdj vs i mode >> fun vs
{-# INLINE withVerticesAdj #-}
igraphVsAdj :: (Ptr VertexSelector) -> (Int) -> (Neimode) -> IO ()
igraphVsAdj a1 a2 a3 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  igraphVsAdj'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 468 "src/IGraph/Internal.chs" #-}


withVerticesVector :: Ptr Vector -> (Ptr VertexSelector -> IO a) -> IO a
withVerticesVector vec fun = allocaVertexSelector $ \vs -> igraphVsVector vs vec >> fun vs
{-# INLINE withVerticesVector #-}
igraphVsVector :: (Ptr VertexSelector) -> (Ptr Vector) -> IO ()
igraphVsVector a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  igraphVsVector'_ a1' a2' >>= \res ->
  return ()

{-# LINE 474 "src/IGraph/Internal.chs" #-}


withVerticesList :: Real a => [a] -> (Ptr VertexSelector -> IO b) -> IO b
withVerticesList xs fun = withList xs $ \vec -> withVerticesVector vec fun
{-# INLINE withVerticesList #-}


--------------------------------------------------------------------------------
-- Vertex iterator
--------------------------------------------------------------------------------

data VertexIterator

iterateVertices :: IGraph -> Ptr VertexSelector -> (Ptr VertexIterator -> IO a) -> IO a
iterateVertices gr vs fun = allocaBytes 40 $ \vit ->
    bracket_ (igraphVitCreate gr vs vit) (igraphVitDestroy vit) (fun vit)
{-# INLINE iterateVertices #-}

iterateVerticesC :: IGraph
                 -> Ptr VertexSelector
                 -> (ConduitT i Int IO () -> IO a)
                 -> IO a
iterateVerticesC gr vs fun = allocaBytes 40 $ \vit ->
    bracket_ (igraphVitCreate gr vs vit) (igraphVitDestroy vit) (fun $ sourceVertexIterator vit)
{-# INLINE iterateVerticesC #-}

igraphVitCreate :: (IGraph) -> (Ptr VertexSelector) -> (Ptr VertexIterator) -> IO ()
igraphVitCreate a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = castPtr a3} in
  igraphVitCreate'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 504 "src/IGraph/Internal.chs" #-}

igraphVitDestroy :: (Ptr VertexIterator) -> IO ()
igraphVitDestroy a1 =
  let {a1' = castPtr a1} in
  igraphVitDestroy'_ a1' >>
  return ()

{-# LINE 505 "src/IGraph/Internal.chs" #-}



sourceVertexIterator :: Ptr VertexIterator -> ConduitT i Int IO ()
sourceVertexIterator vit = do
    isEnd <- liftIO $ igraphVitEnd vit
    if isEnd
      then return ()
      else do
        liftIO (igraphVitGet vit) >>= yield
        liftIO $ igraphVitNext vit
        sourceVertexIterator vit
{-# INLINE sourceVertexIterator #-}

igraphVitEnd :: (Ptr VertexIterator) -> IO ((Bool))
igraphVitEnd a1 =
  let {a1' = castPtr a1} in
  igraphVitEnd'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 530 "src/IGraph/Internal.chs" #-}

igraphVitNext :: (Ptr VertexIterator) -> IO ()
igraphVitNext a1 =
  let {a1' = castPtr a1} in
  igraphVitNext'_ a1' >>
  return ()

{-# LINE 531 "src/IGraph/Internal.chs" #-}

igraphVitGet :: (Ptr VertexIterator) -> IO ((Int))
igraphVitGet a1 =
  let {a1' = castPtr a1} in
  igraphVitGet'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 532 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Edge Selector
--------------------------------------------------------------------------------

data EdgeSelector

allocaEdgeSelector :: (Ptr EdgeSelector -> IO a) -> IO a
allocaEdgeSelector fun = allocaBytes 24 $ \es -> do
    r <- fun es
    igraphEsDestroy es
    return r
{-# INLINE allocaEdgeSelector #-}
igraphEsDestroy :: (Ptr EdgeSelector) -> IO ()
igraphEsDestroy a1 =
  let {a1' = castPtr a1} in
  igraphEsDestroy'_ a1' >>
  return ()

{-# LINE 547 "src/IGraph/Internal.chs" #-}


withEdgesAll :: EdgeOrderType -> (Ptr EdgeSelector -> IO a) -> IO a
withEdgesAll ord fun = allocaEdgeSelector $ \es -> igraphEsAll es ord >> fun es
{-# INLINE withEdgesAll #-}
igraphEsAll :: (Ptr EdgeSelector) -> (EdgeOrderType) -> IO ()
igraphEsAll a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  igraphEsAll'_ a1' a2' >>= \res ->
  return ()

{-# LINE 552 "src/IGraph/Internal.chs" #-}


withEdgeIdsVector :: Ptr Vector -> (Ptr EdgeSelector -> IO a) -> IO a
withEdgeIdsVector vec fun = allocaEdgeSelector $ \es ->
    igraphEsVector es vec >> fun es
{-# INLINE withEdgeIdsVector #-}
igraphEsVector :: (Ptr EdgeSelector) -> (Ptr Vector) -> IO ()
igraphEsVector a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  igraphEsVector'_ a1' a2' >>= \res ->
  return ()

{-# LINE 559 "src/IGraph/Internal.chs" #-}


withEdgeIdsList :: [Int] -> (Ptr EdgeSelector -> IO b) -> IO b
withEdgeIdsList xs fun = withList xs $ \vec -> withEdgeIdsVector vec fun
{-# INLINE withEdgeIdsList #-}


--------------------------------------------------------------------------------
-- Edge iterator
--------------------------------------------------------------------------------

data EdgeIterator

iterateEdges :: IGraph -> Ptr EdgeSelector -> (Ptr EdgeIterator -> IO a) -> IO a
iterateEdges gr es fun = allocaBytes 40 $ \eit ->
    bracket_ (igraphEitCreate gr es eit) (igraphEitDestroy eit) (fun eit)
{-# INLINE iterateEdges #-}
igraphEitCreate :: (IGraph) -> (Ptr EdgeSelector) -> (Ptr EdgeIterator) -> IO ()
igraphEitCreate a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = castPtr a3} in
  igraphEitCreate'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 576 "src/IGraph/Internal.chs" #-}

igraphEitDestroy :: (Ptr EdgeIterator) -> IO ()
igraphEitDestroy a1 =
  let {a1' = castPtr a1} in
  igraphEitDestroy'_ a1' >>
  return ()

{-# LINE 577 "src/IGraph/Internal.chs" #-}


iterateEdgesC :: IGraph
              -> Ptr EdgeSelector
              -> (ConduitT i Int IO () -> IO a)
              -> IO a
iterateEdgesC gr es fun = allocaBytes 40 $ \eit ->
    bracket_ (igraphEitCreate gr es eit) (igraphEitDestroy eit) (fun $ sourceEdgeIterator eit)
{-# INLINE iterateEdgesC #-}

sourceEdgeIterator :: Ptr EdgeIterator -> ConduitT i Int IO ()
sourceEdgeIterator eit = do
    isEnd <- liftIO $ igraphEitEnd eit
    if isEnd
      then return ()
      else do
        liftIO (igraphEitGet eit) >>= yield
        liftIO $ igraphEitNext eit
        sourceEdgeIterator eit
{-# INLINE sourceEdgeIterator #-}

igraphEitEnd :: (Ptr EdgeIterator) -> IO ((Bool))
igraphEitEnd a1 =
  let {a1' = castPtr a1} in
  igraphEitEnd'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 608 "src/IGraph/Internal.chs" #-}

igraphEitNext :: (Ptr EdgeIterator) -> IO ()
igraphEitNext a1 =
  let {a1' = castPtr a1} in
  igraphEitNext'_ a1' >>
  return ()

{-# LINE 609 "src/IGraph/Internal.chs" #-}

igraphEitGet :: (Ptr EdgeIterator) -> IO ((Int))
igraphEitGet a1 =
  let {a1' = castPtr a1} in
  igraphEitGet'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 610 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Basic Query Operations
--------------------------------------------------------------------------------

igraphVcount :: (IGraph) -> IO ((Int))
igraphVcount a1 =
  (withIGraph) a1 $ \a1' ->
  igraphVcount'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 617 "src/IGraph/Internal.chs" #-}


igraphEcount :: (IGraph) -> IO ((Int))
igraphEcount a1 =
  (withIGraph) a1 $ \a1' ->
  igraphEcount'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 619 "src/IGraph/Internal.chs" #-}


igraphGetEid :: (IGraph) -> (Int) -> (Int) -> (Bool) -> (Bool) -> IO ((Int))
igraphGetEid a1 a3 a4 a5 a6 =
  (withIGraph) a1 $ \a1' ->
  alloca $ \a2' ->
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = C2HSImp.fromBool a5} in
  let {a6' = C2HSImp.fromBool a6} in
  igraphGetEid'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  peekIntConv  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 628 "src/IGraph/Internal.chs" #-}


igraphEdge :: (IGraph) -> (Int) -> IO ((Int), (Int))
igraphEdge a1 a2 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  alloca $ \a4' ->
  igraphEdge'_ a1' a2' a3' a4' >>= \res ->
  peekIntConv  a3'>>= \a3'' ->
  peekIntConv  a4'>>= \a4'' ->
  return (a3'', a4'')

{-# LINE 635 "src/IGraph/Internal.chs" #-}


-- Adding and Deleting Vertices and Edges

igraphAddVertices :: (IGraph) -> (Int) -> (Ptr ()) -> IO ()
igraphAddVertices a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  igraphAddVertices'_ a1' a2' a3' >>
  return ()

{-# LINE 639 "src/IGraph/Internal.chs" #-}


igraphAddEdge :: (IGraph) -> (Int) -> (Int) -> IO ()
igraphAddEdge a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  igraphAddEdge'_ a1' a2' a3' >>
  return ()

{-# LINE 641 "src/IGraph/Internal.chs" #-}


-- | The edges are given in a vector, the first two elements define the first
-- edge (the order is from , to for directed graphs). The vector should
-- contain even number of integer numbers between zero and the number of
-- vertices in the graph minus one (inclusive). If you also want to add
-- new vertices, call igraph_add_vertices() first.
igraphAddEdges :: (IGraph) -- ^ The graph to which the edges will be added.
 -> (Ptr Vector) -- ^ The edges themselves.
 -> (Ptr ()) -- ^ The attributes of the new edges.
 -> IO ()
igraphAddEdges a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = id a3} in
  igraphAddEdges'_ a1' a2' a3' >>
  return ()

{-# LINE 652 "src/IGraph/Internal.chs" #-}


-- | delete vertices
igraphDeleteVertices :: (IGraph) -> (Ptr VertexSelector) -> IO ()
igraphDeleteVertices a1 a2 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  igraphDeleteVertices'_ a1' a2' >>= \res ->
  return ()

{-# LINE 656 "src/IGraph/Internal.chs" #-}


-- | delete edges
igraphDeleteEdges :: (IGraph) -> (Ptr EdgeSelector) -> IO ()
igraphDeleteEdges a1 a2 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  igraphDeleteEdges'_ a1' a2' >>= \res ->
  return ()

{-# LINE 660 "src/IGraph/Internal.chs" #-}


data AttributeRecord

withAttr :: Serialize a
         => String   -- ^ Attribute name
         -> [a]      -- ^ Attributes
         -> (Ptr AttributeRecord -> IO b) -> IO b
withAttr name xs fun = withByteStrings (map encode xs) $ \bsvec ->
    withBSAttr name bsvec fun
{-# INLINE withAttr #-}

withBSAttr :: String          -- ^ Attribute name
           -> Ptr BSVector    -- ^ Attributes
           -> (Ptr AttributeRecord -> IO b) -> IO b
withBSAttr name bsvec fun = withCString name $ \name' ->
    allocaBytes 24 $ \attr ->
        setAttribute attr name' (castPtr bsvec) >> fun attr
  where
    setAttribute attr x y = do
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) attr x
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)}) attr 2
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr ()))}) attr y
{-# INLINE withBSAttr #-}

-- | Checks whether a (graph, vertex or edge) attribute exists
igraphHaskellAttributeHasAttr :: (IGraph) -> (AttributeElemtype) -- ^ The type of the attribute
 -> (String) -- ^ The name of the attribute
 -> IO ((Bool))
igraphHaskellAttributeHasAttr a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  C2HSImp.withCString a3 $ \a3' ->
  igraphHaskellAttributeHasAttr'_ a1' a2' a3' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 690 "src/IGraph/Internal.chs" #-}


-- | Query a string vertex attribute
igraphHaskellAttributeVAS :: (IGraph) -> (String) -- ^ The name of the attribute
 -> (Int) -- ^ The id of the queried vertex
 -> IO ((Ptr BSLen))
igraphHaskellAttributeVAS a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  igraphHaskellAttributeVAS'_ a1' a2' a3' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 697 "src/IGraph/Internal.chs" #-}


-- | Query a string edge attribute.
igraphHaskellAttributeEAS :: (IGraph) -> (String) -- ^ The name of the attribute
 -> (Int) -- ^ The id of the queried edge
 -> IO ((Ptr BSLen))
igraphHaskellAttributeEAS a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  igraphHaskellAttributeEAS'_ a1' a2' a3' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 704 "src/IGraph/Internal.chs" #-}


igraphHaskellAttributeVASSet :: (IGraph) -> (String) -> (Int) -> (Ptr BSLen) -> IO ()
igraphHaskellAttributeVASSet a1 a2 a3 a4 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  let {a4' = castPtr a4} in
  igraphHaskellAttributeVASSet'_ a1' a2' a3' a4' >>= \res ->
  return ()

{-# LINE 711 "src/IGraph/Internal.chs" #-}


igraphHaskellAttributeVASSetv :: (IGraph) -> (String) -- ^ Name of the attribute
 -> (Ptr BSVector) -- ^ String vector, the new attribute values.  The length of this vector must match the  number of vertices.
 -> IO ()
igraphHaskellAttributeVASSetv a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = castPtr a3} in
  igraphHaskellAttributeVASSetv'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 719 "src/IGraph/Internal.chs" #-}


-- | Set a string edge attribute.
igraphHaskellAttributeEASSet :: (IGraph) -> (String) -- ^ The name of the attribute
 -> (Int) -- ^ The id of the queried vertex
 -> (Ptr BSLen) -- ^ The (new) value of the attribute.
 -> IO ()
igraphHaskellAttributeEASSet a1 a2 a3 a4 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  let {a4' = castPtr a4} in
  igraphHaskellAttributeEASSet'_ a1' a2' a3' a4' >>= \res ->
  return ()

{-# LINE 727 "src/IGraph/Internal.chs" #-}


-- | Set a string edge attribute for all edges.
igraphHaskellAttributeEASSetv :: (IGraph) -> (String) -- ^ Name of the attribute
 -> (Ptr BSVector) -- ^ String vector, the new attribute values.  The length of this vector must match the  number of edges.
 -> IO ()
igraphHaskellAttributeEASSetv a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = castPtr a3} in
  igraphHaskellAttributeEASSetv'_ a1' a2' a3' >>= \res ->
  return ()

{-# LINE 736 "src/IGraph/Internal.chs" #-}



--------------------------------------------------------------------------------
-- Arpack options
--------------------------------------------------------------------------------

data ArpackOpt

allocaArpackOpt :: (Ptr ArpackOpt -> IO a) -> IO a
allocaArpackOpt fun = allocaBytes 200 $ \opt -> do
    igraphArpackOptionsInit opt >> fun opt
{-# INLINE allocaArpackOpt #-}
igraphArpackOptionsInit :: (Ptr ArpackOpt) -> IO ()
igraphArpackOptionsInit a1 =
  let {a1' = castPtr a1} in
  igraphArpackOptionsInit'_ a1' >>= \res ->
  return ()

{-# LINE 749 "src/IGraph/Internal.chs" #-}


foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_init"
  igraphVectorInit'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_destroy"
  igraphVectorDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_init_copy"
  igraphVectorInitCopy'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_copy_to"
  igraphVectorCopyTo'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ())))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_null"
  igraphVectorNull'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_fill"
  igraphVectorFill'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_e"
  igraphVectorE'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (IO C2HSImp.CDouble)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_set"
  igraphVectorSet'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (C2HSImp.CDouble -> (IO ()))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_tail"
  igraphVectorTail'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CDouble))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_size"
  igraphVectorSize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_ptr_init"
  igraphVectorPtrInit'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_ptr_destroy"
  igraphVectorPtrDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_ptr_e"
  igraphVectorPtrE'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_ptr_set"
  igraphVectorPtrSet'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vector_ptr_size"
  igraphVectorPtrSize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))

foreign import ccall safe "IGraph/Internal.chs.h bsvector_init"
  bsvectorInit'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h bsvector_destroy"
  bsvectorDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h bsvector_set"
  bsvectorSet''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_init"
  igraphMatrixInit'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_destroy"
  igraphMatrixDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_null"
  igraphMatrixNull'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_fill"
  igraphMatrixFill'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_e"
  igraphMatrixE'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO C2HSImp.CDouble))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_set"
  igraphMatrixSet'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (C2HSImp.CLong -> (C2HSImp.CDouble -> (IO ())))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_copy_to"
  igraphMatrixCopyTo'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO ())))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_nrow"
  igraphMatrixNrow'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))

foreign import ccall safe "IGraph/Internal.chs.h igraph_matrix_ncol"
  igraphMatrixNcol'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CLong))

foreign import ccall "IGraph/Internal.chs.h &igraph_destroy"
  igraph_destroy :: C2HSImp.FinalizerPtr IGraph

foreign import ccall safe "IGraph/Internal.chs.h igraph_empty"
  igraphNew''_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_copy"
  igraphCopy'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr (IGraph)) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_create"
  igraphCreate'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_is_simple"
  igraphIsSimple'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_has_multiple"
  igraphHasMultiple'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_to_directed"
  igraphToDirected'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vs_destroy"
  igraphVsDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vs_all"
  igraphVsAll'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vs_adj"
  igraphVsAdj'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vs_vector"
  igraphVsVector'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h __c2hs_wrapped__igraph_vit_create"
  igraphVitCreate'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vit_destroy"
  igraphVitDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vit_end"
  igraphVitEnd'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vit_next"
  igraphVitNext'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vit_get"
  igraphVitGet'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_es_destroy"
  igraphEsDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_es_all"
  igraphEsAll'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_es_vector"
  igraphEsVector'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h __c2hs_wrapped__igraph_eit_create"
  igraphEitCreate'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_eit_destroy"
  igraphEitDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_eit_end"
  igraphEitEnd'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_eit_next"
  igraphEitNext'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "IGraph/Internal.chs.h igraph_eit_get"
  igraphEitGet'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_vcount"
  igraphVcount'_ :: ((C2HSImp.Ptr (IGraph)) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_ecount"
  igraphEcount'_ :: ((C2HSImp.Ptr (IGraph)) -> (IO C2HSImp.CInt))

foreign import ccall safe "IGraph/Internal.chs.h igraph_get_eid"
  igraphGetEid'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_edge"
  igraphEdge'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_add_vertices"
  igraphAddVertices'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_add_edge"
  igraphAddEdge'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_add_edges"
  igraphAddEdges'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h __c2hs_wrapped__igraph_delete_vertices"
  igraphDeleteVertices'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h __c2hs_wrapped__igraph_delete_edges"
  igraphDeleteEdges'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_has_attr"
  igraphHaskellAttributeHasAttr'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_VAS"
  igraphHaskellAttributeVAS'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_EAS"
  igraphHaskellAttributeEAS'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_VAS_set"
  igraphHaskellAttributeVASSet'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_VAS_setv"
  igraphHaskellAttributeVASSetv'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_EAS_set"
  igraphHaskellAttributeEASSet'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_haskell_attribute_EAS_setv"
  igraphHaskellAttributeEASSetv'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_arpack_options_init"
  igraphArpackOptionsInit'_ :: ((C2HSImp.Ptr ()) -> (IO ()))