Data.Data experiment: Use Nothing result instead of error call.

1 files changed, 15 insertions, 12 deletions

diff --git a/AttributeData.hs b/AttributeData.hs
index 2b2bc96..86cb1e4 100644
--- a/AttributeData.hs
+++ b/AttributeData.hs
@@ -36,6 +36,7 @@ import LambdaCube.GL.Util
 import LambdaCube.GL.Input.Type
 import LambdaCube.GL.Input hiding (createObjectCommands)
 
+import Control.Monad.State.Lazy
 
 import MaskableStream
 
@@ -75,17 +76,19 @@ foo lookupA = do
     case dataTypeRep dt of
         AlgRep (c:_) -> do
             let fields = constrFields c
-                mkb :: Data k => String -> k
-                mkb n = fix $ \v ->
-                    fromMaybe (error $ "mkb " ++ n) $ case lookupA n of
-                        Just (This k@(AttributeKey tt _ _)) -> case tagTypable tt of
-                            Witness -> cast k
-                        _ -> Nothing
-                z :: x -> (,) [String] x
-                z r = (fields, r)
-                k :: Data b => (,) [String] (b -> r) -> (,) [String] r
-                k (n:ns,btor) = (ns,btor (mkb n))
-                (_,ks) = gunfold k z c :: (,) [String] attrkeys
-            Just ks
+                mkb :: (MonadPlus m, Data k) => String -> m k
+                mkb n = case lookupA n of
+                            Just (This k@(AttributeKey tt _ _)) -> case tagTypable tt of
+                                Witness -> maybe mzero return $ cast k
+                            _ -> mzero
+                z :: x -> StateT [String] Maybe x
+                z r = put fields >> return r
+                k :: Data b => StateT [String] Maybe (b -> r) -> StateT [String] Maybe r
+                k c = do btor <- c
+                         n:ns <- get
+                         put ns
+                         a <- mkb n
+                         return (btor a)
+            evalStateT (gunfold k z c) [] -- :: (,) [String] attrkeys
         _ -> Nothing