{-# LANGUAGE OverloadedLists #-}

module Vulkan.Utils.Initialization
  ( -- * Instance creation
    createInstanceFromRequirements
  , createDebugInstanceFromRequirements
    -- * Device creation
  , createDeviceFromRequirements
  , -- * Physical device selection
    pickPhysicalDevice
  , physicalDeviceName
  ) where

import           Control.Monad.IO.Class
import           Control.Monad.Trans.Resource
import           Data.Bits
import           Data.Foldable
import           Data.Maybe
import           Data.Ord
import           Data.Text                      ( Text )
import           Data.Text.Encoding             ( decodeUtf8 )
import           Vulkan.CStruct.Extends
import           Vulkan.Core10
import           Vulkan.Extensions.VK_EXT_debug_utils
import           Vulkan.Extensions.VK_EXT_validation_features
import           Vulkan.Requirement
import           Vulkan.Utils.Debug
import           Vulkan.Utils.Internal
import           Vulkan.Utils.Requirements
import           Vulkan.Zero

----------------------------------------------------------------
-- Instance
----------------------------------------------------------------

-- | Like 'createInstanceFromRequirements' except it will create a debug utils
-- messenger (from the @VK_EXT_debug_utils@ extension).
--
-- If the @VK_EXT_validation_features@ extension (from the
-- @VK_LAYER_KHRONOS_validation@ layer) is available is it will be enabled and
-- best practices messages enabled.
createDebugInstanceFromRequirements
  :: forall m es
   . (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es)
  => [InstanceRequirement]
  -- ^ Required
  -> [InstanceRequirement]
  -- ^ Optional
  -> InstanceCreateInfo es
  -> m Instance
createDebugInstanceFromRequirements :: [InstanceRequirement]
-> [InstanceRequirement] -> InstanceCreateInfo es -> m Instance
createDebugInstanceFromRequirements [InstanceRequirement]
required [InstanceRequirement]
optional InstanceCreateInfo es
baseCreateInfo = do
  let debugMessengerCreateInfo :: DebugUtilsMessengerCreateInfoEXT
debugMessengerCreateInfo = DebugUtilsMessengerCreateInfoEXT
forall a. Zero a => a
zero
        { $sel:messageSeverity:DebugUtilsMessengerCreateInfoEXT :: DebugUtilsMessageSeverityFlagsEXT
messageSeverity = DebugUtilsMessageSeverityFlagsEXT
DEBUG_UTILS_MESSAGE_SEVERITY_WARNING_BIT_EXT
                              DebugUtilsMessageSeverityFlagsEXT
-> DebugUtilsMessageSeverityFlagsEXT
-> DebugUtilsMessageSeverityFlagsEXT
forall a. Bits a => a -> a -> a
.|. DebugUtilsMessageSeverityFlagsEXT
DEBUG_UTILS_MESSAGE_SEVERITY_ERROR_BIT_EXT
        , $sel:messageType:DebugUtilsMessengerCreateInfoEXT :: DebugUtilsMessageTypeFlagsEXT
messageType     = DebugUtilsMessageTypeFlagsEXT
DEBUG_UTILS_MESSAGE_TYPE_GENERAL_BIT_EXT
                            DebugUtilsMessageTypeFlagsEXT
-> DebugUtilsMessageTypeFlagsEXT -> DebugUtilsMessageTypeFlagsEXT
forall a. Bits a => a -> a -> a
.|. DebugUtilsMessageTypeFlagsEXT
DEBUG_UTILS_MESSAGE_TYPE_VALIDATION_BIT_EXT
                            DebugUtilsMessageTypeFlagsEXT
-> DebugUtilsMessageTypeFlagsEXT -> DebugUtilsMessageTypeFlagsEXT
forall a. Bits a => a -> a -> a
.|. DebugUtilsMessageTypeFlagsEXT
DEBUG_UTILS_MESSAGE_TYPE_PERFORMANCE_BIT_EXT
        , $sel:pfnUserCallback:DebugUtilsMessengerCreateInfoEXT :: PFN_vkDebugUtilsMessengerCallbackEXT
pfnUserCallback = PFN_vkDebugUtilsMessengerCallbackEXT
debugCallbackPtr
        }
      validationFeatures :: ValidationFeaturesEXT
validationFeatures =
        Vector ValidationFeatureEnableEXT
-> Vector ValidationFeatureDisableEXT -> ValidationFeaturesEXT
ValidationFeaturesEXT [Item (Vector ValidationFeatureEnableEXT)
ValidationFeatureEnableEXT
VALIDATION_FEATURE_ENABLE_BEST_PRACTICES_EXT] []
      instanceCreateInfo
        :: InstanceCreateInfo
             (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
      instanceCreateInfo :: InstanceCreateInfo
  (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
instanceCreateInfo = InstanceCreateInfo es
baseCreateInfo
        { $sel:next:InstanceCreateInfo :: Chain
  (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
next = DebugUtilsMessengerCreateInfoEXT
debugMessengerCreateInfo DebugUtilsMessengerCreateInfoEXT
-> Chain (ValidationFeaturesEXT : es)
-> Chain
     (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
forall e (es :: [*]). e -> Chain es -> Chain (e : es)
:& ValidationFeaturesEXT
validationFeatures ValidationFeaturesEXT
-> Chain es -> Chain (ValidationFeaturesEXT : es)
forall e (es :: [*]). e -> Chain es -> Chain (e : es)
:& InstanceCreateInfo es -> Chain es
forall (es :: [*]). InstanceCreateInfo es -> Chain es
next
                   (InstanceCreateInfo es
baseCreateInfo :: InstanceCreateInfo es)
        }
      additionalRequirements :: l
additionalRequirements =
        [ RequireInstanceExtension :: Maybe ByteString -> ByteString -> Word32 -> InstanceRequirement
RequireInstanceExtension
            { $sel:instanceExtensionLayerName:RequireInstanceVersion :: Maybe ByteString
instanceExtensionLayerName  = Maybe ByteString
forall a. Maybe a
Nothing
            , $sel:instanceExtensionName:RequireInstanceVersion :: ByteString
instanceExtensionName       = ByteString
forall a. (Eq a, IsString a) => a
EXT_DEBUG_UTILS_EXTENSION_NAME
            , $sel:instanceExtensionMinVersion:RequireInstanceVersion :: Word32
instanceExtensionMinVersion = Word32
forall a. Bounded a => a
minBound
            }
        ]
      additionalOptionalRequirements :: l
additionalOptionalRequirements =
        [ RequireInstanceLayer :: ByteString -> Word32 -> InstanceRequirement
RequireInstanceLayer
          { $sel:instanceLayerName:RequireInstanceVersion :: ByteString
instanceLayerName       = ByteString
"VK_LAYER_KHRONOS_validation"
          , $sel:instanceLayerMinVersion:RequireInstanceVersion :: Word32
instanceLayerMinVersion = Word32
forall a. Bounded a => a
minBound
          }
        , RequireInstanceExtension :: Maybe ByteString -> ByteString -> Word32 -> InstanceRequirement
RequireInstanceExtension
          { $sel:instanceExtensionLayerName:RequireInstanceVersion :: Maybe ByteString
instanceExtensionLayerName  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"VK_LAYER_KHRONOS_validation"
          , $sel:instanceExtensionName:RequireInstanceVersion :: ByteString
instanceExtensionName       = ByteString
forall a. (Eq a, IsString a) => a
EXT_VALIDATION_FEATURES_EXTENSION_NAME
          , $sel:instanceExtensionMinVersion:RequireInstanceVersion :: Word32
instanceExtensionMinVersion = Word32
forall a. Bounded a => a
minBound
          }
        ]
  Instance
inst <- [InstanceRequirement]
-> [InstanceRequirement]
-> InstanceCreateInfo
     (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
-> m Instance
forall (m :: * -> *) (es :: [*]).
(MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) =>
[InstanceRequirement]
-> [InstanceRequirement] -> InstanceCreateInfo es -> m Instance
createInstanceFromRequirements
    ([InstanceRequirement]
forall l. (IsList l, Item l ~ InstanceRequirement) => l
additionalRequirements [InstanceRequirement]
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. Semigroup a => a -> a -> a
<> [InstanceRequirement] -> [InstanceRequirement]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [InstanceRequirement]
required)
    ([InstanceRequirement]
forall l. (IsList l, Item l ~ InstanceRequirement) => l
additionalOptionalRequirements [InstanceRequirement]
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. Semigroup a => a -> a -> a
<> [InstanceRequirement] -> [InstanceRequirement]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [InstanceRequirement]
optional)
    InstanceCreateInfo
  (DebugUtilsMessengerCreateInfoEXT : ValidationFeaturesEXT : es)
instanceCreateInfo
  (ReleaseKey, DebugUtilsMessengerEXT)
_ <- Instance
-> DebugUtilsMessengerCreateInfoEXT
-> Maybe AllocationCallbacks
-> (IO DebugUtilsMessengerEXT
    -> (DebugUtilsMessengerEXT -> IO ())
    -> m (ReleaseKey, DebugUtilsMessengerEXT))
-> m (ReleaseKey, DebugUtilsMessengerEXT)
forall (io :: * -> *) r.
MonadIO io =>
Instance
-> DebugUtilsMessengerCreateInfoEXT
-> Maybe AllocationCallbacks
-> (io DebugUtilsMessengerEXT
    -> (DebugUtilsMessengerEXT -> io ()) -> r)
-> r
withDebugUtilsMessengerEXT Instance
inst DebugUtilsMessengerCreateInfoEXT
debugMessengerCreateInfo Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO DebugUtilsMessengerEXT
-> (DebugUtilsMessengerEXT -> IO ())
-> m (ReleaseKey, DebugUtilsMessengerEXT)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
  Instance -> m Instance
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instance
inst

-- | Create an 'Instance from some requirements.
--
-- Will throw an 'IOError in the case of unsatisfied non-optional requirements.
-- Unsatisfied requirements will be listed on stderr.
createInstanceFromRequirements
  :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es)
  => [InstanceRequirement]
  -- ^ Required
  -> [InstanceRequirement]
  -- ^ Optional
  -> InstanceCreateInfo es
  -> m Instance
createInstanceFromRequirements :: [InstanceRequirement]
-> [InstanceRequirement] -> InstanceCreateInfo es -> m Instance
createInstanceFromRequirements [InstanceRequirement]
required [InstanceRequirement]
optional InstanceCreateInfo es
baseCreateInfo = do
  (Maybe (InstanceCreateInfo es)
mbICI, [RequirementResult]
rrs, [RequirementResult]
ors) <- [InstanceRequirement]
-> [InstanceRequirement]
-> InstanceCreateInfo es
-> m (Maybe (InstanceCreateInfo es), [RequirementResult],
      [RequirementResult])
forall (m :: * -> *) (o :: * -> *) (r :: * -> *) (es :: [*]).
(MonadIO m, Traversable r, Traversable o) =>
r InstanceRequirement
-> o InstanceRequirement
-> InstanceCreateInfo es
-> m (Maybe (InstanceCreateInfo es), r RequirementResult,
      o RequirementResult)
checkInstanceRequirements [InstanceRequirement]
required
                                                 [InstanceRequirement]
optional
                                                 InstanceCreateInfo es
baseCreateInfo
  (String -> m ()) -> Maybe String -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
sayErr ([RequirementResult] -> [RequirementResult] -> Maybe String
forall (r :: * -> *) (o :: * -> *).
(Foldable r, Foldable o) =>
r RequirementResult -> o RequirementResult -> Maybe String
requirementReport [RequirementResult]
rrs [RequirementResult]
ors)
  case Maybe (InstanceCreateInfo es)
mbICI of
    Maybe (InstanceCreateInfo es)
Nothing  -> IO Instance -> m Instance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Instance -> m Instance) -> IO Instance -> m Instance
forall a b. (a -> b) -> a -> b
$ String -> IO Instance
forall a. String -> IO a
unsatisfiedConstraints String
"Failed to create instance"
    Just InstanceCreateInfo es
ici -> (ReleaseKey, Instance) -> Instance
forall a b. (a, b) -> b
snd ((ReleaseKey, Instance) -> Instance)
-> m (ReleaseKey, Instance) -> m Instance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstanceCreateInfo es
-> Maybe AllocationCallbacks
-> (IO Instance -> (Instance -> IO ()) -> m (ReleaseKey, Instance))
-> m (ReleaseKey, Instance)
forall (a :: [*]) (io :: * -> *) r.
(Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) =>
InstanceCreateInfo a
-> Maybe AllocationCallbacks
-> (io Instance -> (Instance -> io ()) -> r)
-> r
withInstance InstanceCreateInfo es
ici Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO Instance -> (Instance -> IO ()) -> m (ReleaseKey, Instance)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate

----------------------------------------------------------------
-- * Device creation
----------------------------------------------------------------

-- | Create a 'Device' from some requirements.
--
-- Will throw an 'IOError in the case of unsatisfied non-optional requirements.
-- Unsatisfied requirements will be listed on stderr.
createDeviceFromRequirements
  :: forall m
   . MonadResource m
  => [DeviceRequirement]
  -- ^ Required
  -> [DeviceRequirement]
  -- ^ Optional
  -> PhysicalDevice
  -> DeviceCreateInfo '[]
  -> m Device
createDeviceFromRequirements :: [DeviceRequirement]
-> [DeviceRequirement]
-> PhysicalDevice
-> DeviceCreateInfo '[]
-> m Device
createDeviceFromRequirements [DeviceRequirement]
required [DeviceRequirement]
optional PhysicalDevice
phys DeviceCreateInfo '[]
baseCreateInfo = do
  (Maybe (SomeStruct DeviceCreateInfo)
mbDCI, [RequirementResult]
rrs, [RequirementResult]
ors) <- [DeviceRequirement]
-> [DeviceRequirement]
-> PhysicalDevice
-> DeviceCreateInfo '[]
-> m (Maybe (SomeStruct DeviceCreateInfo), [RequirementResult],
      [RequirementResult])
forall (m :: * -> *) (o :: * -> *) (r :: * -> *).
(MonadIO m, Traversable r, Traversable o) =>
r DeviceRequirement
-> o DeviceRequirement
-> PhysicalDevice
-> DeviceCreateInfo '[]
-> m (Maybe (SomeStruct DeviceCreateInfo), r RequirementResult,
      o RequirementResult)
checkDeviceRequirements [DeviceRequirement]
required
                                               [DeviceRequirement]
optional
                                               PhysicalDevice
phys
                                               DeviceCreateInfo '[]
baseCreateInfo
  (String -> m ()) -> Maybe String -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
sayErr ([RequirementResult] -> [RequirementResult] -> Maybe String
forall (r :: * -> *) (o :: * -> *).
(Foldable r, Foldable o) =>
r RequirementResult -> o RequirementResult -> Maybe String
requirementReport [RequirementResult]
rrs [RequirementResult]
ors)
  case Maybe (SomeStruct DeviceCreateInfo)
mbDCI of
    Maybe (SomeStruct DeviceCreateInfo)
Nothing -> IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ String -> IO Device
forall a. String -> IO a
unsatisfiedConstraints String
"Failed to create instance"
    Just (SomeStruct DeviceCreateInfo es
dci) -> (ReleaseKey, Device) -> Device
forall a b. (a, b) -> b
snd ((ReleaseKey, Device) -> Device)
-> m (ReleaseKey, Device) -> m Device
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PhysicalDevice
-> DeviceCreateInfo es
-> Maybe AllocationCallbacks
-> (IO Device -> (Device -> IO ()) -> m (ReleaseKey, Device))
-> m (ReleaseKey, Device)
forall (a :: [*]) (io :: * -> *) r.
(Extendss DeviceCreateInfo a, PokeChain a, MonadIO io) =>
PhysicalDevice
-> DeviceCreateInfo a
-> Maybe AllocationCallbacks
-> (io Device -> (Device -> io ()) -> r)
-> r
withDevice PhysicalDevice
phys DeviceCreateInfo es
dci Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO Device -> (Device -> IO ()) -> m (ReleaseKey, Device)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate

----------------------------------------------------------------
-- * Physical device selection
----------------------------------------------------------------

-- | Get a single 'PhysicalDevice' deciding with a scoring function
--
-- Pass a function which will extract any required values from a device in the
-- spirit of parse-don't-validate. Also provide a function to compare these
-- results for sorting multiple suitable devices.
--
-- As an example, the suitability function could return a tuple of device
-- memory and the compute queue family index, and the scoring function could be
-- 'fst' to select devices based on their memory capacity. Consider using
-- 'Vulkan.Utils.QueueAssignment.assignQueues' to find your desired queues in
-- the suitability function.
--
-- Pehaps also use the functionality in 'Vulkan.Utils.Requirements' and return
-- the 'DeviceCreateInfo' too.
--
-- If no devices are deemed suitable then a 'NoSuchThing' 'IOError' is thrown.
pickPhysicalDevice
  :: (MonadIO m, Ord b)
  => Instance
  -> (PhysicalDevice -> m (Maybe a))
  -- ^ A suitability funcion for a 'PhysicalDevice', 'Nothing' if it is not to
  -- be chosen.
  -> (a -> b)
  -- ^ Scoring function to rate this result
  -> m (Maybe (a, PhysicalDevice))
  -- ^ The score and the device
pickPhysicalDevice :: Instance
-> (PhysicalDevice -> m (Maybe a))
-> (a -> b)
-> m (Maybe (a, PhysicalDevice))
pickPhysicalDevice Instance
inst PhysicalDevice -> m (Maybe a)
devInfo a -> b
score = do
  (Result
_, "physicalDevices" ::: Vector PhysicalDevice
devs) <- Instance -> m (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (io :: * -> *).
MonadIO io =>
Instance
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
enumeratePhysicalDevices Instance
inst
  [(a, PhysicalDevice)]
infos     <- [Maybe (a, PhysicalDevice)] -> [(a, PhysicalDevice)]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe (a, PhysicalDevice)] -> [(a, PhysicalDevice)])
-> m [Maybe (a, PhysicalDevice)] -> m [(a, PhysicalDevice)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Maybe (a, PhysicalDevice))] -> m [Maybe (a, PhysicalDevice)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (a -> (a, PhysicalDevice)) -> Maybe a -> Maybe (a, PhysicalDevice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, PhysicalDevice
d) (Maybe a -> Maybe (a, PhysicalDevice))
-> m (Maybe a) -> m (Maybe (a, PhysicalDevice))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PhysicalDevice -> m (Maybe a)
devInfo PhysicalDevice
d | PhysicalDevice
d <- ("physicalDevices" ::: Vector PhysicalDevice) -> [PhysicalDevice]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList "physicalDevices" ::: Vector PhysicalDevice
devs ]
  Maybe (a, PhysicalDevice) -> m (Maybe (a, PhysicalDevice))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, PhysicalDevice) -> m (Maybe (a, PhysicalDevice)))
