log JSON to debug-me.log (for now)

useful for debugging, etc

This commit was sponsored by Alexander Thompson on Patreon.

1 files changed, 31 insertions, 18 deletions

diff --git a/debug-me.hs b/debug-me.hs
index 5f0f628..162ca1b 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-}
 
 module Main where
 
@@ -20,12 +20,12 @@ import Data.Aeson
 
 main :: IO ()
 main = do
-	exitstatus <- go ">>> debug-me started"
+	exitstatus <- go ">>> debug-me session starting"
 	putStrLn ""
-	putStrLn ">>> debug-me is exiting..."
+	putStrLn ">>> debug-me session is done"
 	exitWith exitstatus
   where
-	go startmsg = runWithPty "bash" [] $ \(p, ph) -> do
+	go startmsg = runWithPty "dash" [] $ \(p, ph) -> do
 		ichan <- newTChanIO
 		ochan <- newTChanIO
 		dthread <- async (developer ichan ochan)
@@ -110,36 +110,50 @@ sendTtyOutput ochan devstate = go
 			_ -> return mempty
 
 user :: B.ByteString -> Pty -> TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
-user startmsg p ichan ochan = do
+user startmsg p ichan ochan = withLogger "debug-me.log" $ \logger -> do
 	let startact = Activity (Seen (Val (startmsg <> "\r\n"))) Nothing dummySignature
+	logger (ActivitySeen startact)
 	atomically $ writeTChan ochan startact
 	backlog <- newTVarIO $ Backlog ((hash startact, startact) :| [])
-	_ <- sendPtyOutput p ochan backlog
-		`concurrently` sendPtyInput ichan p backlog
+	_ <- sendPtyOutput p ochan backlog logger
+		`concurrently` sendPtyInput ichan p backlog logger
 	return ()
 
 -- | Log of recent output, with the most recent output first.
 data Backlog = Backlog (NonEmpty (HashPointer, Activity Seen))
 	deriving (Show)
 
+type Logger = ActivityLog -> IO ()
+
+withLogger :: FilePath -> (Logger -> IO a) -> IO a
+withLogger logfile a = withFile logfile WriteMode (a . mkLogger)
+
+mkLogger :: Handle -> Logger
+mkLogger h l = do
+	L.hPut h (encode l)
+	hPutStr h "\n"
+	hFlush h
+
 -- | Forward things written to the Pty out the TChan.
-sendPtyOutput :: Pty -> TChan (Activity Seen) -> TVar Backlog -> IO ()
-sendPtyOutput p ochan backlog = go
+sendPtyOutput :: Pty -> TChan (Activity Seen) -> TVar Backlog -> Logger -> IO ()
+sendPtyOutput p ochan backlog logger = go
   where
 	go = do
 		b <- readPty p
-		atomically $ do
+		act <- atomically $ do
 			Backlog (bl@((prevhash, _) :| _)) <- readTVar backlog
 			let seen = Seen (Val b)
 			let act = Activity seen (Just prevhash) dummySignature
 			writeTChan ochan act
 			writeTVar backlog (Backlog ((hash act, act) :| toList bl))
+			return act
+		logger (ActivitySeen act)
 		go
 
 -- | Read things to be entered from the TChan, verify if they're legal,
 -- and send them to the Pty.
-sendPtyInput :: TChan (Activity Entered) -> Pty -> TVar Backlog -> IO ()
-sendPtyInput ichan p backlog = go
+sendPtyInput :: TChan (Activity Entered) -> Pty -> TVar Backlog -> Logger -> IO ()
+sendPtyInput ichan p backlog logger = go
   where
 	go = do
 		networkDelay
@@ -154,14 +168,15 @@ sendPtyInput ichan p backlog = go
 					writeTVar backlog bl'
 					return (Right newact)
 				else do
-					return (Left ("illegal entry" :: String, encode newact, bl'))
+					return (Left (newact, bl'))
 		case v of
 			Right entered -> do
-				L.putStrLn (encode entered)
+				logger (ActivityEntered entered True)
 				writePty p (val (enteredData (activity entered)))
 				go
-			Left _e -> do
-				-- print e
+			Left (illegalentered, _bl) -> do
+				logger (ActivityEntered illegalentered False)
+				-- print bl
 				go
 
 -- | Truncate the Backlog to remove entries older than the one
@@ -178,7 +193,6 @@ truncateBacklog (Backlog (b :| l)) (Activity _ hp _)
 	go c (x:xs)
 		| Just (fst x) == hp = reverse (x:c)
 		| otherwise = go (x:c) xs
-truncateBacklog (Backlog bl) _ = Backlog bl
 
 -- | Entered activity is only legal if it points to the last Seen activvity,
 -- because this guarantees that the person who entered it saw
@@ -197,7 +211,6 @@ isLegal (Activity entered hp sig) (Backlog (lastseen@(lastseenhash, _lastseen) :
 		let sincehp = reverse (lastseen : takeWhile (\(h, _) -> Just h /= hp) bl)
 		in echoData entered == mconcat (map (seenData . activity . snd) sincehp)
 	| otherwise = False
-isLegal _ _ = False
 
 dummySignature :: Signature
 dummySignature = Signature mempty