Drop old loader support

This was masking error messages from the pcap reader, and then the old
loader was crashing with:

    hGetContents: invalid argument (invalid byte sequence)

https://bugzilla.redhat.com/show_bug.cgi?id=1450443

5 files changed, 5 insertions, 343 deletions

diff --git a/Bustle/Loader.hs b/Bustle/Loader.hs
index ea86256..821bf44 100644
--- a/Bustle/Loader.hs
+++ b/Bustle/Loader.hs
@@ -25,17 +25,11 @@ module Bustle.Loader
   )
 where
 
-import Control.Exception
 import Control.Monad.Except
 import Control.Arrow ((***))
 
-import Text.Printf
-
-import qualified Bustle.Loader.OldSkool as Old
 import qualified Bustle.Loader.Pcap as Pcap
-import Bustle.Upgrade (upgrade)
 import Bustle.Types
-import Bustle.Translation (__)
 import Bustle.Util (io)
 
 data LoadError = LoadError FilePath String
@@ -48,27 +42,15 @@ readLog :: MonadIO io
         -> ExceptT LoadError io ([String], Log)
 readLog f = do
     pcapResult <- io $ Pcap.readPcap f
-    liftM (id *** filter (isRelevant . deEvent)) $ case pcapResult of
-        Right ms -> return ms
-        Left _ -> liftM ((,) []) readOldLogFile
-  where
-    readOldLogFile = do
-        result <- liftIO $ try $ readFile f
-        case result of
-            Left e      -> throwError $ LoadError f (show (e :: IOException))
-            Right input -> do
-                let oldResult = fmap upgrade $ Old.readLog input
-                case oldResult of
-                    Left e  -> throwError $ LoadError f (printf (__ "Parse error %s") (show e))
-                    Right r -> return r
+    case pcapResult of
+        Right ms -> return $ (id *** filter (isRelevant . deEvent)) ms
+        Left ioe -> throwError $ LoadError f (show ioe)
 
 isRelevant :: Event
            -> Bool
 isRelevant (NOCEvent _) = True
 isRelevant (MessageEvent m) = case m of
-    Signal {}       -> none [ senderIsBus
-                            , isDisconnected
-                            ]
+    Signal {}       -> not senderIsBus
     MethodCall {}   -> none3
     MethodReturn {} -> none3
     Error {}        -> none3
@@ -79,11 +61,7 @@ isRelevant (MessageEvent m) = case m of
     destIsBus = destination m == busDriver
     busDriver = O (OtherName dbusName)
 
-    -- When the monitor is forcibly disconnected from the bus, the
-    -- Disconnected message has no sender; the old logger spat out <none>.
-    isDisconnected = sender m == O (OtherName Old.senderWhenDisconnected)
-
     none bs = not $ or bs
