GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

Fix for warning messages from checkMapRecover

Browse Source 
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.
This commit is contained in:
hallgren
2012-06-25 15:55:59 +00:00
parent af4886dace
commit 0b1a963d7a
1 changed files with 11 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/compiler/GF/Infra/CheckM.hs
View File

@@ -78,10 +78,13 @@ accumulateError chk a =
-- | Run an error check, report errors and warnings -- | Run an error check, report errors and warnings
runCheck :: Check a -> Err (a,String) runCheck :: Check a -> Err (a,String)
runCheck c = runCheck c =
case unCheck c [] ([],[]) of case unCheck c [] ([],[]) of
(([],ws),Success v) -> Ok (v, render (vcat (reverse ws))) (([],ws),Success v) -> Ok (v,render (list ws))
((es,ws),Success v) -> Bad ( render (vcat (reverse (es++ws)))) (msgs ,Success v) -> bad msgs
((es,ws),Fail msg) -> Bad ( render (vcat (reverse (msg:es++ws)))) ((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 :: (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 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) return (Map.fromAscList xs)
checkMapRecover :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b) 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 checkMapRecover f mp = do
let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp) let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp)
case [s | (_,Bad s) <- xs] of 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] let (kx,ss) = unzip [((k,x),s) | (k, Ok (x,s)) <- xs]
if not (all null ss) then checkWarn (text (unlines ss)) else return () if not (all null ss) then checkWarn (text (unlines ss)) else return ()
return (Map.fromAscList kx) return (Map.fromAscList kx)
-}
checkErr :: Err a -> Check a checkErr :: Err a -> Check a
checkErr (Ok x) = return x checkErr (Ok x) = return x