module Vulkan.Utils.Misc
(
partitionOptReq
, partitionOptReqIO
, showBits
, (.&&.)
) where
import Control.Monad.IO.Class
import Data.Bits
import Data.Foldable
import Data.List ( intercalate
, partition
)
import Vulkan.Utils.Internal
partitionOptReq
:: Eq a
=> [a]
-> [a]
-> [a]
-> ([a], Either [a] [a])
partitionOptReq :: forall a. Eq a => [a] -> [a] -> [a] -> ([a], Either [a] [a])
partitionOptReq [a]
available [a]
optional [a]
required =
let ([a]
optHave, [a]
optMissing) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
available) [a]
optional
([a]
reqHave, [a]
reqMissing) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
available) [a]
required
in ( [a]
optMissing
, case [a]
reqMissing of
[] -> forall a b. b -> Either a b
Right ([a]
reqHave forall a. Semigroup a => a -> a -> a
<> [a]
optHave)
[a]
xs -> forall a b. a -> Either a b
Left [a]
xs
)
partitionOptReqIO
:: (Show a, Eq a, MonadIO m)
=> String
-> [a]
-> [a]
-> [a]
-> m ([a],[a])
partitionOptReqIO :: forall a (m :: * -> *).
(Show a, Eq a, MonadIO m) =>
String -> [a] -> [a] -> [a] -> m ([a], [a])
partitionOptReqIO String
type' [a]
available [a]
optional [a]
required = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let ([a]
optMissing, Either [a] [a]
exts) = forall a. Eq a => [a] -> [a] -> [a] -> ([a], Either [a] [a])
partitionOptReq [a]
available [a]
optional [a]
required
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a]
optMissing
forall a b. (a -> b) -> a -> b
$ \a
o -> forall (m :: * -> *). MonadIO m => String -> m ()
sayErr forall a b. (a -> b) -> a -> b
$ String
"Missing optional " forall a. Semigroup a => a -> a -> a
<> String
type' forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
o
case Either [a] [a]
exts of
Left [a]
reqMissing -> do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a]
reqMissing
forall a b. (a -> b) -> a -> b
$ \a
r -> forall (m :: * -> *). MonadIO m => String -> m ()
sayErr forall a b. (a -> b) -> a -> b
$ String
"Missing required " forall a. Semigroup a => a -> a -> a
<> String
type' forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
r
forall a. String -> IO a
noSuchThing forall a b. (a -> b) -> a -> b
$ String
"Don't have all required " forall a. Semigroup a => a -> a -> a
<> String
type' forall a. Semigroup a => a -> a -> a
<> String
"s"
Right [a]
xs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
xs, [a]
optMissing)
showBits :: forall a . (Show a, FiniteBits a) => a -> String
showBits :: forall a. (Show a, FiniteBits a) => a -> String
showBits a
a = if a
a forall a. Eq a => a -> a -> Bool
== forall a. Bits a => a
zeroBits
then String
"zeroBits"
else forall a. [a] -> [[a]] -> [a]
intercalate String
" .|. " forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show (forall a. FiniteBits a => a -> [a]
setBits a
a)
setBits :: FiniteBits a => a -> [a]
setBits :: forall a. FiniteBits a => a -> [a]
setBits a
a =
[ a
b
|
Int
p <- [forall b. FiniteBits b => b -> Int
countTrailingZeros a
a .. forall b. FiniteBits b => b -> Int
finiteBitSize a
a forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros a
a forall a. Num a => a -> a -> a
- Int
1]
, let b :: a
b = forall a. Bits a => Int -> a
bit Int
p
, a
a forall a. Bits a => a -> a -> Bool
.&&. a
b
]
(.&&.) :: Bits a => a -> a -> Bool
a
x .&&. :: forall a. Bits a => a -> a -> Bool
.&&. a
y = (a
x forall a. Bits a => a -> a -> a
.&. a
y) forall a. Eq a => a -> a -> Bool
/= forall a. Bits a => a
zeroBits