Here is an attempt at implementing a commute progress meter. It lets
you create an arbitrary number of named counters. If you increment a
counter, and it was the last counter incremented, it will write over the
same line. Otherwise, the counter will appear on a new line.
The code is just a proof of concept, so don't expect to see it in an
official repository anytime soon. Carges of amateurishness and
crappiness in all forms shall be gratefully accepted, doubly so if
you volunteer to fix the code.
I suspect that the main reason we never implemented commute counters is
perfectionist inertia: we wanted to do it right, so we never got it
done. Maybe having a completely wrong implementation will help us to
overcome this inertia. That said, I cannot work on this right now, so
please step right up!
----------
Mon Nov 5 00:42:19 CET 2007 Eric Kow <[EMAIL PROTECTED]>
* Count number of times the --verbose and --quiet flags are passed in.
Mon Nov 5 00:43:30 CET 2007 Eric Kow <[EMAIL PROTECTED]>
* Add a new 'debugMode' global variable.
Mon Nov 5 00:46:11 CET 2007 Eric Kow <[EMAIL PROTECTED]>
* Set global debugMode flag on -v -v -v
Mon Nov 5 21:19:01 CET 2007 Eric Kow <[EMAIL PROTECTED]>
* Add some more debug functions.
The debugCounter function lets you output named progress counters in
debug mode.
Mon Nov 5 21:25:54 CET 2007 Eric Kow <[EMAIL PROTECTED]>
* [issue72] Show commute progress.
New patches:
[Count number of times the --verbose and --quiet flags are passed in.
Eric Kow <[EMAIL PROTECTED]>**20071104234219] {
hunk ./src/Darcs/Arguments.lhs 27
- quiet, any_verbosity, disable, restrict_paths,
+ quiet, any_verbosity, get_verbosity, disable, restrict_paths,
hunk ./src/Darcs/Arguments.lhs 333
+
+get_verbosity :: [DarcsFlag] -> Int -- ^ 0 is normal
+get_verbosity opts = if NormalVerbosity `elem` opts
+ then 0
+ else num Verbose - num Quiet
+ where num v = length $ filter (== v) opts
}
[Add a new 'debugMode' global variable.
Eric Kow <[EMAIL PROTECTED]>**20071104234330] {
hunk ./src/Darcs/Global.lhs 26
- sshControlMasterDisabled, setSshControlMasterDisabled,
- ) where
+ sshControlMasterDisabled, setSshControlMasterDisabled,
+ debugMode, setDebugMode
+ ) where
hunk ./src/Darcs/Global.lhs 74
+{-# NOINLINE _debugMode #-}
+_debugMode :: IORef Bool
+_debugMode = unsafePerformIO $ newIORef False
+
+setDebugMode :: IO ()
+setDebugMode = writeIORef _debugMode True
+
+{-# NOINLINE debugMode #-}
+debugMode :: Bool
+debugMode = unsafePerformIO $ readIORef _debugMode
+
}
[Set global debugMode flag on -v -v -v
Eric Kow <[EMAIL PROTECTED]>**20071104234611] {
hunk ./src/Darcs/Commands.lhs 44
-import Darcs.Global ( setSshControlMasterDisabled )
+import Darcs.Global ( setDebugMode, setSshControlMasterDisabled )
hunk ./src/Darcs/Commands.lhs 336
+ when (get_verbosity os >= 3) setDebugMode
}
[Add some more debug functions.
Eric Kow <[EMAIL PROTECTED]>**20071105201901
The debugCounter function lets you output named progress counters in
debug mode.
] {
hunk ./src/Darcs/Global.lhs 27
- debugMode, setDebugMode
+ debugMode, setDebugMode,
+ debug, debugLn, debugCounter,
hunk ./src/Darcs/Global.lhs 31
+import qualified Data.Map as Map
hunk ./src/Darcs/Global.lhs 34
-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef )
hunk ./src/Darcs/Global.lhs 36
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPutStrLn, hFlush, stderr, stdout)
hunk ./src/Darcs/Global.lhs 80
+{-# NOINLINE _debugCounters #-}
+_debugCounters :: IORef (Map.Map String Int)
+_debugCounters = unsafePerformIO $ newIORef Map.empty
+
+{-# NOINLINE _debugPrevious #-}
+_debugPrevious :: IORef String
+_debugPrevious = unsafePerformIO $ newIORef ""
+
hunk ./src/Darcs/Global.lhs 95
+debug :: String -> a -> a
+debug msg x = if debugMode
+ then unsafePerformIO $ putStr msg >> return x
+ else x
+
+debugLn :: String -> a -> a
+debugLn msg = debug (msg ++ "\n")
+
+debugCounter :: String -> a -> a
+debugCounter k x = if debugMode
+ then unsafePerformIO $ do
+ modifyIORef _debugCounters $ Map.insertWith (+) k 1
+ cs <- readIORef _debugCounters
+ previous <- readIORef _debugPrevious
+ writeIORef _debugPrevious k
+ if previous == k
+ then putChar '\r'
+ else putChar '\n'
+ putStr $ k ++ ": " ++ show (cs Map.! k) ++ ". "
+ hFlush stdout
+ return x
+ else x
+
}
[[issue72] Show commute progress.
Eric Kow <[EMAIL PROTECTED]>**20071105202554] {
hunk ./src/Darcs/Patch/Commute.lhs 68
+import Darcs.Global ( debugCounter )
hunk ./src/Darcs/Patch/Commute.lhs 191
+ debugCounter "commute named" $
hunk ./src/Darcs/Patch/Prim.lhs 51
+import Darcs.Global ( debugCounter )
hunk ./src/Darcs/Patch/Prim.lhs 648
+ debugOther $
hunk ./src/Darcs/Patch/Prim.lhs 654
+ debugOther $
hunk ./src/Darcs/Patch/Prim.lhs 660
- | f2 == d' = Failed
+ = debugOther c where
+ c | f2 == d' = Failed
hunk ./src/Darcs/Patch/Prim.lhs 665
- | is_superdir d2 d' || is_superdir d2 d = Failed
+ = debugOther c where
+ c | is_superdir d2 d' || is_superdir d2 d = Failed
hunk ./src/Darcs/Patch/Prim.lhs 671
- | f == d' || f' == d = Failed
+ = debugOther c where
+ c | f == d' || f' == d = Failed
hunk ./src/Darcs/Patch/Prim.lhs 809
+ debugFP $
hunk ./src/Darcs/Patch/Prim.lhs 812
- case try_tok_replace t o n old2 of
+ debugFP $
+ case try_tok_replace t o n old2 of
hunk ./src/Darcs/Patch/Prim.lhs 821
- | seq f $ t /= t2 = Failed
+ = debugFP c where
+ c | seq f $ t /= t2 = Failed
hunk ./src/Darcs/Patch/Prim.lhs 1024
+
+\begin{code}
+debugFP, debugOther :: a -> a
+debugFP = debugCounter "commute primitive"
+debugOther = debugCounter "commute trivial primitive"
+\end{code}
}
Context:
[TAG darcs unstable 2007-11-04
Eric Kow <[EMAIL PROTECTED]>**20071104235616]
Patch bundle hash:
adfe9292bbf525ce466074267cb3d25fcf1ba77a
_______________________________________________
darcs-devel mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-devel
