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

  -- * Types
  FileInfo(..),
  FileFlags(..),
  FileType(..),
  InodeNumber,
  IDs,

  ) where

import Control.Monad (liftM)
import Data.Maybe (catMaybes)
import System.Glib.Flags
import System.Glib.FFI
import System.Glib.UTFString
import System.Gnome.VFS.Marshal
{-# LINE 51 "./System/Gnome/VFS/FileInfo.chs" #-}
-- {#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.BasicTypes
{-# LINE 53 "./System/Gnome/VFS/FileInfo.chs" #-}
import System.Posix.Types (DeviceID, EpochTime)


{-# LINE 56 "./System/Gnome/VFS/FileInfo.chs" #-}

{- typedef struct {
 - char *name;
 - GnomeVFSFileInfoFields valid_fields;
 - GnomeVFSFileType type;
 - GnomeVFSFilePermissions permissions;
 - GnomeVFSFileFlags flags;
 - dev_t device;
 - GnomeVFSInodeNumber inode;
 - guint link_count;
 - guint uid;
 - guint gid;
 - GnomeVFSFileSize size;
 - GnomeVFSFileSize block_count;
 - guint io_block_size;
 - time_t atime;
 - time_t mtime;
 - time_t ctime;
 - char *symlink_name;
 - char *mime_type;
 - guint refcount;
 - GnomeVFSACL *acl;
 - char* selinux_context;
 - } GnomeVFSFileInfo;
 -}

instance Storable FileInfo where
    sizeOf _ = 112
{-# LINE 84 "./System/Gnome/VFS/FileInfo.chs" #-}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do name <- (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) ptr >>= maybePeek peekUTFString

           validFields <- liftM cToFlags $ (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) ptr

           let maybeField field result = if elem field validFields
                                            then liftM Just result
                                            else return Nothing

           fileType <- maybeField FileInfoFieldsType $
                       liftM cToEnum $ cFileInfoGetType ptr
           permissions <- maybeField FileInfoFieldsPermissions $
                          liftM cToFlags $ (\ptr -> do {peekByteOff ptr 12 ::IO CInt}) ptr
           fileFlags <- maybeField FileInfoFieldsFlags $
                        liftM cToFlags $ (\ptr -> do {peekByteOff ptr 16 ::IO CInt}) ptr

           device <- maybeField FileInfoFieldsDevice $
                     liftM cToEnum $ (\ptr -> do {peekByteOff ptr 20 ::IO CULLong}) ptr

           inode <- maybeField FileInfoFieldsInode $
                    liftM fromIntegral $ cFileInfoGetInode ptr
           linkCount <- maybeField FileInfoFieldsLinkCount $
                        liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 36 ::IO CUInt}) ptr

           ids <- maybeField FileInfoFieldsIds $
                  do uid <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 40 ::IO CUInt}) ptr
                     gid <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 44 ::IO CUInt}) ptr
                     return $ (uid, gid)






           size <- maybeField FileInfoFieldsSize $
                   liftM fromIntegral $ cFileInfoGetSize ptr
           blockCount <- maybeField FileInfoFieldsBlockCount $
                         liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 56 ::IO CULLong}) ptr

           ioBlockSize <- maybeField FileInfoFieldsIoBlockSize $
                          liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 64 ::IO CUInt}) ptr

           aTime <- maybeField FileInfoFieldsAtime $
                    liftM cToEnum $ (\ptr -> do {peekByteOff ptr 68 ::IO CLong}) ptr
           mTime <- maybeField FileInfoFieldsMtime $
                    liftM cToEnum $ (\ptr -> do {peekByteOff ptr 72 ::IO CLong}) ptr
           cTime <- maybeField FileInfoFieldsCtime $
                    liftM cToEnum $ (\ptr -> do {peekByteOff ptr 76 ::IO CLong}) ptr
           symlinkName <- maybeField FileInfoFieldsSymlinkName $
                           (\ptr -> do {peekByteOff ptr 80 ::IO (Ptr CChar)}) ptr >>= peekUTFString

           mimeType <- maybeField FileInfoFieldsMimeType $
                       gnome_vfs_file_info_get_mime_type (castPtr ptr) >>= peekUTFString

           return $ FileInfo name
                             fileType
                             permissions
                             fileFlags
                             device
                             inode
                             linkCount
                             ids
                             size
                             blockCount
                             ioBlockSize
                             aTime
                             mTime
                             cTime
                             symlinkName

                             mimeType

    poke ptr (FileInfo name
                       fileType
                       permissions
                       fileFlags
                       device
                       inode
                       linkCount
                       ids
                       size
                       blockCount
                       ioBlockSize
                       aTime
                       mTime
                       cTime
                       symlinkName

                       mimeType

             ) =
        do let marshaller :: FileInfoFields
                          -> Maybe a
                          -> b
                          -> (a -> IO b)
                          -> (Ptr FileInfo -> b -> IO ())
                          -> IO (Maybe FileInfoFields)
               marshaller field Nothing dflt _ action =
                   do action ptr dflt
                      return Nothing
               marshaller field (Just value) _ cast action =
                   do cast value >>= action ptr
                      return $ Just field

           case name of
             Just name' -> newUTFString name' >>= (\ptr val -> do {pokeByteOff ptr 0 (val::(Ptr CChar))}) ptr
             Nothing -> return ()

           validFields <- liftM catMaybes $ sequence $
                          [ marshaller FileInfoFieldsType
                                       fileType
                                       0
                                       (return . cFromEnum)
                                       cFileInfoSetType,

                            marshaller FileInfoFieldsPermissions
                                       permissions
                                       0
                                       (return . cFromFlags)
                                       (\ptr val -> do {pokeByteOff ptr 12 (val::CInt)}),

                            marshaller FileInfoFieldsFlags
                                       fileFlags
                                       0
                                       (return . cFromFlags)
                                       (\ptr val -> do {pokeByteOff ptr 16 (val::CInt)}),

                            marshaller FileInfoFieldsDevice
                                       device
                                       0
                                       (return . cFromEnum)
                                       (\ptr val -> do {pokeByteOff ptr 20 (val::CULLong)}),

                            marshaller FileInfoFieldsInode
                                       inode
                                       0
                                       (return . fromIntegral)
                                       (\ptr val -> do {pokeByteOff ptr 28 (val::CULLong)}),

                            marshaller FileInfoFieldsLinkCount
                                       linkCount
                                       0
                                       (return . fromIntegral)
                                       (\ptr val -> do {pokeByteOff ptr 36 (val::CUInt)}),


                            marshaller FileInfoFieldsIds
                                       ids
                                       (0, 0)
                                       (\(uid, gid) -> return (fromIntegral uid, fromIntegral gid))
                                       (\ptr (uid, gid) ->
                                        do (\ptr val -> do {pokeByteOff ptr 40 (val::CUInt)}) ptr uid
                                           (\ptr val -> do {pokeByteOff ptr 44 (val::CUInt)}) ptr gid),


                            marshaller FileInfoFieldsSize
                                       size
                                       0
                                       (return . fromIntegral)
                                       cFileInfoSetSize,

                            marshaller FileInfoFieldsBlockCount
                                       blockCount
                                       0
                                       (return . fromIntegral)
                                       (\ptr val -> do {pokeByteOff ptr 56 (val::CULLong)}),

                            marshaller FileInfoFieldsIoBlockSize
                                       ioBlockSize
                                       0
                                       (return . fromIntegral)
                                       (\ptr val -> do {pokeByteOff ptr 64 (val::CUInt)}),

                            marshaller FileInfoFieldsAtime
                                       aTime
                                       0
                                       (return . cFromEnum)
                                       (\ptr val -> do {pokeByteOff ptr 68 (val::CLong)}),

                            marshaller FileInfoFieldsMtime
                                       mTime
                                       0
                                       (return . cFromEnum)
                                       (\ptr val -> do {pokeByteOff ptr 72 (val::CLong)}),

                            marshaller FileInfoFieldsCtime
                                       cTime
                                       0
                                       (return . cFromEnum)
                                       (\ptr val -> do {pokeByteOff ptr 76 (val::CLong)}),

                            marshaller FileInfoFieldsSymlinkName
                                       symlinkName
                                       nullPtr
                                       newUTFString
                                       (\ptr str ->
                                        do (\ptr -> do {peekByteOff ptr 80 ::IO (Ptr CChar)}) ptr >>= (gFree . castPtr)
                                           (\ptr val -> do {pokeByteOff ptr 80 (val::(Ptr CChar))}) ptr str),

                            marshaller FileInfoFieldsMimeType
                                       symlinkName
                                       nullPtr
                                       newUTFString
                                       (\ptr str ->
                                        do (\ptr -> do {peekByteOff ptr 84 ::IO (Ptr CChar)}) ptr >>= (gFree . castPtr)
                                           (\ptr val -> do {pokeByteOff ptr 84 (val::(Ptr CChar))}) ptr str) ]
{-# LINE 301 "./System/Gnome/VFS/FileInfo.chs" #-}
           (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) ptr $ cFromFlags validFields

gFree = g_free
{-# LINE 304 "./System/Gnome/VFS/FileInfo.chs" #-}

foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_type"
  cFileInfoGetType :: Ptr FileInfo
                   -> IO (CInt)
{-# LINE 308 "./System/Gnome/VFS/FileInfo.chs" #-}
foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_inode"
  cFileInfoGetInode :: Ptr FileInfo
                    -> IO CULLong
foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_size"
  cFileInfoGetSize :: Ptr FileInfo
                   -> IO CULLong
foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_block_count"
  cFileInfoGetBlockCount :: Ptr FileInfo
                         -> IO CULLong

foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_type"
  cFileInfoSetType :: Ptr FileInfo
                   -> (CInt)
{-# LINE 321 "./System/Gnome/VFS/FileInfo.chs" #-}
                   -> IO ()
foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_inode"
  cFileInfoSetInode :: Ptr FileInfo
                    -> CULLong
                    -> IO ()
foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_size"
  cFileInfoSetSize :: Ptr FileInfo
                   -> (CULLong)
{-# LINE 329 "./System/Gnome/VFS/FileInfo.chs" #-}
                   -> IO ()
foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_block_count"
  cFileInfoSetBlockCount :: Ptr FileInfo
                         -> CULLong
                         -> IO ()

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

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