{-# 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.Drive (

-- * Types
  -- | A container for 'Volume's.
  Drive,
  DriveClass,
  DriveID,
  DeviceType,

-- * Type Conversion
  castToDrive,

-- * Drive Comparison
  driveCompare,

-- * Drive Properties
  driveGetActivationURI,
  driveGetDevicePath,
  driveGetDeviceType,
  driveGetDisplayName,
#if GNOME_VFS_CHECK_VERSION(2,8,0)
  driveGetHalUDI,
#endif
  driveGetIcon,
  driveGetID,

-- * Drive State
  driveIsConnected,
  driveIsMounted,
  driveIsUserVisible,
#if GNOME_VFS_CHECK_VERSION(2,8,0)
  driveGetMountedVolumes,
#endif

-- * Drive Operations
  driveEject,
  driveMount,
  
-- * Drive Signals
  onDriveVolumeMounted,
  afterDriveVolumeMounted,
  onDriveVolumePreUnmount,
  afterDriveVolumePreUnmount,
  onDriveVolumeUnmounted,
  afterDriveVolumeUnmounted
    
  ) where

import Control.Exception
import Control.Monad                ( liftM )
import System.Glib.UTFString
import System.Glib.FFI
import System.Glib.GList            ( fromGList )
{#import System.Glib.Signals#}
{#import System.Gnome.VFS.Marshal#}
{#import System.Gnome.VFS.Types#}
{#import System.Gnome.VFS.Signals#}
{#import System.Gnome.VFS.BasicTypes#}

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

-- | Compares two 'DriveClass' objects @a@ and @b@. Two 'DriveClass'
--   objects referring to different drives are guaranteed to not
--   return 'EQ' when comparing them. If they refer to the same drive '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 drives (ZIP, floppy)
--   
--     * Optical drives (CD, DVD)
--   
--     * External drives (USB sticks, music players)
--   
--     * Mounted hard disks
--   
--     * Other drives
--   
--   Afterwards, the display name of @a@ and @b@ is compared using a
--   locale-sensitive sorting algorithm.
--   
--   If two drives have the same display name, their unique ID is
--   compared which can be queried using 'driveGetID'.
driveCompare :: DriveClass drive =>
                drive       -- ^ @a@ - the first drive
             -> drive       -- ^ @b@ - the second drive
             -> IO Ordering -- ^ the ordering relationship between the drives
driveCompare a b =
    do result <- liftM fromIntegral $ {# call drive_compare #} (castToDrive a) (castToDrive b)
       let ordering | result < 0 = LT
                    | result > 0 = GT
                    | otherwise  = EQ
       return ordering

-- | If drive has associated 'Volume' objects, all of them will be
--   unmounted by calling 'System.Gnome.VFS.Volume.volumeUnmount' for
--   each volume in 'driveGetMountedVolumes', except for the last one,
--   for which 'System.Gnome.VFS.Volume.volumeEject' is called to
--   ensure that the drive's media is ejected.
driveEject :: DriveClass drive =>
              drive                   -- ^ @drive@ - the drive to be ejected
           -> VolumeOpSuccessCallback -- ^ @successCallback@ - the
                                      --   action to be performed on
                                      --   successful ejection
           -> VolumeOpFailureCallback -- ^ @failureCallback@ - the
                                      --   action to be performed on
                                      --   failure
           -> IO ()
driveEject drive successCallback failureCallback =
    do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
       {# call drive_eject #} (castToDrive drive) cCallback $ castFunPtrToPtr cCallback

marshalString cAction drive =
    cAction (castToDrive drive) >>= readUTFString
marshalMaybeString cAction drive =
    cAction (castToDrive drive) >>= (maybePeek readUTFString)

-- | Returns the activation URI of @drive@.
--   
--   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'.
driveGetActivationURI :: DriveClass drive
                      => drive      -- ^ @drive@ - the drive object to query
                      -> IO String  -- ^ the drive's activation URI
driveGetActivationURI =
    marshalString {# call drive_get_activation_uri #}

-- | Returns the device path of a 'Drive' object.
--   
--   For HAL drives, this returns the value of the drive's
--   @block.device@ key. For UNIX mounts, it returns the @mntent@'s
--   @mnt_fsname@ entry.
--   
--   Otherwise, it returns 'Nothing'.
driveGetDevicePath :: DriveClass drive =>
                      drive             -- ^ @drive@ - the drive object to query
                   -> IO (Maybe String) -- ^ the drive's device path
driveGetDevicePath =
    marshalMaybeString {# call drive_get_device_path #}

-- | Returns the 'DeviceType' of a 'Drive' object.
driveGetDeviceType :: DriveClass drive =>
                      drive         -- ^ @drive@ - the drive object to query
                   -> IO DeviceType -- ^ the drive's device type
driveGetDeviceType drive =
    liftM cToEnum $ {# call drive_get_device_type #} (castToDrive drive)

-- | Returns the display name of a 'Drive' object.
driveGetDisplayName :: DriveClass drive =>
                       drive     -- ^ @drive@ - the drive object to query
                    -> IO String -- ^ the drive's display name
driveGetDisplayName =
    marshalString {# call drive_get_display_name #}

#if GNOME_VFS_CHECK_VERSION(2,8,0)
-- | Returns the HAL UDI of a 'Drive' object.
--   
--   For HAL drives, this matches the value of the @info.udi@ key,
--   for other drives it is 'Nothing'.
driveGetHalUDI :: DriveClass drive =>
                  drive             -- ^ @drive@ - the drive object to query
               -> IO (Maybe String) -- ^ the drive's HAL UDI
driveGetHalUDI =
    marshalMaybeString {# call drive_get_hal_udi #}
#endif

-- | Returns the icon filename for a 'Drive' object.
driveGetIcon :: DriveClass drive =>
                drive       -- ^ @drive@ - a drive object
             -> IO FilePath -- ^ the icon that should be used for this drive
driveGetIcon =
    marshalString {# call drive_get_icon #}

-- | Returns a unique identifier for a 'Drive' object.
driveGetID :: DriveClass drive =>
              drive      -- ^ @drive@ - a drive object
           -> IO DriveID -- ^ a unique identifier for the drive
driveGetID drive =
    {# call drive_get_id #} (castToDrive drive)


#if GNOME_VFS_CHECK_VERSION(2,8,0)
-- | Returns a list of mounted volumes for a 'Drive' object.
driveGetMountedVolumes :: DriveClass drive =>
                          drive       -- ^ @drive@ - a drive object
                       -> IO [Volume] -- ^ the 'Volume's currently
                                      --   mounted on the drive
driveGetMountedVolumes drive =
    {# call drive_get_mounted_volumes #} (castToDrive drive) >>=
        fromGList >>=
        mapM newVolume
#endif

marshalBool cAction drive =
    liftM toBool $ cAction (castToDrive drive)

-- | Returns a 'Bool' for whether a drive is connected.
driveIsConnected :: DriveClass drive =>
                    drive   -- ^ @drive@ - a drive object
                 -> IO Bool -- ^ 'True' if the drive is connected,
                            --   'False' otherwise
driveIsConnected =
    marshalBool {# call drive_is_connected #}

-- | Returns a 'Bool' for whether a drive is mounted.
driveIsMounted :: DriveClass drive =>
                  drive   -- ^ @drive@ - a drive object
               -> IO Bool -- ^ 'True' if the drive is mounted,
                          --   'False' otherwise
driveIsMounted =
    marshalBool {# call drive_is_mounted #}

-- | Returns a 'Bool' for whether a drive is user-visible. This should
--   be used by applications to determine whether the drive should be
--   listed in user interfaces listing available drives.
driveIsUserVisible :: DriveClass drive =>
                      drive   -- ^ @drive@ - a drive object
                   -> IO Bool -- ^ 'True' if the drive is
                              --   user-visible, 'False' otherwise
driveIsUserVisible =
    marshalBool {# call drive_is_user_visible #}

-- | Mounts a 'Drive' object.
driveMount :: DriveClass drive =>
              drive                   -- ^ @drive@ - a drive object
           -> VolumeOpSuccessCallback -- ^ @successCallback@ - the
                                      --   action to be performed on
                                      --   successful mount
           -> VolumeOpFailureCallback -- ^ @failureCallback@ - the
                                      --   action to be performed on
                                      --   failure
           -> IO ()
driveMount drive successCallback failureCallback =
    do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
       {# call drive_eject #} (castToDrive drive) cCallback $ castFunPtrToPtr cCallback

onDriveVolumeMounted,
    afterDriveVolumeMounted,
    onDriveVolumePreUnmount,
    afterDriveVolumePreUnmount,
    onDriveVolumeUnmounted,
    afterDriveVolumeUnmounted
    :: (DriveClass drive) =>
       drive                -- ^ @drive@ - the drive to connect the signal handler to
    -> (Volume -> IO ())    -- ^ @handler@ - the signal handling function
    -> IO (ConnectId drive) -- ^ the identifier for the connection

onDriveVolumeMounted       = connect_OBJECT__NONE "volume-mounted" False
afterDriveVolumeMounted    = connect_OBJECT__NONE "volume-mounted" True

onDriveVolumePreUnmount    = connect_OBJECT__NONE "volume-pre-unmount" False
afterDriveVolumePreUnmount = connect_OBJECT__NONE "volume-pre-unmount" True

onDriveVolumeUnmounted     = connect_OBJECT__NONE "volume-unmounted" False
afterDriveVolumeUnmounted  = connect_OBJECT__NONE "volume-unmounted" True