EventBrowser: Polish UI and implement event trimming.

pkg/king/lib/Arvo/Event.hs

@@ -128,6 +128,7 @@ data HttpServerEv
     | HttpServerEvRequestLocal  (ServId, UD, UD, ()) HttpServerReq
     | HttpServerEvLive          (ServId, ())         Port (Maybe Port)
     | HttpServerEvBorn          (KingId, ())         ()
+    | HttpServerEvCrud          Path                 Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''Address
@@ -152,8 +153,9 @@ deriveNoun ''AmesEv
 -- Arvo Events -----------------------------------------------------------------
 
 data ArvoEv
-    = ArvoEvWhom () Ship
-    | ArvoEvWack () Word512
+    = ArvoEvWhom ()   Ship
+    | ArvoEvWack ()   Word512
+    | ArvoEvCrud Path Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''ArvoEv
@@ -162,8 +164,8 @@ deriveNoun ''ArvoEv
 -- Boat Events -----------------------------------------------------------------
 
 data BoatEv
-    = BoatEvBoat () ()
-    | BoatEvVoid Void
+    = BoatEvBoat ()   ()
+    | BoatEvCrud Path Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''BoatEv
@@ -172,8 +174,9 @@ deriveNoun ''BoatEv
 -- Timer Events ----------------------------------------------------------------
 
 data BehnEv
-    = BehnEvWake ()        ()
+    = BehnEvWake ()           ()
     | BehnEvBorn (KingId, ()) ()
+    | BehnEvCrud Path         Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''BehnEv
@@ -183,7 +186,7 @@ deriveNoun ''BehnEv
 
 data NewtEv
     = NewtEvBarn (Atom, ()) ()
-    | NewtEvBorn Void
+    | NewtEvCrud Path       Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''NewtEv
@@ -224,7 +227,7 @@ data TermEv
     | TermEvBlew (Atom, ()) Word Word
     | TermEvBoot (Atom, ()) LegacyBootEvent
     | TermEvHail (Atom, ()) ()
-    | TermEvBorn Void
+    | TermEvCrud Path       Cord Tang
   deriving (Eq, Ord, Show)
 
 deriveNoun ''LegacyBootEvent

pkg/king/lib/EventBrowser.hs

@@ -58,13 +58,13 @@ run log = do
             Init -> loop cyc las 1
             Last -> loop cyc las las
             Quit -> pure ()
-            Trim -> trim cyc las cur
+            Trim -> trim cyc las cur mFx
             Effs -> showEffects mFx >> input cyc las cur mFx
 
-    trim cyc las cur = do
+    trim cyc las cur mFx = do
         deleteFrom log las cur >>= \case
             True  -> loop cyc (pred cur) (pred cur)
-            False -> loop cyc las cur
+            False -> input cyc las cur mFx
 
     loop cyc las 0                = loop cyc las 1
     loop cyc las cur | cur > las  = loop cyc las las
@@ -93,22 +93,28 @@ deleteFrom log las cur = do
     pure sure
   where
     abortDelete = do
-        putStrLn "Aborted delete -- no events pruned"
+        putStrLn "\n\n    [ABORTED]\n"
+        putStrLn "    Aborted delete, no events pruned.\n"
 
-    doDelete = Log.trimEvents log cur
+    doDelete = do
+        Log.trimEvents log cur
+        putStrLn "\n\n    [DELETED]\n"
+        putStrLn "    It's gone forever!\n"
 
     question =
       if las == cur
-      then mconcat [ "Are you sure you want to the last event (#"
+      then mconcat [ "    This will permanently delete the last event (#"
                    , tshow las
-                   , ")?" ]
-      else mconcat [ "Are you sure you want to all events (#"
+                   , ")\n" ]
+      else mconcat [ "    This will permanently delete all events in (#"
                    , tshow cur
                    , " - #"
                    , tshow las
-                   , ")?" ]
+                   , ")\n" ]
 
     areYouSure = do
+        putStrLn "\n\n    ARE YOU SURE????"
+        putStrLn ""
         putStrLn question
         putStr "(y|n) "
         hFlush stdout
@@ -142,20 +148,20 @@ getInput las cur = do
        , "    q    Quit"
        , "    x    Delete (only the last event)"
        , "    ?    Show this help"
-       , ""
        ]
 
 showEffectsTeaser :: Maybe FX -> RIO e ()
-showEffectsTeaser Nothing   = putStrLn "No collected effects\n"
-showEffectsTeaser (Just []) = putStrLn "No effects for this event\n"
+showEffectsTeaser Nothing   = putStrLn "    [No collected effects]\n"
+showEffectsTeaser (Just []) = putStrLn "    [No effects for this event]\n"
 showEffectsTeaser (Just fx) = putStrLn $ mconcat
-    [ tshow (length fx)
-    , " collected effects. Press 'f' to view.\n"
+    [ "    ["
+    , tshow (length fx)
+    , " collected effects. Press 'f' to view]\n"
     ]
 
 showEffects :: Maybe FX -> RIO e ()
-showEffects Nothing   = putStrLn "No collected effects\n"
-showEffects (Just []) = putStrLn "No effects for this event\n"
+showEffects Nothing   = putStrLn "    [No collected effects]\n"
+showEffects (Just []) = putStrLn "    [No effects for this event]\n"
 showEffects (Just fx) = do
     putStrLn "\n"
     putStrLn "    [EFFECTS]"
@@ -176,7 +182,6 @@ showEvent ev = do
     putStrLn "    [EVENT]"
     putStrLn ""
     putStrLn $ unlines $ fmap ("    " <>) $ lines $ pack $ ppShow (ova ev)
-    putStrLn ""
 
 peekEffect :: HasLogFunc e => EventLog -> Word64 -> RIO e (Maybe FX)
 peekEffect log eId = runMaybeT $ do

pkg/king/lib/Vere/Log.hs

@@ -253,9 +253,14 @@ writeEffectsRow log k v = do
 
 trimEvents :: HasLogFunc e => EventLog -> Word64 -> RIO e ()
 trimEvents log start = do
-    rwith (writeTxn $ env log) $ \txn -> do
-        logError "(trimEvents): Not implemented."
-        pure ()
+    last <- lastEv log
+    rwith (writeTxn $ env log) $ \txn ->
+        for_ [start..last] $ \eId ->
+        withWordPtr eId $ \pKey -> do
+            let key = MDB_val 8 (castPtr pKey)
+            found <- io $ mdb_del txn (eventsTbl log) key Nothing
+            unless found $
+                throwIO (MissingEvent eId)
     writeIORef (numEvents log) (pred start)
 
 streamEvents :: HasLogFunc e