{-# LINE 2 "./System/Gnome/VFS/Xfer.chs" #-}
-- 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:
--
-- 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.Xfer (

-- * Types
  XferProgressInfo(..),
  XferOptions ( XferFollowLinks
                    , XferRecursive
                    , XferSamefs
                    , XferDeleteItems
                    , XferEmptyDirectories
                    , XferNewUniqueDirectory
                    , XferRemovesource
                    , XferUseUniqueNames
                    , XferLinkItems
                    , XferFollowLinksRecursive

                    , XferTargetDefaultPerms

                    ),
  XferOverwriteMode ( XferOverwriteModeAbort
                    , XferOverwriteModeReplace
                    , XferOverwriteModeSkip ),
  XferErrorAction(..),
  XferOverwriteAction(..),
  XferProgressCallback,
  XferErrorCallback,
  XferOverwriteCallback,
  XferDuplicateCallback,

-- * Operations
  xferURI,
  xferURIList,
  xferDeleteList

  ) where

import Control.Monad
import Data.Maybe (fromMaybe)
import System.Glib.FFI
import System.Glib.GList
import System.Glib.UTFString
import System.Gnome.VFS.Marshal
{-# LINE 74 "./System/Gnome/VFS/Xfer.chs" #-}
-- {#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.BasicTypes
{-# LINE 76 "./System/Gnome/VFS/Xfer.chs" #-}


{-# LINE 78 "./System/Gnome/VFS/Xfer.chs" #-}

{- typedef struct {
 - GnomeVFSXferProgressStatus status;
 - GnomeVFSResult vfs_status;
 - GnomeVFSXferPhase phase;
 - gchar *source_name;
 - gchar *target_name;
 - gulong file_index;
 - gulong files_total;
 - GnomeVFSFileSize bytes_total;
 - GnomeVFSFileSize file_size;
 - GnomeVFSFileSize bytes_copied;
 - GnomeVFSFileSize total_bytes_copied;
 - gchar *duplicate_name;
 - int duplicate_count;
 - gboolean top_level_item;
 - } GnomeVFSXferProgressInfo;
 -}

instance Storable XferProgressInfo where
    sizeOf _ = 80
{-# LINE 99 "./System/Gnome/VFS/Xfer.chs" #-}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do vfsStatus <- liftM cToEnum $ (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) ptr
           phase <- liftM cToEnum $ (\ptr -> do {peekByteOff ptr 8 ::IO CInt}) ptr
           sourceName <- (\ptr -> do {peekByteOff ptr 12 ::IO (Ptr CChar)}) ptr >>= maybePeek peekUTFString
           targetName <- (\ptr -> do {peekByteOff ptr 16 ::IO (Ptr CChar)}) ptr >>= maybePeek peekUTFString
           fileIndex <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 20 ::IO CULong}) ptr
           filesTotal <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 24 ::IO CULong}) ptr
           bytesTotal <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 28 ::IO CULLong}) ptr
           fileSize <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 36 ::IO CULLong}) ptr
           bytesCopied <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 44 ::IO CULLong}) ptr
           totalBytesCopied <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 52 ::IO CULLong}) ptr
           topLevelItem <- liftM toBool $ (\ptr -> do {peekByteOff ptr 68 ::IO CInt}) ptr

           return $ XferProgressInfo vfsStatus
                                     phase
                                     sourceName
                                     targetName
                                     fileIndex
                                     filesTotal
                                     bytesTotal
                                     fileSize
                                     bytesCopied
                                     totalBytesCopied
                                     topLevelItem
    poke _ = error "XferProgressInfo.poke not implemented"

type CXferProgressCallback = Ptr ()
                           -> ((Ptr ()))
{-# LINE 128 "./System/Gnome/VFS/Xfer.chs" #-}
                           -> IO CInt
xferProgressCallbackMarshal :: Maybe XferProgressCallback
                            -> XferErrorCallback
                            -> XferOverwriteCallback
                            -> Maybe XferDuplicateCallback
                            -> IO (FunPtr CXferProgressCallback)
xferProgressCallbackMarshal progressCallback
                            errorCallback
                            overwriteCallback
                            duplicateCallback =
    makeXferProgressCallback cCallback
    where cCallback :: CXferProgressCallback
          cCallback cInfo cUserData =
              do status <- liftM cToEnum $ (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) $ castPtr cInfo
                 info <- peek $ castPtr cInfo
                 case status of
                   XferProgressStatusOk ->
                       liftM fromBool $ progressCallback' info
                   XferProgressStatusVfserror ->
                       liftM cFromEnum $ errorCallback info
                   XferProgressStatusOverwrite ->
                       liftM cFromEnum $ overwriteCallback info
                   XferProgressStatusDuplicate ->
                       do duplicateCount <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 64 ::IO CInt}) cInfo
                          duplicatePtr <- (\ptr -> do {peekByteOff ptr 60 ::IO (Ptr CChar)}) cInfo
                          duplicateName <- peekUTFString duplicatePtr
                          newDuplicateName <- duplicateCallback' info duplicateName duplicateCount
                          case newDuplicateName of
                            Just newDuplicateName' ->
                                do g_free $ castPtr duplicatePtr
                                   newUTFString newDuplicateName' >>=
                                       (\ptr val -> do {pokeByteOff ptr 60 (val::(Ptr CChar))}) cInfo
                                   return 1
                            Nothing ->
                                return 0
          progressCallback' =
              fromMaybe (const $ return True) progressCallback
          duplicateCallback' =
              fromMaybe (\_ name _ -> return Nothing) duplicateCallback

foreign import ccall safe "wrapper"
  makeXferProgressCallback :: CXferProgressCallback
                           -> IO (FunPtr CXferProgressCallback)

