From c88ec04ec24042c8c65ac9f1f468d49c0a49de38 Mon Sep 17 00:00:00 2001
From: Michael Walker <mike@barrucadu.co.uk>
Date: Sun, 26 Nov 2017 22:22:54 +0000
Subject: [PATCH] Display pre-emptions following a yield with a lower-case "p"

Fixes #109
---
 dejafu/CHANGELOG.markdown    |  1 +
 dejafu/Test/DejaFu/Common.hs | 15 ++++++++++-----
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/dejafu/CHANGELOG.markdown b/dejafu/CHANGELOG.markdown
index f5c9d9a..21294f1 100644
--- a/dejafu/CHANGELOG.markdown
+++ b/dejafu/CHANGELOG.markdown
@@ -13,6 +13,7 @@ unreleased
 ### Test.DejaFu.Common
 
 - Fix some incorrect "@since" haddock comments.
+- Pretty-printed traces now display a pre-emption following a yield with a little "p".
 
 ### Test.DejaFu.Conc
 
diff --git a/dejafu/Test/DejaFu/Common.hs b/dejafu/Test/DejaFu/Common.hs
index 4cee38e..ffc10d5 100644
--- a/dejafu/Test/DejaFu/Common.hs
+++ b/dejafu/Test/DejaFu/Common.hs
@@ -815,15 +815,20 @@ instance NFData Decision where
 -- @since 0.5.0.0
 showTrace :: Trace -> String
 showTrace []  = "<trace discarded>"
-showTrace trc = intercalate "\n" $ concatMap go trc : strkey where
-  go (_,_,CommitCRef _ _) = "C-"
-  go (Start    (ThreadId _ i),_,_) = "S" ++ show i ++ "-"
-  go (SwitchTo (ThreadId _ i),_,_) = "P" ++ show i ++ "-"
-  go (Continue,_,_) = "-"
+showTrace trc = intercalate "\n" $ go False trc : strkey where
+  go _ ((_,_,CommitCRef _ _):rest) = "C-" ++ go False rest
+  go _ ((Start    (ThreadId _ i),_,a):rest) = "S" ++ show i ++ "-" ++ go (didYield a) rest
+  go y ((SwitchTo (ThreadId _ i),_,a):rest) = (if y then "p" else "P") ++ show i ++ "-" ++ go (didYield a) rest
+  go _ ((Continue,_,a):rest) = '-' : go (didYield a) rest
+  go _ _ = ""
 
   strkey =
     ["  " ++ show i ++ ": " ++ name | (i, name) <- threadNames trc]
 
+  didYield Yield = True
+  didYield (ThreadDelay _) = True
+  didYield _ = False
+
 -- | Get all named threads in the trace.
 --
 -- @since 0.7.3.0