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