{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE KindSignatures #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.ImageView.Type where

import GHC.TypeLits

import Gpu.Vulkan.TypeEnum as T
import Gpu.Vulkan.ImageView.Middle qualified as M

newtype I (nm :: Symbol) (fmt :: T.Format) si = I M.I deriving Int -> I nm fmt si -> ShowS
[I nm fmt si] -> ShowS
I nm fmt si -> String
(Int -> I nm fmt si -> ShowS)
-> (I nm fmt si -> String)
-> ([I nm fmt si] -> ShowS)
-> Show (I nm fmt si)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (nm :: Symbol) (fmt :: Format) si.
Int -> I nm fmt si -> ShowS
forall (nm :: Symbol) (fmt :: Format) si. [I nm fmt si] -> ShowS
forall (nm :: Symbol) (fmt :: Format) si. I nm fmt si -> String
$cshowsPrec :: forall (nm :: Symbol) (fmt :: Format) si.
Int -> I nm fmt si -> ShowS
showsPrec :: Int -> I nm fmt si -> ShowS
$cshow :: forall (nm :: Symbol) (fmt :: Format) si. I nm fmt si -> String
show :: I nm fmt si -> String
$cshowList :: forall (nm :: Symbol) (fmt :: Format) si. [I nm fmt si] -> ShowS
showList :: [I nm fmt si] -> ShowS
Show