{-# LANGUAGE GHC2021#-}

--------------------------------------------------------------------------------

-- |

--

-- Module      :  Data.Bitmask.Internal

-- Description :  Bitmasks

-- Copyright   :  (c) Alice Rixte 2025

-- License     :  BSD 3

-- Maintainer  :  alice.rixte@u-bordeaux.fr

-- Stability   :  stable

-- Portability :  portable

--

--  Bitmasks for efficient storing of boolean flags

--

-- = WARNING

--

-- This module is considered __internal__.

--

-- The Package Versioning Policy __does not apply__.

--

-- The contents of this module may change __in any way whatsoever__

-- and __without any warning__ between minor versions of this package.

--

-- Authors importing this module are expected to track development

-- closely.

--

--------------------------------------------------------------------------------


module Data.Bitmask.Internal
  ( Bitmask(..)
  , Bitmask8
  , Bitmask16
  , Bitmask32
  , Bitmask64
  -- ** Conversion to and from bits

  , fromBits
  , toBits
  -- ** Check bitmask validity

  , checkBitmask
  -- ** Bitmask creation

  , noFlag
  , allFlags
  , fromFlags
  , toFlags
  , fromExceptFlags
  , toExceptFlags
  , fromFlagsBool
  , toFlagsBool
  -- ** Flag querying

  , getFlag
  , getFlags
  -- ** Flag modification

  , addFlag
  , addFlags
  , deleteFlag
  , deleteFlags
  , flipFlag
  , flipFlags
  , setFlag
  , setFlags
  , modifyFlag
  , modifyFlags
  ) where

import Data.Word
import Data.Bits


-- | A bitmask that contains boolean flags

--

-- * The 'flag' type should be an enumeration type (i.e. an instance of 'Enum').

--

-- * The 'w' type should be an integral type (e.g. 'Word8', 'Word32', etc.) that

-- supports bitwise operations.

--

-- * The number of bits in 'w' must be at least as many as the number of

-- constructors in 'flag'.

--

-- [Usage:]

--

-- @

-- data PizzaTopping =

--    Cheese

--  | Mushrooms

--  | Pineapple

--  | Ham

--  deriving (Show, Eq, Bounded, Enum)

--

--  type PizzaMask = Bitmask8 PizzaTopping Word8

-- @

--

newtype Bitmask w flag = Bitmask w
  deriving (Bitmask w flag -> Bitmask w flag -> Bool
(Bitmask w flag -> Bitmask w flag -> Bool)
-> (Bitmask w flag -> Bitmask w flag -> Bool)
-> Eq (Bitmask w flag)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w k (flag :: k).
Eq w =>
Bitmask w flag -> Bitmask w flag -> Bool
$c== :: forall w k (flag :: k).
Eq w =>
Bitmask w flag -> Bitmask w flag -> Bool
== :: Bitmask w flag -> Bitmask w flag -> Bool
$c/= :: forall w k (flag :: k).
Eq w =>
Bitmask w flag -> Bitmask w flag -> Bool
/= :: Bitmask w flag -> Bitmask w flag -> Bool
Eq, Eq (Bitmask w flag)
Eq (Bitmask w flag) =>
(Bitmask w flag -> Bitmask w flag -> Ordering)
-> (Bitmask w flag -> Bitmask w flag -> Bool)
-> (Bitmask w flag -> Bitmask w flag -> Bool)
-> (Bitmask w flag -> Bitmask w flag -> Bool)
-> (Bitmask w flag -> Bitmask w flag -> Bool)
-> (Bitmask w flag -> Bitmask w flag -> Bitmask w flag)
-> (Bitmask w flag -> Bitmask w flag -> Bitmask w flag)
-> Ord (Bitmask w flag)
Bitmask w flag -> Bitmask w flag -> Bool
Bitmask w flag -> Bitmask w flag -> Ordering
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w k (flag :: k). Ord w => Eq (Bitmask w flag)
forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bool
forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Ordering
forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$ccompare :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Ordering
compare :: Bitmask w flag -> Bitmask w flag -> Ordering
$c< :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bool
< :: Bitmask w flag -> Bitmask w flag -> Bool
$c<= :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bool
<= :: Bitmask w flag -> Bitmask w flag -> Bool
$c> :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bool
> :: Bitmask w flag -> Bitmask w flag -> Bool
$c>= :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bool
>= :: Bitmask w flag -> Bitmask w flag -> Bool
$cmax :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
max :: Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$cmin :: forall w k (flag :: k).
Ord w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
min :: Bitmask w flag -> Bitmask w flag -> Bitmask w flag
Ord, Int -> Bitmask w flag -> ShowS
[Bitmask w flag] -> ShowS
Bitmask w flag -> String
(Int -> Bitmask w flag -> ShowS)
-> (Bitmask w flag -> String)
-> ([Bitmask w flag] -> ShowS)
-> Show (Bitmask w flag)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w k (flag :: k). Show w => Int -> Bitmask w flag -> ShowS
forall w k (flag :: k). Show w => [Bitmask w flag] -> ShowS
forall w k (flag :: k). Show w => Bitmask w flag -> String
$cshowsPrec :: forall w k (flag :: k). Show w => Int -> Bitmask w flag -> ShowS
showsPrec :: Int -> Bitmask w flag -> ShowS
$cshow :: forall w k (flag :: k). Show w => Bitmask w flag -> String
show :: Bitmask w flag -> String
$cshowList :: forall w k (flag :: k). Show w => [Bitmask w flag] -> ShowS
showList :: [Bitmask w flag] -> ShowS
Show, Eq (Bitmask w flag)
Bitmask w flag
Eq (Bitmask w flag) =>
(Bitmask w flag -> Bitmask w flag -> Bitmask w flag)
-> (Bitmask w flag -> Bitmask w flag -> Bitmask w flag)
-> (Bitmask w flag -> Bitmask w flag -> Bitmask w flag)
-> (Bitmask w flag -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> Bitmask w flag
-> (Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bool)
-> (Bitmask w flag -> Maybe Int)
-> (Bitmask w flag -> Int)
-> (Bitmask w flag -> Bool)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int -> Bitmask w flag)
-> (Bitmask w flag -> Int)
-> Bits (Bitmask w flag)
Int -> Bitmask w flag
Bitmask w flag -> Bool
Bitmask w flag -> Int
Bitmask w flag -> Maybe Int
Bitmask w flag -> Bitmask w flag
Bitmask w flag -> Int -> Bool
Bitmask w flag -> Int -> Bitmask w flag
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
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
forall w k (flag :: k). Bits w => Eq (Bitmask w flag)
forall w k (flag :: k). Bits w => Bitmask w flag
forall w k (flag :: k). Bits w => Int -> Bitmask w flag
forall w k (flag :: k). Bits w => Bitmask w flag -> Bool
forall w k (flag :: k). Bits w => Bitmask w flag -> Int
forall w k (flag :: k). Bits w => Bitmask w flag -> Maybe Int
forall w k (flag :: k). Bits w => Bitmask w flag -> Bitmask w flag
forall w k (flag :: k). Bits w => Bitmask w flag -> Int -> Bool
forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$c.&. :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
.&. :: Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$c.|. :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
.|. :: Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$cxor :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Bitmask w flag -> Bitmask w flag
xor :: Bitmask w flag -> Bitmask w flag -> Bitmask w flag
$ccomplement :: forall w k (flag :: k). Bits w => Bitmask w flag -> Bitmask w flag
complement :: Bitmask w flag -> Bitmask w flag
$cshift :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
shift :: Bitmask w flag -> Int -> Bitmask w flag
$crotate :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
rotate :: Bitmask w flag -> Int -> Bitmask w flag
$czeroBits :: forall w k (flag :: k). Bits w => Bitmask w flag
zeroBits :: Bitmask w flag
$cbit :: forall w k (flag :: k). Bits w => Int -> Bitmask w flag
bit :: Int -> Bitmask w flag
$csetBit :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
setBit :: Bitmask w flag -> Int -> Bitmask w flag
$cclearBit :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
clearBit :: Bitmask w flag -> Int -> Bitmask w flag
$ccomplementBit :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
complementBit :: Bitmask w flag -> Int -> Bitmask w flag
$ctestBit :: forall w k (flag :: k). Bits w => Bitmask w flag -> Int -> Bool
testBit :: Bitmask w flag -> Int -> Bool
$cbitSizeMaybe :: forall w k (flag :: k). Bits w => Bitmask w flag -> Maybe Int
bitSizeMaybe :: Bitmask w flag -> Maybe Int
$cbitSize :: forall w k (flag :: k). Bits w => Bitmask w flag -> Int
bitSize :: Bitmask w flag -> Int
$cisSigned :: forall w k (flag :: k). Bits w => Bitmask w flag -> Bool
isSigned :: Bitmask w flag -> Bool
$cshiftL :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
shiftL :: Bitmask w flag -> Int -> Bitmask w flag
$cunsafeShiftL :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
unsafeShiftL :: Bitmask w flag -> Int -> Bitmask w flag
$cshiftR :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
shiftR :: Bitmask w flag -> Int -> Bitmask w flag
$cunsafeShiftR :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
unsafeShiftR :: Bitmask w flag -> Int -> Bitmask w flag
$crotateL :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
rotateL :: Bitmask w flag -> Int -> Bitmask w flag
$crotateR :: forall w k (flag :: k).
Bits w =>
Bitmask w flag -> Int -> Bitmask w flag
rotateR :: Bitmask w flag -> Int -> Bitmask w flag
$cpopCount :: forall w k (flag :: k). Bits w => Bitmask w flag -> Int
popCount :: Bitmask w flag -> Int
Bits)

type Bitmask8 = Bitmask Word8
type Bitmask16 = Bitmask Word16
type Bitmask32 = Bitmask Word32
type Bitmask64 = Bitmask Word64

-- | Create a bitmask from raw bits.

--

fromBits :: w -> Bitmask w flag
fromBits :: forall {k} w (flag :: k). w -> Bitmask w flag
fromBits = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask

-- | Convert a bitmask to raw bits.

--

toBits :: Bitmask w flag -> w
toBits :: forall {k} w (flag :: k). Bitmask w flag -> w
toBits (Bitmask w
w) = w
w

-- | Check that a bitmask can represent all flags.

--

-- >>> checkBitmask (allFlags :: Bitmask8 PizzaTopping)

-- True

--

checkBitmask :: forall flag w. (FiniteBits w, Enum flag, Bounded flag)
  => Bitmask w flag -> Bool
checkBitmask :: forall flag w.
(FiniteBits w, Enum flag, Bounded flag) =>
Bitmask w flag -> Bool
checkBitmask (Bitmask w
w) =
  w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (flag -> Int
forall a. Enum a => a -> Int
fromEnum (flag
forall a. Bounded a => a
maxBound :: flag) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

---------------------- Creation and conversion to lists ----------------------


-- | A bitmask with all flags set to 'False'.

--

-- >>> getFlag Mushrooms (noFlag :: PizzaMask)

-- False

--

noFlag :: Bits w => Bitmask w flag
noFlag :: forall {k} w (flag :: k). Bits w => Bitmask w flag
noFlag = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask w
forall a. Bits a => a
zeroBits

-- | A bitmask with all flags set to 'True'.

--

-- >>> getFlag Mushrooms (allFlags :: PizzaMask)

-- True

--

allFlags :: (FiniteBits w, Enum flag) => Bitmask w flag
allFlags :: forall w flag. (FiniteBits w, Enum flag) => Bitmask w flag
allFlags = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask w
forall a. FiniteBits a => a
oneBits

-- | Create a bitmask from a list of flags to set to 'True'.

--

-- >>> hawaiian = fromFlags [Pineapple, Ham, Cheese] :: PizzaMask

--

fromFlags :: (Bits w, Enum flag) => [flag] -> Bitmask w flag
fromFlags :: forall w flag. (Bits w, Enum flag) => [flag] -> Bitmask w flag
fromFlags = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr flag -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
addFlag Bitmask w flag
forall {k} w (flag :: k). Bits w => Bitmask w flag
noFlag

-- | Convert a bitmask to a list of flags that are set to 'True'.

--

-- >>> toFlags hawaiian

-- [Cheese,Pineapple,Ham]

--

toFlags :: forall flag w. (FiniteBits w, Enum flag, Bounded flag)
  => Bitmask w flag -> [flag]
toFlags :: forall flag w.
(FiniteBits w, Enum flag, Bounded flag) =>
Bitmask w flag -> [flag]
toFlags bm :: Bitmask w flag
bm@(Bitmask w
w) =
  let n :: Int
n = w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
w in
  (flag -> Bool) -> [flag] -> [flag]
forall a. (a -> Bool) -> [a] -> [a]
filter (flag -> Bitmask w flag -> Bool
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bool
`getFlag` Bitmask w flag
bm)
    [Int -> flag
forall a. Enum a => Int -> a
toEnum Int
i | Int
i <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (flag -> Int
forall a. Enum a => a -> Int
fromEnum (flag
forall a. Bounded a => a
maxBound :: flag))]]

-- | Create a bitmask from a list of flags to set to 'False'

--

-- >>> veggie = fromExceptFlags [Ham] :: PizzaMask

--

fromExceptFlags :: (FiniteBits w, Enum flag) => [flag] -> Bitmask w flag
fromExceptFlags :: forall w flag.
(FiniteBits w, Enum flag) =>
[flag] -> Bitmask w flag
fromExceptFlags = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr flag -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
deleteFlag Bitmask w flag
forall w flag. (FiniteBits w, Enum flag) => Bitmask w flag
allFlags

-- | Convert a bitmask to a list of flags that are set to 'False'.

--

-- >>> toExceptFlags veggie

-- [Ham]

toExceptFlags :: forall flag w. (FiniteBits w, Enum flag, Bounded flag)
  => Bitmask w flag -> [flag]
toExceptFlags :: forall flag w.
(FiniteBits w, Enum flag, Bounded flag) =>
Bitmask w flag -> [flag]
toExceptFlags bm :: Bitmask w flag
bm@(Bitmask w
w) =
  let n :: Int
n = w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
w in
  (flag -> Bool) -> [flag] -> [flag]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (flag -> Bool) -> flag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (flag -> Bitmask w flag -> Bool
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bool
`getFlag` Bitmask w flag
bm))
    [Int -> flag
forall a. Enum a => Int -> a
toEnum Int
i | Int
i <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (flag -> Int
forall a. Enum a => a -> Int
fromEnum (flag
forall a. Bounded a => a
maxBound :: flag))]]

