Util.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.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#}
{#import System.Gnome.VFS.Marshal#}

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

-- | 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 $ {# call 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 {# call 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 {# call url_show #}

-- | 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 ->
            {# call 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 {# call escape_string #}

-- | 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 {# call escape_path_string #}

-- | 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 {# call escape_host_and_path_string #}

-- | 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 {# call escape_slashes #}

-- | 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 ->
            {# call 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 ->
            {# call 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 {# call 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 {# call 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 {# call 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 {# call 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 {# call 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 {# call 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 {# call 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 {# call unescape_string_for_display #}

-- | 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 {# call get_local_path_from_uri #}

-- | 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 {# call get_uri_from_local_path #}

-- | 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 {# call is_executable_command_string #}

-- | 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 ({# call get_volume_free_space #} 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 {# call 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 {# call is_primary_thread #}

-- | 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 {# call get_uri_scheme #}

-- | 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 $ {# call uris_match #} cURI1

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