From a481685d6d441d40a1aa3b44e423da798aae11bc Mon Sep 17 00:00:00 2001 From: Picnoir Date: Fri, 22 Nov 2024 18:45:04 +0100 Subject: [PATCH] Toggle between drvname/name when pressing n TODO - help screen - freeze print when pressing f --- exe/Main.hs | 9 ++++---- flake.nix | 1 + lib/NOM/IO.hs | 59 ++++++++++++++++++++++++++++++++++++++---------- lib/NOM/Print.hs | 19 +++++++++++----- lib/NOM/State.hs | 18 +++++++++++++++ 5 files changed, 84 insertions(+), 22 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 3331c9e..ff65999 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,7 +26,6 @@ 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) 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..27ef0e9 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, 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 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 @@ -214,6 +215,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 +236,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 +251,37 @@ 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 = forever $ do + System.IO.hSetBuffering stdin NoBuffering + System.IO.hSetEcho stdin False + 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 diff --git a/lib/NOM/Print.hs b/lib/NOM/Print.hs index 0d1bf61..2dac460 100644 --- a/lib/NOM/Print.hs +++ b/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 diff --git a/lib/NOM/State.hs b/lib/NOM/State.hs index 02b1d58..6906577 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,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