module Data.SpirV.Enum.Dim 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 Dim = Dim Word32
  deriving (Dim -> Dim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dim -> Dim -> Bool
$c/= :: Dim -> Dim -> Bool
== :: Dim -> Dim -> Bool
$c== :: Dim -> Dim -> Bool
Eq, Eq Dim
Dim -> Dim -> Bool
Dim -> Dim -> Ordering
Dim -> Dim -> Dim
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 :: Dim -> Dim -> Dim
$cmin :: Dim -> Dim -> Dim
max :: Dim -> Dim -> Dim
$cmax :: Dim -> Dim -> Dim
>= :: Dim -> Dim -> Bool
$c>= :: Dim -> Dim -> Bool
> :: Dim -> Dim -> Bool
$c> :: Dim -> Dim -> Bool
<= :: Dim -> Dim -> Bool
$c<= :: Dim -> Dim -> Bool
< :: Dim -> Dim -> Bool
$c< :: Dim -> Dim -> Bool
compare :: Dim -> Dim -> Ordering
$ccompare :: Dim -> Dim -> Ordering
Ord, Ptr Dim -> IO Dim
Ptr Dim -> Int -> IO Dim
Ptr Dim -> Int -> Dim -> IO ()
Ptr Dim -> Dim -> IO ()
Dim -> Int
forall b. Ptr b -> Int -> IO Dim
forall b. Ptr b -> Int -> Dim -> 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 Dim -> Dim -> IO ()
$cpoke :: Ptr Dim -> Dim -> IO ()
peek :: Ptr Dim -> IO Dim
$cpeek :: Ptr Dim -> IO Dim
pokeByteOff :: forall b. Ptr b -> Int -> Dim -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Dim -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Dim
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Dim
pokeElemOff :: Ptr Dim -> Int -> Dim -> IO ()
$cpokeElemOff :: Ptr Dim -> Int -> Dim -> IO ()
peekElemOff :: Ptr Dim -> Int -> IO Dim
$cpeekElemOff :: Ptr Dim -> Int -> IO Dim
alignment :: Dim -> Int
$calignment :: Dim -> Int
sizeOf :: Dim -> Int
$csizeOf :: Dim -> Int
Storable)

pattern Dim1D :: Dim
pattern $bDim1D :: Dim
$mDim1D :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Dim1D = Dim 0

pattern Dim2D :: Dim
pattern $bDim2D :: Dim
$mDim2D :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Dim2D = Dim 1

pattern Dim3D :: Dim
pattern $bDim3D :: Dim
$mDim3D :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Dim3D = Dim 2

pattern Cube :: Dim
pattern $bCube :: Dim
$mCube :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Cube = Dim 3

pattern Rect :: Dim
pattern $bRect :: Dim
$mRect :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Rect = Dim 4

pattern Buffer :: Dim
pattern $bBuffer :: Dim
$mBuffer :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
Buffer = Dim 5

pattern SubpassData :: Dim
pattern $bSubpassData :: Dim
$mSubpassData :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
SubpassData = Dim 6

toName :: IsString a => Dim -> a
toName :: forall a. IsString a => Dim -> a
toName Dim
x = case Dim
x of
  Dim
Dim1D -> a
"Dim1D"
  Dim
Dim2D -> a
"Dim2D"
  Dim
Dim3D -> a
"Dim3D"
  Dim
Cube -> a
"Cube"
  Dim
Rect -> a
"Rect"
  Dim
Buffer -> a
"Buffer"
  Dim
SubpassData -> a
"SubpassData"
  Dim
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"Dim " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Dim
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe Dim
fromName :: forall a. (IsString a, Eq a) => a -> Maybe Dim
fromName a
x = case a
x of
  a
"Dim1D" -> forall a. a -> Maybe a
Just Dim
Dim1D
  a
"Dim2D" -> forall a. a -> Maybe a
Just Dim
Dim2D
  a
"Dim3D" -> forall a. a -> Maybe a
Just Dim
Dim3D
  a
"Cube" -> forall a. a -> Maybe a
Just Dim
Cube
  a
"Rect" -> forall a. a -> Maybe a
Just Dim
Rect
  a
"Buffer" -> forall a. a -> Maybe a
Just Dim
Buffer
  a
"SubpassData" -> forall a. a -> Maybe a
Just Dim
SubpassData
  a
_unknown -> forall a. Maybe a
Nothing

instance Read Dim where
  readPrec :: ReadPrec Dim
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 Dim
fromName [Char]
s