{-# LINE 2 "./System/Gnome/VFS/Util.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.Util (

-- * String Formatting Functions
  formatFileSizeForDisplay,
  formatURIForDisplay,

-- * External Applications
  urlShow,
  urlShowWithEnv,
  isExecutableCommandString,

-- * String Escaping Functions
  escapeString,
  escapePathString,
  escapeHostAndPathString,
  escapeSlashes,
  escapeSet,
  unescapeString,
  unescapeStringForDisplay,

-- * 'TextURI' and Path Functions
  makeURICanonical,
  makeURICanonicalStripFragment,
  makePathNameCanonical,
  makeURIFromInput,
  makeURIFromInputWithDirs,
  makeURIFromShellArg,
  expandInitialTilde,
  getLocalPathFromURI,
  getURIFromLocalPath,
  iconPathFromFilename,
  getVolumeFreeSpace,
  urisMatch,
  getURIScheme,

-- * Miscellaneous Functions
  isPrimaryThread,
  openFD,

  ) where

import Control.Exception (assert)
import Control.Monad (liftM)
import System.Posix.Types (Fd)
import System.Glib.FFI
import System.Glib.UTFString
-- {#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.BasicTypes
{-# LINE 81 "./System/Gnome/VFS/Util.chs" #-}
import System.Gnome.VFS.Marshal
{-# LINE 82 "./System/Gnome/VFS/Util.chs" #-}


{-# LINE 84 "./System/Gnome/VFS/Util.chs" #-}

-- | Formats @size@ so that it is easy for the user to read. Gives the
-- size in bytes, kilobytes, megabytes or gigabytes, choosing
-- whatever is appropriate.
formatFileSizeForDisplay :: FileSize -- ^ @size@ - the file size to be formatted
                         -> String -- ^ the formatted size ready for display
formatFileSizeForDisplay size =
    unsafePerformIO $ gnome_vfs_format_file_size_for_display (fromIntegral size) >>= readUTFString

-- | Filter, modify, unescape, and change @textURI@ to make it appropriate
-- for display to users.
--
-- Rules: A @file:@ URI without fragments should appear as a local
-- path. A @file:@ URI with fragments should appear as @file:uri@. All
-- other URIs appear as expected.
formatURIForDisplay :: TextURI -- ^ @textURI@ - the URI to format
                    -> Maybe String -- ^ the formatted URI ready for display
formatURIForDisplay textURI =
    unsafePerformIO $ withUTFString textURI gnome_vfs_format_uri_for_display >>= maybePeek readUTFString

-- | Launches the default application or component associated with the
-- given URL.
urlShow :: String -- ^ @url@ - the URL to launch an application for
        -> IO ()
urlShow url =
    voidResultMarshal $ withUTFString url gnome_vfs_url_show
{-# LINE 110 "./System/Gnome/VFS/Util.chs" #-}

-- | Like 'urlShow', but using the specified environment variables.
urlShowWithEnv :: String -- ^ @url@ - the URL to launch an application for
               -> [String] -- ^ @env@ - a list of strings @[\"VARIABLE1=value1\", \"VARIABLE2=value2\", ...]@
               -> IO ()
urlShowWithEnv url env =
    voidResultMarshal $ withUTFStringArray env $ \cEnv ->
        withUTFString url $ \cURL ->
            gnome_vfs_url_show_with_env cURL cEnv

marshalPureString :: IO CString
                  -> String
marshalPureString cAction =
    unsafePerformIO $ cAction >>= readUTFString

marshalPureMaybeString :: IO CString
                        -> Maybe String
marshalPureMaybeString cAction =
    unsafePerformIO $ cAction >>= maybePeek readUTFString

-- | Escapes @string@, replacing any and all special characters with
-- equivalent escape sequences.
escapeString :: String -- ^ @string@ - the string to be escaped
             -> String -- the escaped string
escapeString string =
    marshalPureString $ withUTFString string gnome_vfs_escape_string
{-# LINE 136 "./System/Gnome/VFS/Util.chs" #-}

-- | Escapes path, replacing only special characters that would not be
-- found in paths (so @\'\/\'@, @\'&\'@, and @\'=\'@ will not be escaped by this
-- function).
escapePathString :: FilePath -- ^ @path@ - the path string to be escaped
                 -> String -- ^ the escaped string
escapePathString path =
    marshalPureString $ withUTFString path gnome_vfs_escape_path_string
{-# LINE 144 "./System/Gnome/VFS/Util.chs" #-}

-- | Escapes path, replacing only special characters that would not be
-- found in a path or host name (so @\'\/\'@, @\'&\'@, @\'=\'@, @\':\'@ and @\'\@\'@ will
-- not be escaped by this function).
escapeHostAndPathString :: FilePath -- ^ @path@ - the path to be escaped
                        -> String -- ^ the escaped string
escapeHostAndPathString path =
    marshalPureString $ withUTFString path gnome_vfs_escape_host_and_path_string
{-# LINE 152 "./System/Gnome/VFS/Util.chs" #-}

-- | Escapes only @\'\/\'@ and @\'%\'@ characters in @string@, replacing
-- them with their escape sequence equivalents.
escapeSlashes :: String -- ^ @string@ - the string to be escaped
              -> String -- ^ the escaped string
escapeSlashes string =
    marshalPureString $ withUTFString string gnome_vfs_escape_slashes
{-# LINE 159 "./System/Gnome/VFS/Util.chs" #-}

-- | Escapes the characters listed in @matchSet@ in @string@.
escapeSet :: String -- ^ @string@ - the string to be escaped
          -> String -- ^ @matchSet@ - the characters to escape
          -> String -- ^ the escaped string
escapeSet string matchSet =
    marshalPureString $ withUTFString matchSet $ \cMatchSet ->
        withUTFString string $ \cString ->
            gnome_vfs_escape_set cString cMatchSet

-- | Decodes escaped characters (i.e., @%xx@ sequences) in
-- @escapedString@. Characters are decoded in @%xx@ form, where
-- @xx@ is the hex code for an ASCII character.
unescapeString :: String -- @string@ - the string to be unescaped
               -> String -- @illegalCharacters@ - the characters that must not be escaped
               -> String -- ^ the unescaped string
unescapeString escapedString illegalCharacters =
    marshalPureString $ withUTFString illegalCharacters $ \cIllegalCharacters ->
        withUTFString escapedString $ \cEscapedString ->
            gnome_vfs_unescape_string cEscapedString cIllegalCharacters

-- | Standardizes the format of @uri@, so that it can be used later
-- in other functions that expect a canonical URI.
makeURICanonical :: TextURI -- ^ @textURI@ - an absolute or relative URI; it may have a scheme
                 -> Maybe TextURI -- ^ the canonical representation of the URI
makeURICanonical textURI =
    unsafePerformIO $ withUTFString textURI gnome_vfs_make_uri_canonical >>= maybePeek readUTFString

-- | Returns a canonicalized URI. If @uri@ contains a fragment
-- (anything after a @\'#\'@), it is stripped off, and the resulting
-- URI is made canonical.
makeURICanonicalStripFragment :: TextURI -- ^ @textURI@ - the URI to canonicalize
                              -> Maybe TextURI -- ^ the canonical representation of the URI
makeURICanonicalStripFragment textURI =
    unsafePerformIO $ withUTFString textURI gnome_vfs_make_uri_canonical_strip_fragment >>= maybePeek readUTFString


-- | Returns a canonicalized path name.
makePathNameCanonical :: FilePath -- ^ @pathName@ - the path name to canonicalize
                      -> Maybe TextURI -- ^ the canonicalized path name
makePathNameCanonical pathName =
    unsafePerformIO $ withUTFString pathName gnome_vfs_make_path_name_canonical >>= maybePeek readUTFString

-- | Takes a user input path\/URI and makes a valid URI out of it.
--
-- This function is the reverse of 'formatURIForDisplay'.
makeURIFromInput :: String -- ^ @location@ - the input to try to parse
                 -> Maybe TextURI -- ^ the resulting URI, or 'Nothing' if @location@ is invalid
makeURIFromInput location =
    unsafePerformIO $ withUTFString location gnome_vfs_make_uri_from_input >>= maybePeek readUTFString

-- | Determine a fully qualified URI from a relative or absolute input
-- path. The directories specified by @dirs@ are searched when the
-- path is relative.
makeURIFromInputWithDirs :: FilePath -- ^ @location@ - the relative or absolute input path to resolve
                         -> [MakeURIDirs] -- ^ @dirs@ - the directories to search
                         -> IO TextURI -- ^ the resulting URI
makeURIFromInputWithDirs location dirs =
    (withUTFString location $ flip gnome_vfs_make_uri_from_input_with_dirs $ cFromFlags dirs) >>= readUTFString

-- | Similar to 'makeURIFromInput', except:
--
-- 1. guesses relative paths instead of HTTP domains
--
-- 2. doesn\'t bother stripping leading\/trailing white space
--
-- 3. doesn\'t bother with tilde expansion -- that\'s done by the shell
makeURIFromShellArg :: String
                    -> String
makeURIFromShellArg uri =
    unsafePerformIO $ withUTFString uri gnome_vfs_make_uri_from_shell_arg >>= readUTFString

-- | If @path@ begins with a tilde, representing the user's home
-- directory, expand it to the actual directory.
expandInitialTilde :: String
                   -> IO String
expandInitialTilde path =
    withUTFString path gnome_vfs_expand_initial_tilde >>= readUTFString

-- | Similar to @unescapeString@, but returns something
-- semi-intelligible to the user, even upon receiving traumatic
-- input such as @00@ or URIs in bad form.
--
-- WARNING: You should never use this function on a whole URI! It
-- unescapes reserved characters, and can result in a mangled URI
-- that can not be re-entered. For example, it unescapes @\'#\'@, @\'&\'@ and
-- @\'?\'@, which have special meanings in URI strings.
unescapeStringForDisplay :: String
                         -> String
unescapeStringForDisplay escaped =
    marshalPureString $ withUTFString escaped gnome_vfs_unescape_string_for_display
{-# LINE 250 "./System/Gnome/VFS/Util.chs" #-}

-- | Create a local path for a uri.
--
-- If @uri@ is not a @file:\/\/\/@ URI, or it contains a fragment
-- identifier or is chained, this function returns 'Nothing'.
getLocalPathFromURI :: TextURI -- ^ the URI to convert
                    -> Maybe FilePath -- ^ the resulting path
getLocalPathFromURI uri =
    marshalPureMaybeString $ withUTFString uri gnome_vfs_get_local_path_from_uri
{-# LINE 259 "./System/Gnome/VFS/Util.chs" #-}

-- | Returns a @file:\/\/\/@ URI for the local path @localFullPath@,
-- such as a path provided by
-- 'Graphics.UI.Gtk.Selectors.FileChooser.fileChooserGetFilename'. The
-- resulting URI may be provided, for instance, to
-- 'System.Gnome.VFS.URI.uriFromString'.
--
-- On Windows @localFullPath@ should be in the UTF-8 encoding, and
-- can start with a drive letter, but doesn't have to.
getURIFromLocalPath :: FilePath -- ^ @localFullPath@ -
                    -> TextURI -- ^ the resulting URI
getURIFromLocalPath localFullPath =
    marshalPureString $ withUTFString localFullPath gnome_vfs_get_uri_from_local_path
{-# LINE 272 "./System/Gnome/VFS/Util.chs" #-}

-- | Checks if @commandString@ starts with the full path of an
-- executable file or an executable in the system path.
isExecutableCommandString :: String -- ^ @commandString@ -
                          -> IO Bool -- 'True' is @commandString@ is an executable command string, otherwise 'False'
isExecutableCommandString commandString =
    liftM toBool $ withUTFString commandString gnome_vfs_is_executable_command_string
{-# LINE 279 "./System/Gnome/VFS/Util.chs" #-}

-- | Stores the amount of free space in bytes on @uri@'s volume in
-- | size.
getVolumeFreeSpace :: URI -- ^ @uri@ - a URI to a file on a volume
                   -> IO FileSize -- ^ the free space in bytes on the volume
getVolumeFreeSpace uri =
    alloca $ \cFileSizePtr ->
        genericResultMarshal ((\(URI arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_get_volume_free_space argPtr1 arg2) uri cFileSizePtr)
                              (liftM fromIntegral $ peek cFileSizePtr)
                              (do cFileSize <- peek cFileSizePtr
                                  assert (cFileSize == 0) $ return ())

-- | Returns the icon path for @filename@. Example:
--
-- @'iconPathFromFilename' \"nautilus\/nautilus-desktop.png\"@ will
-- return a string forming the full path of the file
-- @nautilus-desktop.png@, i.e.
-- @${prefix}\/share\/pixmaps\/nautilus\/nautilus-desktop.png@.
iconPathFromFilename :: String -- ^ @filename@ - a relative or absolute pathname
                     -> IO String -- ^ the absolute path to the icon file
iconPathFromFilename filename =
    withUTFString filename gnome_vfs_icon_path_from_filename >>= readUTFString

-- | Check if the current thread is the thread with the main glib
-- event loop.
isPrimaryThread :: IO Bool -- ^ 'True' if the current thread is the
                           -- thread with the main glib event loop,
                           -- otherwise 'False'
isPrimaryThread =
    liftM toBool gnome_vfs_is_primary_thread
{-# LINE 309 "./System/Gnome/VFS/Util.chs" #-}

-- | Retrieves the scheme used in @uri@.
getURIScheme :: TextURI -- ^ @uri@ -
             -> Maybe String -- ^ the scheme used in @uri@, or 'Nothing' if @uri@ does not use a scheme
getURIScheme uri =
    marshalPureMaybeString $ withUTFString uri gnome_vfs_get_uri_scheme
{-# LINE 315 "./System/Gnome/VFS/Util.chs" #-}

-- | Compare two URIs.
urisMatch :: TextURI -- ^ @uri1@ -
          -> TextURI -- ^ @uri2@ -
          -> Bool -- ^ 'True' if the URIs are the same, 'False' otherwise.
urisMatch uri1 uri2 =
    unsafePerformIO $ liftM toBool $ withUTFString uri1 $ \cURI1 ->
        withUTFString uri2 $ gnome_vfs_uris_match cURI1

-- | Convert an open 1 file descriptor into a 'Handle' object.
openFD :: Fd -- ^ @filedes@ - the file descriptor to use
       -> IO Handle -- ^ the returned handle
openFD filedes =
    newObjectResultMarshal Handle $ \cHandlePtr ->
        gnome_vfs_open_fd (castPtr cHandlePtr) $ fromIntegral filedes

foreign import ccall safe "gnome_vfs_format_file_size_for_display"
  gnome_vfs_format_file_size_for_display :: (CULLong -> (IO (Ptr CChar)))

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

foreign import ccall safe "gnome_vfs_url_show"
  gnome_vfs_url_show :: ((Ptr CChar) -> (IO CInt))

foreign import ccall safe "gnome_vfs_url_show_with_env"
  gnome_vfs_url_show_with_env :: ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO CInt)))

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

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

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

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

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

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

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

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

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

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

foreign import ccall safe "gnome_vfs_make_uri_from_input_with_dirs"
  gnome_vfs_make_uri_from_input_with_dirs :: ((Ptr CChar) -> (CInt -> (IO (Ptr CChar))))

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

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

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

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

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

foreign import ccall safe "gnome_vfs_is_executable_command_string"
  gnome_vfs_is_executable_command_string :: ((Ptr CChar) -> (IO CInt))

foreign import ccall safe "gnome_vfs_get_volume_free_space"
  gnome_vfs_get_volume_free_space :: ((Ptr URI) -> ((Ptr CULLong) -> (IO CInt)))

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

foreign import ccall safe "gnome_vfs_is_primary_thread"
  gnome_vfs_is_primary_thread :: (IO CInt)

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

foreign import ccall safe "gnome_vfs_uris_match"
  gnome_vfs_uris_match :: ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "gnome_vfs_open_fd"
  gnome_vfs_open_fd :: ((Ptr Handle) -> (CInt -> (IO CInt)))