-- 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/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 qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign




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

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


-- Construtors and destructors

allocaVector :: (Ptr Vector -> IO a) -> IO a
allocaVector f = mallocBytes 24 >>= f
{-# INLINE allocaVector #-}

addVectorFinalizer :: Ptr Vector -> IO Vector
addVectorFinalizer ptr = do
    vec <- newForeignPtr igraph_vector_destroy ptr
    return $ Vector vec
{-# INLINE addVectorFinalizer #-}


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


allocaVectorPtr :: (Ptr VectorPtr -> IO a) -> IO a
allocaVectorPtr f = mallocBytes 32 >>= 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
--------------------------------------------------------------------------------

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


allocaStrVector :: (Ptr StrVector -> IO a) -> IO a
allocaStrVector f = mallocBytes 16 >>= 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
--------------------------------------------------------------------------------

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


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


allocaBSVector :: (Ptr BSVector -> IO a) -> IO a
allocaBSVector f = mallocBytes 16 >>= f
{-# INLINE allocaBSVector #-}

addBSVectorFinalizer :: Ptr BSVector -> IO BSVector
addBSVectorFinalizer ptr = do
    vec <- newForeignPtr bsvector_destroy ptr
    return $ BSVector vec
{-# INLINE addBSVectorFinalizer #-}

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


allocaMatrix :: (Ptr Matrix -> IO a) -> IO a
allocaMatrix f = mallocBytes 40 >>= f
{-# INLINE allocaMatrix #-}

addMatrixFinalizer :: Ptr Matrix -> IO Matrix
addMatrixFinalizer ptr = do
    vec <- newForeignPtr igraph_matrix_destroy ptr
    return $ Matrix vec
{-# INLINE addMatrixFinalizer #-}


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


allocaVs :: (Ptr IGraphVs -> IO a) -> IO a
allocaVs f = mallocBytes 16 >>= f
{-# INLINE allocaVs #-}

addVsFinalizer :: Ptr IGraphVs -> IO IGraphVs
addVsFinalizer ptr = newForeignPtr igraph_vs_destroy ptr >>= return . IGraphVs
{-# INLINE addVsFinalizer #-}


-- Vertex iterator
newtype IGraphVit = IGraphVit (C2HSImp.ForeignPtr (IGraphVit))
withIGraphVit :: IGraphVit -> (C2HSImp.Ptr IGraphVit -> IO b) -> IO b
withIGraphVit (IGraphVit fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 175 "src/IGraph/Internal/Types.chs" #-}


allocaVit :: (Ptr IGraphVit -> IO a) -> IO a
allocaVit f = mallocBytes 40 >>= f
{-# INLINE allocaVit #-}

addVitFinalizer :: Ptr IGraphVit -> IO IGraphVit
addVitFinalizer ptr = newForeignPtr igraph_vit_destroy ptr >>= return . IGraphVit
{-# INLINE addVitFinalizer #-}

-- Edge Selector

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


allocaEs :: (Ptr IGraphEs -> IO a) -> IO a
allocaEs f = mallocBytes 24 >>= f
{-# INLINE allocaEs #-}

addEsFinalizer :: Ptr IGraphEs -> IO IGraphEs
addEsFinalizer ptr = newForeignPtr igraph_es_destroy ptr >>= return . IGraphEs
{-# INLINE addEsFinalizer #-}

-- Edge iterator

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


allocaEit :: (Ptr IGraphEit -> IO a) -> IO a
allocaEit f = mallocBytes 40 >>= f
{-# INLINE allocaEit #-}

addEitFinalizer :: Ptr IGraphEit -> IO IGraphEit
addEitFinalizer ptr = newForeignPtr igraph_eit_destroy ptr >>= return . IGraphEit
{-# INLINE addEitFinalizer #-}


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


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

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

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


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


igraphArpackNew :: IO ((ArpackOpt))
igraphArpackNew =
  C2HSImp.mallocForeignPtrBytes 200 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  igraphArpackNew'_ a1' >>
  return (ArpackOpt a1'')

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


foreign import ccall "IGraph/Internal/Types.chs.h &igraph_vector_destroy"
  igraph_vector_destroy :: C2HSImp.FinalizerPtr Vector

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_vector_ptr_destroy"
  igraph_vector_ptr_destroy :: C2HSImp.FinalizerPtr VectorPtr

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_strvector_destroy"
  igraph_strvector_destroy :: C2HSImp.FinalizerPtr StrVector

foreign import ccall "IGraph/Internal/Types.chs.h &bsvector_destroy"
  bsvector_destroy :: C2HSImp.FinalizerPtr BSVector

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_matrix_destroy"
  igraph_matrix_destroy :: C2HSImp.FinalizerPtr Matrix

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_vs_destroy"
  igraph_vs_destroy :: C2HSImp.FinalizerPtr IGraphVs

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_vit_destroy"
  igraph_vit_destroy :: C2HSImp.FinalizerPtr IGraphVit

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_es_destroy"
  igraph_es_destroy :: C2HSImp.FinalizerPtr IGraphEs

foreign import ccall "IGraph/Internal/Types.chs.h &igraph_eit_destroy"
  igraph_eit_destroy :: C2HSImp.FinalizerPtr IGraphEit

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

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