-- | Convert an association list of flags and boolean values to a bitmask.

--

-- >>> funghi = fromFlagsBool [(Cheese, True), (Ham, False), (Mushrooms, True)] :: PizzaMask

fromFlagsBool :: forall flag w. (Bits w, Enum flag)
  => [(flag, Bool)] -> Bitmask w flag
fromFlagsBool :: forall flag w.
(Bits w, Enum flag) =>
[(flag, Bool)] -> Bitmask w flag
fromFlagsBool = ((flag, Bool) -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [(flag, Bool)] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((flag -> Bool -> Bitmask w flag -> Bitmask w flag)
-> (flag, Bool) -> Bitmask w flag -> Bitmask w flag
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry flag -> Bool -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag) Bitmask w flag
forall {k} w (flag :: k). Bits w => Bitmask w flag
noFlag

-- | Convert a bitmask to an association list of flags and boolean values.

--

-- >>> toFlagsBool funghi

-- [(Cheese,True),(Mushrooms,True),(Pineapple,False),(Ham,False)]

--

toFlagsBool :: forall flag w. (FiniteBits w, Enum flag, Bounded flag)
  => Bitmask w flag -> [(flag, Bool)]
toFlagsBool :: forall flag w.
(FiniteBits w, Enum flag, Bounded flag) =>
Bitmask w flag -> [(flag, Bool)]
toFlagsBool bm :: Bitmask w flag
bm@(Bitmask w
w) =
  let n :: Int
n = w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
w in
  [(Int -> flag
forall a. Enum a => Int -> a
toEnum Int
i, flag -> Bitmask w flag -> Bool
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bool
getFlag (Int -> flag
forall a. Enum a => Int -> a
toEnum Int
i) Bitmask w flag
bm)
    | Int
i <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (flag -> Int
forall a. Enum a => a -> Int
fromEnum (flag
forall a. Bounded a => a
maxBound :: flag))]]

