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 :: [a] -> [a] -> [a] -> ([a], Either [a] [a])
partitionOptReq available :: [a]
available optional :: [a]
optional required :: [a]
required =
  let (optHave :: [a]
optHave, optMissing :: [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
      (reqHave :: [a]
reqHave, reqMissing :: [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)
        xs :: [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 :: String -> [a] -> [a] -> [a] -> m ([a], [a])
partitionOptReqIO type' :: String
type' available :: [a]
available optional :: [a]
optional required :: [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 (optMissing :: [a]
optMissing, exts :: 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
$ \o :: a
o -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
sayErr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "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
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 reqMissing :: [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
$ \r :: a
r -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
sayErr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "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
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
$ "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
<> "s"
    Right xs :: [a]
xs -> ([a], [a]) -> IO ([a], [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 :: a -> String
showBits a :: a
a = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bits a => a
zeroBits
  then "zeroBits"
  else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " .|. " ([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)

-- | The list of bits which are set
setBits :: FiniteBits a => a -> [a]
setBits :: a -> [a]
setBits a :: 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
- 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
x :: a
x .&&. :: a -> a -> Bool
.&&. y :: 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