-> Maybe (a, PhysicalDevice) -> m (Maybe (a, PhysicalDevice))
forall a b. (a -> b) -> a -> b
$ ((a, PhysicalDevice) -> (a, PhysicalDevice) -> Ordering)
-> [(a, PhysicalDevice)] -> Maybe (a, PhysicalDevice)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> Maybe a
maximumByMay (((a, PhysicalDevice) -> b)
-> (a, PhysicalDevice) -> (a, PhysicalDevice) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a -> b
score (a -> b) -> ((a, PhysicalDevice) -> a) -> (a, PhysicalDevice) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, PhysicalDevice) -> a
forall a b. (a, b) -> a
fst)) [(a, PhysicalDevice)]
infos

-- | Extract the name of a 'PhysicalDevice' with 'getPhysicalDeviceProperties'
physicalDeviceName :: MonadIO m => PhysicalDevice -> m Text
physicalDeviceName :: PhysicalDevice -> m Text
physicalDeviceName =
  (PhysicalDeviceProperties -> Text)
-> m PhysicalDeviceProperties -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (PhysicalDeviceProperties -> ByteString)
-> PhysicalDeviceProperties
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalDeviceProperties -> ByteString
deviceName) (m PhysicalDeviceProperties -> m Text)
-> (PhysicalDevice -> m PhysicalDeviceProperties)
-> PhysicalDevice
-> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalDevice -> m PhysicalDeviceProperties
forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> io PhysicalDeviceProperties
getPhysicalDeviceProperties


----------------------------------------------------------------
-- Utils
----------------------------------------------------------------

maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a
maximumByMay :: (a -> a -> Ordering) -> t a -> Maybe a
maximumByMay a -> a -> Ordering
f t a
xs = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> Ordering) -> t a -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy a -> a -> Ordering
f t a
xs)