From f2389270cf83d1e5fcd9c3f1c23e26d00fb51183 Mon Sep 17 00:00:00 2001
From: Csaba Hruska <csaba.hruska@gmail.com>
Date: Tue, 15 Mar 2016 14:26:41 +0100
Subject: add error messages

---
 src/LambdaCube/GL/Backend.hs | 9 +++++----
 src/LambdaCube/GL/Input.hs   | 5 +++--
 src/LambdaCube/GL/Mesh.hs    | 4 ++--
 3 files changed, 10 insertions(+), 8 deletions(-)

(limited to 'src/LambdaCube')

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 478dfd1..282c281 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -4,6 +4,7 @@ module LambdaCube.GL.Backend where
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State
+import Data.Maybe
 import Data.Bits
 import Data.IORef
 import Data.IntMap (IntMap)
@@ -264,7 +265,7 @@ compileProgram p = do
         , inputUniforms         = Map.fromList inUniforms
         , inputTextures         = Map.fromList inTextures
         , inputTextureUniforms  = S.fromList $ texUnis
-        , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName]
+        , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName]
         }
 
 compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget
@@ -393,7 +394,7 @@ compileStreamData s = do
   buffer <- compileBuffer arrays
   cmdRef <- newIORef []
   let toStream (n,i) = (n,Stream
-        { streamType    = fromJust $ toStreamType =<< Map.lookup n (IR.streamType s)
+        { streamType    = fromMaybe (error $ "missing attribute: " ++ n) $ toStreamType =<< Map.lookup n (IR.streamType s)
         , streamBuffer  = buffer
         , streamArrIdx  = i
         , streamStart   = 0
@@ -436,7 +437,7 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
         uniInputType (GLUniform ty _) = ty
 
     -- object attribute stream commands
-    streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let Just s = Map.lookup name attrs]
+    streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs]
       where 
         attrMap = inputStreams prg
         attrCmd i s = case s of
@@ -603,7 +604,7 @@ setStorage' p@GLRenderer{..} input' = do
                     return (i,Nothing)
             -- create input connection
             let sm      = slotMap input
-                pToI    = [i | n <- glSlotNames, let Just i = Map.lookup n sm]
+                pToI    = [i | n <- glSlotNames, let i = fromMaybe (error $ "missing object array: " ++ n) $ Map.lookup n sm]
                 iToP    = V.update (V.replicate (Map.size sm) Nothing) (V.imap (\i v -> (v, Just i)) pToI)
             writeIORef glInput $ Just $ InputConnection idx input pToI iToP
 
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index 0471a57..7a3b809 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -5,6 +5,7 @@ import Control.Applicative
 import Control.Exception
 import Control.Monad
 import Control.Monad.Writer
+import Data.Maybe
 import Data.IORef
 import Data.Map (Map)
 import Data.IntMap (IntMap)
@@ -101,7 +102,7 @@ addObject input slotName prim indices attribs uniformNames = do
     enabled <- newIORef True
     index <- readIORef seed
     modifyIORef seed (1+)
-    (setters,unis) <- mkUniform [(n,t) | n <- uniformNames, let Just t = Map.lookup n (uniforms sch)]
+    (setters,unis) <- mkUniform [(n,t) | n <- uniformNames, let t = fromMaybe (error $ "missing uniform: " ++ n) $ Map.lookup n (uniforms sch)]
     cmdsRef <- newIORef (V.singleton V.empty)
     let obj = Object
             { objSlot       = slotIdx
@@ -216,7 +217,7 @@ createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++
         uniInputType (GLUniform ty _) = ty
 
     -- object attribute stream commands
-    objStreamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let Just s = Map.lookup name objAttrs]
+    objStreamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name objAttrs]
       where 
         attrMap = inputStreams prg
         objAttrs = objAttributes obj
diff --git a/src/LambdaCube/GL/Mesh.hs b/src/LambdaCube/GL/Mesh.hs
index 0c56f26..5c16e42 100644
--- a/src/LambdaCube/GL/Mesh.hs
+++ b/src/LambdaCube/GL/Mesh.hs
@@ -50,7 +50,7 @@ data GPUMesh
 addMeshToObjectArray :: GLStorage -> String -> [String] -> GPUMesh -> IO Object
 addMeshToObjectArray input slotName objUniNames (GPUMesh _ (GPUData prim streams indices _)) = do
     -- select proper attributes
-    let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input
+    let (ObjectArraySchema slotPrim slotStreams) = fromMaybe (error $ "missing object array: " ++ slotName) $ Map.lookup slotName $! objectArrays $! schema input
         filterStream n _ = Map.member n slotStreams
     addObject input slotName prim indices (Map.filterWithKey filterStream streams) objUniNames
 
@@ -82,7 +82,7 @@ updateMesh :: GPUMesh -> [(String,MeshAttribute)] -> Maybe MeshPrimitive -> IO (
 updateMesh (GPUMesh (Mesh dMA dMP) (GPUData _ dS dI _)) al mp = do
   -- check type match
   let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2
-      ok = and [Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2) | (n,a1) <- al, let Just a2 = Map.lookup n dMA]
+      ok = and [Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2) | (n,a1) <- al, let a2 = fromMaybe (error $ "missing mesh attribute: " ++ n) $ Map.lookup n dMA]
   if not ok then putStrLn "updateMesh: attribute mismatch!"
     else do
       forM_ al $ \(n,a) -> do
-- 
cgit v1.2.3