Represent bus names as Text

This cuts memory usage down a little bit. We still have n copies of each
bus name, one every time it appears.

8 files changed, 48 insertions, 40 deletions

diff --git a/Bustle/Loader.hs b/Bustle/Loader.hs
index ee0b7d5..3586dbf 100644
--- a/Bustle/Loader.hs
+++ b/Bustle/Loader.hs
@@ -28,6 +28,10 @@ where
 import Control.Monad.Error
 import Control.Arrow ((***))
 
+import qualified Data.Text as Text
+import DBus.Constants (dbusName)
+import DBus.Types (busNameText)
+
 import qualified Bustle.Loader.OldSkool as Old
 import qualified Bustle.Loader.Pcap as Pcap
 import Bustle.Upgrade (upgrade)
@@ -65,13 +69,13 @@ isRelevant (MessageEvent m) = case m of
   where
     -- FIXME: really? Maybe we should allow people to be interested in,
     --        say, binding to signals?
-    senderIsBus = sender m == O (OtherName "org.freedesktop.DBus")
-    destIsBus = destination m == O (OtherName "org.freedesktop.DBus")
+    senderIsBus = sender m == O (OtherName (busNameText dbusName))
+    destIsBus = destination m == O (OtherName (busNameText dbusName))
 
     -- When the monitor is forcibly disconnected from the bus, the
     -- Disconnected message has no sender, so the logger spits out <none>.
     -- This gets turned into OtherName ""
-    isDisconnected = sender m == O (OtherName "")
+    isDisconnected = sender m == O (OtherName Text.empty)
 
     none bs = not $ or bs
     none3 = none [senderIsBus, destIsBus, isDisconnected]
diff --git a/Bustle/Loader/OldSkool.hs b/Bustle/Loader/OldSkool.hs
index 84125a0..22e01e8 100644
--- a/Bustle/Loader/OldSkool.hs
+++ b/Bustle/Loader/OldSkool.hs
@@ -55,12 +55,12 @@ nameChars = many1 (noneOf "\t\n")
 parseUniqueName :: Parser UniqueName
 parseUniqueName = do
     char ':'
-    fmap (UniqueName . (':':)) nameChars
+    fmap (UniqueName . T.pack . (':':)) nameChars
   <?> "unique name"
 
 parseOtherName :: Parser OtherName
 parseOtherName =
-    fmap OtherName ((none >> return "") <|> nameChars)
+    fmap (OtherName . T.pack) ((none >> return "") <|> nameChars)
   <?>
     "non-unique name"
 
@@ -181,11 +181,11 @@ perhaps act = (noName >> return Nothing) <|> fmap Just act
 
 sameUnique :: UniqueName -> UniqueName -> Parser ()
 sameUnique u u' = guard (u == u')
