{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Macaw.Memory.Permissions
  ( Flags
  , none
  , read
  , write
  , execute
  , hasPerm
  , isExecutable
  , isReadonly
  ) where

import Data.Bits
import Data.Word
import Prelude hiding (read)

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

none :: Flags
none :: Flags
none = Word8 -> Flags
Flags Word8
0x1

read :: Flags
read :: Flags
read = Word8 -> Flags
Flags Word8
0x1

write :: Flags
write :: Flags
write = Word8 -> Flags
Flags Word8
0x2

execute :: Flags
execute :: Flags
execute = Word8 -> Flags
Flags Word8
0x4

-- | @m `hasPerm` r@ returns 'True' when 'm' has all the bits in 'r' set.
hasPerm :: Flags -> Flags -> Bool
hasPerm :: Flags -> Flags -> Bool
hasPerm Flags
m Flags
req = Flags
m Flags -> Flags -> Flags
forall a. Bits a => a -> a -> a
.&. Flags
req Flags -> Flags -> Bool
forall a. Eq a => a -> a -> Bool
== Flags
req

instance Show Flags where
  show :: Flags -> String
show Flags
f = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ Flags -> ShowS
permBit Flags
read String
"r"
                  , Flags -> ShowS
permBit Flags
write String
"w"
                  , Flags -> ShowS
permBit Flags
execute String
"x"
                  ]
    where permBit :: Flags -> ShowS
permBit Flags
r String
s | Flags
f Flags -> Flags -> Bool
`hasPerm` Flags
r = String
s
                      | Bool
otherwise = String
""

-- | Return true if the segment is executable.
isExecutable :: Flags -> Bool
isExecutable :: Flags -> Bool
isExecutable = (Flags -> Flags -> Bool
`hasPerm` Flags
execute)

-- | Return true if segment is read-only.
isReadonly :: Flags -> Bool
isReadonly :: Flags -> Bool
isReadonly Flags
f = Flags
f Flags -> Flags -> Flags
forall a. Bits a => a -> a -> a
.&. (Flags
read Flags -> Flags -> Flags
forall a. Bits a => a -> a -> a
.|. Flags
write) Flags -> Flags -> Bool
forall a. Eq a => a -> a -> Bool
== Flags
read