[clean up what is printed to screen, more clearly define the difference between 'progress' and 'verbose'. wait until after typechecking to print errors.
John Meacham <john@repetae.net>**20090807055158
 Ignore-this: dc48f4cc40e5773032cb4f3bb9a01d6b
] hunk ./src/FrontEnd/Exports.hs 53
-    wdump FD.Progress $ do
-        putErrLn $ "Determining Exports/Imports: " ++ show (sort [ m | m <- map modInfoName ms])
+    --wdump FD.Progress $ do
+    --    putErrLn $ "Determining Exports/Imports: " ++ show (sort [ m | m <- map modInfoName ms])
hunk ./src/FrontEnd/HsErrors.hs 23
-hsType :: MonadWarn m => HsType -> m ()
+hsType :: (MonadSrcLoc m, MonadWarn m) => HsType -> m ()
hunk ./src/FrontEnd/HsErrors.hs 25
-    err "h98-forall" "Explicit quantification is a non-haskell98 feature"
+    addWarn "h98-forall" "Explicit quantification is a non-haskell98 feature"
hunk ./src/FrontEnd/HsErrors.hs 28
-    err "h98-forall" "Explicit quantification is a non-haskell98 feature"
+    addWarn "h98-forall" "Explicit quantification is a non-haskell98 feature"
hunk ./src/FrontEnd/Tc/Main.hs 10
+import System.IO(hPutChar,stderr)
hunk ./src/FrontEnd/Tc/Main.hs 839
-        when verbose $ liftIO $ do putChar '.'; hFlush stdout
+        liftIO $ do hPutChar stderr '.'
+        liftIO $ hFlush stderr
hunk ./src/FrontEnd/Tc/Main.hs 849
-        when verbose $ liftIO $ putStrLn "!"
+        liftIO $ putErrLn "!"
hunk ./src/FrontEnd/Tc/Module.hs 12
+import qualified Data.Foldable as T
hunk ./src/FrontEnd/Tc/Module.hs 85
-processModule :: FieldMap -> ModInfo -> IO ModInfo
+processModule :: FieldMap -> ModInfo -> IO (ModInfo,[Warning])
hunk ./src/FrontEnd/Tc/Module.hs 99
-    processErrors errs
-    return $ modInfoHsModule_s mod' m
+    return $ (modInfoHsModule_s mod' m,errs)
hunk ./src/FrontEnd/Tc/Module.hs 116
-    wdump FD.Progress $ do
-        putErrLn $ "Typing: " ++ show ([ m | Module m <- map modInfoName ms])
+    --wdump FD.Progress $ do
+    --    putErrLn $ "Typing: " ++ show ([ m | Module m <- map modInfoName ms])
hunk ./src/FrontEnd/Tc/Module.hs 119
-    ms <- mapM (processModule (hoFieldMap htc)) ms
+    mserrs <- mapM (processModule (hoFieldMap htc)) ms
+    let ms = fsts mserrs
hunk ./src/FrontEnd/Tc/Module.hs 139
-    wdump FD.Progress $ do
-        putErrLn $ "Kind inference"
+    --wdump FD.Progress $ do
+    --    putErrLn $ "Kind inference"
hunk ./src/FrontEnd/Tc/Module.hs 223
-    wdump FD.Progress $ do
-        putErrLn $ "Type inference"
+    --wdump FD.Progress $ do
+    --    putErrLn $ "Type inference"
hunk ./src/FrontEnd/Tc/Module.hs 236
+        mapM_ addWarning (concatMap snd mserrs)
hunk ./src/FrontEnd/Tc/Module.hs 244
-        return (env,checkedRules out,cc',tcDs)
+        return (env,T.toList $ checkedRules out,cc',tcDs)
hunk ./src/FrontEnd/Tc/Monad.hs 55
+import qualified Data.Foldable as T
+import qualified Data.Sequence as Seq
+
hunk ./src/FrontEnd/Tc/Monad.hs 114
-    checkedRules     :: [Rule],
+    checkedRules     :: Seq.Seq Rule,
hunk ./src/FrontEnd/Tc/Monad.hs 116
+    tcWarnings       :: Seq.Seq Warning,
hunk ./src/FrontEnd/Tc/Monad.hs 190
+    liftIO $ processErrors (T.toList $ tcWarnings out)
hunk ./src/FrontEnd/Tc/Monad.hs 206
-addRule r = tell mempty { checkedRules = [r] }
+addRule r = tell mempty { checkedRules = Seq.singleton r }
hunk ./src/FrontEnd/Tc/Monad.hs 326
-listenCheckedRules action = censor (\x -> x { checkedRules = mempty }) $ listens checkedRules action
+listenCheckedRules action = do
+    (a,r) <- censor (\x -> x { checkedRules = mempty }) $ listens checkedRules action
+    return (a,T.toList r)
hunk ./src/FrontEnd/Tc/Monad.hs 532
-    addWarning w = liftIO $ processErrors [w]
+--    addWarning w = liftIO $ processErrors [w]
+    addWarning w = tell mempty { tcWarnings = Seq.singleton w }
+
hunk ./src/Ho/Build.hs 228
-                False -> putVerboseLn $ printf "%-23s [%s]" (show m) fn'
-                True -> putVerboseLn $ printf "%-23s [%s] <%s>" (show m) fn' mho'
+                False -> putProgressLn $ printf "%-23s [%s]" (show m) fn'
+                True -> putProgressLn $ printf "%-23s [%s] <%s>" (show m) fn' mho'
hunk ./src/Ho/Build.hs 344
-                        putVerboseLn $ printf "Fresh: <%s>" fp
+                        putProgressLn $ printf "Fresh: <%s>" fp
hunk ./src/Ho/Build.hs 352
-                        putVerboseLn $ if null stale
+                        putProgressLn $ if null stale
hunk ./src/Ho/Build.hs 386
-    unless (null libs) $ putVerboseLn $ "Loading libraries:" <+> show libs
+    unless (null libs) $ putProgressLn $ "Loading libraries:" <+> show libs
hunk ./src/Ho/Build.hs 425
+printModProgress :: Int -> Int -> IO Int -> [HsModule] -> IO ()
+printModProgress _ _ _ [] = return ()
+printModProgress _ _ tickProgress ms | not progress = mapM_ (const tickProgress) ms
+printModProgress fmtLen maxModules tickProgress ms = f "[" ms where
+    f bl ms = do
+        curModule <- tickProgress
+        case ms of
+            [x] -> g curModule bl "]" x
+            (x:xs) -> do g curModule bl "|" x; putErrLn ""; f "|" xs
+    g curModule bl el modName = putErr $ printf "%s%*d of %*d%s %s" bl fmtLen curModule fmtLen maxModules el (show $ hsModuleName modName)
hunk ./src/Ho/Build.hs 449
-    let showProgress ms = forM_ ms $ \modName ->
-          do curModule <- tickProgress
-             printf "[%*d of %*d] %s\n" fmtLen curModule fmtLen maxModules (show $ hsModuleName modName)
+    let showProgress ms = printModProgress fmtLen maxModules tickProgress ms
+--    let showProgress ms = forM_ ms $ \modName ->
+--          do curModule <- tickProgress
+--             printf "[%*d of %*d] %s\n" fmtLen curModule fmtLen maxModules (show $ hsModuleName modName)
+--        showProgress ms = forM_ ms $ \modName ->
+--          do curModule <- tickProgress
+--             printf "[%*d of %*d] %s\n" fmtLen curModule fmtLen maxModules (show $ hsModuleName modName)
hunk ./src/Ho/Build.hs 577
-        wdump FD.Progress $ do
+        when verbose $ do
hunk ./src/Ho/Build.hs 668
+    fn <- shortenPath fn
hunk ./src/Main.hs 82
-progress str = wdump FD.Progress $  (putErrLn str) >> hFlush stderr
hunk ./src/Main.hs 326
-    progress "Initial optimization pass"
+    putProgressLn "Initial optimization pass"
hunk ./src/Main.hs 329
-    progress "!"
+    putProgressLn "!"
hunk ./src/Main.hs 392
-    progress "!"
+    putProgressLn "!"
hunk ./src/Main.hs 660
-    progress "Converting to Grin..."
+    putProgressLn "Converting to Grin..."
hunk ./src/Main.hs 754
-    progress ("Writing " ++ show cf)
+    putProgressLn ("Writing " ++ show cf)
hunk ./src/Main.hs 756
-    progress ("Running: " ++ comm)
+    putProgressLn ("Running: " ++ comm)
hunk ./src/Options.hs 9
+    putProgress,
+    putProgressLn,
hunk ./src/Options.hs 14
+    progress,
hunk ./src/Options.hs 216
-    optDumpSet     = S.empty,
+    optDumpSet     = S.singleton FlagDump.Progress,
hunk ./src/Options.hs 369
+putProgress :: String -> IO ()
+putProgress s = when progress $ putErr s
+
+-- | Put a line to stderr when running verbose.
+putProgressLn :: String -> IO ()
+putProgressLn s = putProgress (s ++ "\n")
+
+-- | Is verbose > 0?
+progress :: Bool
+progress = dump FlagDump.Progress
+