---------------------- Querying and modifying flags ----------------------


-- | Get a flag from a bitmask.

--

-- >>> getFlag Mushrooms hawaiian

-- False

--

getFlag :: (Bits w, Enum flag) => flag -> Bitmask w flag -> Bool
getFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bool
getFlag flag
flag (Bitmask w
w) = w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)

-- | Get multiple flags from a bitmask.

--

-- >>> getFlags [Cheese, Mushrooms] hawaiian

-- [True,False]

--

getFlags :: (Bits w, Enum flag) => [flag] -> Bitmask w flag -> [Bool]
getFlags :: forall w flag.
(Bits w, Enum flag) =>
[flag] -> Bitmask w flag -> [Bool]
getFlags [flag]
fs Bitmask w flag
bm = (flag -> Bool) -> [flag] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (flag -> Bitmask w flag -> Bool
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bool
`getFlag` Bitmask w flag
bm) [flag]
fs

-- | Add a flag to a bitmask (set it to 'True').

--

-- >>> margherita = addFlag Cheese (noFlag :: PizzaMask)

--

addFlag :: (Bits w, Enum flag) =>
  flag -> Bitmask w flag -> Bitmask w flag
addFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
addFlag flag
f = flag -> Bool -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag flag
f Bool
True

-- | Add multiple flags to a bitmask (set them to 'True').

