Misc.hs

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 available optional required =
  let (optHave, optMissing) = partition (`elem` available) optional
      (reqHave, reqMissing) = partition (`elem` available) required
  in  ( optMissing
      , case reqMissing of
        [] -> Right (reqHave <> optHave)
        xs -> Left 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 type' available optional required = liftIO $ do
  let (optMissing, exts) = partitionOptReq available optional required
  for_ optMissing
    $ \o -> sayErr $ "Missing optional " <> type' <> ": " <> show o
  case exts of
    Left reqMissing -> do
      for_ reqMissing
        $ \r -> sayErr $ "Missing required " <> type' <> ": " <> show r
      noSuchThing $ "Don't have all required " <> type' <> "s"
    Right xs -> pure 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 = if a == zeroBits
  then "zeroBits"
  else intercalate " .|. " $ fmap show (setBits a)
 where
  setBits :: a -> [a]
  setBits a =
    [ b
    | -- lol, is this really necessary
      p <- [countTrailingZeros a .. finiteBitSize a - countLeadingZeros a - 1]
    , let b = bit p
    , a .&&. b
    ]

-- | Check if the intersection of bits is non-zero
(.&&.) :: Bits a => a -> a -> Bool
x .&&. y = (x .&. y) /= zeroBits

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

noSuchThing :: String -> IO a
noSuchThing message =
  throwIO $ IOError Nothing NoSuchThing "" message Nothing Nothing

sayErr :: MonadIO m => String -> m ()
sayErr = liftIO . hPutStrLn stderr