Improve item location code, including some error detection

src/Dodge/Item/Grammar.hs

@@ -1,7 +1,7 @@
 module Dodge.Item.Grammar
     (invTrees
     , invIndentIM
-    , invAdj
+    , invAdj'
     )
     where
 import Control.Applicative
@@ -92,11 +92,24 @@ invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItemStructu
 invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems .
     fmap (singleLDT . baseCIS)
 
-invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
-invAdj = IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
+-- this has provoked an error: hopefully it will crop up at some point and get
+-- debugged with suitable info
+--invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
+--invAdj =  IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
+--  where
+--    getid (itm, _,_,_) = fromMaybe 
+--        (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
+--        $ itm ^? itLocation . ilInvID
+
+invAdj' :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
+invAdj' im = do
+    l <- mapM g $ invLDT im
+    return $ IM.unions l
   where
-    getid (itm, _,_,_) = fromMaybe (error "invAdj attempt to find item not in inventory") $
-        itm ^? itLocation . ilInvID
+    g = dtToLRAdjEither getid . ldtToDT
+    getid (itm, _,_,_) = maybe
+        (Left ("invAdj' item " ++ show ( _itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
+        Right $ itm ^? itLocation . ilInvID
 
 invIndentIM :: IM.IntMap Item -> IM.IntMap (Item,Int, LabelDoubleTreeNodeType ComposeLinkType )
 invIndentIM = IM.fromAscList . zip [0..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT