module Data.SpirV.Enum.FPRoundingMode where

import Data.String (IsString(..))
import Data.Word (Word32)
import Foreign (Storable(..))
import GHC.Read (Read(..))
import Text.ParserCombinators.ReadPrec (pfail)
import qualified GHC.Read as Read
import qualified Text.Read.Lex as Lex

newtype FPRoundingMode = FPRoundingMode Word32
  deriving (FPRoundingMode -> FPRoundingMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FPRoundingMode -> FPRoundingMode -> Bool
$c/= :: FPRoundingMode -> FPRoundingMode -> Bool
== :: FPRoundingMode -> FPRoundingMode -> Bool
$c== :: FPRoundingMode -> FPRoundingMode -> Bool
Eq, Eq FPRoundingMode
FPRoundingMode -> FPRoundingMode -> Bool
FPRoundingMode -> FPRoundingMode -> Ordering
FPRoundingMode -> FPRoundingMode -> FPRoundingMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FPRoundingMode -> FPRoundingMode -> FPRoundingMode
$cmin :: FPRoundingMode -> FPRoundingMode -> FPRoundingMode
max :: FPRoundingMode -> FPRoundingMode -> FPRoundingMode
$cmax :: FPRoundingMode -> FPRoundingMode -> FPRoundingMode
>= :: FPRoundingMode -> FPRoundingMode -> Bool
$c>= :: FPRoundingMode -> FPRoundingMode -> Bool
> :: FPRoundingMode -> FPRoundingMode -> Bool
$c> :: FPRoundingMode -> FPRoundingMode -> Bool
<= :: FPRoundingMode -> FPRoundingMode -> Bool
$c<= :: FPRoundingMode -> FPRoundingMode -> Bool
< :: FPRoundingMode -> FPRoundingMode -> Bool
$c< :: FPRoundingMode -> FPRoundingMode -> Bool
compare :: FPRoundingMode -> FPRoundingMode -> Ordering
$ccompare :: FPRoundingMode -> FPRoundingMode -> Ordering
Ord, Ptr FPRoundingMode -> IO FPRoundingMode
Ptr FPRoundingMode -> Int -> IO FPRoundingMode
Ptr FPRoundingMode -> Int -> FPRoundingMode -> IO ()
Ptr FPRoundingMode -> FPRoundingMode -> IO ()
FPRoundingMode -> Int
forall b. Ptr b -> Int -> IO FPRoundingMode
forall b. Ptr b -> Int -> FPRoundingMode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr FPRoundingMode -> FPRoundingMode -> IO ()
$cpoke :: Ptr FPRoundingMode -> FPRoundingMode -> IO ()
peek :: Ptr FPRoundingMode -> IO FPRoundingMode
$cpeek :: Ptr FPRoundingMode -> IO FPRoundingMode
pokeByteOff :: forall b. Ptr b -> Int -> FPRoundingMode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> FPRoundingMode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO FPRoundingMode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FPRoundingMode
pokeElemOff :: Ptr FPRoundingMode -> Int -> FPRoundingMode -> IO ()
$cpokeElemOff :: Ptr FPRoundingMode -> Int -> FPRoundingMode -> IO ()
peekElemOff :: Ptr FPRoundingMode -> Int -> IO FPRoundingMode
$cpeekElemOff :: Ptr FPRoundingMode -> Int -> IO FPRoundingMode
alignment :: FPRoundingMode -> Int
$calignment :: FPRoundingMode -> Int
sizeOf :: FPRoundingMode -> Int
$csizeOf :: FPRoundingMode -> Int
Storable)

pattern RTE :: FPRoundingMode
pattern $bRTE :: FPRoundingMode
$mRTE :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
RTE = FPRoundingMode 0

pattern RTZ :: FPRoundingMode
pattern $bRTZ :: FPRoundingMode
$mRTZ :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
RTZ = FPRoundingMode 1

pattern RTP :: FPRoundingMode
pattern $bRTP :: FPRoundingMode
$mRTP :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
RTP = FPRoundingMode 2

pattern RTN :: FPRoundingMode
pattern $bRTN :: FPRoundingMode
$mRTN :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
RTN = FPRoundingMode 3

toName :: IsString a => FPRoundingMode -> a
toName :: forall a. IsString a => FPRoundingMode -> a
toName FPRoundingMode
x = case FPRoundingMode
x of
  FPRoundingMode
RTE -> a
"RTE"
  FPRoundingMode
RTZ -> a
"RTZ"
  FPRoundingMode
RTP -> a
"RTP"
  FPRoundingMode
RTN -> a
"RTN"
  FPRoundingMode
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"FPRoundingMode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FPRoundingMode
unknown

instance Show FPRoundingMode where
  show :: FPRoundingMode -> [Char]
show = forall a. IsString a => FPRoundingMode -> a
toName

fromName :: (IsString a, Eq a) => a -> Maybe FPRoundingMode
fromName :: forall a. (IsString a, Eq a) => a -> Maybe FPRoundingMode
fromName a
x = case a
x of
  a
"RTE" -> forall a. a -> Maybe a
Just FPRoundingMode
RTE
  a
"RTZ" -> forall a. a -> Maybe a
Just FPRoundingMode
RTZ
  a
"RTP" -> forall a. a -> Maybe a
Just FPRoundingMode
RTP
  a
"RTN" -> forall a. a -> Maybe a
Just FPRoundingMode
RTN
  a
_unknown -> forall a. Maybe a
Nothing

instance Read FPRoundingMode where
  readPrec :: ReadPrec FPRoundingMode
readPrec = forall a. ReadPrec a -> ReadPrec a
Read.parens do
    Lex.Ident [Char]
s <- ReadPrec Lexeme
Read.lexP
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (IsString a, Eq a) => a -> Maybe FPRoundingMode
fromName [Char]
s