reorganized message types

Make Control messages be out-of-band async messages, without a pointer
to a previous message.

And then followed the type change through the code for hours..

This commit was sponsored by Nick Daly on Patreon.

1 files changed, 30 insertions, 27 deletions

diff --git a/Log.hs b/Log.hs
index f483e7d..2993ad8 100644
--- a/Log.hs
+++ b/Log.hs
@@ -13,72 +13,75 @@ import Data.Time.Clock.POSIX
 import qualified Data.ByteString.Lazy as L
 import System.IO
 
--- | A log of Activity both Entered and Seen, which can be recorded to
--- prove what happened in a debug-me session.
+-- | One item in a log of a debug-me session.
 --
 -- Note that the time stamp is included to allow replaying logs, but
 -- it's not part of the provable session.
 --
 -- Note that changing this in ways that change the JSON serialization
 -- changes debug-me's log file format.
-data ActivityLog = ActivityLog
-	{ loggedActivity :: SomeActivity
-	, loggedHash :: Hash
+data Log = Log
+	{ loggedMessage :: LogMessage
+	, loggedHash :: Maybe Hash
 	, loggedTimestamp :: Timestamp
 	}
 	deriving (Show, Generic)
 
-instance DataSize ActivityLog where
-	dataSize l = dataSize (loggedActivity l) + dataSize (loggedHash l) + 2
+instance DataSize Log where
+	dataSize l = dataSize (loggedMessage l)
+		+ maybe 0 dataSize (loggedHash l)
+		+ 2
 
-instance ToJSON (ActivityLog)
-instance FromJSON (ActivityLog)
+instance ToJSON Log
+instance FromJSON Log
 
-data SomeActivity
-	= ActivitySeen (Activity Seen)
-	| ActivityEntered (Activity Entered)
+data LogMessage
+	= User (Message Seen)
+	| Developer (Message Entered)
 	deriving (Show, Generic)
 
-instance DataSize SomeActivity where
-	dataSize (ActivitySeen a) = dataSize a
-	dataSize (ActivityEntered a) = dataSize a
+instance DataSize LogMessage where
+	dataSize (User a) = dataSize a
+	dataSize (Developer a) = dataSize a
 
-instance ToJSON SomeActivity where
+instance ToJSON LogMessage where
 	toJSON = genericToJSON sumOptions
 	toEncoding = genericToEncoding sumOptions
-instance FromJSON SomeActivity where
+instance FromJSON LogMessage where
 	parseJSON = genericParseJSON sumOptions
 
-mkActivityLog :: SomeActivity -> POSIXTime -> ActivityLog
-mkActivityLog a now = ActivityLog
-	{ loggedActivity = a
-	, loggedHash = case a of
-		ActivitySeen s -> hash s
-		ActivityEntered e -> hash e
+mkLog :: LogMessage -> POSIXTime -> Log
+mkLog m now = Log
+	{ loggedMessage = m
+	, loggedHash = case m of
+		User (ActivityMessage a) -> Just (hash a)
+		Developer (ActivityMessage a) -> Just (hash a)
+		User (ControlMessage _) -> Nothing
+		Developer (ControlMessage _) -> Nothing
 	, loggedTimestamp = now
 	}
 
 type Timestamp = POSIXTime
 
-type Logger = SomeActivity -> IO ()
+type Logger = LogMessage -> IO ()
 
 withLogger :: FilePath -> (Logger -> IO a) -> IO a
 withLogger logfile a = withFile logfile WriteMode (a . mkLogger)
 
 mkLogger :: Handle -> Logger
 mkLogger h a = do
-	l <- mkActivityLog a <$> getPOSIXTime
+	l <- mkLog a <$> getPOSIXTime
 	L.hPut h (encode l)
 	hPutStr h "\n"
 	hFlush h
 
-parseLog :: L.ByteString -> [Either String ActivityLog]
+parseLog :: L.ByteString -> [Either String Log]
 parseLog = map eitherDecode' 
 	. filter (not . L.null)
 	. L.split (fromIntegral (ord '\n'))
 
 -- | Throws exception on unparsable log.
-loadLog :: FilePath -> IO [ActivityLog]
+loadLog :: FilePath -> IO [Log]
 loadLog f = do
 	parsed <- parseLog <$> L.readFile f
 	case lefts parsed of