-- 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/Graph.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Graph where
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 Control.Monad
import Foreign
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)

import IGraph.Internal.C2HS
import IGraph.Internal.Initialization
{-# LINE 10 "src/IGraph/Internal/Graph.chs" #-}

import IGraph.Internal.Data
{-# LINE 11 "src/IGraph/Internal/Graph.chs" #-}

import IGraph.Internal.Constants
{-# LINE 12 "src/IGraph/Internal/Graph.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 20 "src/IGraph/Internal/Graph.chs" #-}


igraphNew' :: (Int) -> (Bool) -> IO ((IGraph))
igraphNew' a2 a3 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = C2HSImp.fromBool a3} in
  igraphNew''_ a1' a2' a3' >>
  return (IGraph a1'')

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


igraphCopy :: (IGraph) -> IO ((IGraph))
igraphCopy a2 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  (withIGraph) a2 $ \a2' ->
  igraphCopy'_ a1' a2' >>
  return (IGraph a1'')

{-# LINE 24 "src/IGraph/Internal/Graph.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 34 "src/IGraph/Internal/Graph.chs" #-}


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

{-# LINE 36 "src/IGraph/Internal/Graph.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 45 "src/IGraph/Internal/Graph.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 52 "src/IGraph/Internal/Graph.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 56 "src/IGraph/Internal/Graph.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 58 "src/IGraph/Internal/Graph.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 69 "src/IGraph/Internal/Graph.chs" #-}



-- generators

igraphFull :: (Int) -> (Bool) -> (Bool) -> IO ((IGraph))
igraphFull a2 a3 a4 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = C2HSImp.fromBool a3} in
  let {a4' = C2HSImp.fromBool a4} in
  igraphFull'_ a1' a2' a3' a4' >>
  return (IGraph a1'')

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


igraphErdosRenyiGame :: (ErdosRenyi) -> (Int) -> (Double) -> (Bool) -> (Bool) -> IO ((IGraph))
igraphErdosRenyiGame a2 a3 a4 a5 a6 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = realToFrac a4} in
  let {a5' = C2HSImp.fromBool a5} in
  let {a6' = C2HSImp.fromBool a6} in
  igraphErdosRenyiGame'_ a1' a2' a3' a4' a5' a6' >>
  return (IGraph a1'')

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


igraphDegreeSequenceGame :: (Vector) -> (Vector) -> (Degseq) -> IO ((IGraph))
igraphDegreeSequenceGame a2 a3 a4 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  (withVector) a2 $ \a2' ->
  (withVector) a3 $ \a3' ->
  let {a4' = (fromIntegral . fromEnum) a4} in
  igraphDegreeSequenceGame'_ a1' a2' a3' a4' >>
  return (IGraph a1'')

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


igraphRewire :: (IGraph) -> (Int) -> (Rewiring) -> IO ((Int))
igraphRewire a1 a2 a3 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  igraphRewire'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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



igraphIsoclassCreate :: (Int) -> (Int) -> (Bool) -> IO ((IGraph))
igraphIsoclassCreate a2 a3 a4 =
  C2HSImp.mallocForeignPtrBytes 160 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = C2HSImp.fromBool a4} in
  igraphIsoclassCreate'_ a1' a2' a3' a4' >>
  return (IGraph a1'')

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


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

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

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

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

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

foreign import ccall safe "IGraph/Internal/Graph.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/Graph.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/Graph.chs.h igraph_add_vertices"
  igraphAddVertices'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

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

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

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

foreign import ccall safe "IGraph/Internal/Graph.chs.h igraph_erdos_renyi_game"
  igraphErdosRenyiGame'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "IGraph/Internal/Graph.chs.h igraph_degree_sequence_game"
  igraphDegreeSequenceGame'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.Ptr (Vector)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

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

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