-    none3 = none [senderIsBus, destIsBus, isDisconnected]
+    none3 = none [senderIsBus, destIsBus]
 
 
diff --git a/Bustle/Loader/OldSkool.hs b/Bustle/Loader/OldSkool.hs
deleted file mode 100644
index 38167b2..0000000
--- a/Bustle/Loader/OldSkool.hs
+++ /dev/null
@@ -1,248 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-
-Bustle.Loader.OldSkool: reads the output of bustle-dbus-monitor
-Copyright © 2008–2011 Collabora Ltd.
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
--}
-module Bustle.Loader.OldSkool
-  ( readLog
-  , senderWhenDisconnected
-  )
-where
-
-import Bustle.Types
-import qualified DBus as D
-import Text.ParserCombinators.Parsec hiding (Parser)
-import Data.Map (Map)
-import Data.Maybe (isJust)
-import qualified Data.Map as Map
-import Control.Monad (when, guard)
-import Control.Applicative ((<$>), (<*>), (<*))
-
-type Parser a = GenParser Char (Map (TaggedBusName, Serial) (Detailed Message)) a
-
-t :: Parser Char
-t = char '\t'
-
-nameChars :: Parser String
-nameChars = many1 (noneOf "\t\n")
--- this should be
---   nameChars = many1 (oneOf "._-" <|> alphaNum)
--- but making it more tolerant lets us shoehorn misc into this field until the
--- log format is less shit.
-
-parseUniqueName :: Parser UniqueName
-parseUniqueName = do
-    char ':'
-    rest <- nameChars
-    case D.parseBusName (':':rest) of
-        Just n  -> return $ UniqueName n
-        Nothing -> fail $ "':" ++ rest ++ "' is not a valid unique name"
-  <?> "unique name"
-
--- FIXME: this shouldn't exist.
-senderWhenDisconnected :: D.BusName
-senderWhenDisconnected = D.busName_ "org.freedesktop.DBus.Local"
-
-parseMissingName :: Parser OtherName
-parseMissingName = do
-    none
-    return $ OtherName senderWhenDisconnected
-
-parseSpecifiedOtherName :: Parser OtherName
-parseSpecifiedOtherName = do
-    x <- nameChars
-    case D.parseBusName x of
-        Just n  -> return $ OtherName n
-        Nothing -> fail $ "'" ++ x ++ "' is not a valid name"
-
-parseOtherName :: Parser OtherName
-parseOtherName = parseMissingName <|> parseSpecifiedOtherName
-  <?>
-    "non-unique name"
-
-parseBusName :: Parser TaggedBusName
-parseBusName = (fmap U parseUniqueName) <|> (fmap O parseOtherName)
-
-parseSerial :: Parser Serial
-parseSerial = read <$> many1 digit <?> "serial"
-
-parseTimestamp :: Parser Microseconds
-parseTimestamp = do
-    seconds <- i
-    t
-    µs <- i
-    return $ µsFromPair seconds µs
-  where i = read <$> many1 digit <?> "timestamp"
-
-none :: Parser (Maybe a)
-none = do
-    string "<none>"
-    return Nothing
-
-pathify :: String -> D.ObjectPath
-pathify s = case D.parseObjectPath s of
-    Just p -> p
-    Nothing -> D.objectPath_ "/unparseable/object/path"
-
-interfacify :: String -> Maybe D.InterfaceName
-interfacify = D.parseInterfaceName
-
-memberNamify :: String -> D.MemberName
-memberNamify s = case D.parseMemberName s of
-    Just m -> m
-    Nothing -> D.memberName_ "UnparseableMemberName"
-
-entireMember :: Parser Member
-entireMember = do
-    let p = pathify <$> many1 (oneOf "/_" <|> alphaNum) <?> "path"
-        i = none <|> fmap interfacify (many1 (oneOf "._" <|> alphaNum)) <?> "iface"
-        m = memberNamify <$> many1 (oneOf "_" <|> alphaNum) <?> "membername"
-    Member <$> p <* t <*> i <* t <*> m
-  <?> "member"
-
-addPendingCall :: Detailed Message -> Parser ()
-addPendingCall dm = updateState $ Map.insert (sender m, serial m) dm
-  where
-    m = deEvent dm
-
-findPendingCall :: TaggedBusName -> Serial -> Parser (Maybe (Detailed Message))
-findPendingCall dest s = do
-    pending <- getState
-    let key = (dest, s)
-        ret = Map.lookup key pending
-    when (isJust ret) $ updateState (Map.delete key)
-    return ret
-
-methodCall :: Parser DetailedEvent
-methodCall = do
-    char 'c'
-    t
-    µs <- parseTimestamp
-    t
-    m <- MethodCall <$> parseSerial <* t
-                    <*> parseBusName <* t <*> parseBusName <* t <*> entireMember
-    let dm = Detailed µs m Nothing
-    addPendingCall dm
-    return $ fmap MessageEvent dm
-  <?> "method call"
-
-parseReturnOrError :: String
-                   -> (Maybe (Detailed Message) -> TaggedBusName -> TaggedBusName -> Message)
-                   -> Parser DetailedEvent
-parseReturnOrError prefix constructor = do
-    string prefix <* t
-    ts <- parseTimestamp <* t
-    parseSerial <* t
-    replySerial <- parseSerial <* t
-    s <- parseBusName <* t
-    d <- parseBusName
-    call <- findPendingCall d replySerial
-    -- If we can see a call, use its sender and destination as the destination
-    -- and sender for the reply. This might prove unnecessary in the event of
-    -- moving the name collapsing into the UI.
-    let (s', d') = case call of
-            Just (Detailed _ m _) -> (destination m, sender m)
-            Nothing               -> (s, d)
-        message = constructor call s' d'
-    return $ Detailed ts (MessageEvent message) Nothing
- <?> "method return or error"
-
-methodReturn, parseError :: Parser DetailedEvent
-methodReturn = parseReturnOrError "r" MethodReturn <?> "method return"
-parseError = parseReturnOrError "err" Error <?> "error"
-
-signal :: Parser DetailedEvent
-signal = do
-    string "sig"
-    t
-    µs <- parseTimestamp
-    t
-    -- Ignore serial
-    m <- Signal <$> (parseSerial >> t >> parseBusName) <* t
-                <*> return Nothing
-                <*> entireMember
-    return $ Detailed µs (MessageEvent m) Nothing
-  <?> "signal"
-
-method :: Parser DetailedEvent
-method = char 'm' >> (methodCall <|> methodReturn)
-  <?> "method call or return"
-
-noName :: Parser ()
-noName = char '!' >> return ()
-  <?> "the empty name '!'"
-
-perhaps :: Parser a -> Parser (Maybe a)
-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'
-
-atLeastOne :: OtherName -> Parser a
-atLeastOne n = fail ""
-  <?> unOtherName n ++ " to gain or lose an owner"
-
-nameOwnerChanged :: Parser DetailedEvent
-nameOwnerChanged = do
-    string "nameownerchanged"
-    t
-    ts <- parseTimestamp
-    t
-    n <- parseBusName
-    t
-    m <- parseNOCDetails n
-    return $ Detailed ts (NOCEvent m) Nothing
-
-parseNOCDetails :: TaggedBusName
-                -> Parser NOC
-parseNOCDetails n =
-    case n of
-        U u -> do
-            old <- perhaps parseUniqueName
-            case old of
-                Nothing -> do
-                    t
-                    u' <- parseUniqueName
-                    sameUnique u u'
-                    return $ Connected u
-                Just u' -> do
-                    sameUnique u u'
-                    t
-                    noName
-                    return $ Disconnected u
-        O o -> do
-            old <- perhaps parseUniqueName
-            t
-            new <- perhaps parseUniqueName
-            c <- case (old, new) of
-                (Nothing, Nothing) -> atLeastOne o
-                (Just  a, Nothing) -> return $ Released a
-                (Nothing, Just  b) -> return $ Claimed b
-                (Just  a, Just  b) -> return $ Stolen a b
-            return $ NameChanged o c
-
-event :: Parser DetailedEvent
-event = method <|> signal <|> nameOwnerChanged <|> parseError
-
-events :: Parser [DetailedEvent]
-events = sepEndBy event (char '\n') <* eof
-
-readLog :: String -> Either ParseError [DetailedEvent]
-readLog filename = runParser events Map.empty "" filename
-
--- vim: sw=2 sts=2
diff --git a/Bustle/Upgrade.hs b/Bustle/Upgrade.hs
deleted file mode 100644
index 5375229..0000000
--- a/Bustle/Upgrade.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-
-Bustle.Upgrade: synthesise information missing from old logs
-Copyright (C) 2009 Collabora Ltd.
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
--}
-module Bustle.Upgrade (upgrade) where
-
-import Control.Monad.State
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-import Bustle.Types
-
--- Bustle <0.2.0 did not log NameOwnerChanged; this adds fake ones to logs
--- lacking them
-upgrade :: [DetailedEvent] -> [DetailedEvent]
-upgrade es =
-    case partitionDetaileds es of
-        ([], ms) -> concat $ evalState (mapM synthesiseNOC ms) Set.empty
-        _        -> es
-
-synthesiseNOC :: Detailed Message -> State (Set TaggedBusName) [DetailedEvent]
-synthesiseNOC de@(Detailed µs m _) = do
-    fakes <- mapM synthDM $ mentionedNames m
-    return ( concat fakes ++ [fmap MessageEvent de] )
-  where
-    synthDM :: TaggedBusName -> State (Set TaggedBusName) [DetailedEvent]
-    synthDM n = do
-        fakes <- synth n
-        return $ map (\fake -> Detailed µs (NOCEvent fake) Nothing) fakes
-
-synth :: TaggedBusName
-      -> State (Set TaggedBusName) [NOC]
-synth n = do
-    b <- gets (Set.member n)
-    if b
-      then return []
-      else do
-        modify (Set.insert n)
-        return $ case n of
-          U u -> [ Connected u ]
-          O o -> [ Connected (fakeName o)
-                 , NameChanged o (Claimed (fakeName o))
-                 ]
-
-fakeName :: OtherName -> UniqueName
-fakeName = fakeUniqueName . unOtherName
-
--- vim: sw=2 sts=2
diff --git a/INSTALL.md b/INSTALL.md
index 2ce67e8..5fffbfd 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -14,7 +14,6 @@ systems, well, actually just `apt-get build-dep bustle`, but:
         libghc-mtl-dev \
         libghc-cairo-dev \
         libghc-gtk-dev \
-        libghc-parsec3-dev \
         libghc-glade-dev \
         libghc-dbus-dev \
         libghc-pcap-dev \
diff --git a/bustle.cabal b/bustle.cabal
index 30fe299..d108750 100644
--- a/bustle.cabal
+++ b/bustle.cabal
@@ -84,7 +84,6 @@ Executable bustle
   Other-modules: Bustle.Application.Monad
                , Bustle.Diagram
                , Bustle.Loader
-               , Bustle.Loader.OldSkool
                , Bustle.Loader.Pcap
                , Bustle.Marquee
                , Bustle.Monitor
@@ -103,7 +102,6 @@ Executable bustle
                , Bustle.UI.OpenTwoDialog
                , Bustle.UI.Recorder
                , Bustle.UI.Util
-               , Bustle.Upgrade
                , Bustle.Util
                , Bustle.VariantFormatter
   default-language: Haskell2010
@@ -127,7 +125,6 @@ Executable bustle
                , hgettext >= 0.1.5
                , mtl >= 2.2.1
                , pango
-               , parsec
                , pcap
                , process
                , setlocale
@@ -164,7 +161,6 @@ Executable test-monitor
                , hgettext
                , mtl
                , pango
-               , parsec
                , pcap
                , setlocale
                , text