From a38efe70c6aa340242cb25c3b8fd2845f98b1bb8 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Mon, 25 Jun 2012 15:55:59 +0000
Subject: [PATCH] Fix for warning messages from checkMapRecover

Reimplemented it with the new function accumulateError.

Also keeping the formatting of errors and warnings unchanged for now, to avoid
potentially causing problems in the GF Eclipse Plugin.
---
 src/compiler/GF/Infra/CheckM.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs
index e29dbb321..ea07d06c4 100644
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -78,10 +78,13 @@ accumulateError chk a =
 -- | Run an error check, report errors and warnings
 runCheck :: Check a -> Err (a,String)
 runCheck c =
-  case unCheck c [] ([],[]) of
-    (([],ws),Success v) -> Ok  (v, render (vcat (reverse ws)))
-    ((es,ws),Success v) -> Bad (   render (vcat (reverse (es++ws))))
-    ((es,ws),Fail msg)  -> Bad (   render (vcat (reverse (msg:es++ws))))
+    case unCheck c [] ([],[]) of
+      (([],ws),Success v) -> Ok (v,render (list ws))
+      (msgs   ,Success v) -> bad msgs
+      ((es,ws),Fail    e) -> bad ((e:es),ws)
+  where
+    bad (es,ws) = Bad (render $ list ws $$ list es)
+    list = vcat . reverse
 
 checkMap :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b)
 checkMap f map = do xs <- mapM (\(k,v) -> do v <- f k v
@@ -89,6 +92,9 @@ checkMap f map = do xs <- mapM (\(k,v) -> do v <- f k v
                     return (Map.fromAscList xs)
 
 checkMapRecover :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b)
+checkMapRecover f mp = checkMap f' mp
+  where f' key info = accumulateError (f key) info
+{-
 checkMapRecover f mp = do 
   let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp)
   case [s | (_,Bad s) <- xs] of
@@ -97,6 +103,7 @@ checkMapRecover f mp = do
       let (kx,ss) = unzip [((k,x),s) | (k, Ok (x,s)) <- xs]
       if not (all null ss) then checkWarn (text (unlines ss)) else return ()
       return (Map.fromAscList kx)
+-}
 
 checkErr :: Err a -> Check a
 checkErr (Ok x)    = return x