--

-- >>> hawaiian = addFlags [Pineapple, Ham] margherita

--

addFlags :: (Bits w, Enum flag)
  => [flag] -> Bitmask w flag -> Bitmask w flag
addFlags :: forall w flag.
(Bits w, Enum flag) =>
[flag] -> Bitmask w flag -> Bitmask w flag
addFlags [flag]
fs Bitmask w flag
bm = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr flag -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
addFlag Bitmask w flag
bm [flag]
fs

-- | Remove a flag from a bitmask (set it to 'False').

--

-- >>> veggie = deleteFlag Ham (allFlags :: PizzaMask)

--

deleteFlag :: (Bits w, Enum flag) =>
  flag -> Bitmask w flag -> Bitmask w flag
deleteFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
deleteFlag flag
f = flag -> Bool -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag flag
f Bool
False

-- | Remove multiple flags from a bitmask (set them to 'False').

--

-- >>> picky = deleteFlags [Pineapple, Ham] (allFlags :: PizzaMask)

--

deleteFlags :: (Bits w, Enum flag)
  => [flag] -> Bitmask w flag -> Bitmask w flag
deleteFlags :: forall w flag.
(Bits w, Enum flag) =>
[flag] -> Bitmask w flag -> Bitmask w flag
deleteFlags [flag]
fs Bitmask w flag
bm = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr flag -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
deleteFlag Bitmask w flag
bm [flag]
fs

