summaryrefslogtreecommitdiffhomepage
path: root/debug-me.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-14 19:39:23 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-14 19:39:23 -0400
commit74003096f8018827dde28b5746a19c1e325bc68f (patch)
treede5343b6dae38d4ae06b8ad004f45b9669b28cb6 /debug-me.hs
parent0222ca35ec03836ab216aff1a38e337e2be16511 (diff)
downloaddebug-me-74003096f8018827dde28b5746a19c1e325bc68f.tar.gz
add --graphviz mode
This commit was sponsored by Shane-o on Patreon.
Diffstat (limited to 'debug-me.hs')
-rw-r--r--debug-me.hs27
1 files changed, 18 insertions, 9 deletions
diff --git a/debug-me.hs b/debug-me.hs
index 162ca1b..075ca17 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -5,6 +5,8 @@ module Main where
import Types
import Hash
import Pty
+import CmdLine
+import Graphviz
import Control.Concurrent
import Control.Concurrent.Async
@@ -20,6 +22,13 @@ import Data.Aeson
main :: IO ()
main = do
+ c <- getCmdLine
+ case mode c of
+ Test -> test
+ Graphviz logfile -> graphviz logfile
+
+test :: IO ()
+test = do
exitstatus <- go ">>> debug-me session starting"
putStrLn ""
putStrLn ">>> debug-me session is done"
@@ -53,7 +62,7 @@ developer ichan ochan = do
return ()
data DeveloperState = DeveloperState
- { lastSeen :: HashPointer
+ { lastSeen :: Hash
, sentSince :: B.ByteString
}
deriving (Show)
@@ -112,7 +121,7 @@ sendTtyOutput ochan devstate = go
user :: B.ByteString -> Pty -> TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
user startmsg p ichan ochan = withLogger "debug-me.log" $ \logger -> do
let startact = Activity (Seen (Val (startmsg <> "\r\n"))) Nothing dummySignature
- logger (ActivitySeen startact)
+ logger $ ActivitySeen (startact, hash startact)
atomically $ writeTChan ochan startact
backlog <- newTVarIO $ Backlog ((hash startact, startact) :| [])
_ <- sendPtyOutput p ochan backlog logger
@@ -120,7 +129,7 @@ user startmsg p ichan ochan = withLogger "debug-me.log" $ \logger -> do
return ()
-- | Log of recent output, with the most recent output first.
-data Backlog = Backlog (NonEmpty (HashPointer, Activity Seen))
+data Backlog = Backlog (NonEmpty (Hash, Activity Seen))
deriving (Show)
type Logger = ActivityLog -> IO ()
@@ -129,8 +138,8 @@ 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)
+mkLogger h a = do
+ L.hPut h (encode a)
hPutStr h "\n"
hFlush h
@@ -147,7 +156,7 @@ sendPtyOutput p ochan backlog logger = go
writeTChan ochan act
writeTVar backlog (Backlog ((hash act, act) :| toList bl))
return act
- logger (ActivitySeen act)
+ logger $ ActivitySeen (act, hash act)
go
-- | Read things to be entered from the TChan, verify if they're legal,
@@ -171,11 +180,11 @@ sendPtyInput ichan p backlog logger = go
return (Left (newact, bl'))
case v of
Right entered -> do
- logger (ActivityEntered entered True)
+ logger $ ActivityEntered True (entered, hash entered)
writePty p (val (enteredData (activity entered)))
go
Left (illegalentered, _bl) -> do
- logger (ActivityEntered illegalentered False)
+ logger $ ActivityEntered False (illegalentered, hash illegalentered)
-- print bl
go
@@ -199,7 +208,7 @@ truncateBacklog (Backlog (b :| l)) (Activity _ hp _)
-- the current state of the system before manipulating it.
--
-- To support typeahead on slow links, some echoData may be provided
--- in the Entered activity. If the HashPointer in the activity points
+-- in the Entered activity. If the prevActivity points
-- to an older Seen activity, then the echoData must match the
-- concatenation of all activities after that one, up to the most recent
-- Seen activity.