gstreamer: M.S.G.Core.Types.chs: staticPadTemplateGet: Control.Monad.>=> not available before ghc 6.8; don't export StaticPadTemplate constructors

--  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.

-- #hide

-- | Maintainer  : gtk2hs-devel\@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Types (

  module Media.Streaming.GStreamer.Core.Constants,
  module Media.Streaming.GStreamer.Core.Hierarchy,
  module Media.Streaming.GStreamer.Core.HierarchyBase,
  module Media.Streaming.GStreamer.Core.MiniHierarchy,
  module Media.Streaming.GStreamer.Core.MiniHierarchyBase,
  module Media.Streaming.GStreamer.Core.GObjectHierarchy,

  cToFlags,
  cFromFlags,
  cToEnum,
  cFromEnum,

  FourCC,
  Fraction,

  Format(..),
  FormatDefinition(..),

  mkObjectGetFlags,
  mkObjectSetFlags,
  mkObjectUnsetFlags,

  withObject,
  peekObject,
  takeObject,
  giveObject,

  PadDirection(..),
  PadPresence(..),
  PadLinkReturn(..),
  FlowReturn(..),
  ActivateMode(..),
  StaticPadTemplate {-(..)-},
  staticPadTemplateGet,

  State(..),
  StateChangeReturn(..),
  SeekFlags(..),
  SeekType(..),

  PluginFilter,
  PluginFeatureFilter,

  BusFunc,
  BusSyncHandler,
  BusSyncReply(..),

  ClockTimeDiff,
  ClockReturn(..),
  ClockID(..),
  withClockID,
  takeClockID,
  peekClockID,

  IndexCertainty(..),
  IndexEntry(..),
  takeIndexEntry,
  peekIndexEntry,
  IndexEntryType(..),

  IndexLookupMethod(..),
  IndexFilter,
  IndexAssociation(..),
  AssocFlags(..),

  withMiniObject,
  peekMiniObject,
  takeMiniObject,
  giveMiniObject,
  MiniObjectT(..),
  askMiniObjectPtr,
  runMiniObjectT,
  marshalMiniObjectModify,
  mkMiniObjectGetFlags,
  mkMiniObjectGetFlagsM,
  mkMiniObjectSetFlagsM,
  mkMiniObjectUnsetFlagsM,

  QueryType,
  QueryTypeDefinition(..),

  EventTypeFlags(..),

  PtrIterator(..),
  Iterator(..),
  IteratorItem(..),
  IteratorResult(..),
  Iterable(..),
  IteratorFilter,
  IteratorFoldFunction,
  withIterator,
  takeIterator,
  peekIterator,
  -- giveIterator - not defined - iterators don't have a refcount and
  -- are not copyable

  Caps(..),
  mkCaps,
  unCaps,
  withCaps,
  takeCaps,
  peekCaps,
  giveCaps,

  Structure(..),
  StructureForeachFunc,
  withStructure,
  takeStructure,
  peekStructure,
  giveStructure,
  StructureM(..),
  StructureMRep,

  TagList,
  withTagList,
  takeTagList,
  peekTagList,
  giveTagList,
  Tag,
  TagFlag,
  TagMergeMode,

  Segment(..),

  ) where

