Validate event parsing.

pkg/king/app/CLI.hs

@@ -49,6 +49,13 @@ data Bug
     | CollectAllFX
         { bPierPath :: FilePath
         }
+    | ValidateEvents
+        { bPierPath :: FilePath
+        , bFirstEvt :: Word64
+        }
+    | ValidateFX
+        { bPierPath :: FilePath
+        }
   deriving (Show)
 
 data Cmd
@@ -209,6 +216,17 @@ valPill = do
 
     pure ValidatePill{..}
 
+checkEvs :: Parser Bug
+checkEvs = do
+  bPierPath <- strArgument (metavar "PIER" <> help "Path to pier")
+
+  bFirstEvt <- option auto $ long "start"
+                          <> metavar "FST"
+                          <> help "starting from event FST"
+                          <> value 1
+
+  pure ValidateEvents{..}
+
 bugCmd :: Parser Cmd
 bugCmd = fmap CmdBug
         $ subparser
@@ -220,6 +238,10 @@ bugCmd = fmap CmdBug
             ( info (allFx <**> helper)
             $ progDesc "Replay entire event log, collecting all effects"
             )
+       <> command "validate-events"
+            ( info (checkEvs <**> helper)
+            $ progDesc "Parse all data in event log"
+            )
 
 allFx :: Parser Bug
 allFx = do

pkg/king/app/Main.hs

@@ -195,8 +195,8 @@ tryFullReplay shipPath = do
 
 --------------------------------------------------------------------------------
 
-tryParseEvents :: FilePath -> EventId -> IO ()
+checkEvs :: FilePath -> Word64 -> IO ()
-tryParseEvents dir first = do
+checkEvs pier first = do
     vPax <- newIORef []
     with (Log.existing dir) $ \log -> do
         let ident = Log.identity log
@@ -206,16 +206,20 @@ tryParseEvents dir first = do
     paths <- sort . ordNub <$> readIORef vPax
     for_ paths print
   where
+    dir :: FilePath
+    dir = pier <> "/.urb/log"
+
     showEvents :: IORef [Path] -> EventId -> EventId
                -> ConduitT ByteString Void IO ()
     showEvents vPax eId cycle = await >>= \case
-      Nothing -> print "Done!"
+      Nothing -> print "Everything checks out."
       Just bs -> do
           -- print ("got event", eId)
           n <- liftIO $ cueBSExn bs
           -- print ("done cue", eId)
           when (eId <= cycle) $ do
-              putStrLn ("[tryParseEvents] lifecycle nock: " <> tshow eId)
+              -- putStrLn ("[tryParseEvents] lifecycle nock: " <> tshow eId)
+              pure ()
           when (eId > cycle) $ liftIO $ do
               (mug, wen, evNoun) <- unpackJob n
               case fromNounErr evNoun of
@@ -361,6 +365,8 @@ main = CLI.parseArgs >>= \case
     CLI.CmdNew n o                            -> newShip n o
     CLI.CmdBug (CLI.CollectAllFX pax)         -> collectAllFx pax
     CLI.CmdBug (CLI.ValidatePill pax pil seq) -> testPill pax pil seq
+    CLI.CmdBug (CLI.ValidateFX pax)           -> print "validate-fx"
+    CLI.CmdBug (CLI.ValidateEvents pax start) -> checkEvs pax start
 
 validatePill :: FilePath -> IO ()
 validatePill = const (pure ())