{-# 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.MIME (
-- * Types
MIMEType,
-- * MIME Type Operations
mimeTypeFromNameOrDefault,
getMIMETypeCommon,
getMIMETypeFromURI,
getFileMIMETypeFast,
getFileMIMEType,
mimeTypeIsSupertype,
getSupertypeFromMIMEType,
mimeInfoCacheReload
) where
import Control.Monad (liftM)
import System.Glib.Flags
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" #}
-- | Try to determine the MIME-type of the file at @filename@, using
-- only the filename and the Gnome VFS MIME type database. If the
-- MIME-type is not found, return @defaultv@.
mimeTypeFromNameOrDefault :: FilePath -- ^ @filename@ - the file
-- to get the MIME-type
-- for
-> Maybe MIMEType -- ^ @defaultv@ - the
-- default MIME-type to
-- return if no match is
-- found
-> Maybe MIMEType -- ^ the MIME-type of the
-- filename, or @defaultv@
mimeTypeFromNameOrDefault filename defaultv =
unsafePerformIO $ maybeWith withUTFString defaultv $ \cDefaultv ->
withUTFString filename $ \cFilename ->
{# call mime_type_from_name_or_default #} cFilename cDefaultv >>=
maybePeek peekUTFString
-- | Try to get the MIME-type of the file represented by @uri@. This
-- function favors the contents of the file over the extension of
-- the filename. If the file does not exist, the MIME-type for the
-- extension is returned. If no MIME-type can be found for the file,
-- the function returns \"application\/octet-stream\".
--
-- Note: This function will not necessarily return the same
-- MIME-type as 'System.Gnome.VFS.Ops.getFileInfo'.
getMIMETypeCommon :: URI -- ^ @uri@ - the URI of the file to examine
-> IO String -- ^ the guessed MIME-type
getMIMETypeCommon uri =
{# call get_mime_type_common #} uri >>= peekUTFString
-- | Try to get the MIME-type of the file represented by @uri@. This
-- function looks only at the filename pointed to by @uri@.
getMIMETypeFromURI :: URI -- ^ @uri@ - the URI to examine
-> IO String -- ^ the guessed MIME-type
getMIMETypeFromURI uri =
{# call get_mime_type_from_uri #} uri >>= peekUTFString
getFileMIMETypeFast :: FilePath -- ^
-> IO String
getFileMIMETypeFast path =
withUTFString path $ \cPath ->
{# call get_file_mime_type_fast #} cPath nullPtr >>=
peekUTFString
-- | Try to guess the MIME-type of the file represented by @path@. If
-- @suffixOnly@ is 'False', use the MIME-magic based lookup
-- first. Handles non-existant files by returning a type based on
-- the file extension.
getFileMIMEType :: FilePath
-> Bool
-> IO String
getFileMIMEType path suffixOnly =
withUTFString path $ \cPath ->
let cSuffixOnly = fromBool suffixOnly
in {# call get_file_mime_type #} cPath nullPtr cSuffixOnly >>=
peekUTFString
-- | Returns 'True' if @mimeType@ is of the form @foo\/\*@, and 'False'
-- otherwise.
mimeTypeIsSupertype :: String
-> Bool
mimeTypeIsSupertype mimeType =
toBool $ unsafePerformIO $
withUTFString mimeType {# call mime_type_is_supertype #}
-- | Returns the supertype for @mimeType@. The supertype of an
-- application is computed by removing its suffix, and replacing it
-- with @\*@. Thus, @foo\/bar@ will be converted to @foo\/\*@.
getSupertypeFromMIMEType :: String
-> String
getSupertypeFromMIMEType mimeType =
unsafePerformIO $ withUTFString mimeType {# call get_supertype_from_mime_type #} >>=
readUTFString
-- | Reload the MIME information for the specified directory.
mimeInfoCacheReload :: FilePath
-> IO ()
mimeInfoCacheReload dir =
withUTFString dir {# call mime_info_cache_reload #}
-- | Reload the MIME database.
mimeReload :: IO ()
mimeReload = {# call mime_reload #}