Toggle between drvname/name when pressing n

TODO

- help screen
- freeze print when pressing f

Author: picnoir

exe/Main.hs

@@ -10,22 +10,22 @@ 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.Error qualified as IOError
 import System.Posix.Signals qualified as Signals
@@ -160,7 +160,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)
 

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,9 @@
-module NOM.IO (interact, processTextStream, StreamParser, Stream) where
+module NOM.IO (interact, processTextStream, 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 Control.Exception (bracket)
 import Data.ByteString qualified as ByteString
 import Data.ByteString.Builder qualified as Builder
 import Data.ByteString.Char8 qualified as ByteString
@@ -11,6 +12,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 +30,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 +61,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 +91,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
@@ -214,6 +216,14 @@ minFrameDuration =
   -- feel to sluggish for the eye, for me.
   60_000 -- ~17 times per second
 
+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)
+
 processTextStream ::
   forall update state.
   Config ->
@@ -227,6 +237,8 @@ processTextStream ::
   IO state
 processTextStream config parser updater maintenance printerMay finalize initialState inputStream = do
   state_var <- newTMVarIO initialState
+  print_state_var <- newTMVarIO initPrintState
+  input_received <- newEmptyTMVarIO
   output_builder_var <- newTVarIO []
   refresh_display_var <- newTVarIO False
   let keepProcessing :: IO ()
@@ -240,13 +252,47 @@ processTextStream config parser updater maintenance printerMay finalize initialS
       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
+    let keepProcessingStdin :: IO ()
+        keepProcessingStdin = bracket setBuffering restoreBuffering $ const processStdinForeverLoop
+         where
+          setBuffering = do
+            buff <- System.IO.hGetBuffering stdin
+            setEcho <- System.IO.hGetEcho stdin
+            System.IO.hSetBuffering stdin NoBuffering
+            System.IO.hSetEcho stdin False
+            pure (buff, setEcho)
+          restoreBuffering (buff, setEcho) = do
+            System.IO.hSetBuffering stdin buff
+            System.IO.hSetEcho stdin setEcho
+        processStdinForeverLoop :: IO ()
+        processStdinForeverLoop = 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}
+                writeTMVar input_received ()
+            "?" -> do
+              atomically $ do
+                print_state <- takeTMVar print_state_var
+                putTMVar print_state_var $ print_state{printHelp = True}
+                writeTMVar input_received ()
+            _ -> pure ()
+        writeToScreen :: IO ()
+        writeToScreen = writeStateToScreen (not config.silent) linesVar 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)
+          runConcurrently
+            $ (Concurrently (threadDelay minFrameDuration) *> Concurrently waitForInput)
+            <|> Concurrently (threadDelay maxFrameDuration)
+            <|> Concurrently (atomically $ takeTMVar input_received)
           writeToScreen
-    race_ keepProcessing keepPrinting
+    runConcurrently
+      $ Concurrently keepProcessing
+      <|> 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

@@ -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)
+        (printBuilds buildState printState hostNums maxHeight now)
     errorDisplay = printErrors nixErrors maxHeight
     traceDisplay = printTraces nixTraces maxHeight
   -- evalMessage = case evaluationState.lastFileName of
@@ -303,11 +305,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 +456,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

lib/NOM/State.hs

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