-- 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/Selector.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Selector 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.Constants
{-# LINE 9 "src/IGraph/Internal/Selector.chs" #-}

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

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




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


igraphVsAll :: IO ((IGraphVs))
igraphVsAll =
  C2HSImp.mallocForeignPtrBytes 16 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  igraphVsAll'_ a1' >>
  return (IGraphVs a1'')

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


igraphVsAdj :: (Int) -> (Neimode) -> IO ((IGraphVs))
igraphVsAdj a2 a3 =
  C2HSImp.mallocForeignPtrBytes 16 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = fromIntegral a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  igraphVsAdj'_ a1' a2' a3' >>
  return (IGraphVs a1'')

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


igraphVsVector :: (Vector) -> IO ((IGraphVs))
igraphVsVector a2 =
  C2HSImp.mallocForeignPtrBytes 16 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  (withVector) a2 $ \a2' ->
  igraphVsVector'_ a1' a2' >>
  return (IGraphVs a1'')

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



-- Vertex iterator

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


igraphVitNew :: (IGraph) -> (IGraphVs) -> IO ((IGraphVit))
igraphVitNew a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphVs) a2 $ \a2' ->
  C2HSImp.mallocForeignPtrBytes 40 >>= \a3'' -> C2HSImp.withForeignPtr a3'' $ \a3' ->
  igraphVitNew'_ a1' a2' a3' >>
  return (IGraphVit a3'')

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


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

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


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

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


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

{-# LINE 47 "src/IGraph/Internal/Selector.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

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


igraphEsAll :: (EdgeOrderType) -> IO ((IGraphEs))
igraphEsAll a2 =
  C2HSImp.mallocForeignPtrBytes 24 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  igraphEsAll'_ a1' a2' >>
  return (IGraphEs a1'')

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


igraphEsVector :: (Vector) -> IO ((IGraphEs))
igraphEsVector a2 =
  C2HSImp.mallocForeignPtrBytes 24 >>= \a1'' -> C2HSImp.withForeignPtr a1'' $ \a1' ->
  (withVector) a2 $ \a2' ->
  igraphEsVector'_ a1' a2' >>
  return (IGraphEs a1'')

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



-- Edge iterator

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


igraphEitNew :: (IGraph) -> (IGraphEs) -> IO ((IGraphEit))
igraphEitNew a1 a2 =
  (withIGraph) a1 $ \a1' ->
  (withIGraphEs) a2 $ \a2' ->
  C2HSImp.mallocForeignPtrBytes 40 >>= \a3'' -> C2HSImp.withForeignPtr a3'' $ \a3' ->
  igraphEitNew'_ a1' a2' a3' >>
  return (IGraphEit a3'')

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


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

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


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

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


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

{-# LINE 93 "src/IGraph/Internal/Selector.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

-- 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 108 "src/IGraph/Internal/Selector.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 113 "src/IGraph/Internal/Selector.chs" #-}


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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