-- 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
    ( module IGraph.Internal.Types
    -- * Vector type and basic operations
    , igraphVectorNew
    , fromList
    , toList
    , igraphVectorNull
    , igraphVectorFill
    , igraphVectorE
    , igraphVectorSet
    , igraphVectorTail
    , igraphVectorSize
    , igraphVectorCopyTo

    -- * Pointer vector
    , igraphVectorPtrNew
    , fromPtrs
    , toLists

    -- * String vector
    , igraphStrvectorNew
    , igraphStrvectorGet
    , toStrVector

    -- * Bytestring
    , asBS
    , bsToByteString

    -- * Bytestring vector
    , bsvectorNew
    , bsvectorSet
    , toBSVector

    -- * Igraph matrix type
    , igraphMatrixNew
    , igraphMatrixNull
    , igraphMatrixFill
    , igraphMatrixE
    , igraphMatrixSet
    , igraphMatrixCopyTo
    , igraphMatrixNrow
    , igraphMatrixNcol
    , fromRowLists
    , toRowLists
    , toColumnLists

    -- * Igraph vertex selector
    , igraphVsAll
    , igraphVsAdj
    , igraphVsVector

    -- * Igraph vertex iterator
    , igraphVitNew
    , vitToList

    -- * Igraph edge Selector
    , igraphEsAll
    , igraphEsVector

    -- * Igraph edge iterator
    , igraphEitNew
    , eitToList

    -- * IGraph type and basic operations
    , igraphNew
    , igraphCopy
    , igraphVcount
    , igraphEcount
    , igraphGetEid
    , igraphEdge
    , igraphAddVertices
    , igraphAddEdge
    , igraphAddEdges
    , igraphDeleteVertices
    , igraphDeleteEdges

        -- * Igraph attribute record
    , withAttr
    , igraphHaskellAttributeHasAttr
    , igraphHaskellAttributeGANSet
    , igraphHaskellAttributeGAN
    , igraphHaskellAttributeVAS
    , igraphHaskellAttributeEAN
    , igraphHaskellAttributeEAS
    , igraphHaskellAttributeEASSetv
    , igraphHaskellAttributeVASSet
    , igraphHaskellAttributeEASSet
    ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import qualified System.IO.Unsafe 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 Data.List.Split (chunksOf)

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

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

import IGraph.Internal.Types
{-# LINE 104 "src/IGraph/Internal.chs" #-}

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





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

igraphVectorNew :: (Int) -> IO ((Vector))
igraphVectorNew a2 =
  allocaVector $ \a1' ->
  let {a2' = fromIntegral a2} in
  igraphVectorNew'_ a1' a2' >>= \res ->
  addVectorFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphVectorInitCopy :: (Ptr CDouble) -> (Int) -> IO ((Vector))
igraphVectorInitCopy a2 a3 =
  allocaVector $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  igraphVectorInitCopy'_ a1' a2' a3' >>= \res ->
  addVectorFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


fromList :: [Double] -> IO Vector
fromList xs = withArrayLen (map realToFrac xs) $ \n ptr ->
    igraphVectorInitCopy ptr n
{-# INLINE fromList #-}

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

-- Initializing elements

igraphVectorNull :: (Vector) -> IO ()
igraphVectorNull a1 =
  (withVector) a1 $ \a1' ->
  igraphVectorNull'_ a1' >>
  return ()

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


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

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



-- Accessing elements

igraphVectorE :: (Vector) -> (Int) -> (Double)
igraphVectorE a1 a2 =
  C2HSImp.unsafePerformIO $
  (withVector) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  igraphVectorE'_ a1' a2' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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


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

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


igraphVectorTail :: (Vector) -> (Double)
igraphVectorTail a1 =
  C2HSImp.unsafePerformIO $
  (withVector) a1 $ \a1' ->
  igraphVectorTail'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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



-- Copying vectors

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

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


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

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



igraphVectorPtrNew :: (Int) -> IO ((VectorPtr))
igraphVectorPtrNew a2 =
  allocaVectorPtr $ \a1' ->
  let {a2' = fromIntegral a2} in
  igraphVectorPtrNew'_ a1' a2' >>= \res ->
  addVectorPtrFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


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

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

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

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

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

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


fromPtrs :: [Ptr ()] -> IO VectorPtr
fromPtrs xs = do
    vptr <- igraphVectorPtrNew n
    forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorPtrSet vptr i x
    return vptr
  where
    n = length xs
{-# INLINE fromPtrs #-}

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

--------------------------------------------------------------------------------
-- Igraph string vector
--------------------------------------------------------------------------------

igraphStrvectorNew :: (Int) -> IO ((StrVector))
igraphStrvectorNew a2 =
  allocaStrVector $ \a1' ->
  let {a2' = fromIntegral a2} in
  igraphStrvectorNew'_ a1' a2' >>= \res ->
  addStrVectorFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphStrvectorGet :: (StrVector) -> (Int) -> IO ((String))
igraphStrvectorGet a1 a2 =
  (withStrVector) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  alloca $ \a3' ->
  igraphStrvectorGet'_ a1' a2' a3' >>= \res ->
  peekString  a3'>>= \a3'' ->
  return (a3'')

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


peekString :: Ptr CString -> IO String
peekString ptr = peek ptr >>= peekCString
{-# INLINE peekString #-}

igraphStrvectorSet :: (StrVector) -> (Int) -> (CString) -> IO ()
igraphStrvectorSet a1 a2 a3 =
  (withStrVector) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  igraphStrvectorSet'_ a1' a2' a3' >>
  return ()

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

igraphStrvectorSet2 :: (StrVector) -> (Int) -> (CString) -> (Int) -> IO ()
igraphStrvectorSet2 a1 a2 a3 a4 =
  (withStrVector) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  let {a4' = fromIntegral a4} in
  igraphStrvectorSet2'_ a1' a2' a3' a4' >>
  return ()

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


toStrVector :: [B.ByteString] -> IO StrVector
toStrVector xs = do
    vec <- igraphStrvectorNew n
    forM_ (zip [0..] xs) $ \(i,x) -> B.useAsCString x (igraphStrvectorSet vec i)
    return vec
  where
    n = length xs


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

bsToByteString :: Ptr BSLen -> IO B.ByteString
bsToByteString 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 bsToByteString #-}

asBS :: B.ByteString -> (Ptr BSLen -> IO a) -> IO a
asBS x f = unsafeUseAsCStringLen x $ \(str, n) -> do
    fptr <- mallocForeignPtrBytes 16
{-# LINE 229 "src/IGraph/Internal.chs" #-}

    withForeignPtr fptr $ \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 asBS #-}

bsvectorNew :: (Int) -> IO ((BSVector))
bsvectorNew a2 =
  allocaBSVector $ \a1' ->
  let {a2' = fromIntegral a2} in
  bsvectorNew'_ a1' a2' >>= \res ->
  addBSVectorFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


bsvectorSet' :: (BSVector) -> (Int) -> (Ptr BSLen) -> IO ()
bsvectorSet' a1 a2 a3 =
  (withBSVector) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = castPtr a3} in
  bsvectorSet''_ a1' a2' a3' >>
  return ()

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


bsvectorSet :: BSVector -> Int -> B.ByteString -> IO ()
bsvectorSet vec i bs = asBS bs (bsvectorSet' vec i)
{-# INLINE bsvectorSet #-}

toBSVector :: [B.ByteString] -> IO BSVector
toBSVector xs = do
    vec <- bsvectorNew n
    foldM_ (\i x -> bsvectorSet vec i x >> return (i+1)) 0 xs
    return vec
  where
    n = length xs


igraphMatrixNew :: (Int) -> (Int) -> IO ((Matrix))
igraphMatrixNew a2 a3 =
  allocaMatrix $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  igraphMatrixNew'_ a1' a2' a3' >>= \res ->
  addMatrixFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphMatrixNull :: (Matrix) -> IO ()
igraphMatrixNull a1 =
  (withMatrix) a1 $ \a1' ->
  igraphMatrixNull'_ a1' >>
  return ()

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


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

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


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

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


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

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


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

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


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

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


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

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


-- row lists to matrix
fromRowLists :: [[Double]] -> IO Matrix
fromRowLists xs
    | all (==c) $ map length xs = do
        mptr <- igraphMatrixNew r c
        forM_ (zip [0..] xs) $ \(i, row) ->
            forM_ (zip [0..] row) $ \(j,v) ->
                igraphMatrixSet mptr i j v
        return mptr
    | otherwise = error "Not a matrix."
  where
    r = length xs
    c = length $ head xs

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

toColumnLists :: 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


igraphVsAll :: IO ((IGraphVs))
igraphVsAll =
  allocaVs $ \a1' ->
  igraphVsAll'_ a1' >>= \res ->
  addVsFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphVsAdj :: (Int) -> (Neimode) -> IO ((IGraphVs))
igraphVsAdj a2 a3 =
  allocaVs $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  igraphVsAdj'_ a1' a2' a3' >>= \res ->
  addVsFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphVsVector :: (Vector) -> IO ((IGraphVs))
igraphVsVector a2 =
  allocaVs $ \a1' ->
  (withVector) a2 $ \a2' ->
  igraphVsVector'_ a1' a2' >>= \res ->
  addVsFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


-- Vertex iterator

igraphVitNew :: (IGraph) -> (IGraphVs) -> IO ((IGraphVit))
igraphVitNew a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphVs) a2 $ \a2' ->
  allocaVit $ \a3' ->
  igraphVitNew'_ a1' a2' a3' >>= \res ->
  addVitFinalizer  a3'>>= \a3'' ->
  return (a3'')

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


igraphVitEnd :: (IGraphVit) -> IO ((Bool))
igraphVitEnd a1 =
  (withIGraphVit) a1 $ \a1' ->
  igraphVitEnd'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


igraphVitNext :: (IGraphVit) -> IO ()
igraphVitNext a1 =
  (withIGraphVit) a1 $ \a1' ->
  igraphVitNext'_ a1' >>
  return ()

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


igraphVitGet :: (IGraphVit) -> IO ((Int))
igraphVitGet a1 =
  (withIGraphVit) a1 $ \a1' ->
  igraphVitGet'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


vitToList :: IGraphVit -> IO [Int]
vitToList vit = do
    isEnd <- igraphVitEnd vit
    if isEnd
      then return []
      else do
        cur <- igraphVitGet vit
        igraphVitNext vit
        acc <- vitToList vit
        return $ cur : acc


-- Edge Selector

igraphEsAll :: (EdgeOrderType) -> IO ((IGraphEs))
igraphEsAll a2 =
  allocaEs $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  igraphEsAll'_ a1' a2' >>= \res ->
  addEsFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


igraphEsVector :: (Vector) -> IO ((IGraphEs))
igraphEsVector a2 =
  allocaEs $ \a1' ->
  (withVector) a2 $ \a2' ->
  igraphEsVector'_ a1' a2' >>= \res ->
  addEsFinalizer  a1'>>= \a1'' ->
  return (a1'')

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


-- Edge iterator

igraphEitNew :: (IGraph) -> (IGraphEs) -> IO ((IGraphEit))
igraphEitNew a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphEs) a2 $ \a2' ->
  allocaEit $ \a3' ->
  igraphEitNew'_ a1' a2' a3' >>= \res ->
  addEitFinalizer  a3'>>= \a3'' ->
  return (a3'')

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


igraphEitEnd :: (IGraphEit) -> IO ((Bool))
igraphEitEnd a1 =
  (withIGraphEit) a1 $ \a1' ->
  igraphEitEnd'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


igraphEitNext :: (IGraphEit) -> IO ()
igraphEitNext a1 =
  (withIGraphEit) a1 $ \a1' ->
  igraphEitNext'_ a1' >>
  return ()

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


igraphEitGet :: (IGraphEit) -> IO ((Int))
igraphEitGet a1 =
  (withIGraphEit) a1 $ \a1' ->
  igraphEitGet'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


eitToList :: IGraphEit -> IO [Int]
eitToList eit = do
    isEnd <- igraphEitEnd eit
    if isEnd
      then return []
      else do
        cur <- igraphEitGet eit
        igraphEitNext eit
        acc <- eitToList eit
        return $ cur : acc


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

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 414 "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 419 "src/IGraph/Internal.chs" #-}


-- | Create a igraph object and attach a finalizer
igraphNew :: Int -> Bool -> HasInit -> IO IGraph
igraphNew n directed _ = igraphNew' n directed

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

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

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


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

{-# LINE 431 "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 440 "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 447 "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 451 "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 453 "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.
 -> (Vector) -- ^ The edges themselves.
 -> (Ptr ()) -- ^ The attributes of the new edges.
 -> IO ()
igraphAddEdges a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  (withVector) a2 $ \a2' ->
  let {a3' = id a3} in
  igraphAddEdges'_ a1' a2' a3' >>
  return ()

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


-- | delete vertices
igraphDeleteVertices :: (IGraph) -> (IGraphVs) -> IO ((Int))
igraphDeleteVertices a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphVs) a2 $ \a2' ->
  igraphDeleteVertices'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


-- | delete edges
igraphDeleteEdges :: (IGraph) -> (IGraphEs) -> IO ((Int))
igraphDeleteEdges a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphEs) a2 $ \a2' ->
  igraphDeleteEdges'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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




withAttr :: String
         -> BSVector -> (Ptr AttributeRecord -> IO a) -> IO a
withAttr name bs f = withBSVector bs $ \ptr -> do
    fptr <- mallocForeignPtrBytes 24
{-# LINE 477 "src/IGraph/Internal.chs" #-}

    withForeignPtr fptr $ \attr -> withCString name $ \name' -> do
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) attr name'
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)}) attr 2
        (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr ()))}) attr $ castPtr ptr
        f attr
{-# INLINE withAttr #-}

igraphHaskellAttributeHasAttr :: (IGraph) -> (AttributeElemtype) -> (String) -> 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 485 "src/IGraph/Internal.chs" #-}


igraphHaskellAttributeGANSet :: (IGraph) -> (String) -> (Double) -> IO ((Int))
igraphHaskellAttributeGANSet a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = realToFrac a3} in
  igraphHaskellAttributeGANSet'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


igraphHaskellAttributeGAN :: (IGraph) -> (String) -> IO ((Double))
igraphHaskellAttributeGAN a1 a2 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  igraphHaskellAttributeGAN'_ a1' a2' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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


igraphHaskellAttributeVAS :: (IGraph) -> (String) -> (Int) -> 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 491 "src/IGraph/Internal.chs" #-}


igraphHaskellAttributeEAN :: (IGraph) -> (String) -> (Int) -> IO ((Double))
igraphHaskellAttributeEAN a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  igraphHaskellAttributeEAN'_ a1' a2' a3' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

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


igraphHaskellAttributeEAS :: (IGraph) -> (String) -> (Int) -> 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 495 "src/IGraph/Internal.chs" #-}


igraphHaskellAttributeEASSetv :: (IGraph) -> (String) -> (BSVector) -> IO ((Int))
igraphHaskellAttributeEASSetv a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  C2HSImp.withCString a2 $ \a2' ->
  (withBSVector) a3 $ \a3' ->
  igraphHaskellAttributeEASSetv'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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


igraphHaskellAttributeVASSet :: (IGraph) -> (String) -> (Int) -> (Ptr BSLen) -> IO ((Int))
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 ->
  let {res' = fromIntegral res} in
  return (res')

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


igraphHaskellAttributeEASSet :: (IGraph) -> (String) -> (Int) -> (Ptr BSLen) -> IO ((Int))
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 ->
  let {res' = fromIntegral res} in
  return (res')

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "IGraph/Internal.chs.h igraph_strvector_get"
  igraphStrvectorGet'_ :: ((C2HSImp.Ptr (StrVector)) -> (C2HSImp.CLong -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_strvector_set"
  igraphStrvectorSet'_ :: ((C2HSImp.Ptr (StrVector)) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall safe "IGraph/Internal.chs.h igraph_strvector_set2"
  igraphStrvectorSet2'_ :: ((C2HSImp.Ptr (StrVector)) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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_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 (Vector)) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

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

foreign import ccall safe "IGraph/Internal.chs.h __c2hs_wrapped__igraph_delete_edges"
  igraphDeleteEdges'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr (IGraphEs)) -> (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_GAN_set"
  igraphHaskellAttributeGANSet'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CDouble -> (IO C2HSImp.CInt))))

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

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 (BSLen))))))

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

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 (BSLen))))))

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

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 (BSLen)) -> (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 (BSLen)) -> (IO C2HSImp.CInt)))))