type CXfer = (CInt)
{-# LINE 173 "./System/Gnome/VFS/Xfer.chs" #-}
           -> (CInt)
{-# LINE 174 "./System/Gnome/VFS/Xfer.chs" #-}
           -> (CInt)
{-# LINE 175 "./System/Gnome/VFS/Xfer.chs" #-}
           -> FunPtr CXferProgressCallback
           -> ((Ptr ()))
{-# LINE 177 "./System/Gnome/VFS/Xfer.chs" #-}
           -> IO (CInt)
{-# LINE 178 "./System/Gnome/VFS/Xfer.chs" #-}
type Xfer = [XferOptions]
          -> Maybe XferProgressCallback
          -> Maybe XferErrorCallback
          -> Either XferOverwriteMode XferOverwriteCallback
          -> Maybe XferDuplicateCallback
          -> IO ()
marshalXfer :: CXfer
            -> Xfer
marshalXfer cXfer xferOptions progressCallback errorCallback overwriteOpt duplicateCallback =
    voidResultMarshal $ do
      cProgressCallback <- xferProgressCallbackMarshal
                               progressCallback
                               errorCallback'
                               overwriteCallback
                               duplicateCallback
      cResult <- cXfer (cFromFlags xferOptions)
                       (cFromEnum errorMode)
                       (cFromEnum overwriteMode)
                       cProgressCallback nullPtr
      freeHaskellFunPtr cProgressCallback
      return cResult
    where
          (overwriteMode, overwriteCallback) =
              case overwriteOpt of
                Left overwriteMode ->
                    (overwriteMode,
                     const $ return $ error "marshalXfer: overwrite callback called unexpectedly")
                Right overwriteCallback ->
                    (XferOverwriteModeQuery,
                     overwriteCallback)
          (errorMode, errorCallback') =
              case errorCallback of
                Just errorCallback' ->
                    (XferErrorModeQuery,
                     errorCallback')
                Nothing ->
                    (XferErrorModeAbort,
                     const $ return $ error "marshalXfer: error callback called unexpectedly")

-- | Transfer the file located at @sourceURI@ to @targetURI@, using
-- the specified options and callbacks.
xferURI :: URI -- ^ @sourceURI@ - the source URI
        -> URI -- ^ @targetURI@ - the target URI
        -> [XferOptions] -- ^ @options@ -
        -> Maybe XferProgressCallback -- ^ @progressCallback@ -
        -> Maybe XferErrorCallback -- ^ @errorCallback@ -
        -> Either XferOverwriteMode XferOverwriteCallback -- ^ @overwriteOpt@ -
        -> Maybe XferDuplicateCallback -- ^ @duplicateCallback@ -
        -> IO ()
xferURI sourceURI targetURI =
    marshalXfer ((\(URI arg1) (URI arg2) arg3 arg4 arg5 arg6 arg7 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gnome_vfs_xfer_uri argPtr1 argPtr2 arg3 arg4 arg5 arg6 arg7) sourceURI targetURI)

withURIList :: [URI]
            -> (GList -> IO a)
            -> IO a
withURIList uriList action =
    withMany withURI uriList $ \cURIList ->
        toGList cURIList >>= action

-- | For each pair in @sourceTargetURIList@, transfer the file at the
-- first 'URI' to the second 'URI'.
xferURIList :: [(URI, URI)] -- ^ @sourceTargetURIList@ -
            -> [XferOptions] -- ^ @options@ -
            -> Maybe XferProgressCallback -- ^ @progressCallback@ -
            -> Maybe XferErrorCallback -- ^ @errorCallback@ -
            -> Either XferOverwriteMode XferOverwriteCallback -- ^ @overwriteOpt@ -
            -> Maybe XferDuplicateCallback -- ^ @duplicateCallback@ -
            -> IO ()
xferURIList sourceTargetURIList xferOptions progressCallback errorCallback overwriteOpt duplicateCallback =
    withURIList sourceURIList $ \cSourceURIList ->
        withURIList targetURIList $ \cTargetURIList ->
            marshalXfer (gnome_vfs_xfer_uri_list cSourceURIList cTargetURIList)
                        xferOptions progressCallback
                        errorCallback overwriteOpt duplicateCallback
    where (sourceURIList, targetURIList) = unzip sourceTargetURIList

-- | Delete the files at the 'URI's in @sourceURIList@.
xferDeleteList :: [URI] -- ^ @sourceURIList@ -
               -> [XferOptions] -- ^ @options@ -
               -> Maybe XferProgressCallback -- ^ @progressCallback@ -
               -> Maybe XferErrorCallback -- ^ @errorCallback@ -
               -> IO ()
xferDeleteList sourceURIList xferOptions progressCallback errorCallback =
    withURIList sourceURIList $ \cSourceURIList ->
       do cProgressCallback <- xferProgressCallbackMarshal progressCallback
                                                           errorCallback'
                                                           (return $ error "xferDeleteList: overwrite callback called unexpectedly")
                                                           (return $ error "xferDeleteList: duplicate callback called unexpectedly")
          voidResultMarshal $
                    gnome_vfs_xfer_delete_list
{-# LINE 268 "./System/Gnome/VFS/Xfer.chs" #-}
                    cSourceURIList
                    (cFromEnum errorMode)
                    (cFromFlags xferOptions)
                    cProgressCallback
                    nullPtr
    where (errorMode, errorCallback') =
              case errorCallback of
                Just errorCallback' ->
                    (XferErrorModeQuery,
                     errorCallback')
                Nothing ->
                    (XferErrorModeAbort,
                     const $ return XferErrorActionAbort)

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

foreign import ccall safe "gnome_vfs_xfer_uri"
  gnome_vfs_xfer_uri :: ((Ptr URI) -> ((Ptr URI) -> (CInt -> (CInt -> (CInt -> ((FunPtr ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))) -> ((Ptr ()) -> (IO CInt))))))))

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

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