{-# 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
-- .
--
-- 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 . 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.Volume (
-- * Types
-- | An abstraction for a mounted filesystem or network location.
Volume,
VolumeClass,
VolumeID,
-- | Safely cast an object to a 'Volume'.
castToVolume,
-- * Volume Operations
volumeCompare,
volumeEject,
volumeGetActivationURI,
volumeGetDevicePath,
volumeGetDeviceType,
volumeGetDisplayName,
volumeGetDrive,
volumeGetFilesystemType,
#if GNOME_VFS_CHECK_VERSION(2,8,0)
volumeGetHalUDI,
#endif
volumeGetIcon,
volumeGetID,
volumeGetVolumeType,
volumeHandlesTrash,
volumeIsMounted,
volumeIsReadOnly,
volumeIsUserVisible,
volumeUnmount
) where
import Control.Exception
import Control.Monad (liftM)
import System.Glib.UTFString
import System.Glib.FFI
{#import System.Gnome.VFS.Marshal#}
{#import System.Gnome.VFS.Types#}
{#import System.Gnome.VFS.BasicTypes#}
{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-- | Compares two 'Volume' objects @a@ and @b@. Two 'Volume'
-- objects referring to different volumes are guaranteed to not
-- return 'EQ' when comparing them. If they refer to the same volume 'EQ'
-- is returned.
--
-- The resulting gint should be used to determine the order in which
-- @a@ and @b@ are displayed in graphical user interfaces.
--
-- The comparison algorithm first of all peeks the device type of
-- @a@ and @b@, they will be sorted in the following order:
--
-- * Magnetic and opto-magnetic volumes (ZIP, floppy)
--
-- * Optical volumes (CD, DVD)
--
-- * External volumes (USB sticks, music players)
--
-- * Mounted hard disks
--
-- * Network mounts
--
-- * Other volumes
--
-- Afterwards, the display name of @a@ and @b@ is compared using a
-- locale-sensitive sorting algorithm.
--
-- If two volumes have the same display name, their unique ID is
-- compared which can be queried using 'volumeGetID'.
volumeCompare :: (VolumeClass volume1, VolumeClass volume2)
=> volume1
-> volume2
-> IO Ordering
volumeCompare a b =
do result <- liftM fromIntegral $ {# call volume_compare #} (castToVolume a) (castToVolume b)
let ordering | result < 0 = LT
| result > 0 = GT
| otherwise = EQ
return ordering
-- Requests ejection of a 'Volume'.
--
-- Before the unmount operation is executed, the
-- 'Volume' object's @pre-unmount@ signal is emitted.
--
-- If the volume is a mount point, i.e. its type is
-- 'VolumeTypeMountpoint', it is unmounted, and if it refers to a
-- disk, it is also ejected.
--
-- If the volume is a special VFS mount, i.e. its type is
-- 'VolumeTypeMount', it is ejected.
--
-- If the volume is a connected server, it is removed from the list of
-- connected servers.
--
-- Otherwise, no further action is done.
volumeEject :: VolumeClass volume
=> volume -- ^ @volume@ - the volume to eject
-> VolumeOpSuccessCallback -- ^ @successCallback@ - the
-- callback to call once
-- the operation has
-- completed successfully
-> VolumeOpFailureCallback -- ^ @failureCallback@ - the
-- callback to call if the
-- operation fails
-> IO ()
volumeEject volume successCallback failureCallback =
do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
{# call volume_eject #} (castToVolume volume) cCallback $ castFunPtrToPtr cCallback
marshalString cAction volume =
cAction (castToVolume volume) >>= readUTFString
marshalMaybeString cAction volume =
cAction (castToVolume volume) >>= maybePeek readUTFString
-- | Returns the activation URI of @volume@.
--
-- The returned URI usually refers to a valid location. You can
-- check the validity of the location by calling
-- 'System.Gnome.VFS.URI.uriFromString' with the URI, and checking
-- whether the return value is not 'Nothing'.
volumeGetActivationURI :: VolumeClass volume
=> volume -- ^ @volume@ - the volume to query
-> IO TextURI -- ^ the volume's activation URI.
volumeGetActivationURI =
marshalString {# call volume_get_activation_uri #}
-- | Returns the device path of a 'Volume' object.
--
-- For HAL volumes, this returns the value of the volume's
-- @block.device@ key. For UNIX mounts, it returns the @mntent@'s
-- @mnt_fsname@ entry.
--
-- Otherwise, it returns 'Nothing'.
volumeGetDevicePath :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO String -- ^ the volume's device path
volumeGetDevicePath =
marshalString {# call volume_get_device_path #}
-- | Returns the 'DeviceType' of a 'Volume' object.
volumeGetDeviceType :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO DeviceType -- the volume's device type
volumeGetDeviceType volume =
liftM cToEnum $ {# call volume_get_device_type #} (castToVolume volume)
-- | Returns the display name of a 'Volume' object.
volumeGetDisplayName :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO String -- ^ the volume's display name
volumeGetDisplayName =
marshalString {# call volume_get_display_name #}
-- | Returns the 'Drive' that @volume@ is on.
volumeGetDrive :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO Drive -- ^ the containing drive
volumeGetDrive volume =
{# call volume_get_drive #} (castToVolume volume) >>= newDrive
-- | Returns a string describing the file system on @volume@, or
-- 'Nothing' if no information on the underlying file system is
-- available.
--
-- The file system may be used to provide special functionality that
-- depends on the file system type, for instance to determine
-- whether trashing is supported (cf. 'volumeHandlesTrash').
--
-- For HAL mounts, this returns the value of the @\"volume.fstype\"@
-- key, for traditional UNIX mounts it is set to the mntent's
-- mnt_type key, for connected servers, 'Nothing' is returned.
volumeGetFilesystemType :: VolumeClass volume =>
volume -- ^ @volume@ - the
-- volume object to query
-> IO (Maybe String) -- ^ a string describing
-- the filesystem type,
-- or 'Nothing' if no
-- information is
-- available
volumeGetFilesystemType =
marshalMaybeString {# call volume_get_filesystem_type #}
#if GNOME_VFS_CHECK_VERSION(2,8,0)
-- | Returns the HAL UDI of a 'Volume' object.
--
-- For HAL volumes, this matches the value of the @info.udi@ key,
-- for other volumes it is 'Nothing'.
volumeGetHalUDI :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO (Maybe String) -- ^ the volume's HAL UDI
volumeGetHalUDI =
marshalMaybeString {# call volume_get_hal_udi #}
#endif
-- | Returns the icon filename for a 'Volume' object.
volumeGetIcon :: VolumeClass volume =>
volume -- ^ @volume@ - a volume object
-> IO FilePath -- ^ the icon that should be used for this volume
volumeGetIcon =
marshalString {# call volume_get_icon #}
-- | Returns a unique identifier for a 'Volume' object.
volumeGetID :: VolumeClass volume =>
volume -- ^ @volume@ - a volume object
-> IO VolumeID -- ^ a unique identifier for the volume
volumeGetID volume =
{# call volume_get_id #} (castToVolume volume)
-- | Returns the volume type of @volume@.
volumeGetVolumeType :: VolumeClass volume =>
volume -- ^ @volume@ - the volume object to query
-> IO VolumeType -- ^ the volume's volume type
volumeGetVolumeType volume =
liftM cToEnum $ {# call volume_get_volume_type #} (castToVolume volume)
marshalBool cAction volume =
liftM toBool $ cAction (castToVolume volume)
-- | Returns whether the file system on a volume supports trashing of
-- files.
--
-- If the volume has an AutoFS file system (i.e.,
-- 'volumeGetDeviceType' returns 'DeviceTypeAutofs'), or if the
-- volume is mounted read-only (i.e., 'volumeIsReadOnly' returns
-- 'True'), it is assumed to not support trashing of files.
--
-- Otherwise, if the volume provides file system information, it is
-- determined whether the file system supports trashing of
-- files.
volumeHandlesTrash :: VolumeClass volume =>
volume -- ^ @volume@ -
-> IO Bool -- ^ 'True' if the volume handles trash, otherwise 'False'
volumeHandlesTrash =
marshalBool {# call volume_handles_trash #}
-- | Returns whether the file system on a volume is currently mounted.
--
-- For HAL volumes, this reflects the value of the
-- @\"volume.is_mounted\"@ key, for traditional UNIX mounts and
-- connected servers, 'True' is returned, because their existence
-- implies that they are mounted.
volumeIsMounted :: VolumeClass volume =>
volume -- ^ @volume@ -
-> IO Bool -- ^ 'True' if the volume is mounted, otherwise 'False'
volumeIsMounted =
marshalBool {# call volume_is_mounted #}
-- | Returns whether the file system on a volume is read-only.
--
-- For HAL volumes, the @\"volume.is_mounted_read_only\"@ key is
-- authoritative, for traditional UNIX mounts it returns TRUE if the
-- mount was done with the @\"ro\"@ option. For servers, 'False' is
-- returned.
volumeIsReadOnly :: VolumeClass volume =>
volume -- ^ @volume@ -
-> IO Bool -- ^ 'True' if the volume is read-only, otherwise 'False'
volumeIsReadOnly =
marshalBool {# call volume_is_read_only #}
-- | Returns a 'Bool' for whether a volume is user-visible. This should
-- be used by applications to determine whether the volume should be
-- listed in user interfaces listing available volumes.
volumeIsUserVisible :: VolumeClass volume =>
volume -- @volume@ -
-> IO Bool -- ^ 'True' if the volume is user visible, otherwise 'False'
volumeIsUserVisible =
marshalBool {# call volume_is_user_visible #}
-- Requests unmount of a 'Volume'.
--
-- Note that 'volumeUnmount' may also unvoke 'volumeEject', if
-- @volume@ signals that it should be ejected when it is unmounted.
-- This may be true for CD-ROMs, USB sticks, and other devices,
-- depending on the backend providing the volume.
volumeUnmount :: VolumeClass volume
=> volume -- ^ @volume@ - the volume to eject
-> VolumeOpSuccessCallback -- ^ @successCallback@ - the
-- callback to call once
-- the operation has
-- completed successfully
-> VolumeOpFailureCallback -- ^ @failureCallback@ - the
-- callback to call if the
-- operation fails
-> IO ()
volumeUnmount volume successCallback failureCallback =
do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
{# call volume_unmount #} (castToVolume volume) cCallback $ castFunPtrToPtr cCallback