-  <?> "owner to be " ++ unUniqueName u ++ ", not " ++ unUniqueName u'
+  <?> "owner to be " ++ T.unpack (unUniqueName u) ++ ", not " ++ T.unpack (unUniqueName u')
 
 atLeastOne :: OtherName -> Parser a
 atLeastOne n = fail ""
-  <?> unOtherName n ++ " to gain or lose an owner"
+  <?> T.unpack (unOtherName n) ++ " to gain or lose an owner"
 
 nameOwnerChanged :: Parser DetailedEvent
 nameOwnerChanged = do
diff --git a/Bustle/Loader/Pcap.hs b/Bustle/Loader/Pcap.hs
index d2d6815..3e4b9ed 100644
--- a/Bustle/Loader/Pcap.hs
+++ b/Bustle/Loader/Pcap.hs
@@ -39,6 +39,7 @@ import DBus.Wire
 import DBus.Message
 import DBus.Types
 import qualified Data.Text as T
+import Data.Text (Text)
 
 import qualified Data.ByteString as BS
 import Data.ByteString.Lazy (fromChunks)
@@ -48,21 +49,16 @@ import qualified Bustle.Types as B
 
 -- Conversions from dbus-core's types into Bustle's more stupid types. This
 -- whole section is pretty upsetting.
-stringifyBusName :: BusName
-                 -> String
-stringifyBusName = T.unpack . busNameText
-
-stupifyBusName :: String
+stupifyBusName :: Text
                -> B.TaggedBusName
-stupifyBusName n =
-    case n of
-        (':':_) -> B.U $ B.UniqueName n
-        _       -> B.O $ B.OtherName n
+stupifyBusName n
+    | not (T.null n) && T.head n == ':' = B.U $ B.UniqueName n
+    | otherwise                         = B.O $ B.OtherName n
 
-convertBusName :: String
+convertBusName :: Text
                -> Maybe BusName
                -> B.TaggedBusName
-convertBusName context n = stupifyBusName (maybe context stringifyBusName n)
+convertBusName context n = stupifyBusName (maybe context busNameText n)
 
 convertMember :: (a -> ObjectPath)
               -> (a -> Maybe InterfaceName)
@@ -116,7 +112,7 @@ isNOC (Just sender) s | looksLikeNOC =
     looksLikeNOC =
         and [ sender == dbusName
             , signalInterface s == dbusInterface
-            , memberNameText (signalMember s) == T.pack "NameOwnerChanged"
+            , memberNameText (signalMember s) == "NameOwnerChanged"
             ]
 isNOC _ _ = Nothing
 
@@ -139,8 +135,8 @@ bustlifyNOC ns@(name, oldOwner, newOwner)
     isUnique :: BusName -> Bool
     isUnique n = T.head (busNameText n) == ':'
 
-    uniquify = B.UniqueName . T.unpack . busNameText
-    otherify = B.OtherName . T.unpack . busNameText
+    uniquify = B.UniqueName . busNameText
+    otherify = B.OtherName . busNameText
 
 tryBustlifyGetNameOwnerReply :: Maybe (MethodCall, a)
                              -> MethodReturn
@@ -204,7 +200,7 @@ bustlify µs bytes m = do
             | otherwise                      -> return $ B.MessageEvent $
                 B.Signal { B.sender = convertBusName "signal.sender" sender
                          , B.member = convertMember signalPath (Just . signalInterface) signalMember sig
-                         , B.signalDestination = fmap (stupifyBusName . stringifyBusName)
+                         , B.signalDestination = fmap (stupifyBusName . busNameText)
                                                $ signalDestination sig
                          }
 
diff --git a/Bustle/Noninteractive.hs b/Bustle/Noninteractive.hs
index d4d18e1..b3c74ff 100644
--- a/Bustle/Noninteractive.hs
+++ b/Bustle/Noninteractive.hs
@@ -82,7 +82,7 @@ runDot filepath = process filepath makeDigraph id
     makeDigraph log = ["digraph bustle {"] ++ makeDigraph' log ++ ["}"]
 
     makeDigraph' log =
-        [ concat ["  \"", unBusName s, "\" -> \"", unBusName d, "\";"]
+        [ concat ["  \"", T.unpack (unBusName s), "\" -> \"", T.unpack (unBusName d), "\";"]
         | (s, d) <- nub . mapMaybe (methodCall . deEvent) $ log
         ]
 
diff --git a/Bustle/Renderer.hs b/Bustle/Renderer.hs
index 1a691d1..c299c44 100644
--- a/Bustle/Renderer.hs
+++ b/Bustle/Renderer.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFunctor, OverloadedStrings #-}
 {-
 Bustle.Renderer: render nice Cairo diagrams from a list of D-Bus messages
 Copyright (C) 2008 Collabora Ltd.
@@ -47,6 +47,8 @@ import qualified Data.Set as Set
 import Data.Set (Set)
 import qualified Data.Map as Map
 import Data.Map (Map)
+import qualified Data.Text as Text
+import Data.Text (Text)
 import Data.Ratio
 
 import Control.Applicative (Applicative(..), (<$>), (<*>))
@@ -364,13 +366,13 @@ lookupOtherName bus o = do
         -- No matches indicates a corrupt log, which we try to recover from …
         []        -> do
             warn $ concat [ "'"
-                          , unOtherName o
+                          , Text.unpack $ unOtherName o
                           , "' appeared unheralded on the "
                           , describeBus bus
                           , " bus; making something up..."
                           ]
             let namesInUse = Map.keys as
-                candidates = map (UniqueName . (":fake." ++) . show)
+                candidates = map (UniqueName . (Text.append ":fake.") . Text.pack . show)
                                  ([1..] :: [Integer])
                 u = head $ filter (not . (`elem` namesInUse)) candidates
             addUnique bus u
@@ -423,7 +425,7 @@ appCoordinate bus n = do
 
             -- FIXME: Does this really live here?
             currentRow <- gets row
-            let ns = bestNames u os
+            let ns = map Text.unpack $ bestNames u os
                 h  = headerHeight ns
             shape $ Header ns x (currentRow - (10 + h))
             shape $ ClientLine x (currentRow - 5) (currentRow + 15)
@@ -453,7 +455,7 @@ addUnique bus n = do
     case existing of
         Nothing -> return ()
         Just _  -> warn $ concat [ "Unique name '"
-                                 , unUniqueName n
+                                 , Text.unpack $ unUniqueName n
                                  , "' apparently connected to the bus twice"
                                  ]
     modifyApps bus $ Map.insert n ai
@@ -536,7 +538,7 @@ advanceBy d = do
     when (current' - lastLabelling > 400) $ do
         xs <- (++) <$> getsApps Map.toList SessionBus
                    <*> getsApps Map.toList SystemBus
-        let xs' = [ (x, bestNames u os)
+        let xs' = [ (x, map Text.unpack $ bestNames u os)
                   | (u, ApplicationInfo (CurrentColumn x) os _) <- xs
                   ]
         let (height, ss) = headers xs' (current' + 20)
@@ -560,11 +562,11 @@ advanceBy d = do
                | x <- xs
                ]
 
-bestNames :: UniqueName -> Set OtherName -> [String]
+bestNames :: UniqueName -> Set OtherName -> [Text]
 bestNames (UniqueName u) os
     | Set.null os = [u]
-    | otherwise   = reverse . sortBy (comparing length) . map readable $ Set.toList os
-  where readable = reverse . takeWhile (/= '.') . reverse . unOtherName
+    | otherwise   = reverse . sortBy (comparing Text.length) . map readable $ Set.toList os
+  where readable = Text.reverse . Text.takeWhile (/= '.') . Text.reverse . unOtherName
 
 edgemostApp :: Bus -> Renderer (Maybe Double)
 edgemostApp bus = do
diff --git a/Bustle/Types.hs b/Bustle/Types.hs
index b404ca4..3fc3259 100644
--- a/Bustle/Types.hs
+++ b/Bustle/Types.hs
@@ -56,15 +56,16 @@ where
 import Data.Word (Word32)
 import DBus.Types (ObjectPath, objectPathText, InterfaceName, interfaceNameText, MemberName, memberNameText)
 import DBus.Message (ReceivedMessage)
-import qualified Data.Text as T
+import qualified Data.Text as Text
+import Data.Text (Text)
 import Data.Maybe (maybeToList)
 import Data.Either (partitionEithers)
 
 type Serial = Word32
 
-newtype UniqueName = UniqueName { unUniqueName :: String }
+newtype UniqueName = UniqueName { unUniqueName :: Text }
   deriving (Ord, Show, Eq)
-newtype OtherName = OtherName { unOtherName :: String }
+newtype OtherName = OtherName { unOtherName :: Text }
   deriving (Ord, Show, Eq)
 data TaggedBusName =
     U UniqueName
@@ -76,7 +77,7 @@ isUnique (U _) = True
 isUnique (O _) = False
 isOther = not . isUnique
 
-unBusName :: TaggedBusName -> String
+unBusName :: TaggedBusName -> Text
 unBusName (U (UniqueName x)) = x
 unBusName (O (OtherName  x)) = x
 
diff --git a/Bustle/UI/FilterDialog.hs b/Bustle/UI/FilterDialog.hs
index 424f116..db9e9ec 100644
--- a/Bustle/UI/FilterDialog.hs
+++ b/Bustle/UI/FilterDialog.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-
 Bustle.UI.FilterDialog: allows the user to filter the displayed log
 Copyright © 2011 Collabora Ltd.
@@ -26,6 +27,8 @@ import qualified Data.Set as Set
 import Data.Set (Set)
 import qualified Data.Map as Map
 import Data.Map (Map)
+import qualified Data.Text as Text
+import Data.Text (Text)
 
 import Control.Monad (liftM)
 
@@ -34,10 +37,10 @@ import Graphics.UI.Gtk
 import Bustle.Types
 
 formatNames :: (UniqueName, Set OtherName)
-            -> String
+            -> Text
 formatNames (u, os)
     | Set.null os = unUniqueName u
-    | otherwise = intercalate "\n" . map unOtherName $ Set.toAscList os
+    | otherwise = Text.intercalate "\n" . map unOtherName $ Set.toAscList os
 
 type NameStore = ListStore (Bool, (UniqueName, Set OtherName))
 
@@ -79,7 +82,7 @@ makeView nameStore = do
     treeViewAppendColumn nameView nameColumn
 
     cellLayoutSetAttributes nameColumn nameCell nameStore $ \(_, ns) ->
-        [ cellText := formatNames ns ]
+        [ cellText := Text.unpack (formatNames ns) ]
 
     sw <- scrolledWindowNew Nothing Nothing
     scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
diff --git a/Bustle/Upgrade.hs b/Bustle/Upgrade.hs
index 6f3ef92..443123f 100644
--- a/Bustle/Upgrade.hs
+++ b/Bustle/Upgrade.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-
 Bustle.Upgrade: synthesise information missing from old logs
 Copyright (C) 2009 Collabora Ltd.
@@ -21,6 +22,7 @@ module Bustle.Upgrade (upgrade) where
 import Control.Monad.State
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Data.Text as Text
 
 import Bustle.Types
 
@@ -57,6 +59,6 @@ synth n = do
                  ]
 
 fakeName :: OtherName -> UniqueName
-fakeName = UniqueName . (":fake." ++) . unOtherName
+fakeName = UniqueName . Text.append ":fake." . unOtherName
 
 -- vim: sw=2 sts=2