Monitor.chs

{-# LANGUAGE CPP #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-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/>.
--  
--  GnomeVFS, 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 GnomeVFS documentation,
--  Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
--  documentation is covered by the GNU Free Documentation License,
--  version 1.2.
--  
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.Gnome.VFS.Monitor (
  
-- * Types
  MonitorHandle,
  MonitorCallback,
  
-- * Operations
  monitorAdd,
  monitorCancel
  
  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
{#import System.Gnome.VFS.Marshal#}
-- {#import System.Gnome.VFS.Types#}
{#import System.Gnome.VFS.BasicTypes#}

{# context lib = "gnomevfs" prefix = "gnome_vfs" #}

type CMonitorCallback =  Ptr MonitorHandle
                      -> CString
                      -> CString
                      -> {# type GnomeVFSMonitorEventType #}
                      -> {# type gpointer #}
                      -> IO ()

-- | Watch the object at @textURI@ for changes, and call @callback@
--   when a change occurs.
monitorAdd :: String           -- ^ @textURI@ - 
           -> MonitorType      -- ^ @monitorType@ - 
           -> MonitorCallback  -- ^ @callback@ - 
           -> IO MonitorHandle -- ^ a handle to the new monitor
monitorAdd textURI monitorType callback  =
    do cTestURI <- newUTFString textURI
       let cMonitorType = cFromEnum monitorType
       cCallback <- monitorCallbackMarshal callback
       newObjectResultMarshal
           (\cMonitorHandle ->
            MonitorHandle (cMonitorHandle, cCallback))
           (\cMonitorHandlePtr ->
            {# call monitor_add #} (castPtr cMonitorHandlePtr) cTestURI cMonitorType cCallback nullPtr)

monitorCallbackMarshal :: MonitorCallback
                        -> IO {# type GnomeVFSMonitorCallback #}
monitorCallbackMarshal callback =
    let cCallback :: CMonitorCallback
        cCallback cHandle cMonitorURI cInfoURI cEventType cUserData =
            do handle <- liftM (\cHandle -> MonitorHandle (cHandle, castPtrToFunPtr cUserData)) $
                         newForeignPtr_ cHandle
               monitorURI <- peekUTFString cMonitorURI
               infoURI <- peekUTFString cInfoURI
               let eventType = cToEnum cEventType
               callback handle monitorURI infoURI eventType
    in makeMonitorCallback cCallback
foreign import ccall safe "wrapper"
  makeMonitorCallback :: CMonitorCallback
                      -> IO {# type GnomeVFSMonitorCallback #}

-- | Cancels the monitor referred to by @monitorHandle@.
monitorCancel :: MonitorHandle -- ^ @monitorHandle@
              -> IO ()
monitorCancel (MonitorHandle (cMonitorHandle, cCallback)) =
    do freeHaskellFunPtr cCallback
       withForeignPtr cMonitorHandle $
                      voidResultMarshal . {# call monitor_cancel #} . castPtr