diff --git a/exe/Main.hs b/exe/Main.hs
index 3331c9e..33e8742 100644
--- a/exe/Main.hs
+++ b/exe/Main.hs
@@ -10,14 +10,15 @@ 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)
@@ -25,8 +26,8 @@ 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
diff --git a/flake.nix b/flake.nix
index adf6691..1190ab1 100644
--- a/flake.nix
+++ b/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;
diff --git a/lib/NOM/IO.hs b/lib/NOM/IO.hs
index c8271c3..e327ea2 100644
--- a/lib/NOM/IO.hs
+++ b/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,12 +234,14 @@ 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
@@ -238,15 +249,48 @@ processTextStream config parser updater maintenance printerMay finalize initialS
& 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
diff --git a/lib/NOM/Print.hs b/lib/NOM/Print.hs
index 0d1bf61..595f77e 100644
--- a/lib/NOM/Print.hs
+++ b/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"
+ ]
diff --git a/lib/NOM/State.hs b/lib/NOM/State.hs
index 02b1d58..28944cc 100644
--- a/lib/NOM/State.hs
+++ b/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
diff --git a/test/Golden.hs b/test/Golden.hs
index d98bd83..7c4abe5 100644
--- a/test/Golden.hs
+++ b/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)