{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.SpirV.Enum.Dim where

import Data.Word (Word32)
import Foreign.Storable (Storable)

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

instance Show Dim where
  showsPrec :: Int -> Dim -> ShowS
showsPrec Int
p (Dim Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"Dim1D"
    Word32
1 -> String -> ShowS
showString String
"Dim2D"
    Word32
2 -> String -> ShowS
showString String
"Dim3D"
    Word32
3 -> String -> ShowS
showString String
"Cube"
    Word32
4 -> String -> ShowS
showString String
"Rect"
    Word32
5 -> String -> ShowS
showString String
"Buffer"
    Word32
6 -> String -> ShowS
showString String
"SubpassData"
    Word32
4173 -> String -> ShowS
showString String
"TileImageDataEXT"
    Word32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Dim " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
x

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

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

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

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

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

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

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

pattern TileImageDataEXT :: Dim
pattern $mTileImageDataEXT :: forall {r}. Dim -> ((# #) -> r) -> ((# #) -> r) -> r
$bTileImageDataEXT :: Dim
TileImageDataEXT = Dim 4173