error recovery in rename and check grammar: report all errors in a module before terminating

src-3.0/GF/Data/Operations.hs

@@ -22,7 +22,7 @@ module GF.Data.Operations (-- * misc functions
 		   performOps, repeatUntilErr, repeatUntil, okError, isNotError,
 		   showBad, lookupErr, lookupErrMsg, lookupDefault, updateLookupList,
 		   mapPairListM, mapPairsM, pairM, mapErr, mapErrN, foldErr,
-		   (!?), errList, singleton, 
+		   (!?), errList, singleton, mapsErr, mapsErrTree,
 		   
 		   -- ** checking
 		   checkUnique, titleIfNeeded, errMsg, errAndMsg,
@@ -183,6 +183,7 @@ mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2))
     nss = length ss
     fxs = map f xs
 
+
 -- | like @foldM@, but also return the latest value if fails
 foldErr :: (a -> b -> Err a) -> a -> [b] -> Err (a, Maybe String)
 foldErr f s xs = case xs of
@@ -630,6 +631,23 @@ instance ErrorMonad (STM s) where
                                 `handle` (\e -> let STM g' = (g e) in
                                                     g' s))
 
+-- error recovery with multiple reporting AR 30/5/2008
+mapsErr :: (a -> Err b) -> [a] -> Err [b]
+
+mapsErr f = seqs . map f where
+  seqs es = case es of
+    Ok v : ms -> case seqs ms of
+      Ok vs -> return (v : vs)
+      b     -> b
+    Bad s : ms -> case seqs ms of
+      Ok vs  -> Bad s
+      Bad ss -> Bad (s +++++ ss)
+    [] -> return []
+
+mapsErrTree :: (Ord a) => ((a,b) -> Err (a,c)) -> BinTree a b -> Err (BinTree a c)
+mapsErrTree f t =  mapsErr f (tree2list t) >>= return . sorted2tree
+
+
 -- | if the first check fails try another one
 checkAgain :: ErrorMonad m => m a -> m a -> m a
 checkAgain c1 c2 = handle_ c1 c2