ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-15 10:02:47 +03:00
Code Issues Packages Projects Releases Wiki Activity

king bug validate-event uses progress bar.

Browse Source
This commit is contained in:
Benjamin Summers 2019-12-19 04:02:06 -08:00
parent 18ad1d137c
commit 3cc952824e
1 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pkg/king/app/Main.hs
View File

@ -64,6 +64,7 @@ import Noun hiding (Parser)
import Noun.Atom import Noun.Atom
import Noun.Conversions (cordToUW) import Noun.Conversions (cordToUW)
import RIO.Directory import RIO.Directory
import System.ProgressBar
import Vere.Pier import Vere.Pier
import Vere.Pier.Types import Vere.Pier.Types
import Vere.Serf import Vere.Serf
@ -216,29 +217,36 @@ checkEvs :: forall e. HasLogFunc e => FilePath -> Word64 -> Word64 -> RIO e ()
checkEvs pierPath first last = do checkEvs pierPath first last = do
rwith (Log.existing logPath) $ \log -> do rwith (Log.existing logPath) $ \log -> do
let ident = Log.identity log let ident = Log.identity log
let pbSty = defStyle { stylePostfix = exact }
logTrace (displayShow ident) logTrace (displayShow ident)
last <- Log.lastEv log <&> \lastReal -> min last lastReal
let evCount = fromIntegral (last - first)
print (last, first, evCount)
pb <- io $ newProgressBar pbSty 10 (Progress 1 evCount ())
runConduit $ Log.streamEvents log first runConduit $ Log.streamEvents log first
.| showEvents first (fromIntegral $ lifecycleLen ident) .| showEvents pb first (fromIntegral $ lifecycleLen ident)
where where
logPath :: FilePath logPath :: FilePath
logPath = pierPath <> "/.urb/log" logPath = pierPath <> "/.urb/log"
showEvents :: EventId -> EventId -> ConduitT ByteString Void (RIO e) () showEvents :: ProgressBar () -> EventId -> EventId
showEvents eId _ | eId > last = pure () -> ConduitT ByteString Void (RIO e) ()
showEvents eId cycle = do showEvents pb eId _ | eId > last = pure ()
when (eId `mod` 10000 == 0) $ do showEvents pb eId cycle = await >>= \case
lift $ logTrace (display ("#" <> tshow eId)) Nothing -> lift $ logTrace "Everything checks out."
await >>= \case Just bs -> do
Nothing -> lift $ logTrace "Everything checks out." io $ incProgress pb 1
Just bs -> do lift $ do
lift $ do n <- io $ cueBSExn bs
n <- io $ cueBSExn bs when (eId > cycle) $ do
when (eId > cycle) $ do (mug, wen, evNoun) <- unpackJob n
(mug, wen, evNoun) <- unpackJob n fromNounErr evNoun & \case
fromNounErr evNoun & \case Left err -> logError (displayShow (eId, err))
Left err -> logError (displayShow (eId, err)) Right (_ ∷ Ev) -> pure ()
Right (_ ∷ Ev) -> pure () showEvents pb (succ eId) cycle
showEvents (succ eId) cycle
unpackJob :: Noun -> RIO e (Mug, Wen, Noun) unpackJob :: Noun -> RIO e (Mug, Wen, Noun)
unpackJob = io . fromNounExn unpackJob = io . fromNounExn