-- | Set a flag in a bitmask.

--

-- >>> funghi = setFlag Mushrooms True margherita

setFlag :: (Bits w, Enum flag) =>
  flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag flag
flag Bool
value (Bitmask w
w) = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask (w -> Bitmask w flag) -> w -> Bitmask w flag
forall a b. (a -> b) -> a -> b
$
  if Bool
value then
    w -> Int -> w
forall a. Bits a => a -> Int -> a
setBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)
  else
    w -> Int -> w
forall a. Bits a => a -> Int -> a
clearBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)

-- | Set multiple flags in a bitmask.

--

-- >>> hawaiian = setFlags [(Ham, True), (Pineapple, True)] margherita

--

setFlags :: (Bits w, Enum flag) =>
  [(flag, Bool)] -> Bitmask w flag -> Bitmask w flag
setFlags :: forall w flag.
(Bits w, Enum flag) =>
[(flag, Bool)] -> Bitmask w flag -> Bitmask w flag
setFlags [(flag, Bool)]
fs Bitmask w flag
bm = ((flag, Bool) -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [(flag, Bool)] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((flag -> Bool -> Bitmask w flag -> Bitmask w flag)
-> (flag, Bool) -> Bitmask w flag -> Bitmask w flag
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry flag -> Bool -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bool -> Bitmask w flag -> Bitmask w flag
setFlag) Bitmask w flag
bm [(flag, Bool)]
fs

-- | Flip a flag in a bitmask.

--

-- >>> margherita = flipFlag Cheese (noFlag :: PizzaMask)

flipFlag :: (Bits w, Enum flag) =>
  flag -> Bitmask w flag -> Bitmask w flag
flipFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
flipFlag flag
flag (Bitmask w
w) = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask (w -> Bitmask w flag) -> w -> Bitmask w flag
forall a b. (a -> b) -> a -> b
$ w -> Int -> w
forall a. Bits a => a -> Int -> a
complementBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)

