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           GHC.IO                         ( throwIO )
import           GHC.IO.Exception               ( IOErrorType(NoSuchThing)
                                                , IOException(..)
                                                )
import           System.IO                      ( hPutStrLn
                                                , stderr
                                                )

-- | 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]
  -- ^ All the required elements and as many optional elements as possible
partitionOptReqIO :: String -> [a] -> [a] -> [a] -> m [a]
partitionOptReqIO type' :: String
type' available :: [a]
available optional :: [a]
optional required :: [a]
required = IO [a] -> m [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a]) -> IO [a] -> m [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]
forall a. String -> IO a
noSuchThing (String -> IO [a]) -> String -> IO [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] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs

----------------------------------------------------------------
-- * 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]
setBits a
a)
 where
  setBits :: 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

----------------------------------------------------------------
-- Internal utils
----------------------------------------------------------------

noSuchThing :: String -> IO a
noSuchThing :: String -> IO a
noSuchThing message :: String
message =
  IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO a) -> IOException -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
NoSuchThing "" String
message Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

sayErr :: MonadIO m => String -> m ()
sayErr :: String -> m ()
sayErr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr