Toggle between drvname/name when pressing n

exe/Main.hs

@@ -10,23 +10,24 @@ import Data.Time (ZonedTime)
 import Data.Version (showVersion)
 import GHC.IO.Exception (ExitCode (ExitFailure))
 import NOM.Error (NOMError)
-import NOM.IO (interact)
+import NOM.IO (Window, interact)
+import NOM.IO qualified as Nom.IO
 import NOM.IO.Input (NOMInput (..), UpdateResult (..))
 import NOM.IO.Input.JSON ()
 import NOM.IO.Input.OldStyle (OldStyleInput)
 import NOM.NixMessage.JSON (NixJSONMessage)
 import NOM.Print (Config (..), stateToText)
 import NOM.Print.Table (markup, red)
-import NOM.State (NOMV1State (..), ProgressState (..), failedBuilds, fullSummary, initalStateFromBuildPlatform)
+import NOM.State (NOMV1State (..), PrintState, ProgressState (..), failedBuilds, fullSummary, initalStateFromBuildPlatform)
 import NOM.State.CacheId.Map qualified as CMap
 import NOM.Update (detectLocalFinishedBuilds, maintainState)
 import NOM.Update.Monad (UpdateMonad)
 import Optics (gfield, (%), (%~), (.~), (^.))
 import Paths_nix_output_monitor (version)
 import Relude
 import System.Console.ANSI qualified as Terminal
-import System.Console.Terminal.Size (Window)
 import System.Environment qualified as Environment
+import System.IO qualified
 import System.IO.Error qualified as IOError
 import System.Posix.Signals qualified as Signals
 import System.Process.Typed (proc, runProcess)
@@ -160,7 +161,8 @@ runMonitoredCommand config process_config = do
 
 data ProcessState a = MkProcessState
   { updaterState :: UpdaterState a
-  , printFunction :: Maybe (Window Int) -> (ZonedTime, Double) -> Text
+  , printFunction :: PrintState -> Maybe NOM.IO.Window -> (ZonedTime, Double) -> Nom.IO.Output
+  -- ^ That print function is 'NOM.IO.OutputFunc' without the nom state.
   }
   deriving stock (Generic)
 
@@ -170,6 +172,8 @@ monitorHandle config input_handle = withParser @a \streamParser -> do
     do
       Terminal.hHideCursor outputHandle
       hSetBuffering stdout (BlockBuffering (Just 1_000_000))
+      System.IO.hSetBuffering stdin NoBuffering
+      System.IO.hSetEcho stdin False
 
       current_system <- Exception.handle ((Nothing <$) . printIOException) $ Just . decodeUtf8 <$> Process.readProcessStdout_ (Process.proc "nix" ["eval", "--extra-experimental-features", "nix-command", "--impure", "--raw", "--expr", "builtins.currentSystem"])
       first_state <- initalStateFromBuildPlatform current_system

flake.nix

@@ -102,6 +102,7 @@
             pkgs.haskell.packages.ghc92.weeder
             pkgs.haskellPackages.cabal-install
             pkgs.pv
+            pkgs.haskellPackages.fourmolu
           ];
           withHoogle = true;
           inherit (self.checks.${system}.pre-commit-check) shellHook;

lib/NOM/IO.hs

@@ -1,8 +1,8 @@
-module NOM.IO (interact, processTextStream, StreamParser, Stream) where
+module NOM.IO (interact, mainIOLoop, StreamParser, Stream, Window, Output) where
 
 import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async (concurrently_, race_)
-import Control.Concurrent.STM (check, swapTVar)
+import Control.Concurrent.Async (Concurrently (Concurrently, runConcurrently))
+import Control.Concurrent.STM (check, swapTVar, writeTMVar)
 import Data.ByteString qualified as ByteString
 import Data.ByteString.Builder qualified as Builder
 import Data.ByteString.Char8 qualified as ByteString
@@ -11,6 +11,7 @@ import Data.Time (ZonedTime, getZonedTime)
 import NOM.Error (NOMError)
 import NOM.Print (Config (..))
 import NOM.Print.Table as Table (bold, displayWidth, displayWidthBS, markup, red, truncate)
+import NOM.State (PrintNameStyle (..), PrintState (..), initPrintState)
 import NOM.Update.Monad (UpdateMonad, getNow)
 import Relude
 import Streamly.Data.Fold qualified as Fold
