TODO HACK WIP DONTCOMMIT: Suppress serf logging.

pkg/king/app/Main.hs

@@ -432,7 +432,7 @@ runShip (CLI.Run pierPath) opts = do
 
 startBrowser :: HasLogFunc e => FilePath -> RIO e ()
 startBrowser pierPath = runRAcquire $ do
-    lockFile pierPath
+    -- lockFile pierPath
     log <- Log.existing (pierPath <> "/.urb/log")
     rio $ EventBrowser.run log
 

pkg/king/lib/Noun/Conversions.hs

@@ -686,36 +686,35 @@ instance FromNoun a => FromNoun (Maybe a) where
       unexpected s = fail ("Expected unit value, but got " <> s)
 
 -- Each is a direct translation of Hoon +each, preserving order
-
 data Each a b
     = EachYes a
     | EachNo b
   deriving (Eq, Ord, Show)
 
 instance (ToNoun a, ToNoun b) => ToNoun (Each a b) where
-  toNoun (EachYes x)  = Cell (Atom 0) (toNoun x)
-  toNoun (EachNo x) = Cell (Atom 1) (toNoun x)
+    toNoun (EachYes x) = C (A 0) (toNoun x)
+    toNoun (EachNo x)  = C (A 1) (toNoun x)
 
 instance (FromNoun a, FromNoun b) => FromNoun (Each a b) where
-  parseNoun n = named "Each" $ do
-      (Atom tag, v) <- parseNoun n
-      case tag of
-        0 -> named "%y" (EachYes <$> parseNoun v)
-        1 -> named "%|" (EachNo <$> parseNoun v)
-        n -> fail ("Each has invalid head-atom: " <> show n)
+    parseNoun n = named "Each" $ do
+        (Atom tag, v) <- parseNoun n
+        case tag of
+            0 -> named "&" (EachYes <$> parseNoun v)
+            1 -> named "|" (EachNo <$> parseNoun v)
+            n -> fail ("Each has invalid head-atom: " <> show n)
 
 -- Tuple Conversions -----------------------------------------------------------
 
 instance ToNoun () where
-  toNoun () = Atom 0
+    toNoun () = Atom 0
 
 instance FromNoun () where
-  parseNoun = named "()" . \case
-    Atom 0 -> pure ()
-    x      -> fail ("expecting `~`, but got " <> show x)
+    parseNoun = named "()" . \case
+        Atom 0 -> pure ()
+        x      -> fail ("expecting `~`, but got " <> show x)
 
 instance (ToNoun a, ToNoun b) => ToNoun (a, b) where
-  toNoun (x, y) = Cell (toNoun x) (toNoun y)
+    toNoun (x, y) = Cell (toNoun x) (toNoun y)
 
 
 shortRec :: Word -> Parser a

pkg/king/lib/Vere/Log.hs

@@ -68,7 +68,7 @@ rawOpen :: MonadIO m => FilePath -> m Env
 rawOpen dir = io $ do
     env <- mdb_env_create
     mdb_env_set_maxdbs env 3
-    mdb_env_set_mapsize env (40 * 1024 * 1024 * 1024)
+    mdb_env_set_mapsize env (100 * 1024 * 1024 * 1024)
     mdb_env_open env dir []
     pure env
 

pkg/king/lib/Vere/Serf.hs

@@ -60,7 +60,7 @@ data Config = Config FilePath [Flag]
   deriving (Show)
 
 serf :: HasLogFunc e => Text -> RIO e ()
-serf msg = logInfo $ display ("SERF: " <> msg)
+serf msg = pure () -- logInfo $ display ("SERF: " <> msg)
 
 
 -- Types -----------------------------------------------------------------------
@@ -230,9 +230,9 @@ sendLen s i = do
 
 sendOrder :: HasLogFunc e => Serf e -> Order -> RIO e ()
 sendOrder w o = do
-  logDebug $ display ("(sendOrder) " <> tshow o)
+  -- logDebug $ display ("(sendOrder) " <> tshow o)
   sendBytes w $ jamBS $ toNoun o
-  logDebug "(sendOrder) Done"
+  -- logDebug "(sendOrder) Done"
 
 sendBytes :: HasLogFunc e => Serf e -> ByteString -> RIO e ()
 sendBytes s bs = handle ioErr $ do
@@ -281,9 +281,9 @@ shutdown serf code = sendOrder serf (OExit code)
 -}
 recvPlea :: HasLogFunc e => Serf e -> RIO e Plea
 recvPlea w = do
-  logDebug "(recvPlea) Waiting"
+  -- logDebug "(recvPlea) Waiting"
   a <- recvAtom w
-  logDebug "(recvPlea) Got atom"
+  -- logDebug "(recvPlea) Got atom"
   n <- fromRightExn (cue a) (const $ BadPleaAtom a)
   p <- fromRightExn (fromNounErr n) (\(p,m) -> BadPleaNoun n p m)
 
@@ -291,7 +291,7 @@ recvPlea w = do
                                 recvPlea w
             PSlog _ pri t -> do printTank (sStderr w) pri t
                                 recvPlea w
-            _             -> do logTrace "recvPlea got something else"
+            _             -> do -- logTrace "recvPlea got something else"
                                 pure p
 
 {-
@@ -313,7 +313,7 @@ sendWork w job =
   do
     sendOrder w (OWork job)
     res <- loop
-    logTrace ("[sendWork] Got response")
+    -- logTrace ("[sendWork] Got response")
     pure res
   where
     eId = jobId job
@@ -451,7 +451,7 @@ toJobs ident eId =
     await >>= \case
         Nothing -> lift $ logTrace "[toJobs] no more jobs"
         Just at -> do yield =<< lift (fromAtom at)
-                      lift $ logTrace $ display ("[toJobs] " <> tshow eId)
+                      -- lift $ logTrace $ display ("[toJobs] " <> tshow eId)
                       toJobs ident (eId+1)
   where
     isNock = eId <= fromIntegral (lifecycleLen ident)
@@ -497,7 +497,8 @@ doCollectFX serf = go
         Just jb -> do
             -- jb <- pure $ replaceMug jb (ssLastMug ss)
             (_, ss, fx) <- lift $ doJob serf jb
-            lift $ logTrace $ displayShow (jobId jb)
+            when (0 == (jobId jb `mod` 10_000)) $ do
+                lift $ logTrace $ displayShow (jobId jb)
             yield (jobId jb, fx)
             go ss