module Data.FlagSet (
T(Cons, decons),
fromMaskedValue, match,
Enum(fromEnum),
compose, decompose,
Mask(Mask, unmask), maskValue,
Value(Value, unvalue),
MaskedValue(MaskedValue),
get, put, accessor,
) where
import Data.Bits (Bits, (.&.), (.|.), )
import Data.Monoid (Monoid(mempty, mappend, mconcat), )
import Data.Semigroup (Semigroup((<>)), )
import qualified Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
import qualified Data.Accessor.Basic as Acc
import Data.EnumBitSet.Utility (empty, (.-.), )
import qualified Prelude as P
import Prelude hiding (Enum, fromEnum, toEnum, null, flip, )
newtype T word a = Cons {T word a -> word
decons :: word}
deriving (T word a -> T word a -> Bool
(T word a -> T word a -> Bool)
-> (T word a -> T word a -> Bool) -> Eq (T word a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall word a. Eq word => T word a -> T word a -> Bool
/= :: T word a -> T word a -> Bool
$c/= :: forall word a. Eq word => T word a -> T word a -> Bool
== :: T word a -> T word a -> Bool
$c== :: forall word a. Eq word => T word a -> T word a -> Bool
Eq)
instance (Storable w) => Storable (T w a) where
sizeOf :: T w a -> Int
sizeOf = (T w a -> w) -> T w a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf T w a -> w
forall word a. T word a -> word
decons
alignment :: T w a -> Int
alignment = (T w a -> w) -> T w a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment T w a -> w
forall word a. T word a -> word
decons
peek :: Ptr (T w a) -> IO (T w a)
peek = (w -> T w a) -> Ptr (T w a) -> IO (T w a)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek w -> T w a
forall word a. word -> T word a
Cons
poke :: Ptr (T w a) -> T w a -> IO ()
poke = (T w a -> w) -> Ptr (T w a) -> T w a -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke T w a -> w
forall word a. T word a -> word
decons
newtype Mask w a b = Mask {Mask w a b -> w
unmask :: w}
deriving (Mask w a b -> Mask w a b -> Bool
(Mask w a b -> Mask w a b -> Bool)
-> (Mask w a b -> Mask w a b -> Bool) -> Eq (Mask w a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a b. Eq w => Mask w a b -> Mask w a b -> Bool
/= :: Mask w a b -> Mask w a b -> Bool
$c/= :: forall w a b. Eq w => Mask w a b -> Mask w a b -> Bool
== :: Mask w a b -> Mask w a b -> Bool
$c== :: forall w a b. Eq w => Mask w a b -> Mask w a b -> Bool
Eq, Int -> Mask w a b -> ShowS
[Mask w a b] -> ShowS
Mask w a b -> String
(Int -> Mask w a b -> ShowS)
-> (Mask w a b -> String)
-> ([Mask w a b] -> ShowS)
-> Show (Mask w a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a b. Show w => Int -> Mask w a b -> ShowS
forall w a b. Show w => [Mask w a b] -> ShowS
forall w a b. Show w => Mask w a b -> String
showList :: [Mask w a b] -> ShowS
$cshowList :: forall w a b. Show w => [Mask w a b] -> ShowS
show :: Mask w a b -> String
$cshow :: forall w a b. Show w => Mask w a b -> String
showsPrec :: Int -> Mask w a b -> ShowS
$cshowsPrec :: forall w a b. Show w => Int -> Mask w a b -> ShowS
Show)
newtype Value w b = Value {Value w b -> w
unvalue :: w}
deriving (Value w b -> Value w b -> Bool
(Value w b -> Value w b -> Bool)
-> (Value w b -> Value w b -> Bool) -> Eq (Value w b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w b. Eq w => Value w b -> Value w b -> Bool
/= :: Value w b -> Value w b -> Bool
$c/= :: forall w b. Eq w => Value w b -> Value w b -> Bool
== :: Value w b -> Value w b -> Bool
$c== :: forall w b. Eq w => Value w b -> Value w b -> Bool
Eq, Int -> Value w b -> ShowS
[Value w b] -> ShowS
Value w b -> String
(Int -> Value w b -> ShowS)
-> (Value w b -> String)
-> ([Value w b] -> ShowS)
-> Show (Value w b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w b. Show w => Int -> Value w b -> ShowS
forall w b. Show w => [Value w b] -> ShowS
forall w b. Show w => Value w b -> String
showList :: [Value w b] -> ShowS
$cshowList :: forall w b. Show w => [Value w b] -> ShowS
show :: Value w b -> String
$cshow :: forall w b. Show w => Value w b -> String
showsPrec :: Int -> Value w b -> ShowS
$cshowsPrec :: forall w b. Show w => Int -> Value w b -> ShowS
Show)
get :: (Enum a, Bits w) => Mask w a b -> T w a -> Value w b
get :: Mask w a b -> T w a -> Value w b
get (Mask w
m) (Cons w
fs) = w -> Value w b
forall w b. w -> Value w b
Value (w
m w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
fs)
put :: (Enum a, Bits w) => Mask w a b -> Value w b -> T w a -> T w a
put :: Mask w a b -> Value w b -> T w a -> T w a
put (Mask w
m) (Value w
v) (Cons w
fs) =
w -> T w a
forall word a. word -> T word a
Cons (w -> T w a) -> w -> T w a
forall a b. (a -> b) -> a -> b
$ (w
fs w -> w -> w
forall a. Bits a => a -> a -> a
.-. w
m) w -> w -> w
forall a. Bits a => a -> a -> a
.|. w
v
accessor :: (Enum a, Bits w) => Mask w a b -> Acc.T (T w a) (Value w b)
accessor :: Mask w a b -> T (T w a) (Value w b)
accessor Mask w a b
m = (Value w b -> T w a -> T w a)
-> (T w a -> Value w b) -> T (T w a) (Value w b)
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Acc.fromSetGet (Mask w a b -> Value w b -> T w a -> T w a
forall a w b.
(Enum a, Bits w) =>
Mask w a b -> Value w b -> T w a -> T w a
put Mask w a b
m) (Mask w a b -> T w a -> Value w b
forall a w b. (Enum a, Bits w) => Mask w a b -> T w a -> Value w b
get Mask w a b
m)
data MaskedValue w a = MaskedValue w w
deriving (MaskedValue w a -> MaskedValue w a -> Bool
(MaskedValue w a -> MaskedValue w a -> Bool)
-> (MaskedValue w a -> MaskedValue w a -> Bool)
-> Eq (MaskedValue w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a. Eq w => MaskedValue w a -> MaskedValue w a -> Bool
/= :: MaskedValue w a -> MaskedValue w a -> Bool
$c/= :: forall w a. Eq w => MaskedValue w a -> MaskedValue w a -> Bool
== :: MaskedValue w a -> MaskedValue w a -> Bool
$c== :: forall w a. Eq w => MaskedValue w a -> MaskedValue w a -> Bool
Eq, Int -> MaskedValue w a -> ShowS
[MaskedValue w a] -> ShowS
MaskedValue w a -> String
(Int -> MaskedValue w a -> ShowS)
-> (MaskedValue w a -> String)
-> ([MaskedValue w a] -> ShowS)
-> Show (MaskedValue w a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a. Show w => Int -> MaskedValue w a -> ShowS
forall w a. Show w => [MaskedValue w a] -> ShowS
forall w a. Show w => MaskedValue w a -> String
showList :: [MaskedValue w a] -> ShowS
$cshowList :: forall w a. Show w => [MaskedValue w a] -> ShowS
show :: MaskedValue w a -> String
$cshow :: forall w a. Show w => MaskedValue w a -> String
showsPrec :: Int -> MaskedValue w a -> ShowS
$cshowsPrec :: forall w a. Show w => Int -> MaskedValue w a -> ShowS
Show)
fromMaskedValue :: MaskedValue w a -> T w a
fromMaskedValue :: MaskedValue w a -> T w a
fromMaskedValue (MaskedValue w
_m w
v) = w -> T w a
forall word a. word -> T word a
Cons w
v
match :: (Bits w) => T w a -> MaskedValue w a -> Bool
match :: T w a -> MaskedValue w a -> Bool
match (Cons w
fs) (MaskedValue w
m w
v) =
w
m w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
fs w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
v
maskValue :: Mask w a b -> Value w b -> MaskedValue w a
maskValue :: Mask w a b -> Value w b -> MaskedValue w a
maskValue (Mask w
m) (Value w
v) = w -> w -> MaskedValue w a
forall w a. w -> w -> MaskedValue w a
MaskedValue w
m w
v
instance (Bits w) => Semigroup (MaskedValue w a) where
MaskedValue w
mx w
vx <> :: MaskedValue w a -> MaskedValue w a -> MaskedValue w a
<> MaskedValue w
my w
vy =
w -> w -> MaskedValue w a
forall w a. w -> w -> MaskedValue w a
MaskedValue (w
mx w -> w -> w
forall a. Bits a => a -> a -> a
.|. w
my) (w
vx w -> w -> w
forall a. Bits a => a -> a -> a
.-. w
my w -> w -> w
forall a. Bits a => a -> a -> a
.|. w
vy)
instance (Bits w) => Monoid (MaskedValue w a) where
mempty :: MaskedValue w a
mempty = w -> w -> MaskedValue w a
forall w a. w -> w -> MaskedValue w a
MaskedValue w
forall w. Bits w => w
empty w
forall w. Bits w => w
empty
mappend :: MaskedValue w a -> MaskedValue w a -> MaskedValue w a
mappend = MaskedValue w a -> MaskedValue w a -> MaskedValue w a
forall a. Semigroup a => a -> a -> a
(<>)
class Enum a where
:: (Bits w) => a -> MaskedValue w a
decompose :: (Bounded a, Enum a, P.Enum a, Bits w) => T w a -> [a]
decompose :: T w a -> [a]
decompose T w a
x =
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (T w a -> MaskedValue w a -> Bool
forall w a. Bits w => T w a -> MaskedValue w a -> Bool
match T w a
x (MaskedValue w a -> Bool) -> (a -> MaskedValue w a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MaskedValue w a
forall a w. (Enum a, Bits w) => a -> MaskedValue w a
fromEnum) [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]
compose :: (Enum a, P.Enum a, Bits w) => [a] -> T w a
compose :: [a] -> T w a
compose [a]
xs =
MaskedValue w a -> T w a
forall w a. MaskedValue w a -> T w a
fromMaskedValue (MaskedValue w a -> T w a) -> MaskedValue w a -> T w a
forall a b. (a -> b) -> a -> b
$ [MaskedValue w a] -> MaskedValue w a
forall a. Monoid a => [a] -> a
mconcat ([MaskedValue w a] -> MaskedValue w a)
-> [MaskedValue w a] -> MaskedValue w a
forall a b. (a -> b) -> a -> b
$ (a -> MaskedValue w a) -> [a] -> [MaskedValue w a]
forall a b. (a -> b) -> [a] -> [b]
map a -> MaskedValue w a
forall a w. (Enum a, Bits w) => a -> MaskedValue w a
fromEnum [a]
xs