@@ -28,7 +29,7 @@ type Output = Text
 
 type UpdateFunc update state = forall m. (UpdateMonad m) => update -> StateT state m ([NOMError], ByteString, Bool)
 
-type OutputFunc state = state -> Maybe Window -> (ZonedTime, Double) -> Output
+type OutputFunc state = state -> PrintState -> Maybe Window -> (ZonedTime, Double) -> Output
 
 type Finalizer state = forall m. (UpdateMonad m) => StateT state m ()
 
@@ -59,13 +60,14 @@ writeStateToScreen ::
   Bool ->
   TVar Int ->
   TMVar state ->
+  TMVar PrintState ->
   TVar [ByteString] ->
   TVar Bool ->
   (Double -> state -> state) ->
   OutputFunc state ->
   Handle ->
   IO ()
-writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var refresh_display_var maintenance printer output_handle = do
+writeStateToScreen pad printed_lines_var nom_state_var print_state_var nix_output_buffer_var refresh_display_var maintenance printer output_handle = do
   nowClock <- getZonedTime
   now <- getNow
   terminalSize <-
@@ -88,11 +90,10 @@ writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var ref
     nix_output_raw <- swapTVar nix_output_buffer_var []
     pure (nom_state, nix_output_raw)
   -- ====
-
+  print_state <- atomically $ readTMVar print_state_var
   let nix_output = ByteString.lines $ ByteString.concat $ reverse nix_output_raw
       nix_output_length = length nix_output
-
-      nom_output = ByteString.lines $ encodeUtf8 $ truncateOutput terminalSize (printer nom_state terminalSize (nowClock, now))
+      nom_output = ByteString.lines $ encodeUtf8 $ truncateOutput terminalSize (printer nom_state print_state terminalSize (nowClock, now))
       nom_output_length = length nom_output
 
       -- We will try to calculate how many lines we can draw without reaching the end
@@ -200,7 +201,7 @@ interact ::
   state ->
   IO state
 interact config parser updater maintenance printer finalize input_stream output_handle initialState =
-  processTextStream config parser updater maintenance (Just (printer, output_handle)) finalize initialState input_stream
+  mainIOLoop config parser updater maintenance (Just (printer, output_handle)) finalize initialState input_stream
 
 -- frame durations are passed to threadDelay and thus are given in microseconds
 
@@ -214,7 +215,15 @@ minFrameDuration =
   -- feel to sluggish for the eye, for me.
   60_000 -- ~17 times per second
 
