[code cleaning
martin.hofmann@uni-bamberg.de**20090628231248] hunk ./src/Data/HypoSpace.hs 22
-   
+
+import Control.Arrow ( (***) )
hunk ./src/Data/HypoSpace.hs 226
-atSnd f (a,b) = (a, f b)
-prntAssocs hsp = map (asMap . (atSnd ((mapMaybe (flip getById hsp)).  IS.toList)))
+prntAssocs hsp = map (asMap . (id *** ((mapMaybe (flip getById hsp)).  IS.toList) ) )
hunk ./src/RuleDevelopment/Matching.hs 30
-    let tgtcalls  = map (flip (,) (Just LT)) ((name cr):tgtnames) 
+    let tgtcalls  = map (flip (,) (Just LT)) ((name cr):tgtnames)
hunk ./src/RuleDevelopment/Matching.hs 54
-                        text "Direct call to" <+> (squotes.pretty $ n) <+> 
+                        text "Direct call to" <+> (squotes.pretty $ n) <+>
hunk ./src/RuleDevelopment/Matching.hs 60
-{-| Compute all indirect calls from the provided 'CovrRule' to the function 
+{-| Compute all indirect calls from the provided 'CovrRule' to the function
hunk ./src/RuleDevelopment/Matching.hs 70
-             text "No direct call to" <+> (squotes.pretty $ n) <+> 
-             text "possible!" <+> 
+             text "No direct call to" <+> (squotes.pretty $ n) <+>
+             text "possible!" <+>
hunk ./src/RuleDevelopment/Matching.hs 113
-     possiblePats subs = map (buildPat subs) 
+     possiblePats subs = map (buildPat subs)
hunk ./src/RuleDevelopment/Matching.hs 115
-     
-testPat :: Name -> [CovrRule] -> LHS -> LHS -> IM (Maybe LHS)     
+
+testPat :: Name -> [CovrRule] -> LHS -> LHS -> IM (Maybe LHS)
hunk ./src/RuleDevelopment/Matching.hs 199
-               text "(-) Discarded Match" <+> pretty tgt <+> 
-               text (show callrel) <+> pretty cll <+> text "not allowed" <+> 
+               text "(-) Discarded Match" <+> pretty tgt <+>
+               text (show callrel) <+> pretty cll <+> text "not allowed" <+>
hunk ./src/SynthesisEngine.hs 36
-startSynthesis conf tgt bgk = runLM (scr_verbosity conf) (scr_debug conf) (synthesise conf tgt bgk) 
+startSynthesis conf tgt bgk = 
+    (runLM (scr_verbosity conf) (scr_debug conf) (synthesise conf tgt bgk))
+        `catchError` \m -> return (Left (show m), emptyLog)
hunk ./src/SynthesisEngine.hs 132
-    llogNO $ text "Resulted in" <+> int (length advancements) <+> 
+    llogNO $ text "resulted in" <+> int (length advancements) <+> 
hunk ./src/SynthesisEngine.hs 134
+    hypoCount >>= \c -> llogNO $ text "#Hypos:" <+> pretty c
hunk ./src/UI/IOInterpreter.hs 2
-module UI.IOInterpreter (interprete, typecheck) where
+module UI.IOInterpreter (interprete, typecheck, checkFile, checkDir) where
hunk ./src/UI/IOInterpreter.hs 5
+--import Control.Monad.CatchIO
hunk ./src/UI/IOInterpreter.hs 8
+import System.Directory (doesFileExist, doesDirectoryExist)
hunk ./src/UI/IOInterpreter.hs 12
+checkFile :: FilePath -> IO ()
+checkFile p = do
+    exists <- doesFileExist p
+    when (not exists) (fail $ "File not found: " ++ p)
+    return()
+
+checkDir :: FilePath -> IO ()
+checkDir p = do
+    exists <- doesDirectoryExist p
+    when (not exists) (fail $ "Directory not found: " ++ p)
+    return()
+
+typecheck :: String -> IO ()
hunk ./src/UI/IOInterpreter.hs 28
-        Right _  -> return True
-        Left _   -> return False
+        Right _  -> return ()
+        Left e   -> fail (show e)
hunk ./src/UI/REPLoop.hs 30
-                do
-                    putStrLn $ "\nInterrupted (" ++ (show err) ++ " )"
-                    loop s
+                do putStrLn $ "\nInterrupted (" ++ (show err) ++ " )"
+                   loop s
hunk ./src/UI/UIStarter.hs 59
+    , typeCheck :: Bool
hunk ./src/UI/UIStarter.hs 87
+    , typeCheck = True
hunk ./src/UI/UIStarter.hs 203
-loadBatch s path = do
-    exists <- doesFileExist path 
-    if exists 
-      then do file <- readFile path
-              foldUntil eval s $ lines $ stripComments file
-      else cancel s path "File not found!"
+loadBatch s p =
+    (checkFile p >> readFile p >>= (foldUntil eval s) . lines . stripComments)
+     `catchError` 
+    (\e -> reportError ("Failed to load file:") e >> return (False,s))
hunk ./src/UI/UIStarter.hs 220
-loadFile s path = do
-    exists <- doesFileExist path 
-    if exists 
-      then do ok <- (typecheck  path)
-              if ok 
-                 then do ctx <- parseContext (context s) path
-                         return $ (False,s{context=ctx, ctxtFile=path})
-                 else cancel s path "Failed to type check!"
-      else cancel s path "File not found!"
-      
-cancel s path str = do 
-    putStrLn ("\nFailed to load file: " ++ path ++ "!\n" ++ str)
-    return (False,s)       
+loadFile s p = ( checkFile p >> when (typeCheck s) (typecheck  p) >>
+                 parseContext (context s) p >>= \ctx -> 
+                  return (False,s{context=ctx, ctxtFile=p})
+               ) `catchError` (\e -> 
+                reportError ("Failed to load file:") e >> 
+                return (False,s))
hunk ./src/UI/UIStarter.hs 237
-    test d i = do
-        r <- interprete (ctxtFile s) $ prepare (d !! (i-1)) e
-        hPutDoc stdout $ text "Testing" <+> int i <> text ". hypothesis" <+> 
-                         text "of:" <+> setDoc <^> 
-                         text e <+> text " == " <+> text r <$> linebreak
+    test d i = do r <- interprete (ctxtFile s) $ prepare (d !! (i-1)) e
+                  hPutDoc stdout $ text "Testing" <+> int i <> 
+                                   text ". hypothesis" <+> text "of:" <+> 
+                                   setDoc <^> text e <+> text " == " <+> 
+                                   text r <$> linebreak
+               
hunk ./src/UI/UIStarter.hs 295
-    exist <- doesDirectoryExist (dumpDir s)
-    if (not $ dumpLog s) then return ()
-      else if (not exist) then printErr
-             else writeLog
+    (checkDir (dumpDir s) >> when (dumpLog s) writeLog >> return ())
+      `catchError` (reportError "Log not dumped:")
+    
hunk ./src/UI/UIStarter.hs 299
-    printErr =  putStrLn ("Log not dumped! Directory not found: " ++ 
-                          (dumpDir s)) >> return()
hunk ./src/UI/UIStarter.hs 304
- 
+                  
+reportError s e = putDoc $ (red. text $ "ERROR:") <+>  text s <+> (text.show $ e) <> linebreak
+
hunk ./src/UI/UIStarter.hs 415
-            simplify, \ v s -> s { enhanced  = v })
+            enhanced, \ v s -> s { enhanced  = v })
+    , ("typeCheck",           "type check the specification",
+            typeCheck, \ v s -> s { typeCheck  = v })