{-# LINE 1 "System/Gnome/VFS/Constants.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LINE 2 "System/Gnome/VFS/Constants.hsc" #-}
{-# OPTIONS_HADDOCK hide #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 21-Jun-2008
--
--  Copyright (c) 2008 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.

-- #hide


{-# LINE 34 "System/Gnome/VFS/Constants.hsc" #-}

-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.Gnome.VFS.Constants (

  FilePermissions (..),
  permUserAll,
  permGroupAll,
  permOtherAll

  ) where

import System.Glib.Flags

-- | UNIX-like permissions for a file.
data FilePermissions 

{-# LINE 52 "System/Gnome/VFS/Constants.hsc" #-}
    = PermSUID
    | PermSGID
    | PermSticky

{-# LINE 58 "System/Gnome/VFS/Constants.hsc" #-}
    | PermUserRead
    | PermUserWrite
    | PermUserExec
    | PermGroupRead
    | PermGroupWrite
    | PermGroupExec
    | PermOtherRead
    | PermOtherWrite
    | PermOtherExec
    | PermAccessReadable
    | PermAccessWritable
    | PermAccessExecutable
      deriving (Eq, Ord, Bounded, Show, Read)
instance Flags FilePermissions
permUserAll, permGroupAll, permOtherAll :: [FilePermissions]
permUserAll  = [ PermUserRead, PermUserWrite, PermUserExec ]
permGroupAll = [ PermGroupRead, PermGroupWrite, PermGroupExec ]
permOtherAll = [ PermOtherRead, PermOtherWrite, PermOtherExec ]

instance Enum FilePermissions where

{-# LINE 79 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermSUID = 2048
{-# LINE 80 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermSGID = 1024
{-# LINE 81 "System/Gnome/VFS/Constants.hsc" #-}

{-# LINE 82 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermSticky = 512
{-# LINE 83 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermUserRead = 256
{-# LINE 84 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermUserWrite = 128
{-# LINE 85 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermUserExec = 64
{-# LINE 86 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermGroupRead = 32
{-# LINE 87 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermGroupWrite = 16
{-# LINE 88 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermGroupExec = 8
{-# LINE 89 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermOtherRead = 4
{-# LINE 90 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermOtherWrite = 2
{-# LINE 91 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermOtherExec = 1
{-# LINE 92 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermAccessReadable = 65536
{-# LINE 93 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermAccessWritable = 131072
{-# LINE 94 "System/Gnome/VFS/Constants.hsc" #-}
    fromEnum PermAccessExecutable = 262144
{-# LINE 95 "System/Gnome/VFS/Constants.hsc" #-}
    

{-# LINE 97 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 2048 = PermSUID
{-# LINE 98 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 1024 = PermSGID
{-# LINE 99 "System/Gnome/VFS/Constants.hsc" #-}

{-# LINE 100 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 512 = PermSticky
{-# LINE 101 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 256 = PermUserRead
{-# LINE 102 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 128 = PermUserWrite
{-# LINE 103 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 64 = PermUserExec
{-# LINE 104 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 32 = PermGroupRead
{-# LINE 105 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 16 = PermGroupWrite
{-# LINE 106 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 8 = PermGroupExec
{-# LINE 107 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 4 = PermOtherRead
{-# LINE 108 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 2 = PermOtherWrite
{-# LINE 109 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 1 = PermOtherExec
{-# LINE 110 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 65536 = PermAccessReadable
{-# LINE 111 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 131072 = PermAccessWritable
{-# LINE 112 "System/Gnome/VFS/Constants.hsc" #-}
    toEnum 262144 = PermAccessExecutable
{-# LINE 113 "System/Gnome/VFS/Constants.hsc" #-}