-processTextStream ::
+getKey :: IO [Char]
+getKey = reverse <$> getKey' ""
+ where
+  getKey' chars = do
+    char <- System.IO.getChar
+    more <- System.IO.hReady stdin
+    (if more then getKey' else return) (char : chars)
+
+mainIOLoop ::
   forall update state.
   Config ->
   StreamParser update ->
@@ -225,28 +234,63 @@ processTextStream ::
   state ->
   Stream (Either NOMError ByteString) ->
   IO state
-processTextStream config parser updater maintenance printerMay finalize initialState inputStream = do
+mainIOLoop config parser updater maintenance printerMay finalize initialState inputStream = do
   state_var <- newTMVarIO initialState
+  print_state_var <- newTMVarIO initPrintState
+  new_user_input <- newEmptyTMVarIO
   output_builder_var <- newTVarIO []
   refresh_display_var <- newTVarIO False
-  let keepProcessing :: IO ()
-      keepProcessing =
+  let keepProcessingNixCmd :: IO ()
+      keepProcessingNixCmd =
         inputStream
           & Stream.tap (errorsToBuilderFold output_builder_var)
           & Stream.mapMaybe rightToMaybe
           & parser
           & Stream.fold (Fold.drainMapM (runUpdate output_builder_var state_var refresh_display_var updater))
       waitForInput :: IO ()
       waitForInput = atomically $ check =<< readTVar refresh_display_var
-  printerMay & maybe keepProcessing \(printer, output_handle) -> do
-    linesVar <- newTVarIO 0
-    let writeToScreen :: IO ()
-        writeToScreen = writeStateToScreen (not config.silent) linesVar state_var output_builder_var refresh_display_var maintenance printer output_handle
+  printerMay & maybe keepProcessingNixCmd \(printer, output_handle) -> do
+    printedLinesVar <- newTVarIO 0
+    let toggleHelp :: IO () = atomically $ do
+          print_state <- readTMVar print_state_var
+          writeTMVar print_state_var $ print_state{printHelp = not print_state.printHelp}
+          writeTMVar new_user_input ()
+        keepProcessingStdin = forever $ do
+          key <- getKey
+          case key of
+            "n" -> do
+              atomically $ do
+                print_state <- readTMVar print_state_var
+                let print_state_style = if print_state.printName == PrintName then PrintDerivationPath else PrintName
+                writeTMVar print_state_var $ print_state{printName = print_state_style, printHelp = False}
+                writeTMVar new_user_input ()
+            "?" -> toggleHelp
+            "h" -> toggleHelp
+            "f" -> do
+              atomically $ do
+                print_state <- readTMVar print_state_var
+                writeTMVar print_state_var $ print_state{freeze = not print_state.freeze, printHelp = False}
+                writeTMVar new_user_input ()
+            _ -> pure ()
+        writeToScreen :: IO ()
+        writeToScreen = do
+          print_state <- atomically $ readTMVar print_state_var
+          case (print_state.freeze, print_state.printHelp) of
+            (True, _) -> pure () -- Freezing the output, do not print anything.
+            _ -> writeStateToScreen (not config.silent) printedLinesVar state_var print_state_var output_builder_var refresh_display_var maintenance printer output_handle
         keepPrinting :: IO ()
         keepPrinting = forever do
-          race_ (concurrently_ (threadDelay minFrameDuration) waitForInput) (threadDelay maxFrameDuration)
+          -- Wait for either a Nix new input, the max frame duration (to update the timestamp), or a new input from the user.
+          runConcurrently
+            $ (Concurrently (threadDelay minFrameDuration) *> Concurrently waitForInput)
+            <|> Concurrently (threadDelay maxFrameDuration)
+            <|> Concurrently (atomically $ takeTMVar new_user_input)
           writeToScreen
-    race_ keepProcessing keepPrinting
+    -- Actual main loop.
+    runConcurrently
+      $ Concurrently keepProcessingNixCmd
+      <|> Concurrently keepProcessingStdin
+      <|> Concurrently keepPrinting
     atomically (takeTMVar state_var) >>= execStateT finalize >>= atomically . putTMVar state_var
     writeToScreen
   (if isNothing printerMay then (>>= execStateT finalize) else id) $ atomically $ takeTMVar state_var

lib/NOM/Print.hs

@@ -1,4 +1,4 @@
-module NOM.Print (stateToText, showCode, Config (..)) where
+module NOM.Print (stateToText, showCode, helpString, Config (..)) where
 
 import Data.Foldable qualified as Unsafe
 import Data.IntMap.Strict qualified as IntMap
@@ -29,6 +29,8 @@ import NOM.State (
   InputDerivation (..),
   NOMState,
   NOMV1State (..),
+  PrintNameStyle (..),
+  PrintState (..),
   ProgressState (..),
   StorePathId,
   StorePathInfo (..),
@@ -151,8 +153,8 @@ printErrors errors maxHeight =
 compactError :: Text -> Text
 compactError = fst . Text.breakOn "\n       last 10 log lines:"
 
-stateToText :: Config -> NOMV1State -> Maybe (Window Int) -> (ZonedTime, Double) -> Text
-stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Window.height
+stateToText :: Config -> NOMV1State -> PrintState -> Maybe (Window Int) -> (ZonedTime, Double) -> Text
+stateToText config buildState@MkNOMV1State{..} printState = memo printWithSize . fmap Window.height
  where
   printWithSize :: Maybe Int -> (ZonedTime, Double) -> Text
   printWithSize maybeWindow = printWithTime
@@ -182,7 +184,7 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
         horizontal
         (vertical <> " ")
         (vertical <> " ")
-        (printBuilds buildState hostNums maxHeight now)
+        (if not printState.printHelp then printBuilds buildState printState hostNums maxHeight now else helpString)
     errorDisplay = printErrors nixErrors maxHeight
     traceDisplay = printTraces nixTraces maxHeight
   -- evalMessage = case evaluationState.lastFileName of
@@ -195,6 +197,7 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
   MkDependencySummary{..} = fullSummary
   runningBuilds' = (.host) <$> runningBuilds
   completedBuilds' = (.host) <$> completedBuilds
+
   failedBuilds' = (.host) <$> failedBuilds
   numFailedBuilds = CMap.size failedBuilds
   table time' =
@@ -303,11 +306,12 @@ ifTimeDurRelevant dur mod' = memptyIfFalse (dur > 1) (mod' [clock, printDuration
 
 printBuilds ::
   NOMV1State ->
+  PrintState ->
   [(Host, Int)] ->
   Int ->
   Double ->
   NonEmpty Text
-printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
+printBuilds nomState@MkNOMV1State{..} print_state hostNums maxHeight = printBuildsWithTime
  where
   hostLabel :: Bool -> Host -> Text
   hostLabel color host = (if color then markup magenta else id) $ maybe (toText host) (("[" <>) . (<> "]") . show) (List.lookup host hostNums)
@@ -453,8 +457,12 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
         phaseMay activityId' = do
           activityId <- Strict.toLazy activityId'
           activity_status <- IntMap.lookup activityId.value nomState.activities
-          Strict.toLazy $ activity_status.phase
-        drvName = appendDifferingPlatform nomState drvInfo drvInfo.name.storePath.name
+          Strict.toLazy activity_status.phase
+        printStyle = print_state.printName
+        storePathName = case printStyle of
+          PrintName -> drvInfo.name.storePath.name
+          PrintDerivationPath -> "/nix/store/" <> drvInfo.name.storePath.hash <> "-" <> drvInfo.name.storePath.name <> ".drv"
+        drvName = appendDifferingPlatform nomState drvInfo storePathName
         downloadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningDownloads
         uploadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningUploads
         plannedDownloads = store_paths_in drvInfo.dependencySummary.plannedDownloads
@@ -581,3 +589,12 @@ printDuration diff
 
 timeDiffSeconds :: Int -> Text
 timeDiffSeconds = printDuration . fromIntegral
+
+helpString :: NonEmpty Text
+helpString =
+  fromList
+    [ markup bold " Key Bindings"
+    , "n: toggle derivation name/derivation path print"
+    , "f: toggle screen freeze"
+    , "? or h: toggle help view"
+    ]

lib/NOM/State.hs

@@ -24,6 +24,9 @@ module NOM.State (
   InterestingActivity (..),
   InputDerivation (..),
   EvalInfo (..),
+  PrintState (..),
+  PrintNameStyle (..),
+  initPrintState,
   getDerivationInfos,
   initalStateFromBuildPlatform,
   updateSummaryForStorePath,
@@ -194,6 +197,23 @@ data EvalInfo = MkEvalInfo
   }
   deriving stock (Show, Eq, Ord, Generic)
 
+data PrintNameStyle = PrintName | PrintDerivationPath deriving stock (Show, Eq, Ord, Generic)
+
+data PrintState = MkPrintState
+  { printName :: PrintNameStyle
+  , printHelp :: Bool
+  , freeze :: Bool
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+initPrintState :: PrintState
+initPrintState =
+  MkPrintState
+    { printName = PrintName
+    , printHelp = False
+    , freeze = False
+    }
+
 data NOMV1State = MkNOMV1State
   { derivationInfos :: DerivationMap DerivationInfo
   , storePathInfos :: StorePathMap StorePathInfo

test/Golden.hs

@@ -5,7 +5,7 @@ import Data.ByteString.Char8 qualified as ByteString
 import Data.Text qualified as Text
 import NOM.Builds (parseStorePath)
 import NOM.Error (NOMError)
-import NOM.IO (processTextStream)
+import NOM.IO (mainIOLoop)
 import NOM.IO.Input (NOMInput (..), UpdateResult (..))
 import NOM.IO.Input.JSON ()
 import NOM.IO.Input.OldStyle (OldStyleInput)
@@ -100,7 +100,7 @@ testBuild name config asserts =
 testProcess :: forall input. (NOMInput input) => Stream.Stream IO ByteString -> IO NOMV1State
 testProcess input = withParser @input \streamParser -> do
   first_state <- firstState @input <$> initalStateFromBuildPlatform (Just "x86_64-linux")
-  end_state <- processTextStream @input @(UpdaterState input) (MkConfig False False) streamParser stateUpdater (\now -> nomState @input %~ maintainState now) Nothing (finalizer @input) first_state (Right <$> input)
+  end_state <- mainIOLoop @input @(UpdaterState input) (MkConfig False False) streamParser stateUpdater (\now -> nomState @input %~ maintainState now) Nothing (finalizer @input) first_state (Right <$> input)
   pure (end_state ^. nomState @input)
 
 stateUpdater :: forall input m. (NOMInput input, UpdateMonad m) => input -> StateT (UpdaterState input) m ([NOMError], ByteString, Bool)