content: module LambdaCube.Language.Type where
  
  import GHC.TypeLits
  
  import Data.ByteString.Char8
  import Data.Int
  import Data.Word
  import Data.Typeable
  
  import qualified LambdaCube.Core.Type as U
  import LambdaCube.Core.Type hiding (FetchPrimitive, OutputPrimitive, Blending, RasterContext, Blend, TriangleCtx, Image, FragmentOperation, MipMap, TextureDataType, TextureType)
  import LambdaCube.Language.ReifyType hiding (Shadow)
  import qualified LambdaCube.Language.ReifyType as T
  
  data NatNum :: Nat -> * where
      N0 :: NatNum 0
      N1 :: NatNum 1
      N2 :: NatNum 2
      N3 :: NatNum 3
      N4 :: NatNum 4
      N5 :: NatNum 5
      N6 :: NatNum 6
      N7 :: NatNum 7
      N8 :: NatNum 8
      N9 :: NatNum 9
  
  deriving instance Typeable NatNum
  
  n0 = N0
  n1 = N1
  n2 = N2
  n3 = N3
  n4 = N4
  n5 = N5
  n6 = N6
  n7 = N7
  n8 = N8
  n9 = N9
  
  -- user can define stream input using InputTuple type class
  class InputTuple tup where
      type InputTupleRepr tup
      toInputList :: tup -> [(ByteString,InputType)]
  
  instance InputTuple (Input a) where
      type InputTupleRepr (Input a) = a
      toInputList a = [toInput a]
  
  instance InputTuple (Input a, Input b) where
      type InputTupleRepr (Input a, Input b) = (a, b)
      toInputList (a, b) = [toInput a, toInput b]
  
  instance InputTuple (Input a, Input b, Input c) where
      type InputTupleRepr (Input a, Input b, Input c) = (a, b, c)
      toInputList (a, b, c) = [toInput a, toInput b, toInput c]
  
  instance InputTuple (Input a, Input b, Input c, Input d) where
      type InputTupleRepr (Input a, Input b, Input c, Input d) = (a, b, c, d)
      toInputList (a, b, c, d) = [toInput a, toInput b, toInput c, toInput d]
  
  instance InputTuple (Input a, Input b, Input c, Input d, Input e) where
      type InputTupleRepr (Input a, Input b, Input c, Input d, Input e) = (a, b, c, d, e)
      toInputList (a, b, c, d, e) = [toInput a, toInput b, toInput c, toInput d, toInput e]
  
  instance InputTuple (Input a, Input b, Input c, Input d, Input e, Input f) where
      type InputTupleRepr (Input a, Input b, Input c, Input d, Input e, Input f) = (a, b, c, d, e, f)
      toInputList (a, b, c, d, e, f) = [toInput a, toInput b, toInput c, toInput d, toInput e, toInput f]
  
  instance InputTuple (Input a, Input b, Input c, Input d, Input e, Input f, Input g) where
      type InputTupleRepr (Input a, Input b, Input c, Input d, Input e, Input f, Input g) = (a, b, c, d, e, f, g)
      toInputList (a, b, c, d, e, f, g) = [toInput a, toInput b, toInput c, toInput d, toInput e, toInput f, toInput g]
  
  instance InputTuple (Input a, Input b, Input c, Input d, Input e, Input f, Input g, Input h) where
      type InputTupleRepr (Input a, Input b, Input c, Input d, Input e, Input f, Input g, Input h) = (a, b, c, d, e, f, g, h)
      toInputList (a, b, c, d, e, f, g, h) = [toInput a, toInput b, toInput c, toInput d, toInput e, toInput f, toInput g, toInput h]
  
  instance InputTuple (Input a, Input b, Input c, Input d, Input e, Input f, Input g, Input h, Input i) where
      type InputTupleRepr (Input a, Input b, Input c, Input d, Input e, Input f, Input g, Input h, Input i) = (a, b, c, d, e, f, g, h, i)
      toInputList (a, b, c, d, e, f, g, h, i) = [toInput a, toInput b, toInput c, toInput d, toInput e, toInput f, toInput g, toInput h, toInput i]
  
  -- we should define all of input types
  -- supported stream input types (the ByteString argument is the input slot name)
  data Input a where
      IBool   :: ByteString -> Input Bool
      IV2B    :: ByteString -> Input V2B
      IV3B    :: ByteString -> Input V3B
      IV4B    :: ByteString -> Input V4B
      IWord   :: ByteString -> Input Word32
      IV2U    :: ByteString -> Input V2U
      IV3U    :: ByteString -> Input V3U
      IV4U    :: ByteString -> Input V4U
      IInt    :: ByteString -> Input Int32
      IV2I    :: ByteString -> Input V2I
      IV3I    :: ByteString -> Input V3I
      IV4I    :: ByteString -> Input V4I
      IFloat  :: ByteString -> Input Float
      IV2F    :: ByteString -> Input V2F
      IV3F    :: ByteString -> Input V3F
      IV4F    :: ByteString -> Input V4F
      IM22F   :: ByteString -> Input M22F
      IM23F   :: ByteString -> Input M23F
      IM24F   :: ByteString -> Input M24F
      IM32F   :: ByteString -> Input M32F
      IM33F   :: ByteString -> Input M33F
      IM34F   :: ByteString -> Input M34F
      IM42F   :: ByteString -> Input M42F
      IM43F   :: ByteString -> Input M43F
      IM44F   :: ByteString -> Input M44F
  
  toInput :: Input a -> (ByteString,InputType)
  toInput (IBool  n) = (n, U.Bool)
  toInput (IV2B   n) = (n, U.V2B)
  toInput (IV3B   n) = (n, U.V3B)
  toInput (IV4B   n) = (n, U.V4B)
  toInput (IWord  n) = (n, U.Word)
  toInput (IV2U   n) = (n, U.V2U)
  toInput (IV3U   n) = (n, U.V3U)
  toInput (IV4U   n) = (n, U.V4U)
  toInput (IInt   n) = (n, U.Int)
  toInput (IV2I   n) = (n, U.V2I)
  toInput (IV3I   n) = (n, U.V3I)
  toInput (IV4I   n) = (n, U.V4I)
  toInput (IFloat n) = (n, U.Float)
  toInput (IV2F   n) = (n, U.V2F)
  toInput (IV3F   n) = (n, U.V3F)
  toInput (IV4F   n) = (n, U.V4F)
  toInput (IM22F  n) = (n, U.M22F)
  toInput (IM23F  n) = (n, U.M23F)
  toInput (IM24F  n) = (n, U.M24F)
  toInput (IM32F  n) = (n, U.M32F)
  toInput (IM33F  n) = (n, U.M33F)
  toInput (IM34F  n) = (n, U.M34F)
  toInput (IM42F  n) = (n, U.M42F)
  toInput (IM43F  n) = (n, U.M43F)
  toInput (IM44F  n) = (n, U.M44F)
  
  -- primitive types
  data PrimitiveType
      = Triangle
      | Line
      | Point
      | TriangleAdjacency
      | LineAdjacency
  
  data FetchPrimitive :: PrimitiveType -> * where
      Points                  :: FetchPrimitive Point
      Lines                   :: FetchPrimitive Line
      Triangles               :: FetchPrimitive Triangle
      LinesAdjacency          :: FetchPrimitive LineAdjacency
      TrianglesAdjacency      :: FetchPrimitive TriangleAdjacency
  
  data OutputPrimitive :: PrimitiveType -> * where
      TrianglesOutput :: OutputPrimitive Triangle
      LinesOutput     :: OutputPrimitive Line
      PointsOutput    :: OutputPrimitive Point
  
  data Blending c where
      NoBlending      :: Blending c
  
      BlendLogicOp    :: IsIntegral c
                      => LogicOperation
                      -> Blending c
  
      -- FIXME: restrict BlendingFactor at some BlendEquation
      Blend           :: (BlendEquation, BlendEquation) 
                      -> ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor))
                      -> V4F
                      -> Blending Float
  
  blend = Blend (FuncAdd,FuncAdd) ((SrcAlpha,OneMinusSrcAlpha),(SrcAlpha,OneMinusSrcAlpha)) (V4 1 1 1 1)
  
  -- abstract types, used in language AST
  data VertexStream (primitive :: PrimitiveType) t
  data PrimitiveStream (primitive :: PrimitiveType) clipDistances (layerCount :: Nat) (freq :: Frequency) t
  data FragmentStream (layerCount :: Nat) t
  
  
  -- flat tuple, another internal tuple representation
  
  -- means unit
  data ZZ = ZZ deriving (Show,Typeable)
  
  -- used for tuple type description
  infixr 1 :+:
  data tail :+: head = !tail :+: !head deriving (Show,Typeable)
  
  -- used for tuple value description
  infixr 1 :.
  data FlatTuple c a t where
      ZT      :: FlatTuple c a ZZ
  
      (:.)    :: c t
              => a t
              -> FlatTuple c a t'
              -> FlatTuple c a (t :+: t')
  
  class IsFloatTuple a
  instance IsFloatTuple ZZ
  instance IsFloatTuple l => IsFloatTuple (Float :+: l)
  
  -- vertex attribute interpolation
  data Interpolated e a where
      Flat            :: e a -> Interpolated e a
  
      Smooth          :: IsFloating a
                      => e a -> Interpolated e a
  
      NoPerspective   :: IsFloating a
                      => e a -> Interpolated e a
  
  -- framebuffer data / fragment output semantic
  data Color a
  data Depth a
  data Stencil a
  
  -- describe geometry shader input 
  type family PrimitiveVertices (primitive :: PrimitiveType) a
  type instance PrimitiveVertices Point a             = a
  type instance PrimitiveVertices Line a              = (a,a)
  type instance PrimitiveVertices LineAdjacency a     = (a,a,a,a)
  type instance PrimitiveVertices Triangle a          = (a,a,a)
  type instance PrimitiveVertices TriangleAdjacency a = (a,a,a,a,a,a)
  
  -- raster context description
  data RasterContext t where
      PointCtx    ::
          { ctxPointSize          :: PointSize
          , ctxFadeThresholdSize  :: Float
          , ctxSpriteCoordOrigin  :: PointSpriteCoordOrigin
          } -> RasterContext Point
  
      LineCtx     :: 
          { ctxLineWidth          :: Float
          , ctxProvokingVertex'   :: ProvokingVertex
          } -> RasterContext Line
  
      TriangleCtx ::
          { ctxCullMode           :: CullMode
          , ctxPolygonMode        :: PolygonMode
          , ctxPolygonOffset      :: PolygonOffset
          , ctxProvokingVertex    :: ProvokingVertex
          } -> RasterContext Triangle
  
  -- default triangle raster context
  triangleCtx :: RasterContext Triangle
  triangleCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
  
  class NoConstraint a
  instance NoConstraint a
  
  type FrameBuffer layerCount t = FlatTuple NoConstraint (Image layerCount) t
  
  -- Fragment Operation
  data FragmentOperation ty where
      DepthOp         :: DepthFunction
                      -> Bool     -- depth write
                      -> FragmentOperation (Depth Float)
  
      StencilOp       :: StencilTests
                      -> StencilOps
                      -> StencilOps
                      -> FragmentOperation (Stencil Int32)
  
      ColorOp         :: (IsVecScalar d mask Bool, IsVecScalar d color c, IsNum c, IsScalar mask)
                      => Blending c   -- blending type
                      -> mask         -- write mask
                      -> FragmentOperation (Color color)
  
  -- specifies an empty image (pixel rectangle)
  -- hint: framebuffer is composed from images
  data Image (layerCount :: Nat) t where
      DepthImage      :: KnownNat layerCount
                      => NatNum layerCount
                      -> Float    -- initial value
                      -> Image layerCount (Depth Float)
  
      StencilImage    :: KnownNat layerCount
                      => NatNum layerCount
                      -> Int32    -- initial value
                      -> Image layerCount (Stencil Int32)
  
      ColorImage      :: (IsNum t, IsVecScalar d color t, IsScalar color, KnownNat layerCount)
                      => NatNum layerCount
                      -> color    -- initial value
                      -> Image layerCount (Color color)
      
      UnclearedImage  :: (IsNum t, IsVecScalar d color t, IsScalar color, KnownNat layerCount)
                      => NatNum layerCount
                      -> Image layerCount (Color color)
      
  
  
  -- restriction for framebuffer structure according content semantic
  -- supported configurations: optional stencil + optional depth + [zero or more color]
  class IsColorOutput a
  instance IsColorOutput ZZ
  instance (IsColorOutput b) => IsColorOutput (Color c :+: b)
  
  class IsValidOutput a
  instance (IsColorOutput a) => IsValidOutput (Color c :+: a)
  instance (IsColorOutput a) => IsValidOutput (Depth d :+: a)
  instance (IsColorOutput a) => IsValidOutput (Stencil s :+: a)
  instance (IsColorOutput a) => IsValidOutput (Stencil s :+: Depth d :+: a)
  
  -- helper class (type level function), used in language AST
  -- converts FlatTuple type to ordinary tuple type
  type family FTRepr a :: *
  type instance FTRepr ZZ = ()
  type instance FTRepr (a :+: ZZ) = a
  type instance FTRepr (a :+: b :+: ZZ) = (a, b)
  type instance FTRepr (a :+: b :+: c :+: ZZ) = (a, b, c)
  type instance FTRepr (a :+: b :+: c :+: d :+: ZZ) = (a, b, c, d)
  type instance FTRepr (a :+: b :+: c :+: d :+: e :+: ZZ) = (a, b, c, d, e)
  type instance FTRepr (a :+: b :+: c :+: d :+: e :+: f :+: ZZ) = (a, b, c, d, e, f)
  type instance FTRepr (a :+: b :+: c :+: d :+: e :+: f :+: g :+: ZZ) = (a, b, c, d, e, f, g)
  type instance FTRepr (a :+: b :+: c :+: d :+: e :+: f :+: g :+: h :+: ZZ) = (a, b, c, d, e, f, g, h)
  type instance FTRepr (a :+: b :+: c :+: d :+: e :+: f :+: g :+: h :+: i :+: ZZ) = (a, b, c, d, e, f, g, h, i)
  
  -- helper type level function, used in language AST
  type family FTRepr' a :: *
  type instance FTRepr' (i1 a :+: ZZ) = a
  type instance FTRepr' (i1 a :+: i2 b :+: ZZ) = (a, b)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: ZZ) = (a, b, c)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: ZZ) = (a, b, c, d)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: i5 e :+: ZZ) = (a, b, c, d, e)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: i5 e :+: i6 f :+: ZZ) = (a, b, c, d, e, f)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: i5 e :+: i6 f :+: i7 g :+: ZZ) = (a, b, c, d, e, f, g)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: i5 e :+: i6 f :+: i7 g :+: i8 h :+: ZZ) = (a, b, c, d, e, f, g, h)
  type instance FTRepr' (i1 a :+: i2 b :+: i3 c :+: i4 d :+: i5 e :+: i6 f :+: i7 g :+: i8 h :+: i9 i :+: ZZ) = (a, b, c, d, e, f, g, h ,i)
  
  -- helper type level function, used in language AST
  type family ColorRepr a :: *
  type instance ColorRepr ZZ = ZZ
  type instance ColorRepr (a :+: b) = Color a :+: (ColorRepr b)
  
  -- helper type level function, used in language AST
  type family NoStencilRepr a :: *
  type instance NoStencilRepr ZZ = ZZ
  type instance NoStencilRepr (Stencil a :+: b) = NoStencilRepr b
  type instance NoStencilRepr (Color a :+: b) = Color a :+: (NoStencilRepr b)
  type instance NoStencilRepr (Depth a :+: b) = Depth a :+: (NoStencilRepr b)
  
  -- sampler and texture specification
  data TextureMipMap
      = TexMip
      | TexNoMip
  
  deriving instance Typeable TexMip
  deriving instance Typeable TexNoMip
  
  deriving instance Typeable MipMap
  
  
  data MipMap (t :: TextureMipMap) where
      NoMip   :: MipMap TexNoMip
  
      Mip     :: Int  -- base level
              -> Int  -- max level
              -> MipMap TexMip
  
      AutoMip :: Int  -- base level
              -> Int  -- max level
              -> MipMap TexMip
  
  -- helper type level function, used in language AST
  type family TexDataRepr arity (t :: TextureSemantics *)
  type instance TexDataRepr Red  (v a) = a
  type instance TexDataRepr RG   (v a) = V2 a
  type instance TexDataRepr RGB  (v a) = V3 a
  type instance TexDataRepr RGBA (v a) = V4 a
  
  -- describes texel (texture component) type
  data TextureDataType (kind :: TextureSemantics *) arity where
      Float   :: IsColorArity a
              => a
              -> TextureDataType (Regular Float) a
  
      Int     :: IsColorArity a
              => a
              -> TextureDataType (Regular Int) a
  
      Word    :: IsColorArity a
              => a
              -> TextureDataType (Regular Word) a
  
      Shadow  :: TextureDataType (T.Shadow Float) Red   -- TODO: add params required by shadow textures
  
  
  -- helper type level function for texture specification
  -- tells whether a texture is a single or an array texture
  type family TexArrRepr (a :: Nat) :: TextureArray
  {-
  type instance TexArrRepr 1 = SingleTex
  type instance TexArrRepr ((2 <= t) => t) = ArrayTex
  -}
  -- FIXME: implement properly
  type instance TexArrRepr 1 = SingleTex
  type instance TexArrRepr 2 = ArrayTex
  type instance TexArrRepr 3 = ArrayTex
  type instance TexArrRepr 4 = ArrayTex
  type instance TexArrRepr 5 = ArrayTex
  type instance TexArrRepr 6 = ArrayTex
  type instance TexArrRepr 7 = ArrayTex
  type instance TexArrRepr 8 = ArrayTex
  type instance TexArrRepr 9 = ArrayTex
  
  -- supported texture component arities
  class IsColorArity a where
      toColorArity :: a -> U.ColorArity
  
  instance IsColorArity Red where
      toColorArity _  = U.Red
  instance IsColorArity RG where
      toColorArity _  = U.RG
  instance IsColorArity RGB where
      toColorArity _  = U.RGB
  instance IsColorArity RGBA where
      toColorArity _  = U.RGBA
  
  -- component arity specification (Red,RG,RGB,RGBA)
  --          hint: there is an interference with Shadow component format
  --                  alternatives:
  --                      A: move Shadow from TextureDataType to TextureType, this will introduce some new TextureType constructors (1D,2D,Cube,Rect)
  --                      B: restrict ColorArity for Shadow
  --                      C: add color arity definition to TextureDataType, this will solve the problem (best solution)
  
  -- fully describes a texture type
  data TextureType :: TextureShape -> TextureMipMap -> TextureArray -> Nat -> TextureSemantics * -> * -> * where -- hint: arr - single or array texture, ar - arity (Red,RG,RGB,..)
      Texture1D       :: KnownNat layerCount
                      => TextureDataType t ar
                      -> NatNum layerCount
                      -> TextureType Tex1D TexMip (TexArrRepr layerCount) layerCount t ar
  
      Texture2D       :: KnownNat layerCount
                      => TextureDataType t ar
                      -> NatNum layerCount
                      -> TextureType Tex2D TexMip (TexArrRepr layerCount) layerCount t ar
  
      Texture3D       :: TextureDataType (Regular t) ar
                      -> TextureType Tex3D TexMip SingleTex 1 (Regular t) ar
  
      TextureCube     :: TextureDataType t ar
                      -> TextureType Tex2D TexMip CubeTex 6 t ar
  
      TextureRect     :: TextureDataType t ar
                      -> TextureType TexRect TexNoMip SingleTex 1 t ar
  
      Texture2DMS     :: KnownNat layerCount
                      => TextureDataType (Regular t) ar
                      -> NatNum layerCount
                      -> TextureType Tex2D TexNoMip (TexArrRepr layerCount) layerCount (MultiSample t) ar
  
      TextureBuffer   :: TextureDataType (Regular t) ar
                      -> TextureType Tex1D TexNoMip SingleTex 1 (Buffer t) ar
  
  
  -- defines a texture
  data Texture (dim :: TextureShape) (arr :: TextureArray) (t :: TextureSemantics *) ar
  {-
  data Texture (gp :: * -> *) (dim :: TextureShape) (arr :: TextureArray) (t :: TextureSemantics *) ar where
      TextureSlot     :: (IsValidTextureSlot t)
                      => ByteString -- texture slot name
                      -> TextureType dim mip arr layerCount t ar
                      -> Texture gp dim arr t ar
      -- TODO:
      --  add texture internal format specification
      Texture         :: (IsScalar (TexSizeRepr dim), IsMipValid canMip mip, Typeable (TexDataRepr ar t), Typeable (TextureType dim canMip arr layerCount t ar), Typeable (Image layerCount (TexDataRepr ar t)))
                      => TextureType dim canMip arr layerCount t ar
                      -> TexSizeRepr dim
                      -> MipMap mip
  --                    -> TexRepr dim mip gp layerCount (TexDataRepr ar t) -- FIXME: for cube it will give wrong type
                      -> [gp (Image layerCount (TexDataRepr ar t))]
                      -> Texture gp dim arr t ar
  -}
  {-
      -- TODO:
      --  swizzling (arity conversion)
      --  integral -> floating casting (floating -> integral casting if possible)
      ConvertTexture  :: Texture gp dim arr t ar
                      -> Texture gp dim arr t' ar'
  -}
  
  -- MipMap validation
  class IsMipValid (canMip :: TextureMipMap) (mip :: TextureMipMap)
  instance IsMipValid TexMip TexMip
  instance IsMipValid TexMip TexNoMip
  instance IsMipValid TexNoMip TexNoMip
  
  -- restriction for texture types what can be specified as texture slots, e.g. multisample textures cannot be created im this way
  class IsValidTextureSlot (a :: TextureSemantics *)
  instance IsValidTextureSlot (Regular a)
  instance IsValidTextureSlot (T.Shadow a)
  instance IsValidTextureSlot (Buffer a)
  
  -- type level hepler function, used for texture specification
  type family TexSizeRepr (a :: TextureShape)
  type instance TexSizeRepr (Tex1D)   = Word32
  type instance TexSizeRepr (Tex2D)   = V2U
  type instance TexSizeRepr (TexRect) = V2U
  type instance TexSizeRepr (Tex3D)   = V3U
  {-
  -- type level hepler function, used for texture specification
  type family TexRepr dim mip (gp :: * -> *) layerCount t :: *
  type instance TexRepr DIM1 NoMip   gp layerCount t = gp (Image layerCount t)
  type instance TexRepr DIM1 AutoMip gp layerCount t = gp (Image layerCount t)
  type instance TexRepr DIM1 Mip     gp layerCount t = [gp (Image layerCount t)]
  
  type instance TexRepr DIM2 NoMip   gp layerCount t = gp (Image layerCount t)
  type instance TexRepr DIM2 AutoMip gp layerCount t = gp (Image layerCount t)
  type instance TexRepr DIM2 Mip     gp layerCount t = [gp (Image layerCount t)]
  
  type instance TexRepr DIM3 NoMip   gp layerCount t = [gp (Image layerCount t)]
  type instance TexRepr DIM3 AutoMip gp layerCount t = [gp (Image layerCount t)]
  type instance TexRepr DIM3 Mip     gp layerCount t = [[gp (Image layerCount t)]] -- 3D layers contain mipmap
  -}
  
  -- shader stage tags: vertex, geometry, fragment
  -- used in language AST, for primfun restriction and in shader codegen
  data Frequency
      = Obj
      | V
      | G
      | F
  
  data OutputType
      = SingleOutput
      | MultiOutput
  
  deriving instance Typeable Color
  deriving instance Typeable Depth
  deriving instance Typeable Stencil
  deriving instance Typeable Interpolated
  deriving instance Typeable Obj
  deriving instance Typeable V
  deriving instance Typeable G
  deriving instance Typeable F
  deriving instance Typeable Image
  deriving instance Typeable Texture
  deriving instance Typeable TextureType
  deriving instance Typeable SingleOutput
  deriving instance Typeable MultiOutput
  deriving instance Typeable TextureDataType
  
  -- vector types: V2, V3, V4
  class IsVec (dim :: Nat) vec component | vec -> dim component, dim component -> vec
  instance IsVec 2 (V2 Float) Float
  instance IsVec 3 (V3 Float) Float
  instance IsVec 4 (V4 Float) Float
  instance IsVec 2 (V2 Int32) Int32
  instance IsVec 3 (V3 Int32) Int32
  instance IsVec 4 (V4 Int32) Int32
  instance IsVec 2 (V2 Word32) Word32
  instance IsVec 3 (V3 Word32) Word32
  instance IsVec 4 (V4 Word32) Word32
  instance IsVec 2 (V2 Bool) Bool
  instance IsVec 3 (V3 Bool) Bool
  instance IsVec 4 (V4 Bool) Bool
  
  -- scalar and vector types: scalar, V2, V3, V4
  class IsVecScalar (dim :: Nat) vec component | vec -> dim component, dim component -> vec
  instance IsVecScalar 1 Float Float
  instance IsVecScalar 2 (V2 Float) Float
  instance IsVecScalar 3 (V3 Float) Float
  instance IsVecScalar 4 (V4 Float) Float
  instance IsVecScalar 1 Int32 Int32
  instance IsVecScalar 2 (V2 Int32) Int32
  instance IsVecScalar 3 (V3 Int32) Int32
  instance IsVecScalar 4 (V4 Int32) Int32
  instance IsVecScalar 1 Word32 Word32
  instance IsVecScalar 2 (V2 Word32) Word32
  instance IsVecScalar 3 (V3 Word32) Word32
  instance IsVecScalar 4 (V4 Word32) Word32
  instance IsVecScalar 1 Bool Bool
  instance IsVecScalar 2 (V2 Bool) Bool
  instance IsVecScalar 3 (V3 Bool) Bool
  instance IsVecScalar 4 (V4 Bool) Bool
  
  -- matrix types of dimension [2..4] x [2..4]
  class IsMat mat h w | mat -> h w
  instance IsMat M22F V2F V2F
  instance IsMat M23F V2F V3F
  instance IsMat M24F V2F V4F
  instance IsMat M32F V3F V2F
  instance IsMat M33F V3F V3F
  instance IsMat M34F V3F V4F
  instance IsMat M42F V4F V2F
  instance IsMat M43F V4F V3F
  instance IsMat M44F V4F V4F
  
  -- matrix, vector and scalar types
  class IsMatVecScalar a t | a -> t
  instance IsMatVecScalar Float Float
  instance IsMatVecScalar (V2 Float) Float
  instance IsMatVecScalar (V3 Float) Float
  instance IsMatVecScalar (V4 Float) Float
  instance IsMatVecScalar Int32 Int32
  instance IsMatVecScalar (V2 Int32) Int32
  instance IsMatVecScalar (V3 Int32) Int32
  instance IsMatVecScalar (V4 Int32) Int32
  instance IsMatVecScalar Word32 Word32
  instance IsMatVecScalar (V2 Word32) Word32
  instance IsMatVecScalar (V3 Word32) Word32
  instance IsMatVecScalar (V4 Word32) Word32
  instance IsMatVecScalar Bool Bool
  instance IsMatVecScalar (V2 Bool) Bool
  instance IsMatVecScalar (V3 Bool) Bool
  instance IsMatVecScalar (V4 Bool) Bool
  instance IsMatVecScalar M22F Float
  instance IsMatVecScalar M23F Float
  instance IsMatVecScalar M24F Float
  instance IsMatVecScalar M32F Float
  instance IsMatVecScalar M33F Float
  instance IsMatVecScalar M34F Float
  instance IsMatVecScalar M42F Float
  instance IsMatVecScalar M43F Float
  instance IsMatVecScalar M44F Float
  
  -- matrix and vector types
  class IsMatVec a t | a -> t
  instance IsMatVec (V2 Float) Float
  instance IsMatVec (V3 Float) Float
  instance IsMatVec (V4 Float) Float
  instance IsMatVec (V2 Int32) Int32
  instance IsMatVec (V3 Int32) Int32
  instance IsMatVec (V4 Int32) Int32
  instance IsMatVec (V2 Word32) Word32
  instance IsMatVec (V3 Word32) Word32
  instance IsMatVec (V4 Word32) Word32
  instance IsMatVec (V2 Bool) Bool
  instance IsMatVec (V3 Bool) Bool
  instance IsMatVec (V4 Bool) Bool
  instance IsMatVec M22F Float
  instance IsMatVec M23F Float
  instance IsMatVec M24F Float
  instance IsMatVec M32F Float
  instance IsMatVec M33F Float
  instance IsMatVec M34F Float
  instance IsMatVec M42F Float
  instance IsMatVec M43F Float
  instance IsMatVec M44F Float
  
  -- matrix or vector component type
  class IsComponent a
  instance IsComponent Float
  instance IsComponent Int32
  instance IsComponent Word32
  instance IsComponent Bool
  instance IsComponent V2F
  instance IsComponent V3F
  instance IsComponent V4F
  
  -- matrix or vector number component type
  class IsNumComponent a
  instance IsNumComponent Float
  instance IsNumComponent Int32
  instance IsNumComponent Word32
  instance IsNumComponent V2F
  instance IsNumComponent V3F
  instance IsNumComponent V4F
  
  class IsSigned a
  instance IsSigned Float
  instance IsSigned Int
  
  class Real a => IsNum a
  instance IsNum Float
  instance IsNum Int32
  instance IsNum Word32
  
  class IsIntegral a
  instance IsIntegral Int32
  instance IsIntegral Word32
  
  class IsFloating a
  instance IsFloating Float
  instance IsFloating V2F
  instance IsFloating V3F
  instance IsFloating V4F
  instance IsFloating M22F
  instance IsFloating M23F
  instance IsFloating M24F
  instance IsFloating M32F
  instance IsFloating M33F
  instance IsFloating M34F
  instance IsFloating M42F
  instance IsFloating M43F
  instance IsFloating M44F
  