{-# LINE 1 "src/System/Posix/Directory/Foreign.hsc" #-}
module System.Posix.Directory.Foreign where

import Data.Bits
import Data.List (foldl')
import Foreign.C.Types








newtype DirType = DirType Int deriving (DirType -> DirType -> Bool
(DirType -> DirType -> Bool)
-> (DirType -> DirType -> Bool) -> Eq DirType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirType -> DirType -> Bool
$c/= :: DirType -> DirType -> Bool
== :: DirType -> DirType -> Bool
$c== :: DirType -> DirType -> Bool
Eq, Int -> DirType -> ShowS
[DirType] -> ShowS
DirType -> String
(Int -> DirType -> ShowS)
-> (DirType -> String) -> ([DirType] -> ShowS) -> Show DirType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirType] -> ShowS
$cshowList :: [DirType] -> ShowS
show :: DirType -> String
$cshow :: DirType -> String
showsPrec :: Int -> DirType -> ShowS
$cshowsPrec :: Int -> DirType -> ShowS
Show)
data Flags = Flags Int | UnsupportedFlag String deriving (Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq, Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show)

unFlags :: Flags -> Int
unFlags :: Flags -> Int
unFlags (Flags i :: Int
i) = Int
i
unFlags (UnsupportedFlag name :: String
name) = String -> Int
forall a. HasCallStack => String -> a
error (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not supported on this platform")

-- |Returns @True@ if posix-paths was compiled with support for the provided
-- flag. (As of this writing, the only flag for which this check may be
-- necessary is 'oCloexec'; all other flags will always yield @True@.)
isSupported :: Flags -> Bool
isSupported :: Flags -> Bool
isSupported (Flags _) = Bool
True
isSupported _ = Bool
False

-- |@O_CLOEXEC@ is not supported on every POSIX platform. Use
-- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was
-- compiled into your version of posix-paths. (If not, using @oCloexec@ will
-- throw an exception.)
oCloexec :: Flags

oCloexec :: Flags
{-# LINE 34 "src/System/Posix/Directory/Foreign.hsc" #-}
oCloexec = Flags 524288
{-# LINE 35 "src/System/Posix/Directory/Foreign.hsc" #-}

{-# LINE 40 "src/System/Posix/Directory/Foreign.hsc" #-}



-- If these enum declarations occur earlier in the file, haddock
-- gets royally confused about the above doc comments.
-- Probably http://trac.haskell.org/haddock/ticket/138

dtBlk :: DirType
dtBlk :: DirType
dtBlk = Int -> DirType
DirType 6
dtChr :: DirType
dtChr :: DirType
dtChr = Int -> DirType
DirType 2
dtDir :: DirType
dtDir :: DirType
dtDir = Int -> DirType
DirType 4
dtFifo :: DirType
oCreat :: Flags
dtFifo :: DirType
dtFifo = DirType 1
dtLnk :: DirType
dtLnk :: DirType
dtLnk = Int -> DirType
DirType 10
dtReg :: DirType
oExcl :: Flags
dtReg :: DirType
dtReg = Int -> DirType
DirType 8
dtSock :: DirType
dtSock :: DirType
dtSock = Int -> DirType
DirType 12
dtUnknown :: DirType
oNofollow :: Flags
dtUnknown :: DirType
dtUnknown = Int -> DirType
DirType 0

{-# LINE 48 "src/System/Posix/Directory/Foreign.hsc" #-}

oAppend :: Flags
oAppend = Flags 1024
oAsync :: Flags
oAsync = Flags 8192
oCreat :: Flags
oCreat = Flags 64
oDirectory :: Flags
oDirectory = Flags 65536
oExcl :: Flags
oExcl = Flags 128
oNoctty :: Flags
oNoctty = Flags 256
oNofollow :: Flags
oNofollow = Flags 131072
oNonblock :: Flags
oNonblock = Flags 2048
oRdonly :: Flags
oRdonly :: Flags
oRdonly = Int -> Flags
Flags 0
oWronly :: Flags
oWronly :: Flags
oWronly = Int -> Flags
Flags 1
oRdwr :: Flags
oRdwr :: Flags
oRdwr = Int -> Flags
Flags 2
oSync :: Flags
oSync :: Flags
oSync = Int -> Flags
Flags 1052672
oTrunc :: Flags
oTrunc :: Flags
oTrunc = Int -> Flags
Flags 512

{-# LINE 50 "src/System/Posix/Directory/Foreign.hsc" #-}

pathMax :: Int
pathMax = 4096
{-# LINE 53 "src/System/Posix/Directory/Foreign.hsc" #-}

unionFlags :: [Flags] -> CInt
unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0