-- |
-- Module      : WGPU.Internal.SMaybe
-- Description : Strict maybe.
module WGPU.Internal.SMaybe
  ( -- * Types
    SMaybe (SNothing, SJust),

    -- * Functions
    fromSMaybe,
  )
where

-- | Strict version of the 'Maybe' type.
data SMaybe a
  = SNothing
  | SJust !a
  deriving (SMaybe a -> SMaybe a -> Bool
(SMaybe a -> SMaybe a -> Bool)
-> (SMaybe a -> SMaybe a -> Bool) -> Eq (SMaybe a)
forall a. Eq a => SMaybe a -> SMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMaybe a -> SMaybe a -> Bool
$c/= :: forall a. Eq a => SMaybe a -> SMaybe a -> Bool
== :: SMaybe a -> SMaybe a -> Bool
$c== :: forall a. Eq a => SMaybe a -> SMaybe a -> Bool
Eq, Int -> SMaybe a -> ShowS
[SMaybe a] -> ShowS
SMaybe a -> String
(Int -> SMaybe a -> ShowS)
-> (SMaybe a -> String) -> ([SMaybe a] -> ShowS) -> Show (SMaybe a)
forall a. Show a => Int -> SMaybe a -> ShowS
forall a. Show a => [SMaybe a] -> ShowS
forall a. Show a => SMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMaybe a] -> ShowS
$cshowList :: forall a. Show a => [SMaybe a] -> ShowS
show :: SMaybe a -> String
$cshow :: forall a. Show a => SMaybe a -> String
showsPrec :: Int -> SMaybe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SMaybe a -> ShowS
Show)

-- | Return a value from an 'SMaybe' with a default.
--
-- This function returns the 'SJust' value from an 'SMaybe', or the default
-- value if the 'SMaybe' is 'SNothing'.
fromSMaybe ::
  -- | Default value.
  a ->
  -- | 'SMaybe' from which to return the 'SJust' value if possible.
  SMaybe a ->
  -- | 'SJust' value, if present, or the default value, if not.
  a
fromSMaybe :: a -> SMaybe a -> a
fromSMaybe a
defaultValue SMaybe a
sMaybe =
  case SMaybe a
sMaybe of
    SMaybe a
SNothing -> a
defaultValue
    SJust a
providedValue -> a
providedValue