[Better Error Handling
martin.hofmann@uni-bamberg.de**20091111155137] hunk ./igor2.cabal 9
-build-depends: MonadCatchIO-mtl -any, ansi-terminal >=0.5.0,
+build-depends: MonadCatchIO-mtl >= 0.2, ansi-terminal >=0.5.0,
hunk ./igor2.cabal 14
-               haskell98 -any, hint >=0.3, hpc -any, mtl >=1.0, old-locale >=1.0,
+               haskell98 -any, hint >=0.3.2, hpc -any, mtl >=1.0, old-locale >=1.0,
hunk ./src/IOInterpreter.hs 4
+
+import Prelude hiding ( catch )
hunk ./src/IOInterpreter.hs 7
---import Control.Monad.CatchIO
+import Control.Monad.Error (throwError)
+import Control.Monad.CatchIO ( catch )
+--import Control.Exception.Extensible hiding ( catch )
+import Control.Exception hiding (catch)
hunk ./src/IOInterpreter.hs 29
-typecheck :: String -> IO ()
+typecheck :: FilePath -> IO ()
hunk ./src/IOInterpreter.hs 40
-        Left err -> return.show $ err
hunk ./src/IOInterpreter.hs 41
+        Left err -> fail (show err)       
+
hunk ./src/IOInterpreter.hs 50
-        eval s
---      say "Load SomeModule.hs"
---      loadModules ["SomeModule.hs"]
---      --
---      say "Put the Prelude, Data.Map and *SomeModule in scope"
---      say "Data.Map is qualified as M!"
---      setTopLevelModules ["SomeModule"]
---      setImportsQ [("Prelude", Nothing), ("Data.Map", Just "M")]
---      --
---      say "Now we can query the type of an expression"
---      let expr1 = "M.singleton (f, g, h, 42)"
---      say $ "e.g. typeOf " ++ expr1
---      say =<< typeOf expr1
---      --
---      say $ "Observe that f, g and h are defined in SomeModule.hs, " ++
---            "but f is not exported. Let's check it..."
---      exports <- getModuleExports "SomeModule"
---      say (show exports)
---      --
---      say "We can also evaluate an expression; the result will be a string"
---      let expr2 = "length $ concat [[f,g],[h]]"
---      say $ concat ["e.g. eval ", show expr1]
---      a <- eval expr2
---      say (show a)
---      --
---      say "Or we can interpret it as a proper, say, int value!"
---      a_int <- interpret expr2 (as :: Int)
---      say (show a_int)
---      --
---      say "This works for any monomorphic type, even for function types"
---      let expr3 = "\\(Just x) -> succ x"
---      say $ "e.g. we interpret " ++ expr3 ++
---            " with type Maybe Int -> Int and apply it on Just 7"
---      fun <- interpret expr3 (as :: Maybe Int -> Int)
---      say . show $ fun (Just 7)
---      --
---      say "And sometimes we can even use the type system to infer the expected type (eg Maybe Bool -> Bool)!"
---      bool_val <- (interpret expr3 infer `ap` (return $ Just False))
---      say (show $ not bool_val)
---      --
---      say "Here we evaluate an expression of type string, that when evaluated (again) leads to a string"
---      res <- interpret "head $ map show [\"Worked!\", \"Didn't work\"]" infer >>= flip interpret infer
---      say res
+        (forceM $ eval s) `catch` handler
hunk ./src/IOInterpreter.hs 52
+forceM :: Monad m => m a -> m a
+forceM a = a >>= (\x -> return $! x)
hunk ./src/IOInterpreter.hs 55
-say :: String -> Interpreter ()
-say = liftIO . putStrLn
+handler (SomeException e) = throwError . GhcException . show $ e
hunk ./src/IOInterpreter.hs 57
-printInterpreterError :: InterpreterError -> IO ()
-printInterpreterError e = putStrLn $ "Error while interpreting... " ++ (show e)
hunk ./src/UI/UIStarter.hs 225
-                reportError ("Failed to load file:") e >> 
-                return (False,s))
+                 reportError ("Failed to load file:") e >> 
+                 return (False,s)
+               )
hunk ./src/UI/UIStarter.hs 235
-    if (not.isJust $ tdefs) then printerr >> return ()
+    if (not.isJust $ tdefs) then printerr  >> return ()
hunk ./src/UI/UIStarter.hs 242
-    test e d i = do r <- (interprete (ctxtFile s) $ prepare (d !! (i-1)) e) 
-                    hPutDoc stdout $ text "Testing" <+> int i <> 
+    test e d i = ( do r <- (interprete (ctxtFile s) $ prepare (d !! (i-1)) e) 
+                      hPutDoc stdout $ text "Testing" <+> int i <> 
hunk ./src/UI/UIStarter.hs 246
-                                     text r <$> linebreak
+                                     text r <$> linebreak 
+                  ) `catchError` (\e -> reportError "" e)
hunk ./src/UI/UIStarter.hs 250
-    printerr = hPutDoc stdout $ text "No such setting in history:" <+> setDoc <$> linebreak
+    printerr = reportError "No such setting in history:" setDoc
hunk ./src/UI/UIStarter.hs 257
-startIgor s tgts bgks = do
-    let exmpls = liftM2 (,) (getBindings tgts (context s))(getBindings bgks (context s))
+startIgor s tgts bgks =
+    let exmpls = liftM2 (,) (getBindings tgts (context s))(getBindings bgks (context s)) in
hunk ./src/UI/UIStarter.hs 260
-        Left msg      -> putStrLn msg >> return (False, s)
+        Left msg      -> reportError "" msg >> return (False, s)