-- | Flip multiple flags in a bitmask.

--

-- >>> funghi = flipFlags [Mushrooms, Ham, Pineapple] hawaiian

flipFlags :: (Bits w, Enum flag) =>
  [flag] -> Bitmask w flag -> Bitmask w flag
flipFlags :: forall w flag.
(Bits w, Enum flag) =>
[flag] -> Bitmask w flag -> Bitmask w flag
flipFlags [flag]
fs Bitmask w flag
bm = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr flag -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> Bitmask w flag -> Bitmask w flag
flipFlag Bitmask w flag
bm [flag]
fs

-- | Modify a flag in a bitmask.

--

-- >>> veggie = modifyFlag Ham not (allFlags :: PizzaMask)

--

modifyFlag :: (Bits w, Enum flag) =>
  flag -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
modifyFlag :: forall w flag.
(Bits w, Enum flag) =>
flag -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
modifyFlag flag
flag Bool -> Bool
f (Bitmask w
w) = w -> Bitmask w flag
forall {k} w (flag :: k). w -> Bitmask w flag
Bitmask (w -> Bitmask w flag) -> w -> Bitmask w flag
forall a b. (a -> b) -> a -> b
$
  if Bool -> Bool
f (w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)) then
    w -> Int -> w
forall a. Bits a => a -> Int -> a
setBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)
  else
    w -> Int -> w
forall a. Bits a => a -> Int -> a
clearBit w
w (flag -> Int
forall a. Enum a => a -> Int
fromEnum flag
flag)

-- | Modify multiple flags in a bitmask.

--

-- >>> picky = modifyFlags [Pineapple, Ham] not (allFlags :: PizzaMask)

--

modifyFlags :: (Bits w, Enum flag) =>
  [flag] -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
modifyFlags :: forall w flag.
(Bits w, Enum flag) =>
[flag] -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
modifyFlags [flag]
fs Bool -> Bool
f Bitmask w flag
bm = (flag -> Bitmask w flag -> Bitmask w flag)
-> Bitmask w flag -> [flag] -> Bitmask w flag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (flag -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
forall w flag.
(Bits w, Enum flag) =>
flag -> (Bool -> Bool) -> Bitmask w flag -> Bitmask w flag
`modifyFlag` Bool -> Bool
f) Bitmask w flag
bm [flag]
fs