import Control.Monad       ( liftM )
import Control.Monad.Reader
import Control.Monad.Trans
import Data.Ratio          ( Ratio )
import System.Glib.FFI
import System.Glib.Flags
{#import System.Glib.GType#}
{#import System.Glib.GObject#}
{#import System.Glib.GValue#}
import System.Glib.UTFString
import Media.Streaming.GStreamer.Core.Constants
import Media.Streaming.GStreamer.Core.HierarchyBase
{#import Media.Streaming.GStreamer.Core.MiniHierarchyBase#}
{#import Media.Streaming.GStreamer.Core.Hierarchy#}
{#import Media.Streaming.GStreamer.Core.MiniHierarchy#}
{#import Media.Streaming.GStreamer.Core.GObjectHierarchy#}

{# context lib = "gstreamer" prefix = "gst" #}

type FourCC = Word32
type Fraction = Ratio Int

{# enum GstParseError as ParseError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

cToFlags :: (Integral int, Flags flags)
         => int
         -> [flags]
cToFlags = toFlags . fromIntegral
cFromFlags :: (Integral int, Flags flags)
           => [flags]
           -> int
cFromFlags = fromIntegral . fromFlags

cToEnum :: (Integral int, Enum enum)
        => int
        -> enum
cToEnum = toEnum . fromIntegral
cFromEnum :: (Integral int, Enum enum)
           => enum
           -> int
cFromEnum = fromIntegral . fromEnum

--------------------------------------------------------------------

{# enum GstFormat as Format {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

data FormatDefinition = FormatDefinition { formatValue       :: Format
                                         , formatNick        :: String
                                         , formatDescription :: String
                                         , formatQuark       :: Quark }
                        deriving (Eq, Show)
instance Storable FormatDefinition where
    sizeOf = undefined
    alignment = undefined
    peek ptr =
        do value       <- liftM cToEnum $ {# get GstFormatDefinition->value #} ptr
           nick        <- {# get GstFormatDefinition->nick #} ptr >>= peekUTFString
           description <- {# get GstFormatDefinition->description #} ptr >>= peekUTFString
           quark       <- {# get GstFormatDefinition->quark #} ptr
           return $ FormatDefinition value nick description quark
    poke _ _ = undefined
instance Iterable FormatDefinition where
    peekIterable = peek . castPtr
    withIterable = with

--------------------------------------------------------------------

withObject :: ObjectClass objectT
           => objectT
           -> (Ptr objectT -> IO a)
           -> IO a
withObject object action =
    let objectFPtr = unObject $ toObject object
    in withForeignPtr (castForeignPtr objectFPtr) action

peekObject, takeObject :: ObjectClass obj
                       => Ptr obj
                       -> IO obj
peekObject cObject = do
    liftM (unsafeCastGObject . GObject . castForeignPtr) $
        do cObjectRef $ castPtr cObject
           newForeignPtr (castPtr cObject) objectFinalizer
foreign import ccall unsafe "&gst_object_unref"
  objectFinalizer :: FunPtr (Ptr () -> IO ())
foreign import ccall unsafe "gst_object_ref"
  cObjectRef :: Ptr ()
             -> IO (Ptr ())

takeObject cObject =
    liftM (unsafeCastGObject . GObject . castForeignPtr) $
        do cObjectUnfloat $ castPtr cObject
           newForeignPtr (castPtr cObject) objectFinalizer
foreign import ccall unsafe "_hs_gst_object_unfloat"
  cObjectUnfloat :: Ptr ()
                 -> IO ()

mkObjectGetFlags :: (ObjectClass objectT, Flags flagsT)
                 => objectT
                 -> IO [flagsT]
mkObjectGetFlags object =
    liftM cToFlags $
        withObject (toObject object) cObjectGetFlags
foreign import ccall unsafe "_hs_gst_object_flags"
    cObjectGetFlags :: Ptr Object
                    -> IO CUInt

mkObjectSetFlags :: (ObjectClass objectT, Flags flagsT)
                 => objectT
                 -> [flagsT]
                 -> IO ()
mkObjectSetFlags object flags =
    withObject (toObject object) $ \cObject ->
        cObjectSetFlags cObject (fromIntegral $ fromFlags flags)
foreign import ccall unsafe "_hs_gst_object_flag_set"
    cObjectSetFlags :: Ptr Object
                    -> CUInt
                    -> IO ()

mkObjectUnsetFlags :: (ObjectClass objectT, Flags flagsT)
                   => objectT
                   -> [flagsT]
                   -> IO ()
mkObjectUnsetFlags object flags =
    withObject (toObject object) $ \cObject ->
        cObjectUnsetFlags cObject (fromIntegral $ fromFlags flags)
foreign import ccall unsafe "_hs_gst_object_flag_unset"
    cObjectUnsetFlags :: Ptr Object
                    -> CUInt
                    -> IO ()

-- | Use 'giveObject' to pass an object to a function that takes
--   ownership of it.
giveObject :: (ObjectClass obj, MonadIO m)
           => obj
           -> (obj -> m a)
           -> m a
giveObject obj action =
    do liftIO $ withObject (toObject obj) $ {# call gst_object_ref #} . castPtr
       action obj

--------------------------------------------------------------------

{# enum GstPadDirection  as PadDirection  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstPadPresence   as PadPresence   {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstPadLinkReturn as PadLinkReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstFlowReturn    as FlowReturn    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstActivateMode  as ActivateMode  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

instance Iterable Pad where
    peekIterable = peekObject . castPtr
    withIterable = withObject

{# pointer *GstStaticPadTemplate as StaticPadTemplate #}
staticPadTemplateGet :: StaticPadTemplate
                     -> IO PadTemplate
staticPadTemplateGet staticPadTemplate =
    {# call static_pad_template_get #} staticPadTemplate >>= takeObject

--------------------------------------------------------------------

{# enum GstPluginError as PluginError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

--------------------------------------------------------------------

{# enum GstSeekFlags as SeekFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags SeekFlags
{# enum GstSeekType  as SeekType  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstState     as State     {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# enum GstStateChangeReturn as StateChangeReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

instance Iterable Element where
    peekIterable = peekObject . castPtr
    withIterable = withObject

--------------------------------------------------------------------

type PluginFilter = Plugin -> IO Bool
type PluginFeatureFilter = PluginFeature -> IO Bool

--------------------------------------------------------------------

{# enum GstBusSyncReply as BusSyncReply {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

type BusFunc =  Bus
             -> Message
             -> IO Bool
type BusSyncHandler =  Bus
                    -> Message
                    -> IO BusSyncReply

--------------------------------------------------------------------

type ClockTimeDiff = Int64

{# enum GstClockReturn as ClockReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# pointer *GstClockID as ClockID foreign newtype #}
withClockID :: ClockID
            -> (Ptr ClockID -> IO a)
            -> IO a
withClockID (ClockID clockID) = withForeignPtr clockID
takeClockID, peekClockID :: Ptr ClockID
                        -> IO ClockID
takeClockID clockIDPtr =
    liftM ClockID $ newForeignPtr clockIDPtr clockIDFinalizer
peekClockID clockIDPtr =
    do {# call clock_id_ref #} $ castPtr clockIDPtr
       takeClockID clockIDPtr

foreign import ccall unsafe "&gst_clock_id_unref"
    clockIDFinalizer :: FunPtr (Ptr ClockID -> IO ())

--------------------------------------------------------------------

{# enum GstIndexCertainty    as IndexCertainty    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIndexEntryType    as IndexEntryType    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIndexLookupMethod as IndexLookupMethod {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# pointer *GstIndexEntry as IndexEntry foreign newtype #}

takeIndexEntry :: Ptr IndexEntry
              -> IO IndexEntry
takeIndexEntry ptr =
    liftM IndexEntry $ newForeignPtr ptr indexEntryFinalizer
foreign import ccall unsafe "&gst_index_entry_free"
    indexEntryFinalizer :: FunPtr (Ptr IndexEntry -> IO ())
peekIndexEntry :: Ptr IndexEntry
               -> IO IndexEntry
peekIndexEntry ptr =
    (liftM IndexEntry $ newForeignPtr_ ptr) >>=
        {# call index_entry_copy #} >>=
            takeIndexEntry

type IndexFilter  = Index
                 -> IndexEntry
                 -> IO Bool

data IndexAssociation = IndexAssociation Format Int64
                        deriving (Eq, Show)
instance Storable IndexAssociation where
    sizeOf _ = {# sizeof GstIndexAssociation #}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do format <- {# get GstIndexAssociation->format #} ptr
           value <- {# get GstIndexAssociation->value #} ptr
           return $ IndexAssociation (cToEnum format) (fromIntegral value)
    poke ptr (IndexAssociation format value) =
        do {# set GstIndexAssociation->format #} ptr $ cFromEnum format
           {# set GstIndexAssociation->value #} ptr $ fromIntegral value

{# enum GstAssocFlags as AssocFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags AssocFlags

--------------------------------------------------------------------

withMiniObject :: MiniObjectClass miniObjectT
               => miniObjectT
               -> (Ptr miniObjectT -> IO a)
               -> IO a
withMiniObject miniObject action =
    let miniObjectFPtr = unMiniObject $ toMiniObject miniObject
    in withForeignPtr (castForeignPtr miniObjectFPtr) action

takeMiniObject, peekMiniObject :: (MiniObjectClass obj)
                               => Ptr obj
                               -> IO obj
peekMiniObject cMiniObject =
    do cMiniObjectRef $ castPtr cMiniObject
       takeMiniObject cMiniObject
foreign import ccall unsafe "gst_mini_object_ref"
  cMiniObjectRef :: Ptr ()
                 -> IO (Ptr ())

takeMiniObject cMiniObject =
    do cMiniObjectMakeReadOnly $ castPtr cMiniObject
       object <- newForeignPtr (castPtr cMiniObject) miniObjectFinalizer
       return $ unsafeCastMiniObject $ MiniObject $ castForeignPtr object
foreign import ccall unsafe "&gst_mini_object_unref"
  miniObjectFinalizer :: FunPtr (Ptr () -> IO ())
foreign import ccall unsafe "_hs_gst_mini_object_make_read_only"
  cMiniObjectMakeReadOnly :: Ptr MiniObject
                          -> IO ()

-- | Use 'giveMiniObject' to pass an miniObject to a function that takes
--   ownership of it.
giveMiniObject :: (MiniObjectClass obj, MonadIO m)
               => obj
               -> (obj -> m a)
               -> m a
giveMiniObject obj action =
    do liftIO $ {# call gst_mini_object_ref #} (toMiniObject obj)
       action obj

-- | A 'Monad' for sequencing modifications to a 'MiniObject'.
newtype (MiniObjectClass miniObjectT, Monad m) =>
    MiniObjectT miniObjectT m a =
        MiniObjectT (ReaderT (Ptr miniObjectT) m a)
        deriving (Functor, Monad, MonadTrans)
instance (MiniObjectClass miniObjectT, Monad m, MonadIO m) =>
    MonadIO (MiniObjectT miniObjectT m) where
        liftIO = MiniObjectT . liftIO

askMiniObjectPtr :: (MiniObjectClass miniObjectT, Monad m)
                 => MiniObjectT miniObjectT m (Ptr miniObjectT)
askMiniObjectPtr = MiniObjectT $ ask

runMiniObjectT :: (MiniObjectClass miniObjectT, Monad m)
               => MiniObjectT miniObjectT m a
               -> (Ptr miniObjectT)
               -> m a
runMiniObjectT (MiniObjectT action) = runReaderT action

marshalMiniObjectModify :: (MiniObjectClass miniObjectT, MonadIO m)
                        => m (Ptr miniObjectT)
                        -> MiniObjectT miniObjectT m a
                        -> m (miniObjectT, a)
marshalMiniObjectModify mkMiniObject action =
    do ptr' <- mkMiniObject
       ptr <- liftIO $ liftM castPtr $ gst_mini_object_make_writable $ castPtr ptr'
       result <- runMiniObjectT action ptr
       object <- liftIO $ takeMiniObject ptr
       return (object, result)
    where _ = {# call mini_object_make_writable #}

mkMiniObjectGetFlags :: (MiniObjectClass miniObjectT, Flags flagsT)
                     => miniObjectT
                     -> [flagsT]
mkMiniObjectGetFlags miniObject =
    cToFlags $ unsafePerformIO $
        withMiniObject (toMiniObject miniObject) cMiniObjectGetFlags
foreign import ccall unsafe "_hs_gst_mini_object_flags"
    cMiniObjectGetFlags :: Ptr MiniObject
                        -> IO CUInt

mkMiniObjectGetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                      => MiniObjectT miniObjectT m [flagsT]
mkMiniObjectGetFlagsM = do
  ptr <- askMiniObjectPtr
  liftIO $ liftM cToFlags $ cMiniObjectGetFlags $ castPtr ptr

mkMiniObjectSetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                      => [flagsT]
                      -> MiniObjectT miniObjectT m ()
mkMiniObjectSetFlagsM flags = do
  ptr <- askMiniObjectPtr
  liftIO $ cMiniObjectSetFlags (castPtr ptr) $ cFromFlags flags
foreign import ccall unsafe "_hs_gst_mini_object_flag_set"
    cMiniObjectSetFlags :: Ptr MiniObject
                        -> CUInt
                        -> IO ()

mkMiniObjectUnsetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                        => [flagsT]
                        -> MiniObjectT miniObjectT m ()
mkMiniObjectUnsetFlagsM flags = do
  ptr <- askMiniObjectPtr
  liftIO $ cMiniObjectUnsetFlags (castPtr ptr) $ cFromFlags flags
foreign import ccall unsafe "_hs_gst_mini_object_flag_unset"
    cMiniObjectUnsetFlags :: Ptr MiniObject
                          -> CUInt
                          -> IO ()

--------------------------------------------------------------------

type QueryType = {# type GstQueryType #}
data QueryTypeDefinition = QueryTypeDefinition {
    queryTypeDefinitionValue       :: QueryType,
    queryTypeDefinitionNick        :: String,
    queryTypeDefinitionDescription :: String,
    queryTypeDefinitionQuark       :: Quark
    } deriving (Eq, Show)
instance Storable QueryTypeDefinition where
    sizeOf _ = {# sizeof GstQuery #}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do value <- {# get GstQueryTypeDefinition->value #} ptr
           nick <- {# get GstQueryTypeDefinition->nick #} ptr >>= peekUTFString
           description <- {# get GstQueryTypeDefinition->description #} ptr >>= peekUTFString
           quark <- {# get GstQueryTypeDefinition->quark #} ptr
           return $ QueryTypeDefinition value
                                        nick
                                        description
                                        quark
    poke _ _ = undefined
instance Iterable QueryTypeDefinition where
    peekIterable = peek . castPtr
    withIterable = with

--------------------------------------------------------------------

{# enum GstEventTypeFlags as EventTypeFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags EventTypeFlags

--------------------------------------------------------------------

{# pointer *GstIterator as PtrIterator foreign newtype #}

withPtrIterator :: PtrIterator
                -> (Ptr PtrIterator -> IO a)
                -> IO a
withPtrIterator (PtrIterator cPtrIterator) = withForeignPtr cPtrIterator

takePtrIterator, peekPtrIterator :: Ptr PtrIterator
                                 -> IO PtrIterator
takePtrIterator ptrIteratorPtr =
    liftM PtrIterator $ newForeignPtr ptrIteratorPtr ptrIteratorFinalizer
peekPtrIterator ptrIteratorPtr =
    liftM PtrIterator $ newForeignPtr_ ptrIteratorPtr

foreign import ccall unsafe "&gst_iterator_free"
    ptrIteratorFinalizer :: FunPtr (Ptr PtrIterator -> IO ())

{# enum GstIteratorItem   as IteratorItem   {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIteratorResult as IteratorResult {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

mkIterator newPtrIterator cPtrIterator =
    do ptrIterator <- newPtrIterator cPtrIterator
       return $ Iterator ptrIterator

newtype Iterable a => Iterator a = Iterator PtrIterator

withIterator :: Iterator a
             -> (Ptr PtrIterator -> IO a)
             -> IO a
withIterator (Iterator ptrIterator) = withPtrIterator ptrIterator

takeIterator, peekIterator :: Ptr PtrIterator
                          -> IO (Iterator a)
takeIterator  cPtrIterator = mkIterator takePtrIterator  cPtrIterator
peekIterator cPtrIterator = mkIterator peekPtrIterator cPtrIterator

class Iterable a where
    peekIterable :: Ptr ()
                 -> IO a
    withIterable :: a
                 -> (Ptr a -> IO b)
                 -> IO b

type IteratorFilter itemT = itemT
                         -> IO Bool
type IteratorFoldFunction itemT accumT = itemT
                                      -> accumT
                                      -> IO (Bool, accumT)

--------------------------------------------------------------------

{# pointer *GstCaps as Caps foreign newtype #}
mkCaps :: ForeignPtr Caps -> Caps
mkCaps = Caps
unCaps :: Caps -> ForeignPtr Caps
unCaps (Caps caps) = caps

withCaps :: Caps -> (Ptr Caps -> IO a) -> IO a
withCaps = withForeignPtr . unCaps

takeCaps, peekCaps :: Ptr Caps
                  -> IO Caps
takeCaps capsPtr =
    liftM Caps $ newForeignPtr capsPtr capsFinalizer
peekCaps capsPtr =
    cCapsRef capsPtr >>= takeCaps
foreign import ccall unsafe "gst_caps_ref"
    cCapsRef :: Ptr Caps
             -> IO (Ptr Caps)

giveCaps :: MonadIO m
         => Caps
         -> (Caps -> m a)
         -> m a
giveCaps caps action =
    do liftIO $ {# call caps_ref #} caps
       action caps

foreign import ccall unsafe "&gst_caps_unref"
    capsFinalizer :: FunPtr (Ptr Caps -> IO ())

--------------------------------------------------------------------

{# pointer *GstStructure as Structure foreign newtype #}
mkStructure :: ForeignPtr Structure -> Structure
mkStructure = Structure
unStructure :: Structure -> ForeignPtr Structure
unStructure (Structure structure) = structure

withStructure :: Structure -> (Ptr Structure -> IO a) -> IO a
withStructure = withForeignPtr . unStructure

mkNewStructure :: (Ptr Structure -> IO (ForeignPtr Structure))
               -> Ptr Structure
               -> IO Structure
mkNewStructure mkFP structurePtr =
    do cStructureMakeImmutable structurePtr
       liftM Structure $ mkFP structurePtr
foreign import ccall unsafe "_hs_gst_structure_make_immutable"
    cStructureMakeImmutable :: Ptr Structure
                            -> IO ()

takeStructure, peekStructure :: Ptr Structure
                            -> IO Structure
takeStructure =
    mkNewStructure $ flip newForeignPtr structureFinalizer
peekStructure =
    mkNewStructure $ newForeignPtr_

giveStructure :: MonadIO m
              => Structure
              -> (Structure -> m a)
              -> m a
giveStructure structure action =
    do structure <- liftIO $
                        {# call structure_copy #} structure >>=
                            peekStructure
       action structure

foreign import ccall unsafe "&gst_structure_free"
    structureFinalizer :: FunPtr (Ptr Structure -> IO ())

type StructureForeachFunc =  Quark
                          -> GValue
                          -> IO Bool

newtype StructureM a = StructureM (StructureMRep a)
type StructureMRep a = (Structure -> IO a)

instance Monad StructureM where
    (StructureM aM) >>= fbM =
        StructureM $ \structure ->
            do a <- aM structure
               let StructureM bM = fbM a
               bM structure
    return a = StructureM $ const $ return a

--------------------------------------------------------------------

type TagList = Structure
mkTagList = mkStructure
unTagList = unStructure
withTagList = withStructure
takeTagList = takeStructure
peekTagList = takeStructure
giveTagList :: MonadIO m
            => TagList
            -> (TagList -> m a)
            -> m a
giveTagList = giveStructure

type Tag = String

{# enum GstTagFlag      as TagFlag      {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstTagMergeMode as TagMergeMode {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

--------------------------------------------------------------------

data Segment = Segment { segmentRate        :: Double
                       , segmentAbsRate     :: Double
                       , segmentFormat      :: Format
                       , segmentFlags       :: [SeekFlags]
                       , segmentStart       :: Int64
                       , segmentStop        :: Int64
                       , segmentTime        :: Int64
                       , segmentAccum       :: Int64
                       , segmentLastStop    :: Int64
                       , segmentDuration    :: Int64 }
               deriving (Eq, Show)
instance Storable Segment where
    sizeOf _ = fromIntegral cSegmentSizeof
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do rate        <- {# get GstSegment->rate #} ptr
           absRate     <- {# get GstSegment->abs_rate #} ptr
           format      <- {# get GstSegment->format #} ptr
           flags       <- {# get GstSegment->flags #} ptr
           start       <- {# get GstSegment->start #} ptr
           stop        <- {# get GstSegment->stop #} ptr
           time        <- {# get GstSegment->time #} ptr
           accum       <- {# get GstSegment->accum #} ptr
           lastStop    <- {# get GstSegment->last_stop #} ptr
           duration    <- {# get GstSegment->duration #} ptr
           return $ Segment (realToFrac rate)
                            (realToFrac absRate)
                            (cToEnum format)
                            (cToFlags flags)
                            (fromIntegral start)
                            (fromIntegral stop)
                            (fromIntegral time)
                            (fromIntegral accum)
                            (fromIntegral lastStop)
                            (fromIntegral duration)
    poke ptr (Segment rate
                      absRate
                      format
                      flags
                      start
                      stop
                      time
                      accum
                      lastStop
                      duration) =
        do {# call segment_init #} (castPtr ptr)
                                   (cFromEnum format)
           {# set GstSegment->rate #} ptr $ realToFrac rate
           {# set GstSegment->abs_rate #} ptr $ realToFrac absRate
           {# set GstSegment->format #} ptr $ cFromEnum format
           {# set GstSegment->flags #} ptr $ fromIntegral $ fromFlags flags
           {# set GstSegment->start #} ptr $ fromIntegral start
           {# set GstSegment->stop #} ptr $ fromIntegral stop
           {# set GstSegment->time #} ptr $ fromIntegral time
           {# set GstSegment->accum #} ptr $ fromIntegral accum
           {# set GstSegment->last_stop #} ptr $ fromIntegral lastStop
           {# set GstSegment->duration #} ptr $ fromIntegral duration
foreign import ccall unsafe "_hs_gst_segment_sizeof"
    cSegmentSizeof :: {# type gsize #}

--------------------------------------------------------------------

--  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.

-- #hide

-- | Maintainer  : gtk2hs-devel\@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Types (

  module Media.Streaming.GStreamer.Core.Constants,
  module Media.Streaming.GStreamer.Core.Hierarchy,
  module Media.Streaming.GStreamer.Core.HierarchyBase,
  module Media.Streaming.GStreamer.Core.MiniHierarchy,
  module Media.Streaming.GStreamer.Core.MiniHierarchyBase,
  module Media.Streaming.GStreamer.Core.GObjectHierarchy,

  cToFlags,
  cFromFlags,
  cToEnum,
  cFromEnum,

  FourCC,
  Fraction,

  Format(..),
  FormatDefinition(..),

  mkObjectGetFlags,
  mkObjectSetFlags,
  mkObjectUnsetFlags,

  withObject,
  peekObject,
  takeObject,
  giveObject,

  PadDirection(..),
  PadPresence(..),
  PadLinkReturn(..),
  FlowReturn(..),
  ActivateMode(..),
  StaticPadTemplate(..),
  staticPadTemplateGet,

  State(..),
  StateChangeReturn(..),
  SeekFlags(..),
  SeekType(..),

  PluginFilter,
  PluginFeatureFilter,

  BusFunc,
  BusSyncHandler,
  BusSyncReply(..),

  ClockTimeDiff,
  ClockReturn(..),
  ClockID(..),
  withClockID,
  takeClockID,
  peekClockID,

  IndexCertainty(..),
  IndexEntry(..),
  takeIndexEntry,
  peekIndexEntry,
  IndexEntryType(..),

  IndexLookupMethod(..),
  IndexFilter,
  IndexAssociation(..),
  AssocFlags(..),

  withMiniObject,
  peekMiniObject,
  takeMiniObject,
  giveMiniObject,
  MiniObjectT(..),
  askMiniObjectPtr,
  runMiniObjectT,
  marshalMiniObjectModify,
  mkMiniObjectGetFlags,
  mkMiniObjectGetFlagsM,
  mkMiniObjectSetFlagsM,
  mkMiniObjectUnsetFlagsM,

  QueryType,
  QueryTypeDefinition(..),

  EventTypeFlags(..),

  PtrIterator(..),
  Iterator(..),
  IteratorItem(..),
  IteratorResult(..),
  Iterable(..),
  IteratorFilter,
  IteratorFoldFunction,
  withIterator,
  takeIterator,
  peekIterator,
  -- giveIterator - not defined - iterators don't have a refcount and
  -- are not copyable

  Caps(..),
  mkCaps,
  unCaps,
  withCaps,
  takeCaps,
  peekCaps,
  giveCaps,

  Structure(..),
  StructureForeachFunc,
  withStructure,
  takeStructure,
  peekStructure,
  giveStructure,
  StructureM(..),
  StructureMRep,

  TagList,
  withTagList,
  takeTagList,
  peekTagList,
  giveTagList,
  Tag,
  TagFlag,
  TagMergeMode,

  Segment(..),

  ) where

import Control.Monad       ( liftM )
import Control.Monad.Reader
import Control.Monad.Trans
import Data.Ratio          ( Ratio )
import System.Glib.FFI
import System.Glib.Flags
{#import System.Glib.GType#}
{#import System.Glib.GObject#}
{#import System.Glib.GValue#}
import System.Glib.UTFString
import Media.Streaming.GStreamer.Core.Constants
import Media.Streaming.GStreamer.Core.HierarchyBase
{#import Media.Streaming.GStreamer.Core.MiniHierarchyBase#}
{#import Media.Streaming.GStreamer.Core.Hierarchy#}
{#import Media.Streaming.GStreamer.Core.MiniHierarchy#}
{#import Media.Streaming.GStreamer.Core.GObjectHierarchy#}

{# context lib = "gstreamer" prefix = "gst" #}

type FourCC = Word32
type Fraction = Ratio Int

{# enum GstParseError as ParseError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

cToFlags :: (Integral int, Flags flags)
         => int
         -> [flags]
cToFlags = toFlags . fromIntegral
cFromFlags :: (Integral int, Flags flags)
           => [flags]
           -> int
cFromFlags = fromIntegral . fromFlags

cToEnum :: (Integral int, Enum enum)
        => int
        -> enum
cToEnum = toEnum . fromIntegral
cFromEnum :: (Integral int, Enum enum)
           => enum
           -> int
cFromEnum = fromIntegral . fromEnum

--------------------------------------------------------------------

{# enum GstFormat as Format {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

data FormatDefinition = FormatDefinition { formatValue       :: Format
                                         , formatNick        :: String
                                         , formatDescription :: String
                                         , formatQuark       :: Quark }
                        deriving (Eq, Show)
instance Storable FormatDefinition where
    sizeOf = undefined
    alignment = undefined
    peek ptr =
        do value       <- liftM cToEnum $ {# get GstFormatDefinition->value #} ptr
           nick        <- {# get GstFormatDefinition->nick #} ptr >>= peekUTFString
           description <- {# get GstFormatDefinition->description #} ptr >>= peekUTFString
           quark       <- {# get GstFormatDefinition->quark #} ptr
           return $ FormatDefinition value nick description quark
    poke _ _ = undefined
instance Iterable FormatDefinition where
    peekIterable = peek . castPtr
    withIterable = with

--------------------------------------------------------------------

withObject :: ObjectClass objectT
           => objectT
           -> (Ptr objectT -> IO a)
           -> IO a
withObject object action =
    let objectFPtr = unObject $ toObject object
    in withForeignPtr (castForeignPtr objectFPtr) action

peekObject, takeObject :: ObjectClass obj
                       => Ptr obj
                       -> IO obj
peekObject cObject = do
    liftM (unsafeCastGObject . GObject . castForeignPtr) $
        do cObjectRef $ castPtr cObject
           newForeignPtr (castPtr cObject) objectFinalizer
foreign import ccall unsafe "&gst_object_unref"
  objectFinalizer :: FunPtr (Ptr () -> IO ())
foreign import ccall unsafe "gst_object_ref"
  cObjectRef :: Ptr ()
             -> IO (Ptr ())

takeObject cObject =
    liftM (unsafeCastGObject . GObject . castForeignPtr) $
        do cObjectUnfloat $ castPtr cObject
           newForeignPtr (castPtr cObject) objectFinalizer
foreign import ccall unsafe "_hs_gst_object_unfloat"
  cObjectUnfloat :: Ptr ()
                 -> IO ()

mkObjectGetFlags :: (ObjectClass objectT, Flags flagsT)
                 => objectT
                 -> IO [flagsT]
mkObjectGetFlags object =
    liftM cToFlags $
        withObject (toObject object) cObjectGetFlags
foreign import ccall unsafe "_hs_gst_object_flags"
    cObjectGetFlags :: Ptr Object
                    -> IO CUInt

mkObjectSetFlags :: (ObjectClass objectT, Flags flagsT)
                 => objectT
                 -> [flagsT]
                 -> IO ()
mkObjectSetFlags object flags =
    withObject (toObject object) $ \cObject ->
        cObjectSetFlags cObject (fromIntegral $ fromFlags flags)
foreign import ccall unsafe "_hs_gst_object_flag_set"
    cObjectSetFlags :: Ptr Object
                    -> CUInt
                    -> IO ()

mkObjectUnsetFlags :: (ObjectClass objectT, Flags flagsT)
                   => objectT
                   -> [flagsT]
                   -> IO ()
mkObjectUnsetFlags object flags =
    withObject (toObject object) $ \cObject ->
        cObjectUnsetFlags cObject (fromIntegral $ fromFlags flags)
foreign import ccall unsafe "_hs_gst_object_flag_unset"
    cObjectUnsetFlags :: Ptr Object
                    -> CUInt
                    -> IO ()

-- | Use 'giveObject' to pass an object to a function that takes
--   ownership of it.
giveObject :: (ObjectClass obj, MonadIO m)
           => obj
           -> (obj -> m a)
           -> m a
giveObject obj action =
    do liftIO $ withObject (toObject obj) $ {# call gst_object_ref #} . castPtr
       action obj

--------------------------------------------------------------------

{# enum GstPadDirection  as PadDirection  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstPadPresence   as PadPresence   {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstPadLinkReturn as PadLinkReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstFlowReturn    as FlowReturn    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstActivateMode  as ActivateMode  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

instance Iterable Pad where
    peekIterable = peekObject . castPtr
    withIterable = withObject

{# pointer *GstStaticPadTemplate as StaticPadTemplate #}
staticPadTemplateGet :: StaticPadTemplate
                     -> IO PadTemplate
staticPadTemplateGet =
    {# call static_pad_template_get #} >=> takeObject

--------------------------------------------------------------------

{# enum GstPluginError as PluginError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

--------------------------------------------------------------------

{# enum GstSeekFlags as SeekFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags SeekFlags
{# enum GstSeekType  as SeekType  {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstState     as State     {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# enum GstStateChangeReturn as StateChangeReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

instance Iterable Element where
    peekIterable = peekObject . castPtr
    withIterable = withObject

--------------------------------------------------------------------

type PluginFilter = Plugin -> IO Bool
type PluginFeatureFilter = PluginFeature -> IO Bool

--------------------------------------------------------------------

{# enum GstBusSyncReply as BusSyncReply {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

type BusFunc =  Bus
             -> Message
             -> IO Bool
type BusSyncHandler =  Bus
                    -> Message
                    -> IO BusSyncReply

--------------------------------------------------------------------

type ClockTimeDiff = Int64

{# enum GstClockReturn as ClockReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# pointer *GstClockID as ClockID foreign newtype #}
withClockID :: ClockID
            -> (Ptr ClockID -> IO a)
            -> IO a
withClockID (ClockID clockID) = withForeignPtr clockID
takeClockID, peekClockID :: Ptr ClockID
                        -> IO ClockID
takeClockID clockIDPtr =
    liftM ClockID $ newForeignPtr clockIDPtr clockIDFinalizer
peekClockID clockIDPtr =
    do {# call clock_id_ref #} $ castPtr clockIDPtr
       takeClockID clockIDPtr

foreign import ccall unsafe "&gst_clock_id_unref"
    clockIDFinalizer :: FunPtr (Ptr ClockID -> IO ())

--------------------------------------------------------------------

{# enum GstIndexCertainty    as IndexCertainty    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIndexEntryType    as IndexEntryType    {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIndexLookupMethod as IndexLookupMethod {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

{# pointer *GstIndexEntry as IndexEntry foreign newtype #}

takeIndexEntry :: Ptr IndexEntry
              -> IO IndexEntry
takeIndexEntry ptr =
    liftM IndexEntry $ newForeignPtr ptr indexEntryFinalizer
foreign import ccall unsafe "&gst_index_entry_free"
    indexEntryFinalizer :: FunPtr (Ptr IndexEntry -> IO ())
peekIndexEntry :: Ptr IndexEntry
               -> IO IndexEntry
peekIndexEntry ptr =
    (liftM IndexEntry $ newForeignPtr_ ptr) >>=
        {# call index_entry_copy #} >>=
            takeIndexEntry

type IndexFilter  = Index
                 -> IndexEntry
                 -> IO Bool

data IndexAssociation = IndexAssociation Format Int64
                        deriving (Eq, Show)
instance Storable IndexAssociation where
    sizeOf _ = {# sizeof GstIndexAssociation #}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do format <- {# get GstIndexAssociation->format #} ptr
           value <- {# get GstIndexAssociation->value #} ptr
           return $ IndexAssociation (cToEnum format) (fromIntegral value)
    poke ptr (IndexAssociation format value) =
        do {# set GstIndexAssociation->format #} ptr $ cFromEnum format
           {# set GstIndexAssociation->value #} ptr $ fromIntegral value

{# enum GstAssocFlags as AssocFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags AssocFlags

--------------------------------------------------------------------

withMiniObject :: MiniObjectClass miniObjectT
               => miniObjectT
               -> (Ptr miniObjectT -> IO a)
               -> IO a
withMiniObject miniObject action =
    let miniObjectFPtr = unMiniObject $ toMiniObject miniObject
    in withForeignPtr (castForeignPtr miniObjectFPtr) action

takeMiniObject, peekMiniObject :: (MiniObjectClass obj)
                               => Ptr obj
                               -> IO obj
peekMiniObject cMiniObject =
    do cMiniObjectRef $ castPtr cMiniObject
       takeMiniObject cMiniObject
foreign import ccall unsafe "gst_mini_object_ref"
  cMiniObjectRef :: Ptr ()
                 -> IO (Ptr ())

takeMiniObject cMiniObject =
    do cMiniObjectMakeReadOnly $ castPtr cMiniObject
       object <- newForeignPtr (castPtr cMiniObject) miniObjectFinalizer
       return $ unsafeCastMiniObject $ MiniObject $ castForeignPtr object
foreign import ccall unsafe "&gst_mini_object_unref"
  miniObjectFinalizer :: FunPtr (Ptr () -> IO ())
foreign import ccall unsafe "_hs_gst_mini_object_make_read_only"
  cMiniObjectMakeReadOnly :: Ptr MiniObject
                          -> IO ()

-- | Use 'giveMiniObject' to pass an miniObject to a function that takes
--   ownership of it.
giveMiniObject :: (MiniObjectClass obj, MonadIO m)
               => obj
               -> (obj -> m a)
               -> m a
giveMiniObject obj action =
    do liftIO $ {# call gst_mini_object_ref #} (toMiniObject obj)
       action obj

-- | A 'Monad' for sequencing modifications to a 'MiniObject'.
newtype (MiniObjectClass miniObjectT, Monad m) =>
    MiniObjectT miniObjectT m a =
        MiniObjectT (ReaderT (Ptr miniObjectT) m a)
        deriving (Functor, Monad, MonadTrans)
instance (MiniObjectClass miniObjectT, Monad m, MonadIO m) =>
    MonadIO (MiniObjectT miniObjectT m) where
        liftIO = MiniObjectT . liftIO

askMiniObjectPtr :: (MiniObjectClass miniObjectT, Monad m)
                 => MiniObjectT miniObjectT m (Ptr miniObjectT)
askMiniObjectPtr = MiniObjectT $ ask

runMiniObjectT :: (MiniObjectClass miniObjectT, Monad m)
               => MiniObjectT miniObjectT m a
               -> (Ptr miniObjectT)
               -> m a
runMiniObjectT (MiniObjectT action) = runReaderT action

marshalMiniObjectModify :: (MiniObjectClass miniObjectT, MonadIO m)
                        => m (Ptr miniObjectT)
                        -> MiniObjectT miniObjectT m a
                        -> m (miniObjectT, a)
marshalMiniObjectModify mkMiniObject action =
    do ptr' <- mkMiniObject
       ptr <- liftIO $ liftM castPtr $ gst_mini_object_make_writable $ castPtr ptr'
       result <- runMiniObjectT action ptr
       object <- liftIO $ takeMiniObject ptr
       return (object, result)
    where _ = {# call mini_object_make_writable #}

mkMiniObjectGetFlags :: (MiniObjectClass miniObjectT, Flags flagsT)
                     => miniObjectT
                     -> [flagsT]
mkMiniObjectGetFlags miniObject =
    cToFlags $ unsafePerformIO $
        withMiniObject (toMiniObject miniObject) cMiniObjectGetFlags
foreign import ccall unsafe "_hs_gst_mini_object_flags"
    cMiniObjectGetFlags :: Ptr MiniObject
                        -> IO CUInt

mkMiniObjectGetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                      => MiniObjectT miniObjectT m [flagsT]
mkMiniObjectGetFlagsM = do
  ptr <- askMiniObjectPtr
  liftIO $ liftM cToFlags $ cMiniObjectGetFlags $ castPtr ptr

mkMiniObjectSetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                      => [flagsT]
                      -> MiniObjectT miniObjectT m ()
mkMiniObjectSetFlagsM flags = do
  ptr <- askMiniObjectPtr
  liftIO $ cMiniObjectSetFlags (castPtr ptr) $ cFromFlags flags
foreign import ccall unsafe "_hs_gst_mini_object_flag_set"
    cMiniObjectSetFlags :: Ptr MiniObject
                        -> CUInt
                        -> IO ()

mkMiniObjectUnsetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m)
                        => [flagsT]
                        -> MiniObjectT miniObjectT m ()
mkMiniObjectUnsetFlagsM flags = do
  ptr <- askMiniObjectPtr
  liftIO $ cMiniObjectUnsetFlags (castPtr ptr) $ cFromFlags flags
foreign import ccall unsafe "_hs_gst_mini_object_flag_unset"
    cMiniObjectUnsetFlags :: Ptr MiniObject
                          -> CUInt
                          -> IO ()

--------------------------------------------------------------------

type QueryType = {# type GstQueryType #}
data QueryTypeDefinition = QueryTypeDefinition {
    queryTypeDefinitionValue       :: QueryType,
    queryTypeDefinitionNick        :: String,
    queryTypeDefinitionDescription :: String,
    queryTypeDefinitionQuark       :: Quark
    } deriving (Eq, Show)
instance Storable QueryTypeDefinition where
    sizeOf _ = {# sizeof GstQuery #}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do value <- {# get GstQueryTypeDefinition->value #} ptr
           nick <- {# get GstQueryTypeDefinition->nick #} ptr >>= peekUTFString
           description <- {# get GstQueryTypeDefinition->description #} ptr >>= peekUTFString
           quark <- {# get GstQueryTypeDefinition->quark #} ptr
           return $ QueryTypeDefinition value
                                        nick
                                        description
                                        quark
    poke _ _ = undefined
instance Iterable QueryTypeDefinition where
    peekIterable = peek . castPtr
    withIterable = with

--------------------------------------------------------------------

{# enum GstEventTypeFlags as EventTypeFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #}
instance Flags EventTypeFlags

--------------------------------------------------------------------

{# pointer *GstIterator as PtrIterator foreign newtype #}

withPtrIterator :: PtrIterator
                -> (Ptr PtrIterator -> IO a)
                -> IO a
withPtrIterator (PtrIterator cPtrIterator) = withForeignPtr cPtrIterator

takePtrIterator, peekPtrIterator :: Ptr PtrIterator
                                 -> IO PtrIterator
takePtrIterator ptrIteratorPtr =
    liftM PtrIterator $ newForeignPtr ptrIteratorPtr ptrIteratorFinalizer
peekPtrIterator ptrIteratorPtr =
    liftM PtrIterator $ newForeignPtr_ ptrIteratorPtr

foreign import ccall unsafe "&gst_iterator_free"
    ptrIteratorFinalizer :: FunPtr (Ptr PtrIterator -> IO ())

{# enum GstIteratorItem   as IteratorItem   {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstIteratorResult as IteratorResult {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

mkIterator newPtrIterator cPtrIterator =
    do ptrIterator <- newPtrIterator cPtrIterator
       return $ Iterator ptrIterator

newtype Iterable a => Iterator a = Iterator PtrIterator

withIterator :: Iterator a
             -> (Ptr PtrIterator -> IO a)
             -> IO a
withIterator (Iterator ptrIterator) = withPtrIterator ptrIterator

takeIterator, peekIterator :: Ptr PtrIterator
                          -> IO (Iterator a)
takeIterator  cPtrIterator = mkIterator takePtrIterator  cPtrIterator
peekIterator cPtrIterator = mkIterator peekPtrIterator cPtrIterator

class Iterable a where
    peekIterable :: Ptr ()
                 -> IO a
    withIterable :: a
                 -> (Ptr a -> IO b)
                 -> IO b

type IteratorFilter itemT = itemT
                         -> IO Bool
type IteratorFoldFunction itemT accumT = itemT
                                      -> accumT
                                      -> IO (Bool, accumT)

--------------------------------------------------------------------

{# pointer *GstCaps as Caps foreign newtype #}
mkCaps :: ForeignPtr Caps -> Caps
mkCaps = Caps
unCaps :: Caps -> ForeignPtr Caps
unCaps (Caps caps) = caps

withCaps :: Caps -> (Ptr Caps -> IO a) -> IO a
withCaps = withForeignPtr . unCaps

takeCaps, peekCaps :: Ptr Caps
                  -> IO Caps
takeCaps capsPtr =
    liftM Caps $ newForeignPtr capsPtr capsFinalizer
peekCaps capsPtr =
    cCapsRef capsPtr >>= takeCaps
foreign import ccall unsafe "gst_caps_ref"
    cCapsRef :: Ptr Caps
             -> IO (Ptr Caps)

giveCaps :: MonadIO m
         => Caps
         -> (Caps -> m a)
         -> m a
giveCaps caps action =
    do liftIO $ {# call caps_ref #} caps
       action caps

foreign import ccall unsafe "&gst_caps_unref"
    capsFinalizer :: FunPtr (Ptr Caps -> IO ())

--------------------------------------------------------------------

{# pointer *GstStructure as Structure foreign newtype #}
mkStructure :: ForeignPtr Structure -> Structure
mkStructure = Structure
unStructure :: Structure -> ForeignPtr Structure
unStructure (Structure structure) = structure

withStructure :: Structure -> (Ptr Structure -> IO a) -> IO a
withStructure = withForeignPtr . unStructure

mkNewStructure :: (Ptr Structure -> IO (ForeignPtr Structure))
               -> Ptr Structure
               -> IO Structure
mkNewStructure mkFP structurePtr =
    do cStructureMakeImmutable structurePtr
       liftM Structure $ mkFP structurePtr
foreign import ccall unsafe "_hs_gst_structure_make_immutable"
    cStructureMakeImmutable :: Ptr Structure
                            -> IO ()

takeStructure, peekStructure :: Ptr Structure
                            -> IO Structure
takeStructure =
    mkNewStructure $ flip newForeignPtr structureFinalizer
peekStructure =
    mkNewStructure $ newForeignPtr_

giveStructure :: MonadIO m
              => Structure
              -> (Structure -> m a)
              -> m a
giveStructure structure action =
    do structure <- liftIO $
                        {# call structure_copy #} structure >>=
                            peekStructure
       action structure

foreign import ccall unsafe "&gst_structure_free"
    structureFinalizer :: FunPtr (Ptr Structure -> IO ())

type StructureForeachFunc =  Quark
                          -> GValue
                          -> IO Bool

newtype StructureM a = StructureM (StructureMRep a)
type StructureMRep a = (Structure -> IO a)

instance Monad StructureM where
    (StructureM aM) >>= fbM =
        StructureM $ \structure ->
            do a <- aM structure
               let StructureM bM = fbM a
               bM structure
    return a = StructureM $ const $ return a

--------------------------------------------------------------------

type TagList = Structure
mkTagList = mkStructure
unTagList = unStructure
withTagList = withStructure
takeTagList = takeStructure
peekTagList = takeStructure
giveTagList :: MonadIO m
            => TagList
            -> (TagList -> m a)
            -> m a
giveTagList = giveStructure

type Tag = String

{# enum GstTagFlag      as TagFlag      {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}
{# enum GstTagMergeMode as TagMergeMode {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #}

--------------------------------------------------------------------

data Segment = Segment { segmentRate        :: Double
                       , segmentAbsRate     :: Double
                       , segmentFormat      :: Format
                       , segmentFlags       :: [SeekFlags]
                       , segmentStart       :: Int64
                       , segmentStop        :: Int64
                       , segmentTime        :: Int64
                       , segmentAccum       :: Int64
                       , segmentLastStop    :: Int64
                       , segmentDuration    :: Int64 }
               deriving (Eq, Show)
instance Storable Segment where
    sizeOf _ = fromIntegral cSegmentSizeof
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do rate        <- {# get GstSegment->rate #} ptr
           absRate     <- {# get GstSegment->abs_rate #} ptr
           format      <- {# get GstSegment->format #} ptr
           flags       <- {# get GstSegment->flags #} ptr
           start       <- {# get GstSegment->start #} ptr
           stop        <- {# get GstSegment->stop #} ptr
           time        <- {# get GstSegment->time #} ptr
           accum       <- {# get GstSegment->accum #} ptr
           lastStop    <- {# get GstSegment->last_stop #} ptr
           duration    <- {# get GstSegment->duration #} ptr
           return $ Segment (realToFrac rate)
                            (realToFrac absRate)
                            (cToEnum format)
                            (cToFlags flags)
                            (fromIntegral start)
                            (fromIntegral stop)
                            (fromIntegral time)
                            (fromIntegral accum)
                            (fromIntegral lastStop)
                            (fromIntegral duration)
    poke ptr (Segment rate
                      absRate
                      format
                      flags
                      start
                      stop
                      time
                      accum
                      lastStop
                      duration) =
        do {# call segment_init #} (castPtr ptr)
                                   (cFromEnum format)
           {# set GstSegment->rate #} ptr $ realToFrac rate
           {# set GstSegment->abs_rate #} ptr $ realToFrac absRate
           {# set GstSegment->format #} ptr $ cFromEnum format
           {# set GstSegment->flags #} ptr $ fromIntegral $ fromFlags flags
           {# set GstSegment->start #} ptr $ fromIntegral start
           {# set GstSegment->stop #} ptr $ fromIntegral stop
           {# set GstSegment->time #} ptr $ fromIntegral time
           {# set GstSegment->accum #} ptr $ fromIntegral accum
           {# set GstSegment->last_stop #} ptr $ fromIntegral lastStop
           {# set GstSegment->duration #} ptr $ fromIntegral duration
foreign import ccall unsafe "_hs_gst_segment_sizeof"
    cSegmentSizeof :: {# type gsize #}

--------------------------------------------------------------------


[project @ 2002-07-17 16:07:50 by juhp] Export timeoutAdd, timeoutRemove, idleAdd, idleRemove and HandlerId.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry General initialization@
--
--  Author : Manuel M. T. Chakravarty
--  Created: 8 December 1998
--
--  Version $Revision: 1.4 $ from $Date: 2002/07/17 16:07:50 $
--
--  Copyright (c) [2000..2002] Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
--  * quitAddDestroy, quitAdd, quitRemove, inputAdd, inputRemove
--
{-# OPTIONS -optc-include gtk/gtk.h #-}
module General(
  setLocale,
--  getDefaultLanguage,
  init,
  eventsPending,
  main,
  mainLevel,
  mainQuit,
  mainIteration,
  grabAdd,
  grabGetCurrent,
  grabRemove,
  mkDestructor,
  DestroyNotify,
  timeoutAdd,
  timeoutRemove,
  idleAdd,
  idleRemove,
  HandlerId
  ) where

import Prelude
       hiding   (init)
import System   (getProgName, getArgs, ExitCode(ExitSuccess, ExitFailure))
import Monad	(liftM, mapM)
import Foreign
import UTFCForeign
import IOExts	(newIORef, readIORef, writeIORef)
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums    (InputCondition(..))

{#context lib="gtk" prefix ="gtk"#}

-- @method setLocale@ Ensure that the current locale is read.
--
setLocale :: IO String
setLocale  = do
  strPtr <- {#call unsafe set_locale#}
  str <- peekCString strPtr
  destruct strPtr
  return str

-- @dunno@Retreive the current language.
-- * This function returns a String which's pointer can be used later on for
--   comarisions.
--
-- *  @literal@
--getDefaultLanguage :: IO String
--getDefaultLanguage = do
--  strPtr <- {#call unsafe get_default_language#}
--  str <- peekCString strPtr
--  destruct strPtr
--  return str

-- @method init@ initialize GTK+
--
-- * extracts all GTK+ specific arguments from the given options list
--
init :: Maybe (String, [String]) -> IO (String, [String])
init Nothing = do
  prog <- getProgName
  args <- getArgs
  init $ Just (prog, args)
init (Just (prog, args)) = do
  let allArgs = (prog:args)
      argc    = length allArgs
  withMany withCString allArgs $ \addrs  ->
    withArray	       addrs   $ \argv ->
    withObject	       argv    $ \argvp ->
    withObject	       argc    $ \argcp ->
    do
--      {#call unsafe init#} argcp argvp
      {#call unsafe init#} (castPtr argcp) (castPtr argvp)
      argc'   <- peek argcp
      argv'   <- peek argvp
      addrs'  <- peekArray argc' argv'
      _:args' <- mapM peekCString addrs'  -- drop the program name
      return (prog, args')

-- @method eventsPending@ Inquire the number of events pending on the event
-- queue
--
eventsPending :: IO Int
eventsPending  = liftM fromIntegral {#call unsafe events_pending#}

-- @method main@ GTK+'s main event loop
--
main :: IO ()
main  = {#call main#}

-- @method mainLevel@ Inquire the main level
--
mainLevel :: IO Int
mainLevel  = liftM (toEnum.fromEnum) {#call unsafe main_level#}

-- @method mainQuit@ Exit the main event loop
--
mainQuit :: IO ()
mainQuit  = {#call main_quit#}

-- @method mainIteration@ process events
--
mainIteration :: IO Bool
mainIteration  = liftM toBool {#call main_iteration#}

-- @method mainIterationDo@ process events
--
mainIterationDo :: Bool -> IO Bool
mainIterationDo blocking =
  liftM toBool $ {#call main_iteration_do#} (fromBool blocking)

-- @method grabAdd@ add a grab widget
--
grabAdd :: WidgetClass wd => wd -> IO ()
grabAdd  = {#call grab_add#} . toWidget

-- @method grabGetCurrent@ inquire current grab widget
--
grabGetCurrent :: IO (Maybe Widget)
grabGetCurrent  = do
  wPtr <- {#call grab_get_current#}
  if (wPtr==nullPtr) then return Nothing else
    liftM Just $ makeNewObject mkWidget (return wPtr)

-- @method grabRemove@ remove a grab widget
--
grabRemove :: WidgetClass w => w -> IO ()
grabRemove  = {#call grab_remove#} . toWidget

{#pointer Function#}

foreign export dynamic mkHandler :: IO {#type gint#} -> IO Function

{#pointer DestroyNotify#}

foreign export dynamic mkDestructor :: IO () -> IO DestroyNotify

type HandlerId = {#type guint#}

-- Turn a function into a function pointer and a destructor pointer.
--
makeCallback :: IO {#type gint#} -> IO (Function, DestroyNotify)
makeCallback fun = do
  funPtr <- mkHandler fun
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    freeHaskellFunPtr funPtr
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
  writeIORef dRef dPtr
  return (funPtr, dPtr)

-- @method timeoutAdd@ Register a function that is to be called after
-- @ref arg interval@ ms have been elapsed.
--
-- * If the function returns False it will be removed.
--
timeoutAdd :: IO Bool -> Int -> IO HandlerId
timeoutAdd fun msec = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe timeout_add_full#} (fromIntegral msec) funPtr nullFunPtr
    nullPtr dPtr

-- @method timeoutRemove@ Remove a previously added timeout handler by its
-- @ref type TimeoutId@.
--
timeoutRemove :: HandlerId -> IO ()
timeoutRemove  = {#call unsafe timeout_remove#}

-- @method idleAdd@ Add a callback that is called whenever the system is idle.
--
-- * A priority can be specified.
--
idleAdd :: IO Bool -> Int -> IO HandlerId
idleAdd fun pri = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe idle_add_full#} (fromIntegral pri) funPtr nullFunPtr
    nullPtr dPtr

-- @method idleRemove@ Remove a previously added idle handler by its
-- @ref arg TimeoutId@.
--
idleRemove :: HandlerId -> IO ()
idleRemove  = {#call unsafe idle_remove#}

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry General initialization@
--
--  Author : Manuel M. T. Chakravarty
--  Created: 8 December 1998
--
--  Version $Revision: 1.3 $ from $Date: 2002/07/08 09:13:09 $
--
--  Copyright (c) [2000..2002] Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
--  * quitAddDestroy, quitAdd, quitRemove, timeoutAdd, timeoutRemove, idleAdd,
--    idleRemove, inputAdd, inputRemove
--
{-# OPTIONS -optc-include gtk/gtk.h #-}
module General(
  setLocale,
--  getDefaultLanguage,
  init,
  eventsPending,
  main,
  mainLevel,
  mainQuit,
  mainIteration,
  grabAdd,
  grabGetCurrent,
  grabRemove,
  mkDestructor,
  DestroyNotify
  ) where

import Prelude
       hiding   (init)
import System   (getProgName, getArgs, ExitCode(ExitSuccess, ExitFailure))
import Monad	(liftM, mapM)
import Foreign
import UTFCForeign
import IOExts	(newIORef, readIORef, writeIORef)
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Enums    (InputCondition(..))

{#context lib="gtk" prefix ="gtk"#}

-- @method setLocale@ Ensure that the current locale is read.
--
setLocale :: IO String
setLocale  = do
  strPtr <- {#call unsafe set_locale#}
  str <- peekCString strPtr
  destruct strPtr
  return str

-- @dunno@Retreive the current language.
-- * This function returns a String which's pointer can be used later on for
--   comarisions.
--
-- *  @literal@
--getDefaultLanguage :: IO String
--getDefaultLanguage = do
--  strPtr <- {#call unsafe get_default_language#}
--  str <- peekCString strPtr
--  destruct strPtr
--  return str

-- @method init@ initialize GTK+
--
-- * extracts all GTK+ specific arguments from the given options list
--
init :: Maybe (String, [String]) -> IO (String, [String])
init Nothing = do
  prog <- getProgName
  args <- getArgs
  init $ Just (prog, args)
init (Just (prog, args)) = do
  let allArgs = (prog:args)
      argc    = length allArgs
  withMany withCString allArgs $ \addrs  ->
    withArray	       addrs   $ \argv ->
    withObject	       argv    $ \argvp ->
    withObject	       argc    $ \argcp ->
    do
--      {#call unsafe init#} argcp argvp
      {#call unsafe init#} (castPtr argcp) (castPtr argvp)
      argc'   <- peek argcp
      argv'   <- peek argvp
      addrs'  <- peekArray argc' argv'
      _:args' <- mapM peekCString addrs'  -- drop the program name
      return (prog, args')

-- @method eventsPending@ Inquire the number of events pending on the event
-- queue
--
eventsPending :: IO Int
eventsPending  = liftM fromIntegral {#call unsafe events_pending#}

-- @method main@ GTK+'s main event loop
--
main :: IO ()
main  = {#call main#}

-- @method mainLevel@ Inquire the main level
--
mainLevel :: IO Int
mainLevel  = liftM (toEnum.fromEnum) {#call unsafe main_level#}

-- @method mainQuit@ Exit the main event loop
--
mainQuit :: IO ()
mainQuit  = {#call main_quit#}

-- @method mainIteration@ process events
--
mainIteration :: IO Bool
mainIteration  = liftM toBool {#call main_iteration#}

-- @method mainIterationDo@ process events
--
mainIterationDo :: Bool -> IO Bool
mainIterationDo blocking =
  liftM toBool $ {#call main_iteration_do#} (fromBool blocking)

-- @method grabAdd@ add a grab widget
--
grabAdd :: WidgetClass wd => wd -> IO ()
grabAdd  = {#call grab_add#} . toWidget

-- @method grabGetCurrent@ inquire current grab widget
--
grabGetCurrent :: IO (Maybe Widget)
grabGetCurrent  = do
  wPtr <- {#call grab_get_current#}
  if (wPtr==nullPtr) then return Nothing else
    liftM Just $ makeNewObject mkWidget (return wPtr)

-- @method grabRemove@ remove a grab widget
--
grabRemove :: WidgetClass w => w -> IO ()
grabRemove  = {#call grab_remove#} . toWidget

{#pointer Function#}

foreign export dynamic mkHandler :: IO {#type gint#} -> IO Function

{#pointer DestroyNotify#}

foreign export dynamic mkDestructor :: IO () -> IO DestroyNotify

type HandlerId = {#type guint#}

-- Turn a function into a function pointer and a destructor pointer.
--
makeCallback :: IO {#type gint#} -> IO (Function, DestroyNotify)
makeCallback fun = do
  funPtr <- mkHandler fun
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    freeHaskellFunPtr funPtr
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
  writeIORef dRef dPtr
  return (funPtr, dPtr)

-- @method timeoutAdd@ Register a function that is to be called after
-- @ref arg interval@ ms have been elapsed.
--
-- * If the function returns False it will be removed.
--
timeoutAdd :: IO Bool -> Int -> IO HandlerId
timeoutAdd fun msec = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe timeout_add_full#} (fromIntegral msec) funPtr nullFunPtr
    nullPtr dPtr

-- @method timeoutRemove@ Remove a previously added timeout handler by its
-- @ref type TimeoutId@.
--
timeoutRemove :: HandlerId -> IO ()
timeoutRemove  = {#call unsafe timeout_remove#}

-- @method idleAdd@ Add a callback that is called whenever the system is idle.
--
-- * A priority can be specified.
--
idleAdd :: IO Bool -> Int -> IO HandlerId
idleAdd fun pri = do
  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
  {#call unsafe idle_add_full#} (fromIntegral pri) funPtr nullFunPtr
    nullPtr dPtr

-- @method idleRemove@ Remove a previously added idle handler by its
-- @ref arg TimeoutId@.
--
idleRemove :: HandlerId -> IO ()
idleRemove  = {#call unsafe idle_remove#}


more work on the ffi stuff

more work on the ffi stuff

{-# LANGUAGE ForeignFunctionInterface #-}
module Network.LibRSync.Internal where

import System.IO
import GHC.IO.Handle
import System.Posix.IO
import System.Posix.Types

import Foreign
-- import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types
-- import Foreign.Storable

#include <stdio.h>
#include "librsync.h"

--------------------------------------------------------------------------------
-- | The CTypes

type CRSLong = CLLong

-- data Target = Target { t :: CUShort , i :: CInt }
--               deriving (Show, Eq)

-- {#pointer *rs_target as TargetPtr -> Target #}

-- data BlockSig
-- {#pointer *rs_block_sig_t as BlockSigPtr -> BlockSig #}

-- | The Signature type
data CSignature -- = CSignature { flength :: CRSLong
               --               , count   :: CInt
               --               , remainder :: CInt
               --               , blockLenth :: CInt
               --               , strongSumLenght :: CInt
               --               , blockSigs :: BlockSigPtr
               --               , targets   :: TargetPtr
               --               }
               -- deriving (Eq, Show)

{#pointer *rs_signature_t as SignaturePtr -> CSignature #}

-- | The Stats type
data Stats
{#pointer *rs_stats as StatsPtr -> Stats #}

-- | The results type
{#enum rs_result as Result {underscoreToCase} deriving (Eq, Show)#}

--------------------------------------------------------------------------------
-- | Generating Signatures

-- crsSignature   :: Handle -> IO (Maybe CSignature, Result)
-- crsSignature h = undefined

type CFilePtr = Ptr CFile

-- | Loading signatures
-- the c-function is:
-- rs_result rs_loadsig_file(FILE *, rs_signature_t **, rs_stats_t *);
{#fun unsafe rs_loadsig_file as cRSLoadSigFile
      { id      `CFilePtr'
      , alloca- `SignaturePtr' peek*
      , alloca- `StatsPtr'
      } -> `Result' cIntToEnum
 #}

--------------------------------------------------------------------------------
-- | Helper functions

cIntToEnum :: Enum a => CInt -> a
cIntToEnum = toEnum . fromIntegral

{-# LANGUAGE ForeignFunctionInterface #-}
module Network.LibRSync.Internal where

import Foreign.Ptr
import Foreign.C.Types
import Foreign.Storable

#include "librsync.h"

--------------------------------------------------------------------------------
-- | The CTypes

type CRSLong = CLLong

-- | Extract the signature type
{#pointer *rs_signature_t as Stignature #}

-- | Extract the stats type
{#pointer *rs_stats as Stats #}

-- | The results type
{#enum rs_result as Result {underscoreToCase} deriving (Eq, Show)#}

--------------------------------------------------------------------------------
-- | The functions

-- | Loading signatures
-- the c-function is:
-- rs_result rs_loadsig_file(FILE *, rs_signature_t **, rs_stats_t *);
{#fun unsafe rs_loadsig_file as cRSLoadSigFile
      { handleToCFile* `Handle'
      , alloca- `Ptr Signature' peek*
      , alloca- `Ptr Stats' peek*
      } -> `Result' cIntToEnum
 #}

--------------------------------------------------------------------------------
-- | Helper functions

cIntToEnum :: Enum a => CInt -> a
cIntToEnum = toEnum . cIntConv

-- | Convert a handle into a pointer to a CFile
-- Code taken from http://www.pwan.org/wp/?p=33
handleToCFile     :: Handle -> String -> IO (Ptr CFile)
handleToCFile h m =
 do iomode <- newCString m
    -- Duplicate the handle, so the original stays open
    -- after the handleToFd call closes the duplicate
    dup_h <- hDuplicate h
    fd <- handleToFd dup_h
    fdopen fd iomode


[project @ 2003-11-11 12:07:43 by juhp] (sourceTagSetStyle): Fix docu typo.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry SourceTag@
--
--  Author : Duncan Coutts
--  derived from GtkTextView bindings by Axel Simon
--
--  Created: 22 October 2003
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
--
module SourceTag (
  SourceTag,
  syntaxTagNew,
  patternTagNew,
  keywordListTagNew,
  blockCommentTagNew,
  lineCommentTagNew,
  stringTagNew,
  sourceTagGetStyle,
  sourceTagSetStyle
  ) where

import Monad	(liftM)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import SourceViewType#}
import SourceTagStyle
import GList   (toGSList, fromGSList)

{# context lib="gtk" prefix="gtk" #}

-- methods

-- @constructor syntaxTagNew@ Create a new @ref type SourceTag@
--
syntaxTagNew :: String -> String -> String -> String -> IO SourceTag
syntaxTagNew id name patternStart patternEnd =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id           $ \strPtr1 ->
  withCString name         $ \strPtr2 ->
  withCString patternStart $ \strPtr3 ->
  withCString patternEnd   $ \strPtr4 ->
  {#call syntax_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4

-- @constructor patternTagNew@ Create a new @ref type SourceTag@
--
patternTagNew :: String -> String -> String -> IO SourceTag
patternTagNew id name pattern =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id      $ \strPtr1 ->
  withCString name    $ \strPtr2 ->
  withCString pattern $ \strPtr3 ->
  {#call unsafe pattern_tag_new#} strPtr1 strPtr2 strPtr3

-- @constructor keywordListTagNew@ Create a new @ref type SourceTag@.
--
keywordListTagNew :: String -> String -> [String] -> Bool -> Bool -> Bool ->
		     String -> String -> IO SourceTag
keywordListTagNew id name keywords
                  caseSensitive
                  matchEmptyStringAtBeginning
                  matchEmptyStringAtEnd
                  beginningRegex
                  endRegex = do
  keywordPtrs <- mapM newUTFString keywords
  keywordList <- toGSList keywordPtrs
  obj <- makeNewGObject mkSourceTag $ liftM castPtr $
	 withCString  id      $ \strPtr1 ->
	 withCString  name    $ \strPtr2 ->
	 withCString  beginningRegex $ \strPtr3 ->
	 withCString  endRegex $ \strPtr4 -> {#call unsafe keyword_list_tag_new#}
	   strPtr1 strPtr2 keywordList (fromBool caseSensitive)
	   (fromBool matchEmptyStringAtBeginning) (fromBool matchEmptyStringAtEnd)
	   strPtr3 strPtr4
  -- destory the list
  fromGSList keywordList
  -- destory the elements
  mapM_ free keywordPtrs
  return obj

-- @constructor blockCommentTagNew@ Create a new @ref type SourceTag@
--
blockCommentTagNew :: String -> String -> String -> String -> IO SourceTag
blockCommentTagNew = syntaxTagNew --in the C header this is just a macro

-- @constructor lineCommentTagNew@ Create a new @ref type SourceTag@
--
lineCommentTagNew :: String -> String -> String -> IO SourceTag
lineCommentTagNew id name pattern =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id      $ \strPtr1 ->
  withCString name    $ \strPtr2 ->
  withCString pattern $ \strPtr3 ->
  {#call unsafe line_comment_tag_new#} strPtr1 strPtr2 strPtr3

-- @constructor stringTagNew@ Create a new @ref type SourceTag@
--
stringTagNew :: String -> String -> String -> String -> Bool -> IO SourceTag
stringTagNew id name patternStart patternEnd endAtLineEnd =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id           $ \strPtr1 ->
  withCString name         $ \strPtr2 ->
  withCString patternStart $ \strPtr3 ->
  withCString patternEnd   $ \strPtr4 ->
  {#call unsafe string_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4 (fromBool endAtLineEnd)

-- @method sourceTagGetStyle@
--
sourceTagGetStyle :: SourceTag -> IO SourceTagStyle
sourceTagGetStyle tag = do
  tsPtr <- {#call unsafe source_tag_get_style#} tag
  ts <- peek (castPtr tsPtr)
  {#call unsafe g_free#} tsPtr
  return ts

-- @method sourceTagSetStyle@
--
sourceTagSetStyle :: SourceTag -> SourceTagStyle -> IO ()
sourceTagSetStyle tag ts = alloca $ \tsPtr -> do
  poke tsPtr ts
  {#call unsafe source_tag_set_style#} tag (castPtr tsPtr)

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry SourceTag@
--
--  Author : Duncan Coutts
--  derived from GtkTextView bindings by Axel Simon
--
--  Created: 22 October 2003
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
--
module SourceTag (
  SourceTag,
  syntaxTagNew,
  patternTagNew,
  keywordListTagNew,
  blockCommentTagNew,
  lineCommentTagNew,
  stringTagNew,
  sourceTagGetStyle,
  sourceTagSetStyle
  ) where

import Monad	(liftM)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import SourceViewType#}
import SourceTagStyle
import GList   (toGSList, fromGSList)

{# context lib="gtk" prefix="gtk" #}

-- methods

-- @constructor syntaxTagNew@ Create a new @ref type SourceTag@
--
syntaxTagNew :: String -> String -> String -> String -> IO SourceTag
syntaxTagNew id name patternStart patternEnd =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id           $ \strPtr1 ->
  withCString name         $ \strPtr2 ->
  withCString patternStart $ \strPtr3 ->
  withCString patternEnd   $ \strPtr4 ->
  {#call syntax_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4

-- @constructor patternTagNew@ Create a new @ref type SourceTag@
--
patternTagNew :: String -> String -> String -> IO SourceTag
patternTagNew id name pattern =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id      $ \strPtr1 ->
  withCString name    $ \strPtr2 ->
  withCString pattern $ \strPtr3 ->
  {#call unsafe pattern_tag_new#} strPtr1 strPtr2 strPtr3

-- @constructor keywordListTagNew@ Create a new @ref type SourceTag@.
--
keywordListTagNew :: String -> String -> [String] -> Bool -> Bool -> Bool ->
		     String -> String -> IO SourceTag
keywordListTagNew id name keywords
                  caseSensitive
                  matchEmptyStringAtBeginning
                  matchEmptyStringAtEnd
                  beginningRegex
                  endRegex = do
  keywordPtrs <- mapM newUTFString keywords
  keywordList <- toGSList keywordPtrs
  obj <- makeNewGObject mkSourceTag $ liftM castPtr $
	 withCString  id      $ \strPtr1 ->
	 withCString  name    $ \strPtr2 ->
	 withCString  beginningRegex $ \strPtr3 ->
	 withCString  endRegex $ \strPtr4 -> {#call unsafe keyword_list_tag_new#}
	   strPtr1 strPtr2 keywordList (fromBool caseSensitive)
	   (fromBool matchEmptyStringAtBeginning) (fromBool matchEmptyStringAtEnd)
	   strPtr3 strPtr4
  -- destory the list
  fromGSList keywordList
  -- destory the elements
  mapM_ free keywordPtrs
  return obj

-- @constructor blockCommentTagNew@ Create a new @ref type SourceTag@
--
blockCommentTagNew :: String -> String -> String -> String -> IO SourceTag
blockCommentTagNew = syntaxTagNew --in the C header this is just a macro

-- @constructor lineCommentTagNew@ Create a new @ref type SourceTag@
--
lineCommentTagNew :: String -> String -> String -> IO SourceTag
lineCommentTagNew id name pattern =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id      $ \strPtr1 ->
  withCString name    $ \strPtr2 ->
  withCString pattern $ \strPtr3 ->
  {#call unsafe line_comment_tag_new#} strPtr1 strPtr2 strPtr3

-- @constructor stringTagNew@ Create a new @ref type SourceTag@
--
stringTagNew :: String -> String -> String -> String -> Bool -> IO SourceTag
stringTagNew id name patternStart patternEnd endAtLineEnd =
  makeNewGObject mkSourceTag $ liftM castPtr $
  withCString id           $ \strPtr1 ->
  withCString name         $ \strPtr2 ->
  withCString patternStart $ \strPtr3 ->
  withCString patternEnd   $ \strPtr4 ->
  {#call unsafe string_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4 (fromBool endAtLineEnd)

-- @method sourceTagGetStyle@
--
sourceTagGetStyle :: SourceTag -> IO SourceTagStyle
sourceTagGetStyle tag = do
  tsPtr <- {#call unsafe source_tag_get_style#} tag
  ts <- peek (castPtr tsPtr)
  {#call unsafe g_free#} tsPtr
  return ts

-- @method sourceTagGetStyle@
--
sourceTagSetStyle :: SourceTag -> SourceTagStyle -> IO ()
sourceTagSetStyle tag ts = alloca $ \tsPtr -> do
  poke tsPtr ts
  {#call unsafe source_tag_set_style#} tag (castPtr tsPtr)


fix return type

fix return type

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}

module CuddC (
    CDdManager,
    CDdNode,
    c_cuddReadOne,
    c_cuddReadLogicZero,
    c_cuddReadOneWithRef,
    c_cuddReadLogicZeroWithRef,
    c_cuddBddIthVar,
    c_cuddBddAnd,
    c_cuddBddOr,
    c_cuddBddNand,
    c_cuddBddNor,
    c_cuddBddXor,
    c_cuddBddXnor,
    c_cuddNot,
    c_cuddNotNoRef,
    c_cuddBddIte,
    c_cuddBddExistAbstract,
    c_cuddBddUnivAbstract,
    c_cuddIterDerefBdd,
    cuddRef,
    c_cuddInit,
    c_cuddShuffleHeap,
    c_cuddSetVarMap,
    c_cuddBddVarMap,
    c_cuddBddLeq,
    c_cuddBddSwapVariables,
    c_cuddLargestCube,
    c_cuddBddMakePrime,
    c_cuddSupportIndex,
    c_cuddSupportIndices,
    c_cuddIndicesToCube,
    c_cuddBddComputeCube,
    c_cuddBddToCubeArray,
    c_cuddReadSize,
    c_cuddBddCompose,
    c_cuddBddAndAbstract,
    c_cuddBddXorExistAbstract,
    c_cuddBddLeqUnless,
    c_cuddEquivDC,
    c_cuddXeqy,
    c_cuddDebugCheck,
    c_cuddCheckKeys,
    c_cuddBddPickOneMinterm,
    c_cuddCheckZeroRef,
    c_cuddReadInvPerm,
    c_cuddReadPerm,
    c_cuddDagSize,
    c_cuddReadNodeCount,
    c_cuddReadPeakNodeCount,
    c_cuddReadMaxCache,
    c_cuddReadMaxCacheHard,
    c_cuddSetMaxCacheHard,
    c_cuddReadCacheSlots,
    c_cuddReadCacheUsedSlots,
    c_cuddBddAndLimit,
    c_cuddBddNewVarAtLevel,
    c_cuddReadTree
    ) where

import Foreign
import Foreign.Ptr
import Foreign.C.Types

import MTR

data CDdManager
data CDdNode = CDdNode {index :: CInt, ref :: CInt}

{-
instance Storable CDdNode where
	sizeOf _ = (#size DdNode)
	alignment _ = alignment (undefined :: Int)
	peek ptr = do
		index <- (#peek DdNode, index) ptr
		ref <- (#peek DdNode, ref) ptr
		return $ CDdNode index ref
	poke ptr (CDdNode index ref) = do
		(#poke DdNode, index) ptr index
		(#poke DdNode, ref) ptr ref
        -}

foreign import ccall safe "cudd.h Cudd_ReadOne_s"
	c_cuddReadOne :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadLogicZero_s"
	c_cuddReadLogicZero :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadOne_withRef_s"
	c_cuddReadOneWithRef :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadLogicZero_withRef_s"
	c_cuddReadLogicZeroWithRef :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddIthVar_s"
	c_cuddBddIthVar :: Ptr CDdManager -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddAnd_s"
	c_cuddBddAnd :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddOr_s"
	c_cuddBddOr :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNand_s"
	c_cuddBddNand :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNor_s"
	c_cuddBddNor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXor_s"
	c_cuddBddXor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXnor_s"
	c_cuddBddXnor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_Not_s"
	c_cuddNot :: Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_NotNoRef_s"
	c_cuddNotNoRef :: Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddIte_s"
    c_cuddBddIte :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddExistAbstract_s"
	c_cuddBddExistAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddUnivAbstract_s"
	c_cuddBddUnivAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_IterDerefBdd"
	c_cuddIterDerefBdd :: Ptr CDdManager -> Ptr CDdNode -> IO ()

foreign import ccall safe "cuddwrap.h wrappedCuddRef"
	cuddRef :: Ptr CDdNode -> IO ()

foreign import ccall safe "cudd.h Cudd_Init"
	c_cuddInit :: CInt -> CInt -> CInt -> CInt -> CInt -> IO (Ptr CDdManager)

foreign import ccall safe "cudd.h Cudd_ShuffleHeap"
    c_cuddShuffleHeap :: Ptr CDdManager -> Ptr CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_SetVarMap"
    c_cuddSetVarMap :: Ptr CDdManager -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddVarMap_s"
    c_cuddBddVarMap :: Ptr CDdManager -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddLeq"
    c_cuddBddLeq :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddSwapVariables_s"
    c_cuddBddSwapVariables :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_LargestCube_s"
    c_cuddLargestCube :: Ptr CDdManager -> Ptr CDdNode -> Ptr CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddMakePrime_s"
    c_cuddBddMakePrime :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_SupportIndex"
	c_cuddSupportIndex :: Ptr CDdManager -> Ptr CDdNode -> IO(Ptr CInt)

foreign import ccall safe "cudd.h Cudd_SupportIndices"
    c_cuddSupportIndices :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CInt) -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_IndicesToCube_s"
    c_cuddIndicesToCube :: Ptr CDdManager -> Ptr CInt -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddComputeCube_s"
    c_cuddBddComputeCube :: Ptr CDdManager -> Ptr (Ptr CDdNode) -> Ptr CInt -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_BddToCubeArray"
    c_cuddBddToCubeArray :: Ptr CDdManager -> Ptr CDdNode -> Ptr CInt -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_ReadSize"
	c_cuddReadSize :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddCompose_s"
    c_cuddBddCompose :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddAndAbstract_s"
    c_cuddBddAndAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXorExistAbstract_s"
    c_cuddBddXorExistAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddLeqUnless"
    c_cuddBddLeqUnless :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_EquivDC"
    c_cuddEquivDC :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_Xeqy_s"
	c_cuddXeqy :: Ptr CDdManager -> CInt -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_DebugCheck"
    c_cuddDebugCheck :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_CheckKeys"
    c_cuddCheckKeys :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddPickOneMinterm_s"
	c_cuddBddPickOneMinterm :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CDdNode) -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_CheckZeroRef"
    c_cuddCheckZeroRef :: Ptr CDdManager -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_ReadInvPerm"
    c_cuddReadInvPerm :: Ptr CDdManager -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadPerm"
    c_cuddReadPerm :: Ptr CDdManager -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_DagSize"
    c_cuddDagSize :: Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadNodeCount"
    c_cuddReadNodeCount :: Ptr CDdManager -> IO CLong

foreign import ccall safe "cudd.h Cudd_ReadPeakNodeCount"
    c_cuddReadPeakNodeCount :: Ptr CDdManager -> IO CLong

foreign import ccall safe "cudd.h Cudd_ReadMaxCache"
    c_cuddReadMaxCache :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadMaxCacheHard"
    c_cuddReadMaxCacheHard :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_SetMaxCacheHard"
    c_cuddSetMaxCacheHard :: Ptr CDdManager -> CInt -> IO ()

foreign import ccall safe "cudd.h Cudd_ReadCacheSlots"
    c_cuddReadCacheSlots :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadCacheUsedSlots"
    c_cuddReadCacheUsedSlots :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddAndLimit"
    c_cuddBddAndLimit :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> CUInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNewVarAtLevel_s"
    c_cuddBddNewVarAtLevel :: Ptr CDdManager -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadTree"
    c_cuddReadTree :: Ptr CDdManager -> IO (Ptr CMtrNode)

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}

module CuddC (
    CDdManager,
    CDdNode,
    c_cuddReadOne,
    c_cuddReadLogicZero,
    c_cuddReadOneWithRef,
    c_cuddReadLogicZeroWithRef,
    c_cuddBddIthVar,
    c_cuddBddAnd,
    c_cuddBddOr,
    c_cuddBddNand,
    c_cuddBddNor,
    c_cuddBddXor,
    c_cuddBddXnor,
    c_cuddNot,
    c_cuddNotNoRef,
    c_cuddBddIte,
    c_cuddBddExistAbstract,
    c_cuddBddUnivAbstract,
    c_cuddIterDerefBdd,
    cuddRef,
    c_cuddInit,
    c_cuddShuffleHeap,
    c_cuddSetVarMap,
    c_cuddBddVarMap,
    c_cuddBddLeq,
    c_cuddBddSwapVariables,
    c_cuddLargestCube,
    c_cuddBddMakePrime,
    c_cuddSupportIndex,
    c_cuddSupportIndices,
    c_cuddIndicesToCube,
    c_cuddBddComputeCube,
    c_cuddBddToCubeArray,
    c_cuddReadSize,
    c_cuddBddCompose,
    c_cuddBddAndAbstract,
    c_cuddBddXorExistAbstract,
    c_cuddBddLeqUnless,
    c_cuddEquivDC,
    c_cuddXeqy,
    c_cuddDebugCheck,
    c_cuddCheckKeys,
    c_cuddBddPickOneMinterm,
    c_cuddCheckZeroRef,
    c_cuddReadInvPerm,
    c_cuddReadPerm,
    c_cuddDagSize,
    c_cuddReadNodeCount,
    c_cuddReadPeakNodeCount,
    c_cuddReadMaxCache,
    c_cuddReadMaxCacheHard,
    c_cuddSetMaxCacheHard,
    c_cuddReadCacheSlots,
    c_cuddReadCacheUsedSlots,
    c_cuddBddAndLimit,
    c_cuddBddNewVarAtLevel,
    c_cuddReadTree
    ) where

import Foreign
import Foreign.Ptr
import Foreign.C.Types

import MTR

data CDdManager
data CDdNode = CDdNode {index :: CInt, ref :: CInt}

{-
instance Storable CDdNode where
	sizeOf _ = (#size DdNode)
	alignment _ = alignment (undefined :: Int)
	peek ptr = do
		index <- (#peek DdNode, index) ptr
		ref <- (#peek DdNode, ref) ptr
		return $ CDdNode index ref
	poke ptr (CDdNode index ref) = do
		(#poke DdNode, index) ptr index
		(#poke DdNode, ref) ptr ref
        -}

foreign import ccall safe "cudd.h Cudd_ReadOne_s"
	c_cuddReadOne :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadLogicZero_s"
	c_cuddReadLogicZero :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadOne_withRef_s"
	c_cuddReadOneWithRef :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadLogicZero_withRef_s"
	c_cuddReadLogicZeroWithRef :: Ptr CDdManager -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddIthVar_s"
	c_cuddBddIthVar :: Ptr CDdManager -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddAnd_s"
	c_cuddBddAnd :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddOr_s"
	c_cuddBddOr :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNand_s"
	c_cuddBddNand :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNor_s"
	c_cuddBddNor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXor_s"
	c_cuddBddXor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXnor_s"
	c_cuddBddXnor :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_Not_s"
	c_cuddNot :: Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_NotNoRef_s"
	c_cuddNotNoRef :: Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddIte_s"
    c_cuddBddIte :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddExistAbstract_s"
	c_cuddBddExistAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddUnivAbstract_s"
	c_cuddBddUnivAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_IterDerefBdd"
	c_cuddIterDerefBdd :: Ptr CDdManager -> Ptr CDdNode -> IO ()

foreign import ccall safe "cuddwrap.h wrappedCuddRef"
	cuddRef :: Ptr CDdNode -> IO ()

foreign import ccall safe "cudd.h Cudd_Init"
	c_cuddInit :: CInt -> CInt -> CInt -> CInt -> CInt -> IO (Ptr CDdManager)

foreign import ccall safe "cudd.h Cudd_ShuffleHeap"
    c_cuddShuffleHeap :: Ptr CDdManager -> Ptr CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_SetVarMap"
    c_cuddSetVarMap :: Ptr CDdManager -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddVarMap_s"
    c_cuddBddVarMap :: Ptr CDdManager -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddLeq"
    c_cuddBddLeq :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddSwapVariables_s"
    c_cuddBddSwapVariables :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_LargestCube_s"
    c_cuddLargestCube :: Ptr CDdManager -> Ptr CDdNode -> Ptr CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddMakePrime_s"
    c_cuddBddMakePrime :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_SupportIndex"
	c_cuddSupportIndex :: Ptr CDdManager -> Ptr CDdNode -> IO(Ptr CInt)

foreign import ccall safe "cudd.h Cudd_SupportIndices"
    c_cuddSupportIndices :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CInt) -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_IndicesToCube_s"
    c_cuddIndicesToCube :: Ptr CDdManager -> Ptr CInt -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddComputeCube_s"
    c_cuddBddComputeCube :: Ptr CDdManager -> Ptr (Ptr CDdNode) -> Ptr CInt -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_BddToCubeArray"
    c_cuddBddToCubeArray :: Ptr CDdManager -> Ptr CDdNode -> Ptr CInt -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_ReadSize"
	c_cuddReadSize :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddCompose_s"
    c_cuddBddCompose :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddAndAbstract_s"
    c_cuddBddAndAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddXorExistAbstract_s"
    c_cuddBddXorExistAbstract :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddLeqUnless"
    c_cuddBddLeqUnless :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_EquivDC"
    c_cuddEquivDC :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_Xeqy_s"
	c_cuddXeqy :: Ptr CDdManager -> CInt -> Ptr (Ptr CDdNode) -> Ptr (Ptr CDdNode) -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_DebugCheck"
    c_cuddDebugCheck :: Ptr CDdManager -> IO ()

foreign import ccall safe "cudd.h Cudd_CheckKeys"
    c_cuddCheckKeys :: Ptr CDdManager -> IO ()

foreign import ccall safe "cudd.h Cudd_bddPickOneMinterm_s"
	c_cuddBddPickOneMinterm :: Ptr CDdManager -> Ptr CDdNode -> Ptr (Ptr CDdNode) -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_CheckZeroRef"
    c_cuddCheckZeroRef :: Ptr CDdManager -> IO (CInt)

foreign import ccall safe "cudd.h Cudd_ReadInvPerm"
    c_cuddReadInvPerm :: Ptr CDdManager -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadPerm"
    c_cuddReadPerm :: Ptr CDdManager -> CInt -> IO CInt

foreign import ccall safe "cudd.h Cudd_DagSize"
    c_cuddDagSize :: Ptr CDdNode -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadNodeCount"
    c_cuddReadNodeCount :: Ptr CDdManager -> IO CLong

foreign import ccall safe "cudd.h Cudd_ReadPeakNodeCount"
    c_cuddReadPeakNodeCount :: Ptr CDdManager -> IO CLong

foreign import ccall safe "cudd.h Cudd_ReadMaxCache"
    c_cuddReadMaxCache :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadMaxCacheHard"
    c_cuddReadMaxCacheHard :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_SetMaxCacheHard"
    c_cuddSetMaxCacheHard :: Ptr CDdManager -> CInt -> IO ()

foreign import ccall safe "cudd.h Cudd_ReadCacheSlots"
    c_cuddReadCacheSlots :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_ReadCacheUsedSlots"
    c_cuddReadCacheUsedSlots :: Ptr CDdManager -> IO CInt

foreign import ccall safe "cudd.h Cudd_bddAndLimit"
    c_cuddBddAndLimit :: Ptr CDdManager -> Ptr CDdNode -> Ptr CDdNode -> CUInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_bddNewVarAtLevel_s"
    c_cuddBddNewVarAtLevel :: Ptr CDdManager -> CInt -> IO (Ptr CDdNode)

foreign import ccall safe "cudd.h Cudd_ReadTree"
    c_cuddReadTree :: Ptr CDdManager -> IO (Ptr CMtrNode)