{-# LINE 1 "src/Posix/File/Types.hsc" #-}
{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language NamedFieldPuns #-}

-- This is needed because hsc2hs does not currently handle ticked
-- promoted data constructors correctly.
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}






-- | All of the data constructors provided by this module are unsafe.
--   Only use them if you really know what you are doing.
module Posix.File.Types
  ( DescriptorFlags(..)
  , StatusFlags(..)
  , CreationFlags(..)
  , AccessMode(..)
    -- * Open Access Mode
  , readOnly
  , writeOnly
  , readWrite
    -- * File Status Flags
  , nonblocking
  , append
    -- * File Creation Flags
  , create
  , truncate
  , exclusive
  ) where

import Prelude hiding (truncate)

import Data.Bits (Bits,(.|.))
import Foreign.C.Types (CInt)

-- | File Descriptor Flags
newtype DescriptorFlags = DescriptorFlags CInt
  deriving stock (DescriptorFlags -> DescriptorFlags -> Bool
(DescriptorFlags -> DescriptorFlags -> Bool)
-> (DescriptorFlags -> DescriptorFlags -> Bool)
-> Eq DescriptorFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DescriptorFlags -> DescriptorFlags -> Bool
== :: DescriptorFlags -> DescriptorFlags -> Bool
$c/= :: DescriptorFlags -> DescriptorFlags -> Bool
/= :: DescriptorFlags -> DescriptorFlags -> Bool
Eq)
  deriving newtype (Eq DescriptorFlags
DescriptorFlags
Eq DescriptorFlags =>
(DescriptorFlags -> DescriptorFlags -> DescriptorFlags)
-> (DescriptorFlags -> DescriptorFlags -> DescriptorFlags)
-> (DescriptorFlags -> DescriptorFlags -> DescriptorFlags)
-> (DescriptorFlags -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> DescriptorFlags
-> (Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> Bool)
-> (DescriptorFlags -> Maybe Int)
-> (DescriptorFlags -> Int)
-> (DescriptorFlags -> Bool)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int -> DescriptorFlags)
-> (DescriptorFlags -> Int)
-> Bits DescriptorFlags
Int -> DescriptorFlags
DescriptorFlags -> Bool
DescriptorFlags -> Int
DescriptorFlags -> Maybe Int
DescriptorFlags -> DescriptorFlags
DescriptorFlags -> Int -> Bool
DescriptorFlags -> Int -> DescriptorFlags
DescriptorFlags -> DescriptorFlags -> DescriptorFlags
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
.&. :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
$c.|. :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
.|. :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
$cxor :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
xor :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
$ccomplement :: DescriptorFlags -> DescriptorFlags
complement :: DescriptorFlags -> DescriptorFlags
$cshift :: DescriptorFlags -> Int -> DescriptorFlags
shift :: DescriptorFlags -> Int -> DescriptorFlags
$crotate :: DescriptorFlags -> Int -> DescriptorFlags
rotate :: DescriptorFlags -> Int -> DescriptorFlags
$czeroBits :: DescriptorFlags
zeroBits :: DescriptorFlags
$cbit :: Int -> DescriptorFlags
bit :: Int -> DescriptorFlags
$csetBit :: DescriptorFlags -> Int -> DescriptorFlags
setBit :: DescriptorFlags -> Int -> DescriptorFlags
$cclearBit :: DescriptorFlags -> Int -> DescriptorFlags
clearBit :: DescriptorFlags -> Int -> DescriptorFlags
$ccomplementBit :: DescriptorFlags -> Int -> DescriptorFlags
complementBit :: DescriptorFlags -> Int -> DescriptorFlags
$ctestBit :: DescriptorFlags -> Int -> Bool
testBit :: DescriptorFlags -> Int -> Bool
$cbitSizeMaybe :: DescriptorFlags -> Maybe Int
bitSizeMaybe :: DescriptorFlags -> Maybe Int
$cbitSize :: DescriptorFlags -> Int
bitSize :: DescriptorFlags -> Int
$cisSigned :: DescriptorFlags -> Bool
isSigned :: DescriptorFlags -> Bool
$cshiftL :: DescriptorFlags -> Int -> DescriptorFlags
shiftL :: DescriptorFlags -> Int -> DescriptorFlags
$cunsafeShiftL :: DescriptorFlags -> Int -> DescriptorFlags
unsafeShiftL :: DescriptorFlags -> Int -> DescriptorFlags
$cshiftR :: DescriptorFlags -> Int -> DescriptorFlags
shiftR :: DescriptorFlags -> Int -> DescriptorFlags
$cunsafeShiftR :: DescriptorFlags -> Int -> DescriptorFlags
unsafeShiftR :: DescriptorFlags -> Int -> DescriptorFlags
$crotateL :: DescriptorFlags -> Int -> DescriptorFlags
rotateL :: DescriptorFlags -> Int -> DescriptorFlags
$crotateR :: DescriptorFlags -> Int -> DescriptorFlags
rotateR :: DescriptorFlags -> Int -> DescriptorFlags
$cpopCount :: DescriptorFlags -> Int
popCount :: DescriptorFlags -> Int
Bits)

-- | File Status Flags
newtype StatusFlags = StatusFlags CInt
  deriving stock (StatusFlags -> StatusFlags -> Bool
(StatusFlags -> StatusFlags -> Bool)
-> (StatusFlags -> StatusFlags -> Bool) -> Eq StatusFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusFlags -> StatusFlags -> Bool
== :: StatusFlags -> StatusFlags -> Bool
$c/= :: StatusFlags -> StatusFlags -> Bool
/= :: StatusFlags -> StatusFlags -> Bool
Eq)
  deriving newtype (Eq StatusFlags
StatusFlags
Eq StatusFlags =>
(StatusFlags -> StatusFlags -> StatusFlags)
-> (StatusFlags -> StatusFlags -> StatusFlags)
-> (StatusFlags -> StatusFlags -> StatusFlags)
-> (StatusFlags -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> StatusFlags
-> (Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> Bool)
-> (StatusFlags -> Maybe Int)
-> (StatusFlags -> Int)
-> (StatusFlags -> Bool)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int -> StatusFlags)
-> (StatusFlags -> Int)
-> Bits StatusFlags
Int -> StatusFlags
StatusFlags -> Bool
StatusFlags -> Int
StatusFlags -> Maybe Int
StatusFlags -> StatusFlags
StatusFlags -> Int -> Bool
StatusFlags -> Int -> StatusFlags
StatusFlags -> StatusFlags -> StatusFlags
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: StatusFlags -> StatusFlags -> StatusFlags
.&. :: StatusFlags -> StatusFlags -> StatusFlags
$c.|. :: StatusFlags -> StatusFlags -> StatusFlags
.|. :: StatusFlags -> StatusFlags -> StatusFlags
$cxor :: StatusFlags -> StatusFlags -> StatusFlags
xor :: StatusFlags -> StatusFlags -> StatusFlags
$ccomplement :: StatusFlags -> StatusFlags
complement :: StatusFlags -> StatusFlags
$cshift :: StatusFlags -> Int -> StatusFlags
shift :: StatusFlags -> Int -> StatusFlags
$crotate :: StatusFlags -> Int -> StatusFlags
rotate :: StatusFlags -> Int -> StatusFlags
$czeroBits :: StatusFlags
zeroBits :: StatusFlags
$cbit :: Int -> StatusFlags
bit :: Int -> StatusFlags
$csetBit :: StatusFlags -> Int -> StatusFlags
setBit :: StatusFlags -> Int -> StatusFlags
$cclearBit :: StatusFlags -> Int -> StatusFlags
clearBit :: StatusFlags -> Int -> StatusFlags
$ccomplementBit :: StatusFlags -> Int -> StatusFlags
complementBit :: StatusFlags -> Int -> StatusFlags
$ctestBit :: StatusFlags -> Int -> Bool
testBit :: StatusFlags -> Int -> Bool
$cbitSizeMaybe :: StatusFlags -> Maybe Int
bitSizeMaybe :: StatusFlags -> Maybe Int
$cbitSize :: StatusFlags -> Int
bitSize :: StatusFlags -> Int
$cisSigned :: StatusFlags -> Bool
isSigned :: StatusFlags -> Bool
$cshiftL :: StatusFlags -> Int -> StatusFlags
shiftL :: StatusFlags -> Int -> StatusFlags
$cunsafeShiftL :: StatusFlags -> Int -> StatusFlags
unsafeShiftL :: StatusFlags -> Int -> StatusFlags
$cshiftR :: StatusFlags -> Int -> StatusFlags
shiftR :: StatusFlags -> Int -> StatusFlags
$cunsafeShiftR :: StatusFlags -> Int -> StatusFlags
unsafeShiftR :: StatusFlags -> Int -> StatusFlags
$crotateL :: StatusFlags -> Int -> StatusFlags
rotateL :: StatusFlags -> Int -> StatusFlags
$crotateR :: StatusFlags -> Int -> StatusFlags
rotateR :: StatusFlags -> Int -> StatusFlags
$cpopCount :: StatusFlags -> Int
popCount :: StatusFlags -> Int
Bits)

-- | File Creation Flags
newtype CreationFlags = CreationFlags CInt
  deriving stock (CreationFlags -> CreationFlags -> Bool
(CreationFlags -> CreationFlags -> Bool)
-> (CreationFlags -> CreationFlags -> Bool) -> Eq CreationFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreationFlags -> CreationFlags -> Bool
== :: CreationFlags -> CreationFlags -> Bool
$c/= :: CreationFlags -> CreationFlags -> Bool
/= :: CreationFlags -> CreationFlags -> Bool
Eq)
  deriving newtype (Eq CreationFlags
CreationFlags
Eq CreationFlags =>
(CreationFlags -> CreationFlags -> CreationFlags)
-> (CreationFlags -> CreationFlags -> CreationFlags)
-> (CreationFlags -> CreationFlags -> CreationFlags)
-> (CreationFlags -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> CreationFlags
-> (Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> Bool)
-> (CreationFlags -> Maybe Int)
-> (CreationFlags -> Int)
-> (CreationFlags -> Bool)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int -> CreationFlags)
-> (CreationFlags -> Int)
-> Bits CreationFlags
Int -> CreationFlags
CreationFlags -> Bool
CreationFlags -> Int
CreationFlags -> Maybe Int
CreationFlags -> CreationFlags
CreationFlags -> Int -> Bool
CreationFlags -> Int -> CreationFlags
CreationFlags -> CreationFlags -> CreationFlags
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: CreationFlags -> CreationFlags -> CreationFlags
.&. :: CreationFlags -> CreationFlags -> CreationFlags
$c.|. :: CreationFlags -> CreationFlags -> CreationFlags
.|. :: CreationFlags -> CreationFlags -> CreationFlags
$cxor :: CreationFlags -> CreationFlags -> CreationFlags
xor :: CreationFlags -> CreationFlags -> CreationFlags
$ccomplement :: CreationFlags -> CreationFlags
complement :: CreationFlags -> CreationFlags
$cshift :: CreationFlags -> Int -> CreationFlags
shift :: CreationFlags -> Int -> CreationFlags
$crotate :: CreationFlags -> Int -> CreationFlags
rotate :: CreationFlags -> Int -> CreationFlags
$czeroBits :: CreationFlags
zeroBits :: CreationFlags
$cbit :: Int -> CreationFlags
bit :: Int -> CreationFlags
$csetBit :: CreationFlags -> Int -> CreationFlags
setBit :: CreationFlags -> Int -> CreationFlags
$cclearBit :: CreationFlags -> Int -> CreationFlags
clearBit :: CreationFlags -> Int -> CreationFlags
$ccomplementBit :: CreationFlags -> Int -> CreationFlags
complementBit :: CreationFlags -> Int -> CreationFlags
$ctestBit :: CreationFlags -> Int -> Bool
testBit :: CreationFlags -> Int -> Bool
$cbitSizeMaybe :: CreationFlags -> Maybe Int
bitSizeMaybe :: CreationFlags -> Maybe Int
$cbitSize :: CreationFlags -> Int
bitSize :: CreationFlags -> Int
$cisSigned :: CreationFlags -> Bool
isSigned :: CreationFlags -> Bool
$cshiftL :: CreationFlags -> Int -> CreationFlags
shiftL :: CreationFlags -> Int -> CreationFlags
$cunsafeShiftL :: CreationFlags -> Int -> CreationFlags
unsafeShiftL :: CreationFlags -> Int -> CreationFlags
$cshiftR :: CreationFlags -> Int -> CreationFlags
shiftR :: CreationFlags -> Int -> CreationFlags
$cunsafeShiftR :: CreationFlags -> Int -> CreationFlags
unsafeShiftR :: CreationFlags -> Int -> CreationFlags
$crotateL :: CreationFlags -> Int -> CreationFlags
rotateL :: CreationFlags -> Int -> CreationFlags
$crotateR :: CreationFlags -> Int -> CreationFlags
rotateR :: CreationFlags -> Int -> CreationFlags
$cpopCount :: CreationFlags -> Int
popCount :: CreationFlags -> Int
Bits)

newtype AccessMode = AccessMode CInt
  deriving stock (AccessMode -> AccessMode -> Bool
(AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool) -> Eq AccessMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
/= :: AccessMode -> AccessMode -> Bool
Eq)

instance Semigroup DescriptorFlags where <> :: DescriptorFlags -> DescriptorFlags -> DescriptorFlags
(<>) = DescriptorFlags -> DescriptorFlags -> DescriptorFlags
forall a. Bits a => a -> a -> a
(.|.)
instance Monoid DescriptorFlags where mempty :: DescriptorFlags
mempty = CInt -> DescriptorFlags
DescriptorFlags CInt
0

instance Semigroup CreationFlags where <> :: CreationFlags -> CreationFlags -> CreationFlags
(<>) = CreationFlags -> CreationFlags -> CreationFlags
forall a. Bits a => a -> a -> a
(.|.)
instance Monoid CreationFlags where mempty :: CreationFlags
mempty = CInt -> CreationFlags
CreationFlags CInt
0

instance Semigroup StatusFlags where <> :: StatusFlags -> StatusFlags -> StatusFlags
(<>) = StatusFlags -> StatusFlags -> StatusFlags
forall a. Bits a => a -> a -> a
(.|.)
instance Monoid StatusFlags where mempty :: StatusFlags
mempty = CInt -> StatusFlags
StatusFlags CInt
0

-- | The @O_RDONLY@ access mode.
readOnly :: AccessMode
readOnly :: AccessMode
readOnly = CInt -> AccessMode
AccessMode CInt
0
{-# LINE 75 "src/Posix/File/Types.hsc" #-}

-- | The @O_WRONLY@ access mode.
writeOnly :: AccessMode
writeOnly :: AccessMode
writeOnly = CInt -> AccessMode
AccessMode CInt
1
{-# LINE 79 "src/Posix/File/Types.hsc" #-}

-- | The @O_RDWR@ access mode.
readWrite :: AccessMode
readWrite :: AccessMode
readWrite = CInt -> AccessMode
AccessMode CInt
2
{-# LINE 83 "src/Posix/File/Types.hsc" #-}

-- | The @O_NONBLOCK@ flag
nonblocking :: StatusFlags
nonblocking :: StatusFlags
nonblocking = CInt -> StatusFlags
StatusFlags CInt
2048
{-# LINE 87 "src/Posix/File/Types.hsc" #-}

-- | The @O_APPEND@ flag
append :: StatusFlags
append :: StatusFlags
append = CInt -> StatusFlags
StatusFlags CInt
1024
{-# LINE 91 "src/Posix/File/Types.hsc" #-}

-- | The @O_CREAT@ flag
create :: CreationFlags
create :: CreationFlags
create = CInt -> CreationFlags
CreationFlags CInt
64
{-# LINE 95 "src/Posix/File/Types.hsc" #-}

-- | The @O_TRUNC@ flag
truncate :: CreationFlags
truncate :: CreationFlags
truncate = CInt -> CreationFlags
CreationFlags CInt
512
{-# LINE 99 "src/Posix/File/Types.hsc" #-}

-- | The @O_EXCL@ flag
exclusive :: CreationFlags
exclusive :: CreationFlags
exclusive = CInt -> CreationFlags
CreationFlags CInt
128
{-# LINE 103 "src/Posix/File/Types.hsc" #-}