module Vulkan.Utils.Misc
  ( -- * Sorting things
    partitionOptReq
  , partitionOptReqIO

    -- * Bit Utils
  , showBits
  , (.&&.)
  ) where

import Control.Monad.IO.Class
import Data.Bits
import Data.Foldable
import Data.List
  ( intercalate
  , partition
  )
import Vulkan.Utils.Internal

{- | From a list of things, take all the required things and as many optional
things as possible.
-}
partitionOptReq
  :: (Eq a)
  => [a]
  -- ^ What do we have available
  -> [a]
  -- ^ Optional desired elements
  -> [a]
  -- ^ Required desired elements
  -> ([a], Either [a] [a])
  {- ^ (Missing optional elements, Either (missing required elements) or (all
  required elements and as many optional elements as possible)
  -}
partitionOptReq :: forall a. Eq a => [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 a. Eq a => 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 a. Eq a => 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
    )

{- | Like 'partitionOptReq'.

Will throw an 'IOError in the case of missing things. Details on missing
things will be reported in stderr.

This is useful in dealing with layers and extensions.
-}
partitionOptReqIO
  :: (Show a, Eq a, MonadIO m)
  => String
  -- ^ What are we sorting (Used for a debug message)
  -> [a]
  -- ^ What do we have available
  -> [a]
  -- ^ Optional desired elements
  -> [a]
  -- ^ Required desired elements
  -> m ([a], [a])
  {- ^ All the required elements and as many optional elements as possible,
  as well as the missing optional elements.
  -}
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 = IO ([a], [a]) -> m ([a], [a])
forall a. IO a -> m 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
xs, [a]
optMissing)

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

-- * Bit utils

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

{- | Show valies as a union of their individual bits

>>> showBits @Int 5
"1 .|. 4"

>>> showBits @Int 0
"zeroBits"

>>> import Vulkan.Core10.Enums.QueueFlagBits
>>> showBits (QUEUE_COMPUTE_BIT .|. QUEUE_GRAPHICS_BIT)
"QUEUE_GRAPHICS_BIT .|. QUEUE_COMPUTE_BIT"
-}
showBits :: forall a. (Show a, FiniteBits a) => a -> String
showBits :: forall a. (Show a, FiniteBits a) => 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 a b. (a -> b) -> [a] -> [b]
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 :: forall a. FiniteBits a => a -> [a]
setBits a
a =
  [ a
b
  | -- lol, is this really necessary
  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
  ]

-- | Check if the intersection of bits is non-zero
(.&&.) :: (Bits a) => a -> a -> Bool
a
x .&&. :: forall a. Bits a => 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