packages feed

lambdacube-ir (empty) → 0.2.0.0

raw patch · 8 files changed

+2021/−0 lines, 8 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, mtl, text, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Csaba Hruska++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Csaba Hruska nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lambdacube-ir.cabal view
@@ -0,0 +1,34 @@+-- Initial lambdacube-ir.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                lambdacube-ir+version:             0.2.0.0+synopsis:            LambdaCube 3D intermediate representation of 3D graphics pipelines+description:         LambdaCube 3D intermediate representation of 3D graphics pipelines+license:             BSD3+license-file:        LICENSE+author:              Csaba Hruska+maintainer:          csaba.hruska@gmail.com+-- copyright:           +category:            Graphics+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     LambdaCube.Linear+                       LambdaCube.IR+                       LambdaCube.Mesh+                       LambdaCube.PipelineSchema+                       LambdaCube.PipelineSchemaUtil+  -- other-modules:       +  other-extensions:    OverloadedStrings, RecordWildCards, DeriveFunctor+  -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository+  build-depends:       base >=4.8 && <4.9,+                       containers >=0.5 && <0.6,+                       vector >=0.11 && <0.12,+                       text >=1.2 && <1.3,+                       aeson >=0.9 && <0.11,+                       mtl >=2.2 && <2.3+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/LambdaCube/IR.hs view
@@ -0,0 +1,1608 @@+-- generated file, do not modify!+-- 2016-01-28T13:15:30.803775Z++{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module LambdaCube.IR where++import Data.Int+import Data.Word+import Data.Map+import Data.Vector (Vector(..))+import LambdaCube.Linear++import Data.Text+import Data.Aeson hiding (Value,Bool)+import Data.Aeson.Types hiding (Value,Bool)+import Control.Monad+++type StreamName = Int++type ProgramName = Int++type TextureName = Int++type SamplerName = Int++type UniformName = String++type SlotName = Int++type FrameBufferComponent = Int++type TextureUnit = Int++type RenderTargetName = Int++type TextureUnitMapping = Map UniformName TextureUnit++data ArrayValue+  = VBoolArray (Vector Bool)+  | VIntArray (Vector Int32)+  | VWordArray (Vector Word32)+  | VFloatArray (Vector Float)+  deriving (Show, Eq, Ord)++data Value+  = VBool Bool+  | VV2B V2B+  | VV3B V3B+  | VV4B V4B+  | VWord Word32+  | VV2U V2U+  | VV3U V3U+  | VV4U V4U+  | VInt Int32+  | VV2I V2I+  | VV3I V3I+  | VV4I V4I+  | VFloat Float+  | VV2F V2F+  | VV3F V3F+  | VV4F V4F+  | VM22F M22F+  | VM23F M23F+  | VM24F M24F+  | VM32F M32F+  | VM33F M33F+  | VM34F M34F+  | VM42F M42F+  | VM43F M43F+  | VM44F M44F+  deriving (Show, Eq, Ord)++data InputType+  = Bool+  | V2B+  | V3B+  | V4B+  | Word+  | V2U+  | V3U+  | V4U+  | Int+  | V2I+  | V3I+  | V4I+  | Float+  | V2F+  | V3F+  | V4F+  | M22F+  | M23F+  | M24F+  | M32F+  | M33F+  | M34F+  | M42F+  | M43F+  | M44F+  | STexture1D+  | STexture2D+  | STextureCube+  | STexture1DArray+  | STexture2DArray+  | STexture2DRect+  | FTexture1D+  | FTexture2D+  | FTexture3D+  | FTextureCube+  | FTexture1DArray+  | FTexture2DArray+  | FTexture2DMS+  | FTexture2DMSArray+  | FTextureBuffer+  | FTexture2DRect+  | ITexture1D+  | ITexture2D+  | ITexture3D+  | ITextureCube+  | ITexture1DArray+  | ITexture2DArray+  | ITexture2DMS+  | ITexture2DMSArray+  | ITextureBuffer+  | ITexture2DRect+  | UTexture1D+  | UTexture2D+  | UTexture3D+  | UTextureCube+  | UTexture1DArray+  | UTexture2DArray+  | UTexture2DMS+  | UTexture2DMSArray+  | UTextureBuffer+  | UTexture2DRect+  deriving (Show, Eq, Ord)++data PointSpriteCoordOrigin+  = LowerLeft+  | UpperLeft+  deriving (Show, Eq, Ord)++data PointSize+  = PointSize Float+  | ProgramPointSize+  deriving (Show, Eq, Ord)++data PolygonOffset+  = NoOffset+  | Offset Float Float+  deriving (Show, Eq, Ord)++data FrontFace+  = CCW+  | CW+  deriving (Show, Eq, Ord)++data PolygonMode+  = PolygonPoint PointSize+  | PolygonLine Float+  | PolygonFill+  deriving (Show, Eq, Ord)++data ProvokingVertex+  = FirstVertex+  | LastVertex+  deriving (Show, Eq, Ord)++data CullMode+  = CullNone+  | CullFront FrontFace+  | CullBack FrontFace+  deriving (Show, Eq, Ord)++data ComparisonFunction+  = Never+  | Less+  | Equal+  | Lequal+  | Greater+  | Notequal+  | Gequal+  | Always+  deriving (Show, Eq, Ord)++type DepthFunction = ComparisonFunction++data StencilOperation+  = OpZero+  | OpKeep+  | OpReplace+  | OpIncr+  | OpIncrWrap+  | OpDecr+  | OpDecrWrap+  | OpInvert+  deriving (Show, Eq, Ord)++data BlendEquation+  = FuncAdd+  | FuncSubtract+  | FuncReverseSubtract+  | Min+  | Max+  deriving (Show, Eq, Ord)++data BlendingFactor+  = Zero+  | One+  | SrcColor+  | OneMinusSrcColor+  | DstColor+  | OneMinusDstColor+  | SrcAlpha+  | OneMinusSrcAlpha+  | DstAlpha+  | OneMinusDstAlpha+  | ConstantColor+  | OneMinusConstantColor+  | ConstantAlpha+  | OneMinusConstantAlpha+  | SrcAlphaSaturate+  deriving (Show, Eq, Ord)++data LogicOperation+  = Clear+  | And+  | AndReverse+  | Copy+  | AndInverted+  | Noop+  | Xor+  | Or+  | Nor+  | Equiv+  | Invert+  | OrReverse+  | CopyInverted+  | OrInverted+  | Nand+  | Set+  deriving (Show, Eq, Ord)++data StencilOps+  = StencilOps+  { frontStencilOp :: StencilOperation+  , backStencilOp :: StencilOperation+  }++  deriving (Show, Eq, Ord)++data StencilTest+  = StencilTest+  { stencilComparision :: ComparisonFunction+  , stencilReference :: Int32+  , stencilMask :: Word32+  }++  deriving (Show, Eq, Ord)++data StencilTests+  = StencilTests StencilTest StencilTest+  deriving (Show, Eq, Ord)++data FetchPrimitive+  = Points+  | Lines+  | Triangles+  | LinesAdjacency+  | TrianglesAdjacency+  deriving (Show, Eq, Ord)++data OutputPrimitive+  = TrianglesOutput+  | LinesOutput+  | PointsOutput+  deriving (Show, Eq, Ord)++data ColorArity+  = Red+  | RG+  | RGB+  | RGBA+  deriving (Show, Eq, Ord)++data Blending+  = NoBlending+  | BlendLogicOp LogicOperation+  | Blend+  { colorEqSrc :: BlendEquation+  , alphaEqSrc :: BlendEquation+  , colorFSrc :: BlendingFactor+  , colorFDst :: BlendingFactor+  , alphaFSrc :: BlendingFactor+  , alphaFDst :: BlendingFactor+  , color :: V4F+  }++  deriving (Show, Eq, Ord)++data RasterContext+  = PointCtx PointSize Float PointSpriteCoordOrigin+  | LineCtx Float ProvokingVertex+  | TriangleCtx CullMode PolygonMode PolygonOffset ProvokingVertex+  deriving (Show, Eq, Ord)++data FragmentOperation+  = DepthOp DepthFunction Bool+  | StencilOp StencilTests StencilOps StencilOps+  | ColorOp Blending Value+  deriving (Show, Eq, Ord)++data AccumulationContext+  = AccumulationContext+  { accViewportName :: Maybe String+  , accOperations :: [FragmentOperation]+  }++  deriving (Show, Eq, Ord)++data TextureDataType+  = FloatT ColorArity+  | IntT ColorArity+  | WordT ColorArity+  | ShadowT+  deriving (Show, Eq, Ord)++data TextureType+  = Texture1D TextureDataType Int+  | Texture2D TextureDataType Int+  | Texture3D TextureDataType+  | TextureCube TextureDataType+  | TextureRect TextureDataType+  | Texture2DMS TextureDataType Int Int Bool+  | TextureBuffer TextureDataType+  deriving (Show, Eq, Ord)++data MipMap+  = Mip Int Int+  | NoMip+  | AutoMip Int Int+  deriving (Show, Eq, Ord)++data Filter+  = Nearest+  | Linear+  | NearestMipmapNearest+  | NearestMipmapLinear+  | LinearMipmapNearest+  | LinearMipmapLinear+  deriving (Show, Eq, Ord)++data EdgeMode+  = Repeat+  | MirroredRepeat+  | ClampToEdge+  | ClampToBorder+  deriving (Show, Eq, Ord)++data ImageSemantic+  = Depth+  | Stencil+  | Color+  deriving (Show, Eq, Ord)++data ImageRef+  = TextureImage TextureName Int (Maybe Int)+  | Framebuffer ImageSemantic+  deriving (Show, Eq, Ord)++data ClearImage+  = ClearImage+  { imageSemantic :: ImageSemantic+  , clearValue :: Value+  }++  deriving (Show, Eq, Ord)++data Command+  = SetRasterContext RasterContext+  | SetAccumulationContext AccumulationContext+  | SetRenderTarget RenderTargetName+  | SetProgram ProgramName+  | SetSamplerUniform UniformName TextureUnit+  | SetTexture TextureUnit TextureName+  | SetSampler TextureUnit (Maybe SamplerName)+  | RenderSlot SlotName+  | RenderStream StreamName+  | ClearRenderTarget (Vector ClearImage)+  | GenerateMipMap TextureUnit+  | SaveImage FrameBufferComponent ImageRef+  | LoadImage ImageRef FrameBufferComponent+  deriving (Show, Eq, Ord)++data SamplerDescriptor+  = SamplerDescriptor+  { samplerWrapS :: EdgeMode+  , samplerWrapT :: Maybe EdgeMode+  , samplerWrapR :: Maybe EdgeMode+  , samplerMinFilter :: Filter+  , samplerMagFilter :: Filter+  , samplerBorderColor :: Value+  , samplerMinLod :: Maybe Float+  , samplerMaxLod :: Maybe Float+  , samplerLodBias :: Float+  , samplerCompareFunc :: Maybe ComparisonFunction+  }++  deriving (Show, Eq, Ord)++data TextureDescriptor+  = TextureDescriptor+  { textureType :: TextureType+  , textureSize :: Value+  , textureSemantic :: ImageSemantic+  , textureSampler :: SamplerDescriptor+  , textureBaseLevel :: Int+  , textureMaxLevel :: Int+  }++  deriving (Show, Eq, Ord)++data Parameter+  = Parameter+  { name :: String+  , ty :: InputType+  }++  deriving (Show, Eq, Ord)++data Program+  = Program+  { programUniforms :: Map UniformName InputType+  , programStreams :: Map UniformName Parameter+  , programInTextures :: Map UniformName InputType+  , programOutput :: Vector Parameter+  , vertexShader :: String+  , geometryShader :: Maybe String+  , fragmentShader :: String+  }++  deriving (Show, Eq, Ord)++data Slot+  = Slot+  { slotName :: String+  , slotStreams :: Map String InputType+  , slotUniforms :: Map UniformName InputType+  , slotPrimitive :: FetchPrimitive+  , slotPrograms :: Vector ProgramName+  }++  deriving (Show, Eq, Ord)++data StreamData+  = StreamData+  { streamData :: Map String ArrayValue+  , streamType :: Map String InputType+  , streamPrimitive :: FetchPrimitive+  , streamPrograms :: Vector ProgramName+  }++  deriving (Show, Eq, Ord)++data TargetItem+  = TargetItem+  { targetSemantic :: ImageSemantic+  , targetRef :: Maybe ImageRef+  }++  deriving (Show, Eq, Ord)++data RenderTarget+  = RenderTarget+  { renderTargets :: Vector TargetItem+  }++  deriving (Show, Eq, Ord)++data Backend+  = WebGL1+  | OpenGL33+  deriving (Show, Eq, Ord)++data Pipeline+  = Pipeline+  { backend :: Backend+  , textures :: Vector TextureDescriptor+  , samplers :: Vector SamplerDescriptor+  , targets :: Vector RenderTarget+  , programs :: Vector Program+  , slots :: Vector Slot+  , streams :: Vector StreamData+  , commands :: Vector Command+  }++  deriving (Show, Eq, Ord)+++instance ToJSON ArrayValue where+  toJSON v = case v of+    VBoolArray arg0 -> object [ "tag" .= ("VBoolArray" :: Text), "arg0" .= arg0]+    VIntArray arg0 -> object [ "tag" .= ("VIntArray" :: Text), "arg0" .= arg0]+    VWordArray arg0 -> object [ "tag" .= ("VWordArray" :: Text), "arg0" .= arg0]+    VFloatArray arg0 -> object [ "tag" .= ("VFloatArray" :: Text), "arg0" .= arg0]++instance FromJSON ArrayValue where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "VBoolArray" -> VBoolArray <$> obj .: "arg0"+      "VIntArray" -> VIntArray <$> obj .: "arg0"+      "VWordArray" -> VWordArray <$> obj .: "arg0"+      "VFloatArray" -> VFloatArray <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON Value where+  toJSON v = case v of+    VBool arg0 -> object [ "tag" .= ("VBool" :: Text), "arg0" .= arg0]+    VV2B arg0 -> object [ "tag" .= ("VV2B" :: Text), "arg0" .= arg0]+    VV3B arg0 -> object [ "tag" .= ("VV3B" :: Text), "arg0" .= arg0]+    VV4B arg0 -> object [ "tag" .= ("VV4B" :: Text), "arg0" .= arg0]+    VWord arg0 -> object [ "tag" .= ("VWord" :: Text), "arg0" .= arg0]+    VV2U arg0 -> object [ "tag" .= ("VV2U" :: Text), "arg0" .= arg0]+    VV3U arg0 -> object [ "tag" .= ("VV3U" :: Text), "arg0" .= arg0]+    VV4U arg0 -> object [ "tag" .= ("VV4U" :: Text), "arg0" .= arg0]+    VInt arg0 -> object [ "tag" .= ("VInt" :: Text), "arg0" .= arg0]+    VV2I arg0 -> object [ "tag" .= ("VV2I" :: Text), "arg0" .= arg0]+    VV3I arg0 -> object [ "tag" .= ("VV3I" :: Text), "arg0" .= arg0]+    VV4I arg0 -> object [ "tag" .= ("VV4I" :: Text), "arg0" .= arg0]+    VFloat arg0 -> object [ "tag" .= ("VFloat" :: Text), "arg0" .= arg0]+    VV2F arg0 -> object [ "tag" .= ("VV2F" :: Text), "arg0" .= arg0]+    VV3F arg0 -> object [ "tag" .= ("VV3F" :: Text), "arg0" .= arg0]+    VV4F arg0 -> object [ "tag" .= ("VV4F" :: Text), "arg0" .= arg0]+    VM22F arg0 -> object [ "tag" .= ("VM22F" :: Text), "arg0" .= arg0]+    VM23F arg0 -> object [ "tag" .= ("VM23F" :: Text), "arg0" .= arg0]+    VM24F arg0 -> object [ "tag" .= ("VM24F" :: Text), "arg0" .= arg0]+    VM32F arg0 -> object [ "tag" .= ("VM32F" :: Text), "arg0" .= arg0]+    VM33F arg0 -> object [ "tag" .= ("VM33F" :: Text), "arg0" .= arg0]+    VM34F arg0 -> object [ "tag" .= ("VM34F" :: Text), "arg0" .= arg0]+    VM42F arg0 -> object [ "tag" .= ("VM42F" :: Text), "arg0" .= arg0]+    VM43F arg0 -> object [ "tag" .= ("VM43F" :: Text), "arg0" .= arg0]+    VM44F arg0 -> object [ "tag" .= ("VM44F" :: Text), "arg0" .= arg0]++instance FromJSON Value where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "VBool" -> VBool <$> obj .: "arg0"+      "VV2B" -> VV2B <$> obj .: "arg0"+      "VV3B" -> VV3B <$> obj .: "arg0"+      "VV4B" -> VV4B <$> obj .: "arg0"+      "VWord" -> VWord <$> obj .: "arg0"+      "VV2U" -> VV2U <$> obj .: "arg0"+      "VV3U" -> VV3U <$> obj .: "arg0"+      "VV4U" -> VV4U <$> obj .: "arg0"+      "VInt" -> VInt <$> obj .: "arg0"+      "VV2I" -> VV2I <$> obj .: "arg0"+      "VV3I" -> VV3I <$> obj .: "arg0"+      "VV4I" -> VV4I <$> obj .: "arg0"+      "VFloat" -> VFloat <$> obj .: "arg0"+      "VV2F" -> VV2F <$> obj .: "arg0"+      "VV3F" -> VV3F <$> obj .: "arg0"+      "VV4F" -> VV4F <$> obj .: "arg0"+      "VM22F" -> VM22F <$> obj .: "arg0"+      "VM23F" -> VM23F <$> obj .: "arg0"+      "VM24F" -> VM24F <$> obj .: "arg0"+      "VM32F" -> VM32F <$> obj .: "arg0"+      "VM33F" -> VM33F <$> obj .: "arg0"+      "VM34F" -> VM34F <$> obj .: "arg0"+      "VM42F" -> VM42F <$> obj .: "arg0"+      "VM43F" -> VM43F <$> obj .: "arg0"+      "VM44F" -> VM44F <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON InputType where+  toJSON v = case v of+    Bool -> object [ "tag" .= ("Bool" :: Text)]+    V2B -> object [ "tag" .= ("V2B" :: Text)]+    V3B -> object [ "tag" .= ("V3B" :: Text)]+    V4B -> object [ "tag" .= ("V4B" :: Text)]+    Word -> object [ "tag" .= ("Word" :: Text)]+    V2U -> object [ "tag" .= ("V2U" :: Text)]+    V3U -> object [ "tag" .= ("V3U" :: Text)]+    V4U -> object [ "tag" .= ("V4U" :: Text)]+    Int -> object [ "tag" .= ("Int" :: Text)]+    V2I -> object [ "tag" .= ("V2I" :: Text)]+    V3I -> object [ "tag" .= ("V3I" :: Text)]+    V4I -> object [ "tag" .= ("V4I" :: Text)]+    Float -> object [ "tag" .= ("Float" :: Text)]+    V2F -> object [ "tag" .= ("V2F" :: Text)]+    V3F -> object [ "tag" .= ("V3F" :: Text)]+    V4F -> object [ "tag" .= ("V4F" :: Text)]+    M22F -> object [ "tag" .= ("M22F" :: Text)]+    M23F -> object [ "tag" .= ("M23F" :: Text)]+    M24F -> object [ "tag" .= ("M24F" :: Text)]+    M32F -> object [ "tag" .= ("M32F" :: Text)]+    M33F -> object [ "tag" .= ("M33F" :: Text)]+    M34F -> object [ "tag" .= ("M34F" :: Text)]+    M42F -> object [ "tag" .= ("M42F" :: Text)]+    M43F -> object [ "tag" .= ("M43F" :: Text)]+    M44F -> object [ "tag" .= ("M44F" :: Text)]+    STexture1D -> object [ "tag" .= ("STexture1D" :: Text)]+    STexture2D -> object [ "tag" .= ("STexture2D" :: Text)]+    STextureCube -> object [ "tag" .= ("STextureCube" :: Text)]+    STexture1DArray -> object [ "tag" .= ("STexture1DArray" :: Text)]+    STexture2DArray -> object [ "tag" .= ("STexture2DArray" :: Text)]+    STexture2DRect -> object [ "tag" .= ("STexture2DRect" :: Text)]+    FTexture1D -> object [ "tag" .= ("FTexture1D" :: Text)]+    FTexture2D -> object [ "tag" .= ("FTexture2D" :: Text)]+    FTexture3D -> object [ "tag" .= ("FTexture3D" :: Text)]+    FTextureCube -> object [ "tag" .= ("FTextureCube" :: Text)]+    FTexture1DArray -> object [ "tag" .= ("FTexture1DArray" :: Text)]+    FTexture2DArray -> object [ "tag" .= ("FTexture2DArray" :: Text)]+    FTexture2DMS -> object [ "tag" .= ("FTexture2DMS" :: Text)]+    FTexture2DMSArray -> object [ "tag" .= ("FTexture2DMSArray" :: Text)]+    FTextureBuffer -> object [ "tag" .= ("FTextureBuffer" :: Text)]+    FTexture2DRect -> object [ "tag" .= ("FTexture2DRect" :: Text)]+    ITexture1D -> object [ "tag" .= ("ITexture1D" :: Text)]+    ITexture2D -> object [ "tag" .= ("ITexture2D" :: Text)]+    ITexture3D -> object [ "tag" .= ("ITexture3D" :: Text)]+    ITextureCube -> object [ "tag" .= ("ITextureCube" :: Text)]+    ITexture1DArray -> object [ "tag" .= ("ITexture1DArray" :: Text)]+    ITexture2DArray -> object [ "tag" .= ("ITexture2DArray" :: Text)]+    ITexture2DMS -> object [ "tag" .= ("ITexture2DMS" :: Text)]+    ITexture2DMSArray -> object [ "tag" .= ("ITexture2DMSArray" :: Text)]+    ITextureBuffer -> object [ "tag" .= ("ITextureBuffer" :: Text)]+    ITexture2DRect -> object [ "tag" .= ("ITexture2DRect" :: Text)]+    UTexture1D -> object [ "tag" .= ("UTexture1D" :: Text)]+    UTexture2D -> object [ "tag" .= ("UTexture2D" :: Text)]+    UTexture3D -> object [ "tag" .= ("UTexture3D" :: Text)]+    UTextureCube -> object [ "tag" .= ("UTextureCube" :: Text)]+    UTexture1DArray -> object [ "tag" .= ("UTexture1DArray" :: Text)]+    UTexture2DArray -> object [ "tag" .= ("UTexture2DArray" :: Text)]+    UTexture2DMS -> object [ "tag" .= ("UTexture2DMS" :: Text)]+    UTexture2DMSArray -> object [ "tag" .= ("UTexture2DMSArray" :: Text)]+    UTextureBuffer -> object [ "tag" .= ("UTextureBuffer" :: Text)]+    UTexture2DRect -> object [ "tag" .= ("UTexture2DRect" :: Text)]++instance FromJSON InputType where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Bool" -> pure Bool+      "V2B" -> pure V2B+      "V3B" -> pure V3B+      "V4B" -> pure V4B+      "Word" -> pure Word+      "V2U" -> pure V2U+      "V3U" -> pure V3U+      "V4U" -> pure V4U+      "Int" -> pure Int+      "V2I" -> pure V2I+      "V3I" -> pure V3I+      "V4I" -> pure V4I+      "Float" -> pure Float+      "V2F" -> pure V2F+      "V3F" -> pure V3F+      "V4F" -> pure V4F+      "M22F" -> pure M22F+      "M23F" -> pure M23F+      "M24F" -> pure M24F+      "M32F" -> pure M32F+      "M33F" -> pure M33F+      "M34F" -> pure M34F+      "M42F" -> pure M42F+      "M43F" -> pure M43F+      "M44F" -> pure M44F+      "STexture1D" -> pure STexture1D+      "STexture2D" -> pure STexture2D+      "STextureCube" -> pure STextureCube+      "STexture1DArray" -> pure STexture1DArray+      "STexture2DArray" -> pure STexture2DArray+      "STexture2DRect" -> pure STexture2DRect+      "FTexture1D" -> pure FTexture1D+      "FTexture2D" -> pure FTexture2D+      "FTexture3D" -> pure FTexture3D+      "FTextureCube" -> pure FTextureCube+      "FTexture1DArray" -> pure FTexture1DArray+      "FTexture2DArray" -> pure FTexture2DArray+      "FTexture2DMS" -> pure FTexture2DMS+      "FTexture2DMSArray" -> pure FTexture2DMSArray+      "FTextureBuffer" -> pure FTextureBuffer+      "FTexture2DRect" -> pure FTexture2DRect+      "ITexture1D" -> pure ITexture1D+      "ITexture2D" -> pure ITexture2D+      "ITexture3D" -> pure ITexture3D+      "ITextureCube" -> pure ITextureCube+      "ITexture1DArray" -> pure ITexture1DArray+      "ITexture2DArray" -> pure ITexture2DArray+      "ITexture2DMS" -> pure ITexture2DMS+      "ITexture2DMSArray" -> pure ITexture2DMSArray+      "ITextureBuffer" -> pure ITextureBuffer+      "ITexture2DRect" -> pure ITexture2DRect+      "UTexture1D" -> pure UTexture1D+      "UTexture2D" -> pure UTexture2D+      "UTexture3D" -> pure UTexture3D+      "UTextureCube" -> pure UTextureCube+      "UTexture1DArray" -> pure UTexture1DArray+      "UTexture2DArray" -> pure UTexture2DArray+      "UTexture2DMS" -> pure UTexture2DMS+      "UTexture2DMSArray" -> pure UTexture2DMSArray+      "UTextureBuffer" -> pure UTextureBuffer+      "UTexture2DRect" -> pure UTexture2DRect+  parseJSON _ = mzero++instance ToJSON PointSpriteCoordOrigin where+  toJSON v = case v of+    LowerLeft -> object [ "tag" .= ("LowerLeft" :: Text)]+    UpperLeft -> object [ "tag" .= ("UpperLeft" :: Text)]++instance FromJSON PointSpriteCoordOrigin where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "LowerLeft" -> pure LowerLeft+      "UpperLeft" -> pure UpperLeft+  parseJSON _ = mzero++instance ToJSON PointSize where+  toJSON v = case v of+    PointSize arg0 -> object [ "tag" .= ("PointSize" :: Text), "arg0" .= arg0]+    ProgramPointSize -> object [ "tag" .= ("ProgramPointSize" :: Text)]++instance FromJSON PointSize where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "PointSize" -> PointSize <$> obj .: "arg0"+      "ProgramPointSize" -> pure ProgramPointSize+  parseJSON _ = mzero++instance ToJSON PolygonOffset where+  toJSON v = case v of+    NoOffset -> object [ "tag" .= ("NoOffset" :: Text)]+    Offset arg0 arg1 -> object [ "tag" .= ("Offset" :: Text), "arg0" .= arg0, "arg1" .= arg1]++instance FromJSON PolygonOffset where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "NoOffset" -> pure NoOffset+      "Offset" -> Offset <$> obj .: "arg0" <*> obj .: "arg1"+  parseJSON _ = mzero++instance ToJSON FrontFace where+  toJSON v = case v of+    CCW -> object [ "tag" .= ("CCW" :: Text)]+    CW -> object [ "tag" .= ("CW" :: Text)]++instance FromJSON FrontFace where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "CCW" -> pure CCW+      "CW" -> pure CW+  parseJSON _ = mzero++instance ToJSON PolygonMode where+  toJSON v = case v of+    PolygonPoint arg0 -> object [ "tag" .= ("PolygonPoint" :: Text), "arg0" .= arg0]+    PolygonLine arg0 -> object [ "tag" .= ("PolygonLine" :: Text), "arg0" .= arg0]+    PolygonFill -> object [ "tag" .= ("PolygonFill" :: Text)]++instance FromJSON PolygonMode where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "PolygonPoint" -> PolygonPoint <$> obj .: "arg0"+      "PolygonLine" -> PolygonLine <$> obj .: "arg0"+      "PolygonFill" -> pure PolygonFill+  parseJSON _ = mzero++instance ToJSON ProvokingVertex where+  toJSON v = case v of+    FirstVertex -> object [ "tag" .= ("FirstVertex" :: Text)]+    LastVertex -> object [ "tag" .= ("LastVertex" :: Text)]++instance FromJSON ProvokingVertex where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "FirstVertex" -> pure FirstVertex+      "LastVertex" -> pure LastVertex+  parseJSON _ = mzero++instance ToJSON CullMode where+  toJSON v = case v of+    CullNone -> object [ "tag" .= ("CullNone" :: Text)]+    CullFront arg0 -> object [ "tag" .= ("CullFront" :: Text), "arg0" .= arg0]+    CullBack arg0 -> object [ "tag" .= ("CullBack" :: Text), "arg0" .= arg0]++instance FromJSON CullMode where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "CullNone" -> pure CullNone+      "CullFront" -> CullFront <$> obj .: "arg0"+      "CullBack" -> CullBack <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON ComparisonFunction where+  toJSON v = case v of+    Never -> object [ "tag" .= ("Never" :: Text)]+    Less -> object [ "tag" .= ("Less" :: Text)]+    Equal -> object [ "tag" .= ("Equal" :: Text)]+    Lequal -> object [ "tag" .= ("Lequal" :: Text)]+    Greater -> object [ "tag" .= ("Greater" :: Text)]+    Notequal -> object [ "tag" .= ("Notequal" :: Text)]+    Gequal -> object [ "tag" .= ("Gequal" :: Text)]+    Always -> object [ "tag" .= ("Always" :: Text)]++instance FromJSON ComparisonFunction where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Never" -> pure Never+      "Less" -> pure Less+      "Equal" -> pure Equal+      "Lequal" -> pure Lequal+      "Greater" -> pure Greater+      "Notequal" -> pure Notequal+      "Gequal" -> pure Gequal+      "Always" -> pure Always+  parseJSON _ = mzero++instance ToJSON StencilOperation where+  toJSON v = case v of+    OpZero -> object [ "tag" .= ("OpZero" :: Text)]+    OpKeep -> object [ "tag" .= ("OpKeep" :: Text)]+    OpReplace -> object [ "tag" .= ("OpReplace" :: Text)]+    OpIncr -> object [ "tag" .= ("OpIncr" :: Text)]+    OpIncrWrap -> object [ "tag" .= ("OpIncrWrap" :: Text)]+    OpDecr -> object [ "tag" .= ("OpDecr" :: Text)]+    OpDecrWrap -> object [ "tag" .= ("OpDecrWrap" :: Text)]+    OpInvert -> object [ "tag" .= ("OpInvert" :: Text)]++instance FromJSON StencilOperation where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "OpZero" -> pure OpZero+      "OpKeep" -> pure OpKeep+      "OpReplace" -> pure OpReplace+      "OpIncr" -> pure OpIncr+      "OpIncrWrap" -> pure OpIncrWrap+      "OpDecr" -> pure OpDecr+      "OpDecrWrap" -> pure OpDecrWrap+      "OpInvert" -> pure OpInvert+  parseJSON _ = mzero++instance ToJSON BlendEquation where+  toJSON v = case v of+    FuncAdd -> object [ "tag" .= ("FuncAdd" :: Text)]+    FuncSubtract -> object [ "tag" .= ("FuncSubtract" :: Text)]+    FuncReverseSubtract -> object [ "tag" .= ("FuncReverseSubtract" :: Text)]+    Min -> object [ "tag" .= ("Min" :: Text)]+    Max -> object [ "tag" .= ("Max" :: Text)]++instance FromJSON BlendEquation where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "FuncAdd" -> pure FuncAdd+      "FuncSubtract" -> pure FuncSubtract+      "FuncReverseSubtract" -> pure FuncReverseSubtract+      "Min" -> pure Min+      "Max" -> pure Max+  parseJSON _ = mzero++instance ToJSON BlendingFactor where+  toJSON v = case v of+    Zero -> object [ "tag" .= ("Zero" :: Text)]+    One -> object [ "tag" .= ("One" :: Text)]+    SrcColor -> object [ "tag" .= ("SrcColor" :: Text)]+    OneMinusSrcColor -> object [ "tag" .= ("OneMinusSrcColor" :: Text)]+    DstColor -> object [ "tag" .= ("DstColor" :: Text)]+    OneMinusDstColor -> object [ "tag" .= ("OneMinusDstColor" :: Text)]+    SrcAlpha -> object [ "tag" .= ("SrcAlpha" :: Text)]+    OneMinusSrcAlpha -> object [ "tag" .= ("OneMinusSrcAlpha" :: Text)]+    DstAlpha -> object [ "tag" .= ("DstAlpha" :: Text)]+    OneMinusDstAlpha -> object [ "tag" .= ("OneMinusDstAlpha" :: Text)]+    ConstantColor -> object [ "tag" .= ("ConstantColor" :: Text)]+    OneMinusConstantColor -> object [ "tag" .= ("OneMinusConstantColor" :: Text)]+    ConstantAlpha -> object [ "tag" .= ("ConstantAlpha" :: Text)]+    OneMinusConstantAlpha -> object [ "tag" .= ("OneMinusConstantAlpha" :: Text)]+    SrcAlphaSaturate -> object [ "tag" .= ("SrcAlphaSaturate" :: Text)]++instance FromJSON BlendingFactor where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Zero" -> pure Zero+      "One" -> pure One+      "SrcColor" -> pure SrcColor+      "OneMinusSrcColor" -> pure OneMinusSrcColor+      "DstColor" -> pure DstColor+      "OneMinusDstColor" -> pure OneMinusDstColor+      "SrcAlpha" -> pure SrcAlpha+      "OneMinusSrcAlpha" -> pure OneMinusSrcAlpha+      "DstAlpha" -> pure DstAlpha+      "OneMinusDstAlpha" -> pure OneMinusDstAlpha+      "ConstantColor" -> pure ConstantColor+      "OneMinusConstantColor" -> pure OneMinusConstantColor+      "ConstantAlpha" -> pure ConstantAlpha+      "OneMinusConstantAlpha" -> pure OneMinusConstantAlpha+      "SrcAlphaSaturate" -> pure SrcAlphaSaturate+  parseJSON _ = mzero++instance ToJSON LogicOperation where+  toJSON v = case v of+    Clear -> object [ "tag" .= ("Clear" :: Text)]+    And -> object [ "tag" .= ("And" :: Text)]+    AndReverse -> object [ "tag" .= ("AndReverse" :: Text)]+    Copy -> object [ "tag" .= ("Copy" :: Text)]+    AndInverted -> object [ "tag" .= ("AndInverted" :: Text)]+    Noop -> object [ "tag" .= ("Noop" :: Text)]+    Xor -> object [ "tag" .= ("Xor" :: Text)]+    Or -> object [ "tag" .= ("Or" :: Text)]+    Nor -> object [ "tag" .= ("Nor" :: Text)]+    Equiv -> object [ "tag" .= ("Equiv" :: Text)]+    Invert -> object [ "tag" .= ("Invert" :: Text)]+    OrReverse -> object [ "tag" .= ("OrReverse" :: Text)]+    CopyInverted -> object [ "tag" .= ("CopyInverted" :: Text)]+    OrInverted -> object [ "tag" .= ("OrInverted" :: Text)]+    Nand -> object [ "tag" .= ("Nand" :: Text)]+    Set -> object [ "tag" .= ("Set" :: Text)]++instance FromJSON LogicOperation where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Clear" -> pure Clear+      "And" -> pure And+      "AndReverse" -> pure AndReverse+      "Copy" -> pure Copy+      "AndInverted" -> pure AndInverted+      "Noop" -> pure Noop+      "Xor" -> pure Xor+      "Or" -> pure Or+      "Nor" -> pure Nor+      "Equiv" -> pure Equiv+      "Invert" -> pure Invert+      "OrReverse" -> pure OrReverse+      "CopyInverted" -> pure CopyInverted+      "OrInverted" -> pure OrInverted+      "Nand" -> pure Nand+      "Set" -> pure Set+  parseJSON _ = mzero++instance ToJSON StencilOps where+  toJSON v = case v of+    StencilOps{..} -> object+      [ "tag" .= ("StencilOps" :: Text)+      , "frontStencilOp" .= frontStencilOp+      , "backStencilOp" .= backStencilOp+      ]++instance FromJSON StencilOps where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "StencilOps" -> do+        frontStencilOp <- obj .: "frontStencilOp"+        backStencilOp <- obj .: "backStencilOp"+        pure $ StencilOps+          { frontStencilOp = frontStencilOp+          , backStencilOp = backStencilOp+          } +  parseJSON _ = mzero++instance ToJSON StencilTest where+  toJSON v = case v of+    StencilTest{..} -> object+      [ "tag" .= ("StencilTest" :: Text)+      , "stencilComparision" .= stencilComparision+      , "stencilReference" .= stencilReference+      , "stencilMask" .= stencilMask+      ]++instance FromJSON StencilTest where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "StencilTest" -> do+        stencilComparision <- obj .: "stencilComparision"+        stencilReference <- obj .: "stencilReference"+        stencilMask <- obj .: "stencilMask"+        pure $ StencilTest+          { stencilComparision = stencilComparision+          , stencilReference = stencilReference+          , stencilMask = stencilMask+          } +  parseJSON _ = mzero++instance ToJSON StencilTests where+  toJSON v = case v of+    StencilTests arg0 arg1 -> object [ "tag" .= ("StencilTests" :: Text), "arg0" .= arg0, "arg1" .= arg1]++instance FromJSON StencilTests where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "StencilTests" -> StencilTests <$> obj .: "arg0" <*> obj .: "arg1"+  parseJSON _ = mzero++instance ToJSON FetchPrimitive where+  toJSON v = case v of+    Points -> object [ "tag" .= ("Points" :: Text)]+    Lines -> object [ "tag" .= ("Lines" :: Text)]+    Triangles -> object [ "tag" .= ("Triangles" :: Text)]+    LinesAdjacency -> object [ "tag" .= ("LinesAdjacency" :: Text)]+    TrianglesAdjacency -> object [ "tag" .= ("TrianglesAdjacency" :: Text)]++instance FromJSON FetchPrimitive where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Points" -> pure Points+      "Lines" -> pure Lines+      "Triangles" -> pure Triangles+      "LinesAdjacency" -> pure LinesAdjacency+      "TrianglesAdjacency" -> pure TrianglesAdjacency+  parseJSON _ = mzero++instance ToJSON OutputPrimitive where+  toJSON v = case v of+    TrianglesOutput -> object [ "tag" .= ("TrianglesOutput" :: Text)]+    LinesOutput -> object [ "tag" .= ("LinesOutput" :: Text)]+    PointsOutput -> object [ "tag" .= ("PointsOutput" :: Text)]++instance FromJSON OutputPrimitive where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "TrianglesOutput" -> pure TrianglesOutput+      "LinesOutput" -> pure LinesOutput+      "PointsOutput" -> pure PointsOutput+  parseJSON _ = mzero++instance ToJSON ColorArity where+  toJSON v = case v of+    Red -> object [ "tag" .= ("Red" :: Text)]+    RG -> object [ "tag" .= ("RG" :: Text)]+    RGB -> object [ "tag" .= ("RGB" :: Text)]+    RGBA -> object [ "tag" .= ("RGBA" :: Text)]++instance FromJSON ColorArity where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Red" -> pure Red+      "RG" -> pure RG+      "RGB" -> pure RGB+      "RGBA" -> pure RGBA+  parseJSON _ = mzero++instance ToJSON Blending where+  toJSON v = case v of+    NoBlending -> object [ "tag" .= ("NoBlending" :: Text)]+    BlendLogicOp arg0 -> object [ "tag" .= ("BlendLogicOp" :: Text), "arg0" .= arg0]+    Blend{..} -> object+      [ "tag" .= ("Blend" :: Text)+      , "colorEqSrc" .= colorEqSrc+      , "alphaEqSrc" .= alphaEqSrc+      , "colorFSrc" .= colorFSrc+      , "colorFDst" .= colorFDst+      , "alphaFSrc" .= alphaFSrc+      , "alphaFDst" .= alphaFDst+      , "color" .= color+      ]++instance FromJSON Blending where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "NoBlending" -> pure NoBlending+      "BlendLogicOp" -> BlendLogicOp <$> obj .: "arg0"+      "Blend" -> do+        colorEqSrc <- obj .: "colorEqSrc"+        alphaEqSrc <- obj .: "alphaEqSrc"+        colorFSrc <- obj .: "colorFSrc"+        colorFDst <- obj .: "colorFDst"+        alphaFSrc <- obj .: "alphaFSrc"+        alphaFDst <- obj .: "alphaFDst"+        color <- obj .: "color"+        pure $ Blend+          { colorEqSrc = colorEqSrc+          , alphaEqSrc = alphaEqSrc+          , colorFSrc = colorFSrc+          , colorFDst = colorFDst+          , alphaFSrc = alphaFSrc+          , alphaFDst = alphaFDst+          , color = color+          } +  parseJSON _ = mzero++instance ToJSON RasterContext where+  toJSON v = case v of+    PointCtx arg0 arg1 arg2 -> object [ "tag" .= ("PointCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2]+    LineCtx arg0 arg1 -> object [ "tag" .= ("LineCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    TriangleCtx arg0 arg1 arg2 arg3 -> object [ "tag" .= ("TriangleCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2, "arg3" .= arg3]++instance FromJSON RasterContext where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "PointCtx" -> PointCtx <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2"+      "LineCtx" -> LineCtx <$> obj .: "arg0" <*> obj .: "arg1"+      "TriangleCtx" -> TriangleCtx <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" <*> obj .: "arg3"+  parseJSON _ = mzero++instance ToJSON FragmentOperation where+  toJSON v = case v of+    DepthOp arg0 arg1 -> object [ "tag" .= ("DepthOp" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    StencilOp arg0 arg1 arg2 -> object [ "tag" .= ("StencilOp" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2]+    ColorOp arg0 arg1 -> object [ "tag" .= ("ColorOp" :: Text), "arg0" .= arg0, "arg1" .= arg1]++instance FromJSON FragmentOperation where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "DepthOp" -> DepthOp <$> obj .: "arg0" <*> obj .: "arg1"+      "StencilOp" -> StencilOp <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2"+      "ColorOp" -> ColorOp <$> obj .: "arg0" <*> obj .: "arg1"+  parseJSON _ = mzero++instance ToJSON AccumulationContext where+  toJSON v = case v of+    AccumulationContext{..} -> object+      [ "tag" .= ("AccumulationContext" :: Text)+      , "accViewportName" .= accViewportName+      , "accOperations" .= accOperations+      ]++instance FromJSON AccumulationContext where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "AccumulationContext" -> do+        accViewportName <- obj .: "accViewportName"+        accOperations <- obj .: "accOperations"+        pure $ AccumulationContext+          { accViewportName = accViewportName+          , accOperations = accOperations+          } +  parseJSON _ = mzero++instance ToJSON TextureDataType where+  toJSON v = case v of+    FloatT arg0 -> object [ "tag" .= ("FloatT" :: Text), "arg0" .= arg0]+    IntT arg0 -> object [ "tag" .= ("IntT" :: Text), "arg0" .= arg0]+    WordT arg0 -> object [ "tag" .= ("WordT" :: Text), "arg0" .= arg0]+    ShadowT -> object [ "tag" .= ("ShadowT" :: Text)]++instance FromJSON TextureDataType where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "FloatT" -> FloatT <$> obj .: "arg0"+      "IntT" -> IntT <$> obj .: "arg0"+      "WordT" -> WordT <$> obj .: "arg0"+      "ShadowT" -> pure ShadowT+  parseJSON _ = mzero++instance ToJSON TextureType where+  toJSON v = case v of+    Texture1D arg0 arg1 -> object [ "tag" .= ("Texture1D" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    Texture2D arg0 arg1 -> object [ "tag" .= ("Texture2D" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    Texture3D arg0 -> object [ "tag" .= ("Texture3D" :: Text), "arg0" .= arg0]+    TextureCube arg0 -> object [ "tag" .= ("TextureCube" :: Text), "arg0" .= arg0]+    TextureRect arg0 -> object [ "tag" .= ("TextureRect" :: Text), "arg0" .= arg0]+    Texture2DMS arg0 arg1 arg2 arg3 -> object [ "tag" .= ("Texture2DMS" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2, "arg3" .= arg3]+    TextureBuffer arg0 -> object [ "tag" .= ("TextureBuffer" :: Text), "arg0" .= arg0]++instance FromJSON TextureType where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Texture1D" -> Texture1D <$> obj .: "arg0" <*> obj .: "arg1"+      "Texture2D" -> Texture2D <$> obj .: "arg0" <*> obj .: "arg1"+      "Texture3D" -> Texture3D <$> obj .: "arg0"+      "TextureCube" -> TextureCube <$> obj .: "arg0"+      "TextureRect" -> TextureRect <$> obj .: "arg0"+      "Texture2DMS" -> Texture2DMS <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" <*> obj .: "arg3"+      "TextureBuffer" -> TextureBuffer <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON MipMap where+  toJSON v = case v of+    Mip arg0 arg1 -> object [ "tag" .= ("Mip" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    NoMip -> object [ "tag" .= ("NoMip" :: Text)]+    AutoMip arg0 arg1 -> object [ "tag" .= ("AutoMip" :: Text), "arg0" .= arg0, "arg1" .= arg1]++instance FromJSON MipMap where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Mip" -> Mip <$> obj .: "arg0" <*> obj .: "arg1"+      "NoMip" -> pure NoMip+      "AutoMip" -> AutoMip <$> obj .: "arg0" <*> obj .: "arg1"+  parseJSON _ = mzero++instance ToJSON Filter where+  toJSON v = case v of+    Nearest -> object [ "tag" .= ("Nearest" :: Text)]+    Linear -> object [ "tag" .= ("Linear" :: Text)]+    NearestMipmapNearest -> object [ "tag" .= ("NearestMipmapNearest" :: Text)]+    NearestMipmapLinear -> object [ "tag" .= ("NearestMipmapLinear" :: Text)]+    LinearMipmapNearest -> object [ "tag" .= ("LinearMipmapNearest" :: Text)]+    LinearMipmapLinear -> object [ "tag" .= ("LinearMipmapLinear" :: Text)]++instance FromJSON Filter where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Nearest" -> pure Nearest+      "Linear" -> pure Linear+      "NearestMipmapNearest" -> pure NearestMipmapNearest+      "NearestMipmapLinear" -> pure NearestMipmapLinear+      "LinearMipmapNearest" -> pure LinearMipmapNearest+      "LinearMipmapLinear" -> pure LinearMipmapLinear+  parseJSON _ = mzero++instance ToJSON EdgeMode where+  toJSON v = case v of+    Repeat -> object [ "tag" .= ("Repeat" :: Text)]+    MirroredRepeat -> object [ "tag" .= ("MirroredRepeat" :: Text)]+    ClampToEdge -> object [ "tag" .= ("ClampToEdge" :: Text)]+    ClampToBorder -> object [ "tag" .= ("ClampToBorder" :: Text)]++instance FromJSON EdgeMode where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Repeat" -> pure Repeat+      "MirroredRepeat" -> pure MirroredRepeat+      "ClampToEdge" -> pure ClampToEdge+      "ClampToBorder" -> pure ClampToBorder+  parseJSON _ = mzero++instance ToJSON ImageSemantic where+  toJSON v = case v of+    Depth -> object [ "tag" .= ("Depth" :: Text)]+    Stencil -> object [ "tag" .= ("Stencil" :: Text)]+    Color -> object [ "tag" .= ("Color" :: Text)]++instance FromJSON ImageSemantic where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Depth" -> pure Depth+      "Stencil" -> pure Stencil+      "Color" -> pure Color+  parseJSON _ = mzero++instance ToJSON ImageRef where+  toJSON v = case v of+    TextureImage arg0 arg1 arg2 -> object [ "tag" .= ("TextureImage" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2]+    Framebuffer arg0 -> object [ "tag" .= ("Framebuffer" :: Text), "arg0" .= arg0]++instance FromJSON ImageRef where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "TextureImage" -> TextureImage <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2"+      "Framebuffer" -> Framebuffer <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON ClearImage where+  toJSON v = case v of+    ClearImage{..} -> object+      [ "tag" .= ("ClearImage" :: Text)+      , "imageSemantic" .= imageSemantic+      , "clearValue" .= clearValue+      ]++instance FromJSON ClearImage where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "ClearImage" -> do+        imageSemantic <- obj .: "imageSemantic"+        clearValue <- obj .: "clearValue"+        pure $ ClearImage+          { imageSemantic = imageSemantic+          , clearValue = clearValue+          } +  parseJSON _ = mzero++instance ToJSON Command where+  toJSON v = case v of+    SetRasterContext arg0 -> object [ "tag" .= ("SetRasterContext" :: Text), "arg0" .= arg0]+    SetAccumulationContext arg0 -> object [ "tag" .= ("SetAccumulationContext" :: Text), "arg0" .= arg0]+    SetRenderTarget arg0 -> object [ "tag" .= ("SetRenderTarget" :: Text), "arg0" .= arg0]+    SetProgram arg0 -> object [ "tag" .= ("SetProgram" :: Text), "arg0" .= arg0]+    SetSamplerUniform arg0 arg1 -> object [ "tag" .= ("SetSamplerUniform" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    SetTexture arg0 arg1 -> object [ "tag" .= ("SetTexture" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    SetSampler arg0 arg1 -> object [ "tag" .= ("SetSampler" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    RenderSlot arg0 -> object [ "tag" .= ("RenderSlot" :: Text), "arg0" .= arg0]+    RenderStream arg0 -> object [ "tag" .= ("RenderStream" :: Text), "arg0" .= arg0]+    ClearRenderTarget arg0 -> object [ "tag" .= ("ClearRenderTarget" :: Text), "arg0" .= arg0]+    GenerateMipMap arg0 -> object [ "tag" .= ("GenerateMipMap" :: Text), "arg0" .= arg0]+    SaveImage arg0 arg1 -> object [ "tag" .= ("SaveImage" :: Text), "arg0" .= arg0, "arg1" .= arg1]+    LoadImage arg0 arg1 -> object [ "tag" .= ("LoadImage" :: Text), "arg0" .= arg0, "arg1" .= arg1]++instance FromJSON Command where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "SetRasterContext" -> SetRasterContext <$> obj .: "arg0"+      "SetAccumulationContext" -> SetAccumulationContext <$> obj .: "arg0"+      "SetRenderTarget" -> SetRenderTarget <$> obj .: "arg0"+      "SetProgram" -> SetProgram <$> obj .: "arg0"+      "SetSamplerUniform" -> SetSamplerUniform <$> obj .: "arg0" <*> obj .: "arg1"+      "SetTexture" -> SetTexture <$> obj .: "arg0" <*> obj .: "arg1"+      "SetSampler" -> SetSampler <$> obj .: "arg0" <*> obj .: "arg1"+      "RenderSlot" -> RenderSlot <$> obj .: "arg0"+      "RenderStream" -> RenderStream <$> obj .: "arg0"+      "ClearRenderTarget" -> ClearRenderTarget <$> obj .: "arg0"+      "GenerateMipMap" -> GenerateMipMap <$> obj .: "arg0"+      "SaveImage" -> SaveImage <$> obj .: "arg0" <*> obj .: "arg1"+      "LoadImage" -> LoadImage <$> obj .: "arg0" <*> obj .: "arg1"+  parseJSON _ = mzero++instance ToJSON SamplerDescriptor where+  toJSON v = case v of+    SamplerDescriptor{..} -> object+      [ "tag" .= ("SamplerDescriptor" :: Text)+      , "samplerWrapS" .= samplerWrapS+      , "samplerWrapT" .= samplerWrapT+      , "samplerWrapR" .= samplerWrapR+      , "samplerMinFilter" .= samplerMinFilter+      , "samplerMagFilter" .= samplerMagFilter+      , "samplerBorderColor" .= samplerBorderColor+      , "samplerMinLod" .= samplerMinLod+      , "samplerMaxLod" .= samplerMaxLod+      , "samplerLodBias" .= samplerLodBias+      , "samplerCompareFunc" .= samplerCompareFunc+      ]++instance FromJSON SamplerDescriptor where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "SamplerDescriptor" -> do+        samplerWrapS <- obj .: "samplerWrapS"+        samplerWrapT <- obj .: "samplerWrapT"+        samplerWrapR <- obj .: "samplerWrapR"+        samplerMinFilter <- obj .: "samplerMinFilter"+        samplerMagFilter <- obj .: "samplerMagFilter"+        samplerBorderColor <- obj .: "samplerBorderColor"+        samplerMinLod <- obj .: "samplerMinLod"+        samplerMaxLod <- obj .: "samplerMaxLod"+        samplerLodBias <- obj .: "samplerLodBias"+        samplerCompareFunc <- obj .: "samplerCompareFunc"+        pure $ SamplerDescriptor+          { samplerWrapS = samplerWrapS+          , samplerWrapT = samplerWrapT+          , samplerWrapR = samplerWrapR+          , samplerMinFilter = samplerMinFilter+          , samplerMagFilter = samplerMagFilter+          , samplerBorderColor = samplerBorderColor+          , samplerMinLod = samplerMinLod+          , samplerMaxLod = samplerMaxLod+          , samplerLodBias = samplerLodBias+          , samplerCompareFunc = samplerCompareFunc+          } +  parseJSON _ = mzero++instance ToJSON TextureDescriptor where+  toJSON v = case v of+    TextureDescriptor{..} -> object+      [ "tag" .= ("TextureDescriptor" :: Text)+      , "textureType" .= textureType+      , "textureSize" .= textureSize+      , "textureSemantic" .= textureSemantic+      , "textureSampler" .= textureSampler+      , "textureBaseLevel" .= textureBaseLevel+      , "textureMaxLevel" .= textureMaxLevel+      ]++instance FromJSON TextureDescriptor where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "TextureDescriptor" -> do+        textureType <- obj .: "textureType"+        textureSize <- obj .: "textureSize"+        textureSemantic <- obj .: "textureSemantic"+        textureSampler <- obj .: "textureSampler"+        textureBaseLevel <- obj .: "textureBaseLevel"+        textureMaxLevel <- obj .: "textureMaxLevel"+        pure $ TextureDescriptor+          { textureType = textureType+          , textureSize = textureSize+          , textureSemantic = textureSemantic+          , textureSampler = textureSampler+          , textureBaseLevel = textureBaseLevel+          , textureMaxLevel = textureMaxLevel+          } +  parseJSON _ = mzero++instance ToJSON Parameter where+  toJSON v = case v of+    Parameter{..} -> object+      [ "tag" .= ("Parameter" :: Text)+      , "name" .= name+      , "ty" .= ty+      ]++instance FromJSON Parameter where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Parameter" -> do+        name <- obj .: "name"+        ty <- obj .: "ty"+        pure $ Parameter+          { name = name+          , ty = ty+          } +  parseJSON _ = mzero++instance ToJSON Program where+  toJSON v = case v of+    Program{..} -> object+      [ "tag" .= ("Program" :: Text)+      , "programUniforms" .= programUniforms+      , "programStreams" .= programStreams+      , "programInTextures" .= programInTextures+      , "programOutput" .= programOutput+      , "vertexShader" .= vertexShader+      , "geometryShader" .= geometryShader+      , "fragmentShader" .= fragmentShader+      ]++instance FromJSON Program where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Program" -> do+        programUniforms <- obj .: "programUniforms"+        programStreams <- obj .: "programStreams"+        programInTextures <- obj .: "programInTextures"+        programOutput <- obj .: "programOutput"+        vertexShader <- obj .: "vertexShader"+        geometryShader <- obj .: "geometryShader"+        fragmentShader <- obj .: "fragmentShader"+        pure $ Program+          { programUniforms = programUniforms+          , programStreams = programStreams+          , programInTextures = programInTextures+          , programOutput = programOutput+          , vertexShader = vertexShader+          , geometryShader = geometryShader+          , fragmentShader = fragmentShader+          } +  parseJSON _ = mzero++instance ToJSON Slot where+  toJSON v = case v of+    Slot{..} -> object+      [ "tag" .= ("Slot" :: Text)+      , "slotName" .= slotName+      , "slotStreams" .= slotStreams+      , "slotUniforms" .= slotUniforms+      , "slotPrimitive" .= slotPrimitive+      , "slotPrograms" .= slotPrograms+      ]++instance FromJSON Slot where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Slot" -> do+        slotName <- obj .: "slotName"+        slotStreams <- obj .: "slotStreams"+        slotUniforms <- obj .: "slotUniforms"+        slotPrimitive <- obj .: "slotPrimitive"+        slotPrograms <- obj .: "slotPrograms"+        pure $ Slot+          { slotName = slotName+          , slotStreams = slotStreams+          , slotUniforms = slotUniforms+          , slotPrimitive = slotPrimitive+          , slotPrograms = slotPrograms+          } +  parseJSON _ = mzero++instance ToJSON StreamData where+  toJSON v = case v of+    StreamData{..} -> object+      [ "tag" .= ("StreamData" :: Text)+      , "streamData" .= streamData+      , "streamType" .= streamType+      , "streamPrimitive" .= streamPrimitive+      , "streamPrograms" .= streamPrograms+      ]++instance FromJSON StreamData where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "StreamData" -> do+        streamData <- obj .: "streamData"+        streamType <- obj .: "streamType"+        streamPrimitive <- obj .: "streamPrimitive"+        streamPrograms <- obj .: "streamPrograms"+        pure $ StreamData+          { streamData = streamData+          , streamType = streamType+          , streamPrimitive = streamPrimitive+          , streamPrograms = streamPrograms+          } +  parseJSON _ = mzero++instance ToJSON TargetItem where+  toJSON v = case v of+    TargetItem{..} -> object+      [ "tag" .= ("TargetItem" :: Text)+      , "targetSemantic" .= targetSemantic+      , "targetRef" .= targetRef+      ]++instance FromJSON TargetItem where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "TargetItem" -> do+        targetSemantic <- obj .: "targetSemantic"+        targetRef <- obj .: "targetRef"+        pure $ TargetItem+          { targetSemantic = targetSemantic+          , targetRef = targetRef+          } +  parseJSON _ = mzero++instance ToJSON RenderTarget where+  toJSON v = case v of+    RenderTarget{..} -> object+      [ "tag" .= ("RenderTarget" :: Text)+      , "renderTargets" .= renderTargets+      ]++instance FromJSON RenderTarget where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "RenderTarget" -> do+        renderTargets <- obj .: "renderTargets"+        pure $ RenderTarget+          { renderTargets = renderTargets+          } +  parseJSON _ = mzero++instance ToJSON Backend where+  toJSON v = case v of+    WebGL1 -> object [ "tag" .= ("WebGL1" :: Text)]+    OpenGL33 -> object [ "tag" .= ("OpenGL33" :: Text)]++instance FromJSON Backend where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "WebGL1" -> pure WebGL1+      "OpenGL33" -> pure OpenGL33+  parseJSON _ = mzero++instance ToJSON Pipeline where+  toJSON v = case v of+    Pipeline{..} -> object+      [ "tag" .= ("Pipeline" :: Text)+      , "backend" .= backend+      , "textures" .= textures+      , "samplers" .= samplers+      , "targets" .= targets+      , "programs" .= programs+      , "slots" .= slots+      , "streams" .= streams+      , "commands" .= commands+      ]++instance FromJSON Pipeline where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Pipeline" -> do+        backend <- obj .: "backend"+        textures <- obj .: "textures"+        samplers <- obj .: "samplers"+        targets <- obj .: "targets"+        programs <- obj .: "programs"+        slots <- obj .: "slots"+        streams <- obj .: "streams"+        commands <- obj .: "commands"+        pure $ Pipeline+          { backend = backend+          , textures = textures+          , samplers = samplers+          , targets = targets+          , programs = programs+          , slots = slots+          , streams = streams+          , commands = commands+          } +  parseJSON _ = mzero+
+ src/LambdaCube/Linear.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveFunctor, OverloadedStrings #-}+module LambdaCube.Linear where++import Data.Int+import Data.Word+import Data.Map++import Data.Text+import Data.Aeson+import Control.Monad++data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Functor)+data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Functor)+data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Functor)++-- matrices are stored in column major order+type M22F = V2 V2F+type M23F = V3 V2F+type M24F = V4 V2F+type M32F = V2 V3F+type M33F = V3 V3F+type M34F = V4 V3F+type M42F = V2 V4F+type M43F = V3 V4F+type M44F = V4 V4F++type V2F = V2 Float+type V3F = V3 Float+type V4F = V4 Float+type V2I = V2 Int32+type V3I = V3 Int32+type V4I = V4 Int32+type V2U = V2 Word32+type V3U = V3 Word32+type V4U = V4 Word32+type V2B = V2 Bool+type V3B = V3 Bool+type V4B = V4 Bool++instance ToJSON a => ToJSON (V2 a) where+  toJSON (V2 x y) = object ["x" .= x, "y" .= y]++instance ToJSON a => ToJSON (V3 a) where+  toJSON (V3 x y z) = object ["x" .= x, "y" .= y, "z" .= z]++instance ToJSON a => ToJSON (V4 a) where+  toJSON (V4 x y z w) = object ["x" .= x, "y" .= y, "z" .= z, "w" .= w]++instance FromJSON a => FromJSON (V2 a) where+  parseJSON (Object obj) = V2 <$> obj .: "x" <*> obj .: "y"+  parseJSON _ = mzero++instance FromJSON a => FromJSON (V3 a) where+  parseJSON (Object obj) = V3 <$> obj .: "x" <*> obj .: "y" <*> obj .: "z"+  parseJSON _ = mzero++instance FromJSON a => FromJSON (V4 a) where+  parseJSON (Object obj) = V4 <$> obj .: "x" <*> obj .: "y" <*> obj .: "z" <*> obj .: "w"+  parseJSON _ = mzero+
+ src/LambdaCube/Mesh.hs view
@@ -0,0 +1,114 @@+-- generated file, do not modify!+-- 2016-01-28T13:15:31.220124Z++{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module LambdaCube.Mesh where++import Data.Int+import Data.Word+import Data.Map+import Data.Vector (Vector(..))+import LambdaCube.Linear++import Data.Text+import Data.Aeson hiding (Value,Bool)+import Data.Aeson.Types hiding (Value,Bool)+import Control.Monad+++data MeshAttribute+  = A_Float (Vector Float)+  | A_V2F (Vector V2F)+  | A_V3F (Vector V3F)+  | A_V4F (Vector V4F)+  | A_M22F (Vector M22F)+  | A_M33F (Vector M33F)+  | A_M44F (Vector M44F)+  | A_Int (Vector Int32)+  | A_Word (Vector Word32)+  deriving (Show, Eq, Ord)++data MeshPrimitive+  = P_Points+  | P_TriangleStrip+  | P_Triangles+  | P_TriangleStripI (Vector Int32)+  | P_TrianglesI (Vector Int32)+  deriving (Show, Eq, Ord)++data Mesh+  = Mesh+  { mAttributes :: Map String MeshAttribute+  , mPrimitive :: MeshPrimitive+  }++  deriving (Show, Eq, Ord)+++instance ToJSON MeshAttribute where+  toJSON v = case v of+    A_Float arg0 -> object [ "tag" .= ("A_Float" :: Text), "arg0" .= arg0]+    A_V2F arg0 -> object [ "tag" .= ("A_V2F" :: Text), "arg0" .= arg0]+    A_V3F arg0 -> object [ "tag" .= ("A_V3F" :: Text), "arg0" .= arg0]+    A_V4F arg0 -> object [ "tag" .= ("A_V4F" :: Text), "arg0" .= arg0]+    A_M22F arg0 -> object [ "tag" .= ("A_M22F" :: Text), "arg0" .= arg0]+    A_M33F arg0 -> object [ "tag" .= ("A_M33F" :: Text), "arg0" .= arg0]+    A_M44F arg0 -> object [ "tag" .= ("A_M44F" :: Text), "arg0" .= arg0]+    A_Int arg0 -> object [ "tag" .= ("A_Int" :: Text), "arg0" .= arg0]+    A_Word arg0 -> object [ "tag" .= ("A_Word" :: Text), "arg0" .= arg0]++instance FromJSON MeshAttribute where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "A_Float" -> A_Float <$> obj .: "arg0"+      "A_V2F" -> A_V2F <$> obj .: "arg0"+      "A_V3F" -> A_V3F <$> obj .: "arg0"+      "A_V4F" -> A_V4F <$> obj .: "arg0"+      "A_M22F" -> A_M22F <$> obj .: "arg0"+      "A_M33F" -> A_M33F <$> obj .: "arg0"+      "A_M44F" -> A_M44F <$> obj .: "arg0"+      "A_Int" -> A_Int <$> obj .: "arg0"+      "A_Word" -> A_Word <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON MeshPrimitive where+  toJSON v = case v of+    P_Points -> object [ "tag" .= ("P_Points" :: Text)]+    P_TriangleStrip -> object [ "tag" .= ("P_TriangleStrip" :: Text)]+    P_Triangles -> object [ "tag" .= ("P_Triangles" :: Text)]+    P_TriangleStripI arg0 -> object [ "tag" .= ("P_TriangleStripI" :: Text), "arg0" .= arg0]+    P_TrianglesI arg0 -> object [ "tag" .= ("P_TrianglesI" :: Text), "arg0" .= arg0]++instance FromJSON MeshPrimitive where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "P_Points" -> pure P_Points+      "P_TriangleStrip" -> pure P_TriangleStrip+      "P_Triangles" -> pure P_Triangles+      "P_TriangleStripI" -> P_TriangleStripI <$> obj .: "arg0"+      "P_TrianglesI" -> P_TrianglesI <$> obj .: "arg0"+  parseJSON _ = mzero++instance ToJSON Mesh where+  toJSON v = case v of+    Mesh{..} -> object+      [ "tag" .= ("Mesh" :: Text)+      , "mAttributes" .= mAttributes+      , "mPrimitive" .= mPrimitive+      ]++instance FromJSON Mesh where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Mesh" -> do+        mAttributes <- obj .: "mAttributes"+        mPrimitive <- obj .: "mPrimitive"+        pure $ Mesh+          { mAttributes = mAttributes+          , mPrimitive = mPrimitive+          } +  parseJSON _ = mzero+
+ src/LambdaCube/PipelineSchema.hs view
@@ -0,0 +1,153 @@+-- generated file, do not modify!+-- 2016-01-28T13:15:31.196716Z++{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module LambdaCube.PipelineSchema where++import Data.Int+import Data.Word+import Data.Map+import Data.Vector (Vector(..))+import LambdaCube.Linear++import Data.Text+import Data.Aeson hiding (Value,Bool)+import Data.Aeson.Types hiding (Value,Bool)+import Control.Monad++import LambdaCube.IR++data StreamType+  = Attribute_Word+  | Attribute_V2U+  | Attribute_V3U+  | Attribute_V4U+  | Attribute_Int+  | Attribute_V2I+  | Attribute_V3I+  | Attribute_V4I+  | Attribute_Float+  | Attribute_V2F+  | Attribute_V3F+  | Attribute_V4F+  | Attribute_M22F+  | Attribute_M23F+  | Attribute_M24F+  | Attribute_M32F+  | Attribute_M33F+  | Attribute_M34F+  | Attribute_M42F+  | Attribute_M43F+  | Attribute_M44F+  deriving (Show, Eq, Ord)++data ObjectArraySchema+  = ObjectArraySchema+  { primitive :: FetchPrimitive+  , attributes :: Map String StreamType+  }++  deriving (Show, Eq, Ord)++data PipelineSchema+  = PipelineSchema+  { objectArrays :: Map String ObjectArraySchema+  , uniforms :: Map String InputType+  }++  deriving (Show, Eq, Ord)+++instance ToJSON StreamType where+  toJSON v = case v of+    Attribute_Word -> object [ "tag" .= ("Attribute_Word" :: Text)]+    Attribute_V2U -> object [ "tag" .= ("Attribute_V2U" :: Text)]+    Attribute_V3U -> object [ "tag" .= ("Attribute_V3U" :: Text)]+    Attribute_V4U -> object [ "tag" .= ("Attribute_V4U" :: Text)]+    Attribute_Int -> object [ "tag" .= ("Attribute_Int" :: Text)]+    Attribute_V2I -> object [ "tag" .= ("Attribute_V2I" :: Text)]+    Attribute_V3I -> object [ "tag" .= ("Attribute_V3I" :: Text)]+    Attribute_V4I -> object [ "tag" .= ("Attribute_V4I" :: Text)]+    Attribute_Float -> object [ "tag" .= ("Attribute_Float" :: Text)]+    Attribute_V2F -> object [ "tag" .= ("Attribute_V2F" :: Text)]+    Attribute_V3F -> object [ "tag" .= ("Attribute_V3F" :: Text)]+    Attribute_V4F -> object [ "tag" .= ("Attribute_V4F" :: Text)]+    Attribute_M22F -> object [ "tag" .= ("Attribute_M22F" :: Text)]+    Attribute_M23F -> object [ "tag" .= ("Attribute_M23F" :: Text)]+    Attribute_M24F -> object [ "tag" .= ("Attribute_M24F" :: Text)]+    Attribute_M32F -> object [ "tag" .= ("Attribute_M32F" :: Text)]+    Attribute_M33F -> object [ "tag" .= ("Attribute_M33F" :: Text)]+    Attribute_M34F -> object [ "tag" .= ("Attribute_M34F" :: Text)]+    Attribute_M42F -> object [ "tag" .= ("Attribute_M42F" :: Text)]+    Attribute_M43F -> object [ "tag" .= ("Attribute_M43F" :: Text)]+    Attribute_M44F -> object [ "tag" .= ("Attribute_M44F" :: Text)]++instance FromJSON StreamType where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "Attribute_Word" -> pure Attribute_Word+      "Attribute_V2U" -> pure Attribute_V2U+      "Attribute_V3U" -> pure Attribute_V3U+      "Attribute_V4U" -> pure Attribute_V4U+      "Attribute_Int" -> pure Attribute_Int+      "Attribute_V2I" -> pure Attribute_V2I+      "Attribute_V3I" -> pure Attribute_V3I+      "Attribute_V4I" -> pure Attribute_V4I+      "Attribute_Float" -> pure Attribute_Float+      "Attribute_V2F" -> pure Attribute_V2F+      "Attribute_V3F" -> pure Attribute_V3F+      "Attribute_V4F" -> pure Attribute_V4F+      "Attribute_M22F" -> pure Attribute_M22F+      "Attribute_M23F" -> pure Attribute_M23F+      "Attribute_M24F" -> pure Attribute_M24F+      "Attribute_M32F" -> pure Attribute_M32F+      "Attribute_M33F" -> pure Attribute_M33F+      "Attribute_M34F" -> pure Attribute_M34F+      "Attribute_M42F" -> pure Attribute_M42F+      "Attribute_M43F" -> pure Attribute_M43F+      "Attribute_M44F" -> pure Attribute_M44F+  parseJSON _ = mzero++instance ToJSON ObjectArraySchema where+  toJSON v = case v of+    ObjectArraySchema{..} -> object+      [ "tag" .= ("ObjectArraySchema" :: Text)+      , "primitive" .= primitive+      , "attributes" .= attributes+      ]++instance FromJSON ObjectArraySchema where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "ObjectArraySchema" -> do+        primitive <- obj .: "primitive"+        attributes <- obj .: "attributes"+        pure $ ObjectArraySchema+          { primitive = primitive+          , attributes = attributes+          } +  parseJSON _ = mzero++instance ToJSON PipelineSchema where+  toJSON v = case v of+    PipelineSchema{..} -> object+      [ "tag" .= ("PipelineSchema" :: Text)+      , "objectArrays" .= objectArrays+      , "uniforms" .= uniforms+      ]++instance FromJSON PipelineSchema where+  parseJSON (Object obj) = do+    tag <- obj .: "tag"+    case tag :: Text of+      "PipelineSchema" -> do+        objectArrays <- obj .: "objectArrays"+        uniforms <- obj .: "uniforms"+        pure $ PipelineSchema+          { objectArrays = objectArrays+          , uniforms = uniforms+          } +  parseJSON _ = mzero+
+ src/LambdaCube/PipelineSchemaUtil.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-}+module LambdaCube.PipelineSchemaUtil where++import Control.Monad.Writer+import qualified Data.Map as Map+import LambdaCube.PipelineSchema++a @: b = tell [(a,b)]+defObjectArray n p m = mapM_ tell [PipelineSchema (Map.singleton n $ ObjectArraySchema p $ Map.singleton a t) mempty | (a,t) <- execWriter m]+defUniforms m = tell $ PipelineSchema mempty $ Map.fromList $ execWriter m+makeSchema a = execWriter a :: PipelineSchema++unionObjectArraySchema (ObjectArraySchema a1 b1) (ObjectArraySchema a2 b2) =+  ObjectArraySchema (if a1 == a2 then a1 else error $ "object array schema primitive mismatch " ++ show (a1,a2))+                    (Map.unionWith (\a b -> if a == b then a else error $ "object array schema attribute type mismatch " ++ show (a,b)) b1 b2)++instance Monoid PipelineSchema where+  mempty = PipelineSchema mempty mempty+  mappend (PipelineSchema a1 b1) (PipelineSchema a2 b2) =+    PipelineSchema (Map.unionWith unionObjectArraySchema a1 a2) (Map.unionWith (\a b -> if a == b then a else error $ "schema type mismatch " ++ show (a,b)) b1 b2)