Handle missing interfaces more neatly

The types are still wrong: interface is optional on method calls (which
is stupid) but mandatory on signals (wtf).

But hey.

8 files changed, 56 insertions, 24 deletions

diff --git a/Bustle/Diagram.hs b/Bustle/Diagram.hs
index c20fc8f..8a7e7e8 100644
--- a/Bustle/Diagram.hs
+++ b/Bustle/Diagram.hs
@@ -95,7 +95,9 @@ data Colour = Colour Double Double Double
 data Shape = Header { strs :: [String]
                     , shapex, shapey :: Double
                     }
-           | MemberLabel { labelPath, labelInterface, labelMember :: String
+           | MemberLabel { labelPath :: String
+                         , labelInterface :: Maybe String
+                         , labelMember :: String
                          , shapeIsReturn :: Bool
                          , shapex :: Double -- The coordinates of the *centre*
                          , shapey :: Double -- of the label
@@ -120,7 +122,7 @@ data Shape = Header { strs :: [String]
 -- Smart constructors for TimestampLabel and MemberLabel that fill in the
 -- hardcoded (spit) x coordinates.
 memberLabel :: String -- ^ object path
-            -> String -- ^ interface
+            -> Maybe String -- ^ interface
             -> String -- ^ method name
             -> Bool   -- ^ True if this is a return; False if it's a call
             -> Double -- ^ y-coordinate
@@ -432,7 +434,7 @@ drawHeader names x y = forM_ (zip [0..] names) $ \(i, name) -> do
     showLayout l
   where h = 10
 
-drawMember :: String -> String -> String -> Bool -> Double -> Double -> Render ()
+drawMember :: String -> Maybe String -> String -> Bool -> Double -> Double -> Render ()
 drawMember p i m isReturn x y = do
     drawOne path (y - 10)
     drawOne fullMethod y
diff --git a/Bustle/Markup.hs b/Bustle/Markup.hs
index 4e0db7d..5dca58d 100644
--- a/Bustle/Markup.hs
+++ b/Bustle/Markup.hs
@@ -32,9 +32,13 @@ where
 import Data.Monoid
 
 #if MIN_VERSION_gtk(0,11,0)
+import Graphics.Rendering.Pango.BasicTypes (Weight(..))
 import Graphics.Rendering.Pango.Layout (escapeMarkup)
+import Graphics.Rendering.Pango.Markup (markSpan, SpanAttribute(..))
 #else
+import Graphics.UI.Gtk.Pango.BasicTypes (Weight(..))
 import Graphics.UI.Gtk.Pango.Layout (escapeMarkup)
+import Graphics.UI.Gtk.Pango.Markup (markSpan, SpanAttribute(..))
 #endif
 
 newtype Markup = Markup { unMarkup :: String }
@@ -59,11 +63,18 @@ b, i :: Markup -> Markup
 b = tag "b"
 i = tag "i"
 
+span_ :: [SpanAttribute] -> Markup -> Markup
+span_ attrs = Markup . markSpan attrs . unMarkup
+
+light :: Markup -> Markup
+light = span_ [FontWeight WeightLight]
+
 escape :: String -> Markup
 escape = Markup . escapeMarkup
 
-formatMember :: String -> String -> Markup
-formatMember iface member = mconcat [ escape iface
-                                    , escape "."
-                                    , b (escape member)
-                                    ]
+formatMember :: Maybe String -> String -> Markup
+formatMember iface member = iface' `mappend` b (escape member)
+  where
+    iface' = case iface of
+        Just ifaceName -> escape $ ifaceName ++ "."
+        Nothing        -> light (escape "(no interface) ")
diff --git a/Bustle/Noninteractive.hs b/Bustle/Noninteractive.hs
index 2aa1e05..4b4a086 100644
--- a/Bustle/Noninteractive.hs
+++ b/Bustle/Noninteractive.hs
@@ -1,10 +1,14 @@
-module Bustle.Noninteractive (run)
+module Bustle.Noninteractive
+  ( run
+  , formatInterface
+  )
 where
 
 import Prelude hiding (log)
 
 import System
 import System.IO (hPutStrLn, stderr)
+import Data.Maybe (fromMaybe)
 
 import Bustle.Parser (readLog)
 import Bustle.Types
@@ -34,3 +38,6 @@ run appName analyze format = do
                                                    , " foo.bustle"
                                                    ]
                          exitFailure
+
+formatInterface :: Maybe String -> String
+formatInterface = fromMaybe "(no interface)"
diff --git a/Bustle/Parser.hs b/Bustle/Parser.hs
index ed4a0d5..347d8aa 100644
--- a/Bustle/Parser.hs
+++ b/Bustle/Parser.hs
@@ -54,7 +54,10 @@ parseUniqueName = do
   <?> "unique name"
 
 parseOtherName :: Parser OtherName
-parseOtherName = fmap OtherName (none <|> nameChars) <?> "non-unique name"
+parseOtherName =
+    fmap OtherName ((none >> return "") <|> nameChars)
+  <?>
+    "non-unique name"
 
 parseBusName :: Parser BusName
 parseBusName = (fmap U parseUniqueName) <|> (fmap O parseOtherName)
@@ -70,13 +73,16 @@ parseTimestamp = do
     return (seconds * 1000000 + ms)
   where i = read <$> many1 digit <?> "timestamp"
 
-none :: Parser String
-none = string "<none>"
+none :: Parser (Maybe a)
+none = do
+    string "<none>"
+    return Nothing
+
 
 entireMember :: Parser Member
 entireMember = do
     let p = many1 (oneOf "/_" <|> alphaNum) <?> "path"
-        i = none <|> many1 (oneOf "._" <|> alphaNum) <?> "iface"
+        i = none <|> fmap Just (many1 (oneOf "._" <|> alphaNum)) <?> "iface"
         m = many1 (oneOf "_" <|> alphaNum) <?> "membername"
     Member <$> p <* t <*> i <* t <*> m
   <?> "member"
@@ -201,7 +207,8 @@ readLog filename = filter isRelevant <$> runParser events Map.empty "" filename
 
         -- When the monitor is forcibly disconnected from the bus, the
         -- Disconnected message has no sender, so the logger spits out <none>.
-        isDisconnected m = sender m == O (OtherName "<none>")
+        -- This gets turned into OtherName ""
+        isDisconnected m = sender m == O (OtherName "")
 
         -- Surely this function must have a standard name?
         none_ fs x = not $ any ($ x) fs
diff --git a/Bustle/Stats.hs b/Bustle/Stats.hs
index ad9ec39..7edf19b 100644
--- a/Bustle/Stats.hs
+++ b/Bustle/Stats.hs
@@ -18,7 +18,7 @@ import Bustle.Types
 data TallyType = TallyMethod | TallySignal
     deriving (Eq, Ord, Show)
 
-repr :: Message -> Maybe (TallyType, String, String)
+repr :: Message -> Maybe (TallyType, Maybe Interface, MemberName)
 repr msg =
     case msg of
         MethodCall { member = m } -> Just (TallyMethod, iface m, membername m)
@@ -28,8 +28,8 @@ repr msg =
 data FrequencyInfo =
     FrequencyInfo { fiFrequency :: Int
                   , fiType :: TallyType
-                  , fiInterface :: String
-                  , fiMember :: String
+                  , fiInterface :: Maybe Interface
+                  , fiMember :: MemberName
                   }
   deriving (Show, Eq, Ord)
 
@@ -50,8 +50,8 @@ mean = acc 0 0
          acc n t (x:xs) = acc (n + 1) (t + x) xs
 
 data TimeInfo =
-    TimeInfo { tiInterface :: String
-             , tiMethodName :: String
+    TimeInfo { tiInterface :: Maybe Interface
+             , tiMethodName :: MemberName
              , tiTotalTime :: Double -- seconds
              , tiCallFrequency :: Int
              , tiMeanCallTime :: Double -- seconds
@@ -69,6 +69,8 @@ methodTimes = reverse
           alt newtime (Just (total, times)) =
               Just (newtime + total, newtime : times)
 
+          methodReturn :: Message
+                       -> Maybe (Maybe Interface, MemberName, Integer)
           methodReturn (MethodReturn { timestamp = end,
                             inReplyTo = Just (MethodCall {
                                 timestamp = start, member = m }) }) =
diff --git a/Bustle/Types.hs b/Bustle/Types.hs
index 4d2b519..def3878 100644
--- a/Bustle/Types.hs
+++ b/Bustle/Types.hs
@@ -46,7 +46,7 @@ unBusName (O (OtherName  x)) = x
 type Milliseconds = Integer
 
 data Member = Member { path :: ObjectPath
-                     , iface :: Interface
+                     , iface :: Maybe Interface
                      , membername :: MemberName
                      }
   deriving (Ord, Show, Read, Eq)
diff --git a/bustle-count.hs b/bustle-count.hs
index 1699c5e..2770aaf 100644
--- a/bustle-count.hs
+++ b/bustle-count.hs
@@ -1,10 +1,12 @@
 import Text.Printf
 
-import Bustle.Noninteractive (run)
+import Bustle.Noninteractive (run, formatInterface)
 import Bustle.Stats (frequencies, TallyType, FrequencyInfo(..))
+import Data.Maybe (maybe)
 
 format :: FrequencyInfo -> String
-format (FrequencyInfo c t i m) = printf " %4d %6s %s.%s" c (show t) i m
+format (FrequencyInfo c t i m) =
+    printf " %4d %6s %s.%s" c (show t) (formatInterface i) m
 
 main :: IO ()
 main = run "bustle-count" frequencies format
diff --git a/bustle-time.hs b/bustle-time.hs
index 52b13e6..2ea2de3 100644
--- a/bustle-time.hs
+++ b/bustle-time.hs
@@ -1,11 +1,12 @@
 import Text.Printf
 
-import Bustle.Noninteractive (run)
+import Bustle.Noninteractive (run, formatInterface)
 import Bustle.Stats (methodTimes, TimeInfo(..))
 
 format :: TimeInfo -> String
 format (TimeInfo interface method total ncalls mean) =
-    printf " %9.4f %3d %9.4f %s.%s" total ncalls mean interface method
+    printf " %9.4f %3d %9.4f %s.%s" total ncalls mean
+        (formatInterface interface) method
 
 main :: IO ()
 main = run "bustle-time" methodTimes format