-- GENERATED by C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--  
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--  
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--  
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--  
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Iterator (
  
  Iterator,
  Iterable,
  IteratorFilter,
  IteratorFoldFunction,
  IteratorResult(..),
  
  iteratorNext,
  iteratorResync,
  iteratorFilter,
  iteratorFold,
  iteratorForeach,
  iteratorFind
  
  ) where

import Media.Streaming.GStreamer.Core.Types
{-# LINE 46 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}

import Data.Maybe (fromJust)
import System.Glib.FFI
import System.Glib.GValue
{-# LINE 50 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
import Data.IORef


{-# LINE 53 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}

iteratorNext :: Iterable a
             => Iterator a
             -> IO (IteratorResult, Maybe a)
iteratorNext (Iterator iterator) =
    alloca $ \elemPtr ->
        do result <- (\(PtrIterator arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_iterator_next argPtr1 arg2) iterator elemPtr
           obj <- peek elemPtr >>= maybePeek peekIterable
           return (toEnum $ fromIntegral result, obj)

iteratorResync :: Iterator a
               -> IO ()
iteratorResync (Iterator iterator) =
    (\(PtrIterator arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_iterator_resync argPtr1) iterator

type CIteratorFilter =  ((Ptr ()))
{-# LINE 69 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
                     -> ((Ptr ()))
{-# LINE 70 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
                     -> IO (CInt)
{-# LINE 71 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
marshalIteratorFilter :: Iterable a
                      => IteratorFilter a
                      -> IO ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))))
{-# LINE 74 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
marshalIteratorFilter iteratorFilter =
    makeIteratorFilter cIteratorFilter
    where cIteratorFilter elementPtr _ =
              do include <- peekIterable elementPtr >>= iteratorFilter
                 return $ if include then 1 else 0
foreign import ccall "wrapper"
    makeIteratorFilter :: CIteratorFilter
                    -> IO ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))))
{-# LINE 82 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}

iteratorFilter :: Iterable a
               => Iterator a
               -> IteratorFilter a
               -> IO (Iterator a)
iteratorFilter (Iterator iterator) filter =
    do cFilter <- marshalIteratorFilter filter
       (\(PtrIterator arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gst_iterator_filter argPtr1 arg2 arg3) iterator cFilter nullPtr >>=
           takeIterator

{- type IteratorFoldFunction itemT accumT = itemT
                                         -> accumT
                                         -> IO (Maybe accumT) -}
type CIteratorFoldFunction =  ((Ptr ()))
{-# LINE 96 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
                           -> GValue
                           -> ((Ptr ()))
{-# LINE 98 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
                           -> IO (CInt)
{-# LINE 99 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
marshalIteratorFoldFunction :: Iterable itemT
                            => IteratorFoldFunction itemT accumT
                            -> IORef accumT
                            -> IO ((FunPtr ((Ptr ()) -> ((Ptr GValue) -> ((Ptr ()) -> (IO CInt))))))
{-# LINE 103 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}
marshalIteratorFoldFunction iteratorFoldFunction accumRef =
    makeIteratorFoldFunction cIteratorFoldFunction
    where cIteratorFoldFunction :: CIteratorFoldFunction
          cIteratorFoldFunction itemPtr _ _ =
              do item <- peekIterable itemPtr
                 accum <- readIORef accumRef
                 (continue, accum') <- iteratorFoldFunction item accum
                 writeIORef accumRef accum'
                 return $ fromBool continue
foreign import ccall "wrapper"
    makeIteratorFoldFunction :: CIteratorFoldFunction
                             -> IO ((FunPtr ((Ptr ()) -> ((Ptr GValue) -> ((Ptr ()) -> (IO CInt))))))
{-# LINE 115 "./Media/Streaming/GStreamer/Core/Iterator.chs" #-}

iteratorFold :: Iterable itemT
             => Iterator itemT
             -> accumT
             -> IteratorFoldFunction itemT accumT
             -> IO (IteratorResult, accumT)
iteratorFold (Iterator iterator) init func =
    do accumRef <- newIORef init
       func' <- marshalIteratorFoldFunction func accumRef
       result <- (\(PtrIterator arg1) arg2 (GValue arg3) arg4 -> withForeignPtr arg1 $ \argPtr1 ->gst_iterator_fold argPtr1 arg2 arg3 arg4) iterator
                                          func'
                                          (GValue nullPtr)
                                          nullPtr
       freeHaskellFunPtr func'
       accum <- readIORef accumRef
       return (toEnum $ fromIntegral result, accum)

iteratorForeach :: Iterable itemT
                => Iterator itemT
                -> (itemT -> IO ())
                -> IO IteratorResult
iteratorForeach iterator func =
    do (result, _) <- iteratorFold iterator () $ \item _ ->
                          func item >> return (True, ())
       return result

iteratorFind :: Iterable itemT
             => Iterator itemT
             -> (itemT -> IO Bool)
             -> IO (IteratorResult, Maybe itemT)
iteratorFind iterator pred =
    iteratorFold iterator Nothing $ \item accum ->
        do found <- pred item
           if found
               then return (False, Just item)
               else return (True, accum)

foreign import ccall safe "gst_iterator_next"
  gst_iterator_next :: ((Ptr PtrIterator) -> ((Ptr (Ptr ())) -> (IO CInt)))

foreign import ccall safe "gst_iterator_resync"
  gst_iterator_resync :: ((Ptr PtrIterator) -> (IO ()))

foreign import ccall safe "gst_iterator_filter"
  gst_iterator_filter :: ((Ptr PtrIterator) -> ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))) -> ((Ptr ()) -> (IO (Ptr PtrIterator)))))

foreign import ccall safe "gst_iterator_fold"
  gst_iterator_fold :: ((Ptr PtrIterator) -> ((FunPtr ((Ptr ()) -> ((Ptr GValue) -> ((Ptr ()) -> (IO CInt))))) -> ((Ptr GValue) -> ((Ptr ()) -> (IO CInt)))))