Strictify

exe/Main.hs

@@ -4,6 +4,7 @@ import Control.Exception qualified as Exception
 import Control.Monad.Writer.Strict (WriterT (runWriterT))
 import Data.ByteString qualified as ByteString
 import Data.Hermes qualified as JSON
+import Data.Strict qualified as Strict
 import Data.Text.IO (hPutStrLn)
 import Data.Time (ZonedTime)
 import Data.Version (showVersion)
@@ -22,77 +23,77 @@ import NOM.State (NOMV1State (..), ProgressState (..), failedBuilds, fullSummary
 import NOM.State.CacheId.Map qualified as CMap
 import NOM.Update (detectLocalFinishedBuilds, maintainState, updateStateNixJSONMessage, updateStateNixOldStyleMessage)
 import NOM.Update.Monad (UpdateMonad)
-import Optics (Lens', gfield, (%), (%~), (.~), (^.), _2)
+import Optics (Lens', gfield, (%), (%~), (.~), (^.))
 import Optics qualified
 import Paths_nix_output_monitor (version)
 import Relude
-import Streamly.Internal.Data.Time.Units (AbsTime)
 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.Process.Typed qualified as Process
+import Type.Strict qualified as StrictType
 
-outputHandle ∷ Handle
+outputHandle :: Handle
 outputHandle = stderr
 
-defaultConfig ∷ Config
+defaultConfig :: Config
 defaultConfig =
   MkConfig
     { piping = False
     , silent = False
     }
 
-main ∷ IO Void
+main :: IO Void
 main = do
-  args ← Environment.getArgs
-  prog_name ← Environment.getProgName
+  args <- Environment.getArgs
+  prog_name <- Environment.getProgName
   case (args, prog_name) of
-    (["--version"], _) → do
+    (["--version"], _) -> do
       hPutStrLn stderr ("nix-output-monitor " <> fromString (showVersion version))
       exitWith =<< Process.runProcess (Process.proc "nix" ["--version"])
-    (nix_args, "nom-build") → do
+    (nix_args, "nom-build") -> do
       exitWith =<< runMonitoredCommand defaultConfig (Process.proc "nix-build" ("-v" : "--log-format" : "internal-json" : nix_args))
-    (nix_args, "nom-shell") → do
+    (nix_args, "nom-shell") -> do
       exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (Process.proc "nix-shell" (("-v" : "--log-format" : "internal-json" : nix_args) <> ["--run", "exit"]))
       exitWith =<< Process.runProcess (Process.proc "nix-shell" nix_args)
-    ("build" : nix_args, _) → do
+    ("build" : nix_args, _) -> do
       exitWith =<< runMonitoredCommand defaultConfig (Process.proc "nix" ("build" : "-v" : "--log-format" : "internal-json" : nix_args))
-    ("shell" : nix_args, _) → do
+    ("shell" : nix_args, _) -> do
       exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (Process.proc "nix" (("shell" : "-v" : "--log-format" : "internal-json" : nix_args) <> ["--command", "sh", "-c", "exit"]))
       exitWith =<< Process.runProcess (Process.proc "nix" ("shell" : nix_args))
-    ("develop" : nix_args, _) → do
+    ("develop" : nix_args, _) -> do
       exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (Process.proc "nix" (("develop" : "-v" : "--log-format" : "internal-json" : nix_args) <> ["--command", "sh", "-c", "exit"]))
       exitWith =<< Process.runProcess (Process.proc "nix" ("develop" : nix_args))
-    ([], _) → do
-      finalState ← monitorHandle (Proxy @(Maybe NixOldStyleMessage, ByteString)) defaultConfig{piping = True} stdin
+    ([], _) -> do
+      finalState <- monitorHandle (Proxy @(Maybe NixOldStyleMessage, ByteString)) defaultConfig{piping = True} stdin
       if CMap.size finalState.fullSummary.failedBuilds + length finalState.nixErrors == 0
         then exitSuccess
         else exitFailure
-    (["--json"], _) → do
-      finalState ← monitorHandle (Proxy @(Either NOMError NixJSONMessage)) defaultConfig{piping = True} stdin
+    (["--json"], _) -> do
+      finalState <- monitorHandle (Proxy @(Either NOMError NixJSONMessage)) defaultConfig{piping = True} stdin
       if CMap.size finalState.fullSummary.failedBuilds + length finalState.nixErrors == 0
         then exitSuccess
         else exitFailure
-    xs → do
+    xs -> do
       hPutStrLn stderr helpText
       -- It's not a mistake if the user requests the help text, otherwise tell
       -- them off with a non-zero exit code.
       if any (liftA2 (||) (== "-h") (== "--help")) xs then exitSuccess else exitFailure
 
-exitOnFailure ∷ Process.ExitCode → IO ()
+exitOnFailure :: Process.ExitCode -> IO ()
 exitOnFailure = \case
-  code@Process.ExitFailure{} → exitWith code
-  _ → pass
+  code@Process.ExitFailure{} -> exitWith code
+  _ -> pass
 
-printIOException ∷ IOError.IOError → IO ()
+printIOException :: IOError.IOError -> IO ()
 printIOException io_exception = do
   let error_msg = case (IOError.isDoesNotExistError io_exception, IOError.ioeGetFileName io_exception) of
-        (True, Just cmd) → "Command '" <> toText cmd <> "' not available from $PATH."
-        _ → show io_exception
+        (True, Just cmd) -> "Command '" <> toText cmd <> "' not available from $PATH."
+        _ -> show io_exception
   hPutStrLn stderr $ markup red ("nix-output-monitor: " <> error_msg)
 
-runMonitoredCommand ∷ Config → Process.ProcessConfig () () () → IO Process.ExitCode
+runMonitoredCommand :: Config -> Process.ProcessConfig () () () -> IO Process.ExitCode
 runMonitoredCommand config process_config = do
   let process_config_with_handles =
         Process.setStdout Process.createPipe $
@@ -100,34 +101,34 @@ runMonitoredCommand config process_config = do
             Process.createPipe
             process_config
   Exception.handle ((ExitFailure 1 <$) . printIOException) $
-    Process.withProcessWait process_config_with_handles \process → do
+    Process.withProcessWait process_config_with_handles \process -> do
       void $ monitorHandle (Proxy @(Either NOMError NixJSONMessage)) config (Process.getStderr process)
-      exitCode ← Process.waitExitCode process
-      output ← ByteString.hGetContents (Process.getStdout process)
+      exitCode <- Process.waitExitCode process
+      output <- ByteString.hGetContents (Process.getStdout process)
       unless (ByteString.null output) $ ByteString.hPut stdout output
       pure exitCode
 
 data UpdateResult a = MkUpdateResult
-  { errors ∷ [NOMError]
-  , output ∷ ByteString
-  , newStateToPrint ∷ Maybe NOMV1State
-  , newState ∷ UpdaterState a
+  { errors :: [NOMError]
+  , output :: ByteString
+  , newStateToPrint :: Maybe NOMV1State
+  , newState :: UpdaterState a
   }
   deriving stock (Generic)
 
 data ProcessState a = MkProcessState
-  { updaterState ∷ UpdaterState a
-  , printFunction ∷ Maybe (Window Int) → (ZonedTime, AbsTime) → Text
+  { updaterState :: UpdaterState a
+  , printFunction :: Maybe (Window Int) -> (ZonedTime, Double) -> Text
   }
   deriving stock (Generic)
 
 class NOMInput a where
   type UpdaterState a
-  firstState ∷ NOMV1State → UpdaterState a
-  updateState ∷ UpdateMonad m ⇒ a → UpdaterState a → m (UpdateResult a)
-  nomState ∷ Lens' (UpdaterState a) NOMV1State
-  inputStream ∷ Handle → Stream (Either NOMError ByteString)
-  withParser ∷ (StreamParser a → IO t) → IO t
+  firstState :: NOMV1State -> UpdaterState a
+  updateState :: (StrictType.Strict (UpdaterState a), UpdateMonad m) => a -> UpdaterState a -> m (UpdateResult a)
+  nomState :: Lens' (UpdaterState a) NOMV1State
+  inputStream :: Handle -> Stream (Either NOMError ByteString)
+  withParser :: (StreamParser a -> IO t) -> IO t
 
 instance NOMInput (Either NOMError NixJSONMessage) where
   withParser body = JSON.withHermesEnv (body . parseStreamSimple . parseJSON)
@@ -146,32 +147,38 @@ instance NOMInput (Either NOMError NixJSONMessage) where
         , newState = fromMaybe old_state new_state
         }
 
+data OldStyleState = MkOldStyleState
+  { state :: NOMV1State
+  , lastRead :: Strict.Maybe Double
+  }
+  deriving stock (Generic)
+
 instance NOMInput (Maybe NixOldStyleMessage, ByteString) where
   withParser body = body (parseStreamAttoparsec parser)
-  type UpdaterState (Maybe NixOldStyleMessage, ByteString) = (Maybe AbsTime, NOMV1State)
+  type UpdaterState (Maybe NixOldStyleMessage, ByteString) = OldStyleState
   inputStream = readTextChunks
-  nomState = _2
-  firstState = (Nothing,)
+  nomState = gfield @"state"
+  firstState state' = MkOldStyleState{state = state', lastRead = Strict.Nothing}
   {-# INLINE updateState #-}
-  updateState input old_state = mkUpdateResult <$> updateStateNixOldStyleMessage input old_state
+  updateState input old_state = mkUpdateResult <$> updateStateNixOldStyleMessage input (Strict.toLazy old_state.lastRead, old_state.state)
    where
     mkUpdateResult ((errors, output), (new_timestamp, new_state)) =
       MkUpdateResult
         { errors
         , output
         , newStateToPrint = new_state
-        , newState = (new_timestamp, fromMaybe (snd old_state) new_state)
+        , newState = MkOldStyleState (fromMaybe (old_state.state) new_state) (Strict.toStrict new_timestamp)
         }
 
-monitorHandle ∷ ∀ a. NOMInput a ⇒ Proxy a → Config → Handle → IO NOMV1State
-monitorHandle _ config input_handle = withParser @a \streamParser → do
-  finalState ←
+monitorHandle :: forall a. (StrictType.Strict (UpdaterState a), NOMInput a) => Proxy a -> Config -> Handle -> IO NOMV1State
+monitorHandle _ config input_handle = withParser @a \streamParser -> do
+  finalState <-
     do
       Terminal.hHideCursor outputHandle
       hSetBuffering stdout (BlockBuffering (Just 1_000_000))
 
-      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
+      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
       let first_process_state = MkProcessState (firstState @a first_state) (stateToText config first_state)
       interact config streamParser (processStateUpdater @a config) (gfield @"updaterState" % nomState @a %~ maintainState) (.printFunction) (finalizer config) (inputStream @a input_handle) outputHandle first_process_state
       `Exception.finally` do
@@ -180,15 +187,15 @@ monitorHandle _ config input_handle = withParser @a \streamParser → do
   pure (finalState.updaterState ^. nomState @a)
 
 {-# INLINE processStateUpdater #-}
-processStateUpdater ∷
-  ∀ a m.
-  (NOMInput a, UpdateMonad m) ⇒
-  Config →
-  a →
+processStateUpdater ::
+  forall a m.
+  (NOMInput a, UpdateMonad m, StrictType.Strict (UpdaterState a)) =>
+  Config ->
+  a ->
   StateT (ProcessState a) m ([NOMError], ByteString)
 processStateUpdater config input = do
-  old_state ← get
-  updater_result ← updateState input (old_state.updaterState)
+  old_state <- get
+  updater_result <- updateState input (old_state.updaterState)
   put
     MkProcessState
       { updaterState = updater_result.newState
@@ -196,21 +203,21 @@ processStateUpdater config input = do
       }
   pure (updater_result.errors, updater_result.output)
 
-finalizer ∷
-  ∀ a m.
-  (NOMInput a, UpdateMonad m) ⇒
-  Config →
+finalizer ::
+  forall a m.
+  (NOMInput a, UpdateMonad m) =>
+  Config ->
   StateT (ProcessState a) m ()
 finalizer config = do
-  old_state ← get
-  newState ← (gfield @"progressState" .~ Finished) <$> execStateT (runWriterT detectLocalFinishedBuilds) (old_state.updaterState ^. nomState @a)
+  old_state <- get
+  newState <- (gfield @"progressState" .~ Finished) <$> execStateT (runWriterT detectLocalFinishedBuilds) (old_state.updaterState ^. nomState @a)
   put
     MkProcessState
       { updaterState = nomState @a .~ newState $ old_state.updaterState
       , printFunction = stateToText config newState
       }
 
-helpText ∷ Text
+helpText :: Text
 helpText =
   unlines
     [ "nix-output-monitor usages:"

fourmolu.yaml

@@ -1,3 +1,3 @@
 indentation: 2
-unicode: always
+unicode: never
 respectful: false

lib/Data/Sequence/Strict.hs

@@ -0,0 +1,17 @@
+module Data.Sequence.Strict (
+  Seq.sortOn,
+  Seq.filter,
+  (<|),
+  Data.Sequence.Strict.fromList,
+  Seq.null,
+  Seq ((Seq.:<|)),
+) where
+
+import Data.Sequence qualified as Seq
+import Relude
+
+(<|) :: a -> Seq a -> Seq a
+!item <| rest = item Seq.<| rest
+
+fromList :: [a] -> Seq.Seq a
+fromList = foldr (<|) mempty

lib/NOM/Builds.hs

@@ -1,11 +1,10 @@
 module NOM.Builds (parseHost, Derivation (..), StorePath (..), Host (..), FailType (..), parseStorePath, parseDerivation, storePathByteStringParser, derivationByteStringParser, parseIndentedStoreObject) where
 
-import Relude
-
 import Data.Attoparsec.ByteString qualified as Parser
 import Data.Attoparsec.ByteString.Char8 qualified as Parser.Char
 import Data.Attoparsec.Text qualified as TextParser
 import Data.Text qualified as Text
+import Relude
 
 data StorePath = StorePath
   { hash :: Text
@@ -85,7 +84,7 @@ instance ToText StorePath where
 instance ToString StorePath where
   toString = toString . toText
 
-data Host = Localhost | Host !Text
+data Host = Localhost | Host Text
   deriving stock (Ord, Eq, Show, Generic)
 
 instance ToText Host where

lib/NOM/Error.hs

@@ -1,8 +1,7 @@
 module NOM.Error (NOMError (..)) where
 
-import Relude
-
 import Control.Exception (IOException)
+import Relude
 
 data NOMError
   = InputError IOException

lib/NOM/IO.hs

@@ -15,7 +15,6 @@ import NOM.Print.Table as Table (bold, displayWidth, displayWidthBS, markup, red
 import NOM.Update.Monad (UpdateMonad, getNow)
 import Relude
 import Streamly.Data.Fold qualified as Fold
-import Streamly.Internal.Data.Time.Units (AbsTime)
 import Streamly.Prelude ((.:), (|&), (|&.))
 import Streamly.Prelude qualified as Stream
 import System.Console.ANSI (SGR (Reset), setSGRCode)
@@ -25,68 +24,68 @@ import System.IO qualified
 
 type Stream = Stream.SerialT IO
 
-type StreamParser update = Stream ByteString → Stream update
+type StreamParser update = Stream ByteString -> Stream update
 
 type Output = Text
 
-type UpdateFunc update state = ∀ m. UpdateMonad m ⇒ update → StateT state m ([NOMError], ByteString)
+type UpdateFunc update state = forall m. UpdateMonad m => update -> StateT state m ([NOMError], ByteString)
 
-type OutputFunc state = state → Maybe Window → (ZonedTime, AbsTime) → Output
+type OutputFunc state = state -> Maybe Window -> (ZonedTime, Double) -> Output
 
-type Finalizer state = ∀ m. UpdateMonad m ⇒ StateT state m ()
+type Finalizer state = forall m. UpdateMonad m => StateT state m ()
 
 type Window = Terminal.Size.Window Int
 
-readTextChunks ∷ Handle → Stream (Either NOMError ByteString)
+readTextChunks :: Handle -> Stream (Either NOMError ByteString)
 readTextChunks handle = loop
  where
   -- We read up-to 4kb of input at once. We will rarely need more than that for one successful parse (i.e. a line).
   -- I don‘t know much about computers, but 4k seems like something which would be cached efficiently.
-  bufferSize ∷ Int
+  bufferSize :: Int
   bufferSize = 4096
-  tryRead ∷ Stream (Either IOException ByteString)
+  tryRead :: Stream (Either IOException ByteString)
   tryRead = liftIO $ try $ ByteString.hGetSome handle bufferSize
-  loop ∷ Stream (Either NOMError ByteString)
+  loop :: Stream (Either NOMError ByteString)
   loop =
     tryRead >>= \case
-      Left err → Left (InputError err) .: loop -- Forward Exceptions, when we encounter them
-      Right "" → mempty -- EOF
-      Right input → Right input .: loop
+      Left err -> Left (InputError err) .: loop -- Forward Exceptions, when we encounter them
+      Right "" -> mempty -- EOF
+      Right input -> Right input .: loop
 
-runUpdate ∷
-  ∀ update state.
-  TVar ByteString →
-  TVar state →
-  UpdateFunc update state →
-  update →
+runUpdate ::
+  forall update state.
+  TVar ByteString ->
+  TVar state ->
+  UpdateFunc update state ->
+  update ->
   IO ByteString
 runUpdate bufferVar stateVar updater input = do
-  oldState ← readTVarIO stateVar
-  ((!errors, !output), !newState) ← runStateT (updater input) oldState
+  oldState <- readTVarIO stateVar
+  ((!errors, !output), !newState) <- runStateT (updater input) oldState
   atomically $ do
-    forM_ errors (\error' → modifyTVar bufferVar (appendError error'))
+    forM_ errors (\error' -> modifyTVar bufferVar (appendError error'))
     writeTVar stateVar newState
   pure output
 
-writeStateToScreen ∷ ∀ state. Bool → TVar Int → TVar state → TVar ByteString → (state → state) → OutputFunc state → Handle → IO ()
+writeStateToScreen :: forall state. Bool -> TVar Int -> TVar state -> TVar ByteString -> (state -> state) -> OutputFunc state -> Handle -> IO ()
 writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var maintenance printer output_handle = do
-  nowClock ← getZonedTime
-  now ← getNow
-  terminalSize ←
+  nowClock <- getZonedTime
+  now <- getNow
+  terminalSize <-
     Terminal.Size.hSize output_handle <&> \case
       -- We throw away non positive window sizes, which some terminals apparently report
       -- to avoid divisions by zero later on.
-      val@(Just window) | window.width > 0, window.height > 0 → val
-      _ → Nothing
+      val@(Just window) | window.width > 0, window.height > 0 -> val
+      _ -> Nothing
 
-  (nom_state, nix_output_raw) ← atomically do
+  (nom_state, nix_output_raw) <- atomically do
     -- ==== Time Critical Segment - calculating to much in atomically can lead
     -- to recalculations.  In this section we are racing with the input parsing
     -- thread to update the state.
     modifyTVar nom_state_var maintenance
     -- we bind those lazily to not calculate them during STM
-    ~nom_state ← readTVar nom_state_var
-    ~nix_output_raw ← swapTVar nix_output_buffer_var mempty
+    ~nom_state <- readTVar nom_state_var
+    ~nix_output_raw <- swapTVar nix_output_buffer_var mempty
     pure (nom_state, nix_output_raw)
   -- ====
 
@@ -105,18 +104,18 @@ writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var mai
       -- might be slightly to high in corner cases but that will only trigger
       -- sligthly more redraws which is totally acceptable.
       reflow_line_count_correction =
-        terminalSize <&> \size →
+        terminalSize <&> \size ->
           -- This division is fine, because we don‘t accept non positiv window sizes.
-          getSum $ foldMap (\line → Sum (displayWidthBS line `div` size.width)) nix_output
+          getSum $ foldMap (\line -> Sum (displayWidthBS line `div` size.width)) nix_output
 
-  (last_printed_line_count, lines_to_pad) ← atomically do
-    last_printed_line_count ← readTVar printed_lines_var
+  (last_printed_line_count, lines_to_pad) <- atomically do
+    last_printed_line_count <- readTVar printed_lines_var
     -- When the nom output suddenly gets smaller, it might jump up from the bottom of the screen.
     -- To prevent this we insert a few newlines before it.
     -- We only do this if we know the size of the terminal.
     let lines_to_pad = case reflow_line_count_correction of
-          Just reflow_correction | pad → max 0 (last_printed_line_count - reflow_correction - nix_output_length - nom_output_length)
-          _ → 0
+          Just reflow_correction | pad -> max 0 (last_printed_line_count - reflow_correction - nix_output_length - nom_output_length)
+          _ -> 0
         line_count_to_print = nom_output_length + lines_to_pad
     writeTVar printed_lines_var line_count_to_print
     pure (last_printed_line_count, lines_to_pad)
@@ -145,11 +144,11 @@ writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var mai
               )
             <>
             -- Insert the output to write to the screen.
-            ( output_to_print_with_newline_annotations & foldMap \(newline, line) →
+            ( output_to_print_with_newline_annotations & foldMap \(newline, line) ->
                 ( case newline of
-                    StayInLine → mempty
-                    MoveToNextLine → Builder.stringUtf8 (Terminal.cursorDownLineCode 1)
-                    PrintNewLine → Builder.byteString "\n"
+                    StayInLine -> mempty
+                    MoveToNextLine -> Builder.stringUtf8 (Terminal.cursorDownLineCode 1)
+                    PrintNewLine -> Builder.byteString "\n"
                 )
                   <> Builder.byteString line
             )
@@ -166,81 +165,81 @@ data ToNextLine = StayInLine | MoveToNextLine | PrintNewLine
 
 -- Depending on the current line of the output we are printing we need to decide
 -- how to move to a new line before printing.
-howToGoToNextLine ∷ Int → Maybe Int → Int → ToNextLine
+howToGoToNextLine :: Int -> Maybe Int -> Int -> ToNextLine
 howToGoToNextLine _ Nothing = \case
   -- When we have no info about terminal size, better be careful and always print
   -- newlines if necessary.
-  0 → StayInLine
-  _ → PrintNewLine
+  0 -> StayInLine
+  _ -> PrintNewLine
 howToGoToNextLine previousPrintedLines (Just correction) = \case
   -- When starting to print we are always in an empty line with the cursor at the start.
   -- So we don‘t need to go to a new line
-  0 → StayInLine
+  0 -> StayInLine
   -- When the current offset is smaller than the number of previously printed lines.
   -- e.g. we have printed 1 line, but before we had printed 2
   -- then we can probably move the cursor a row down without needing to print a newline.
   x
-    | x + correction < previousPrintedLines →
+    | x + correction < previousPrintedLines ->
         MoveToNextLine
   -- When we are at the bottom of the terminal we have no choice but need to
   -- print a newline and thus (sadly) flush the terminal
-  _ → PrintNewLine
+  _ -> PrintNewLine
 
-interact ∷
-  ∀ update state.
-  Config →
-  StreamParser update →
-  UpdateFunc update state →
-  (state → state) →
-  OutputFunc state →
-  Finalizer state →
-  Stream (Either NOMError ByteString) →
-  Handle →
-  state →
+interact ::
+  forall update state.
+  Config ->
+  StreamParser update ->
+  UpdateFunc update state ->
+  (state -> state) ->
+  OutputFunc state ->
+  Finalizer state ->
+  Stream (Either NOMError ByteString) ->
+  Handle ->
+  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
 
 -- frame durations are passed to threadDelay and thus are given in microseconds
 
-maxFrameDuration ∷ Int
+maxFrameDuration :: Int
 maxFrameDuration = 1_000_000 -- once per second to update timestamps
 
-minFrameDuration ∷ Int
+minFrameDuration :: Int
 minFrameDuration =
   -- this seems to be a nice compromise to reduce excessive
   -- flickering, since the movement is not continuous this low frequency doesn‘t
   -- feel to sluggish for the eye, for me.
   100_000 -- 10 times per second
 
-processTextStream ∷
-  ∀ update state.
-  Config →
-  StreamParser update →
-  UpdateFunc update state →
-  (state → state) →
-  Maybe (OutputFunc state, Handle) →
-  Finalizer state →
-  state →
-  Stream (Either NOMError ByteString) →
+processTextStream ::
+  forall update state.
+  Config ->
+  StreamParser update ->
+  UpdateFunc update state ->
+  (state -> state) ->
+  Maybe (OutputFunc state, Handle) ->
+  Finalizer state ->
+  state ->
+  Stream (Either NOMError ByteString) ->
   IO state
 processTextStream config parser updater maintenance printerMay finalize initialState inputStream = do
-  stateVar ← newTVarIO initialState
-  bufferVar ← newTVarIO mempty
-  let keepProcessing ∷ IO ()
+  stateVar <- newTVarIO initialState
+  bufferVar <- newTVarIO mempty
+  let keepProcessing :: IO ()
       keepProcessing =
         inputStream
           |& Stream.tap (writeErrorsToBuffer bufferVar)
           |& Stream.mapMaybe rightToMaybe
           |& parser
           |&. Stream.mapM_ (runUpdate bufferVar stateVar updater >=> atomically . modifyTVar bufferVar . flip (<>))
-      waitForInput ∷ IO ()
+      waitForInput :: IO ()
       waitForInput = atomically $ check . not . ByteString.null =<< readTVar bufferVar
-  printerMay & maybe keepProcessing \(printer, output_handle) → do
-    linesVar ← newTVarIO 0
-    let writeToScreen ∷ IO ()
+  printerMay & maybe keepProcessing \(printer, output_handle) -> do
+    linesVar <- newTVarIO 0
+    let writeToScreen :: IO ()
         writeToScreen = writeStateToScreen (not config.silent) linesVar stateVar bufferVar maintenance printer output_handle
-        keepPrinting ∷ IO ()
+        keepPrinting :: IO ()
         keepPrinting = forever do
           race_ (concurrently_ (threadDelay minFrameDuration) waitForInput) (threadDelay maxFrameDuration)
           writeToScreen
@@ -249,36 +248,36 @@ processTextStream config parser updater maintenance printerMay finalize initialS
     writeToScreen
   (if isNothing printerMay then (>>= execStateT finalize) else id) $ readTVarIO stateVar
 
-writeErrorsToBuffer ∷ TVar ByteString → Fold.Fold IO (Either NOMError ByteString) ()
+writeErrorsToBuffer :: TVar ByteString -> Fold.Fold IO (Either NOMError ByteString) ()
 writeErrorsToBuffer bufferVar = Fold.drainBy saveInput
  where
-  saveInput ∷ Either NOMError ByteString → IO ()
+  saveInput :: Either NOMError ByteString -> IO ()
   saveInput = \case
-    Left error' → atomically $ modifyTVar bufferVar (appendError error')
-    _ → pass
+    Left error' -> atomically $ modifyTVar bufferVar (appendError error')
+    _ -> pass
 
-appendError ∷ NOMError → ByteString → ByteString
+appendError :: NOMError -> ByteString -> ByteString
 appendError err prev = (if ByteString.null prev || ByteString.isSuffixOf "\n" prev then "" else "\n") <> nomError <> show err <> "\n"
 
-nomError ∷ ByteString
+nomError :: ByteString
 nomError = encodeUtf8 (markup (red . bold) "nix-output-monitor error: ")
 
-truncateOutput ∷ Maybe Window → Text → Text
+truncateOutput :: Maybe Window -> Text -> Text
 truncateOutput win output = maybe output go win
  where
-  go ∷ Window → Text
+  go :: Window -> Text
   go window = Text.intercalate "\n" $ truncateColumns window.width <$> truncateRows window.height
 
-  truncateColumns ∷ Int → Text → Text
+  truncateColumns :: Int -> Text -> Text
   truncateColumns columns line = if displayWidth line > columns then Table.truncate (columns - 1) line <> "…" <> toText (setSGRCode [Reset]) else line
 
-  truncateRows ∷ Int → [Text]
+  truncateRows :: Int -> [Text]
   truncateRows rows
     | length outputLines >= rows - outputLinesToAlwaysShow = take 1 outputLines <> [" ⋮ "] <> drop (length outputLines + outputLinesToAlwaysShow + 2 - rows) outputLines
     | otherwise = outputLines
 
-  outputLines ∷ [Text]
+  outputLines :: [Text]
   outputLines = Text.lines output
 
-outputLinesToAlwaysShow ∷ Int
+outputLinesToAlwaysShow :: Int
 outputLinesToAlwaysShow = 5

lib/NOM/IO/ParseStream/Attoparsec.hs

@@ -1,10 +1,9 @@
 module NOM.IO.ParseStream.Attoparsec (parseStreamAttoparsec, parseOneText, stripANSICodes) where
 
-import Relude
-
 import Data.Attoparsec.ByteString (IResult (..), Parser, Result, parse)
 import Data.ByteString qualified as ByteString
 import Data.Word8 qualified as Word8
+import Relude
 import Streamly.Prelude ((.:))
 import Streamly.Prelude qualified as Stream
 
@@ -22,8 +21,10 @@ parseChunk initState (strippedInput, rawInput) = join $ state \(currentParser, c
 
 csi :: ByteString
 csi = "\27["
+
 breakOnANSIStartCode :: ByteString -> (ByteString, ByteString)
 breakOnANSIStartCode = ByteString.breakSubstring csi
+
 streamANSIChunks :: ByteString -> Stream.SerialT m (ByteString, ByteString)
 streamANSIChunks input =
   let (!filtered, !unfiltered) = breakOnANSIStartCode input

lib/NOM/IO/ParseStream/Simple.hs

@@ -1,8 +1,7 @@
 module NOM.IO.ParseStream.Simple (parseStreamSimple) where
 
-import Relude
-
 import Data.ByteString qualified as ByteString
+import Relude
 import Streamly.Prelude ((.:), (|$))
 import Streamly.Prelude qualified as Stream
 

lib/NOM/NixMessage/JSON.hs

@@ -5,6 +5,7 @@ import Relude
 
 newtype ActivityId = MkId {value :: Int}
   deriving newtype (Show, Eq, Ord)
+  deriving stock (Generic)
 
 newtype StopAction = MkStopAction {id :: ActivityId}
   deriving newtype (Eq)

lib/NOM/NixMessage/OldStyle.hs

@@ -1,16 +1,15 @@
 module NOM.NixMessage.OldStyle (NixOldStyleMessage (..)) where
 
+import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..))
 import Relude
 
-import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..))
-
 data NixOldStyleMessage
-  = Uploading !StorePath !Host
-  | Downloading !StorePath !Host
-  | PlanCopies !Int
-  | Build Derivation !Host
-  | PlanBuilds (Set Derivation) !Derivation
-  | PlanDownloads !Double !Double (Set StorePath)
-  | Checking !Derivation
-  | Failed !Derivation !FailType
+  = Uploading StorePath Host
+  | Downloading StorePath Host
+  | PlanCopies Int
+  | Build Derivation Host
+  | PlanBuilds (Set Derivation) Derivation
+  | PlanDownloads Double Double (Set StorePath)
+  | Checking Derivation
+  | Failed Derivation FailType
   deriving stock (Show, Eq)

lib/NOM/Parser.hs

@@ -1,7 +1,5 @@
 module NOM.Parser (parser, oldStyleParser, planBuildLine, planDownloadLine, inTicks) where
 
-import Relude hiding (take, takeWhile)
-
 import Data.Attoparsec.ByteString (
   Parser,
   choice,
@@ -18,7 +16,6 @@ import Data.Attoparsec.ByteString.Char8 (
   isEndOfLine,
   takeTill,
  )
-
 import NOM.Builds (
   Derivation (..),
   FailType (ExitCode, HashMismatch),
@@ -28,6 +25,7 @@ import NOM.Builds (
   storePathByteStringParser,
  )
 import NOM.NixMessage.OldStyle (NixOldStyleMessage (..))
+import Relude hiding (take, takeWhile)
 
 parser :: Parser (Maybe NixOldStyleMessage)
 parser = Just <$> oldStyleParser <|> Nothing <$ noMatch

lib/NOM/Parser/JSON/Hermes.hs

@@ -1,16 +1,14 @@
 module NOM.Parser.JSON.Hermes (parseJSON) where
 
-import Relude hiding (one)
-
 import Control.Exception (try)
+import Data.ByteString qualified as ByteString
 import Data.Hermes qualified as JSON
 import Data.Hermes.Decoder (listOfInt)
-import System.IO.Unsafe qualified as Unsafe
-
-import Data.ByteString qualified as ByteString
 import NOM.Builds (parseDerivation, parseHost, parseStorePath)
 import NOM.Error (NOMError (..))
 import NOM.NixMessage.JSON (Activity (..), ActivityId (..), ActivityProgress (..), ActivityResult (..), ActivityType (..), MessageAction (..), NixJSONMessage (..), ResultAction (..), StartAction (..), StopAction (..), Verbosity (..))
+import Relude hiding (one)
+import System.IO.Unsafe qualified as Unsafe
 
 parseJSON :: JSON.HermesEnv -> ByteString -> Either NOMError NixJSONMessage
 parseJSON env input = first translate_hermes_error_to_nom_error json_parse_result
@@ -74,8 +72,10 @@ parseMessageAction object = do
 
 textFields :: JSON.Object -> JSON.Decoder [Text]
 textFields = JSON.atKey "fields" (JSON.list JSON.text)
+
 textOrNumFields :: JSON.Object -> JSON.Decoder [Either Text Int]
 textOrNumFields = JSON.atKey "fields" (JSON.list \val -> (Left <$> JSON.text val) <|> (Right <$> JSON.int val))
+
 intFields :: JSON.Object -> JSON.Decoder [Int]
 intFields = JSON.atKey "fields" listOfInt
 

lib/NOM/Print.hs

@@ -1,15 +1,14 @@
 module NOM.Print (stateToText, showCode, Config (..)) where
 
--- terminal-size
-
 import Data.Foldable qualified as Unsafe
 import Data.IntMap qualified as IntMap
 import Data.List qualified as List
 import Data.List.NonEmpty.Extra (appendr)
 import Data.Map.Strict qualified as Map
 import Data.MemoTrie (memo)
-import Data.Sequence qualified as Seq
+import Data.Sequence.Strict qualified as Seq
 import Data.Set qualified as Set
+import Data.Strict qualified as Strict
 import Data.Text qualified as Text
 import Data.Time (NominalDiffTime, ZonedTime, defaultTimeLocale, formatTime)
 import Data.Tree (Forest, Tree (Node))
@@ -18,25 +17,23 @@ import NOM.Builds (Derivation (..), FailType (..), Host (..), StorePath (..))
 import NOM.NixMessage.JSON (ActivityId (..))
 import NOM.Print.Table (Entry, blue, bold, cells, dummy, green, grey, header, label, magenta, markup, markups, prependLines, printAlignedSep, red, text, yellow)
 import NOM.Print.Tree (showForest)
-import NOM.State (BuildInfo (..), BuildStatus (..), DependencySummary (..), DerivationId, DerivationInfo (..), DerivationSet, NOMState, NOMV1State (..), ProgressState (..), StorePathId, StorePathInfo (..), StorePathMap, StorePathSet, TransferInfo (..), getDerivationInfos, getStorePathInfos, inputStorePaths)
+import NOM.State (ActivityStatus (..), BuildFail (..), BuildInfo (..), BuildStatus (..), DependencySummary (..), DerivationId, DerivationInfo (..), DerivationSet, InputDerivation (..), NOMState, NOMV1State (..), ProgressState (..), StorePathId, StorePathInfo (..), StorePathMap, StorePathSet, TransferInfo (..), getDerivationInfos, getStorePathInfos, inputStorePaths)
 import NOM.State.CacheId.Map qualified as CMap
 import NOM.State.CacheId.Set qualified as CSet
 import NOM.State.Sorting (SortKey, sortKey, summaryIncludingRoot)
 import NOM.State.Tree (mapRootsTwigsAndLeafs)
 import NOM.Update (appendDifferingPlatform)
-import NOM.Util (diffTime, relTimeToSeconds)
 import Optics (itoList, view, _2)
 import Relude
-import Streamly.Internal.Data.Time.Units (AbsTime, diffAbsTime)
 import System.Console.ANSI (SGR (Reset), setSGRCode)
 import System.Console.Terminal.Size (Window)
 import System.Console.Terminal.Size qualified as Window
 import Text.Printf (printf)
 
-showCode ∷ Text → [String]
+showCode :: Text -> [String]
 showCode = map (printf "%02X" . fromEnum) . toString
 
-textRep, vertical, lowerleft, upperleft, horizontal, down, up, clock, running, done, bigsum, warning, todo, leftT, average ∷ Text
+textRep, vertical, lowerleft, upperleft, horizontal, down, up, clock, running, done, bigsum, warning, todo, leftT, average :: Text
 textRep = fromString [toEnum 0xFE0E]
 vertical = "┃"
 lowerleft = "┗"
@@ -71,34 +68,34 @@ average = "∅" <> textRep
 -- ["2211","FE0E"]
 bigsum = "∑" <> textRep
 
-showCond ∷ Monoid m ⇒ Bool → m → m
+showCond :: Monoid m => Bool -> m -> m
 showCond = memptyIfFalse
 
-targetRatio, defaultTreeMax ∷ Int
+targetRatio, defaultTreeMax :: Int
 targetRatio = 3 -- We divide by this, don‘t set this to zero.
 defaultTreeMax = 20
 
 data Config = MkConfig
-  { silent ∷ Bool
-  , piping ∷ Bool
+  { silent :: Bool
+  , piping :: Bool
   }
 
-stateToText ∷ Config → NOMV1State → Maybe (Window Int) → (ZonedTime, AbsTime) → Text
+stateToText :: Config -> NOMV1State -> Maybe (Window Int) -> (ZonedTime, Double) -> Text
 stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Window.height
  where
-  printWithSize ∷ Maybe Int → (ZonedTime, AbsTime) → Text
+  printWithSize :: Maybe Int -> (ZonedTime, Double) -> Text
   printWithSize maybeWindow = printWithTime
    where
-    printWithTime ∷ (ZonedTime, AbsTime) → Text
+    printWithTime :: (ZonedTime, Double) -> Text
     printWithTime
-      | progressState == JustStarted && config.piping = \nows@(_, now) → time nows <> showCond (diffTime now startTime > 15) (markup grey " nom hasn‘t detected any input. Have you redirected nix-build stderr into nom? (See -h and the README for details.)")
+      | progressState == JustStarted && config.piping = \nows@(_, now) -> time nows <> showCond (now - startTime > 15) (markup grey " nom hasn‘t detected any input. Have you redirected nix-build stderr into nom? (See -h and the README for details.)")
       | progressState == Finished && config.silent = const ""
-      | showBuildGraph = \nows@(_, now) → buildsDisplay now <> table (time nows)
+      | showBuildGraph = \nows@(_, now) -> buildsDisplay now <> table (time nows)
       | not anythingGoingOn = if config.silent then const "" else time
       | otherwise = table . time
     maxHeight = case maybeWindow of
-      Just limit → limit `div` targetRatio -- targetRatio is hardcoded to be bigger than zero.
-      Nothing → defaultTreeMax
+      Just limit -> limit `div` targetRatio -- targetRatio is hardcoded to be bigger than zero.
+      Nothing -> defaultTreeMax
     buildsDisplay now =
       prependLines
         (toText (setSGRCode [Reset]) <> upperleft <> horizontal)
@@ -108,8 +105,8 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
         <> "\n"
   runTime now = timeDiff now startTime
   time
-    | progressState == Finished = \(nowClock, now) → finishMarkup (" at " <> toText (formatTime defaultTimeLocale "%H:%M:%S" nowClock) <> " after " <> runTime now)
-    | otherwise = \(_, now) → clock <> " " <> runTime now
+    | progressState == Finished = \(nowClock, now) -> finishMarkup (" at " <> toText (formatTime defaultTimeLocale "%H:%M:%S" nowClock) <> " after " <> runTime now)
+    | otherwise = \(_, now) -> clock <> " " <> runTime now
   MkDependencySummary{..} = fullSummary
   runningBuilds' = (.host) <$> runningBuilds
   completedBuilds' = (.host) <$> completedBuilds
@@ -119,18 +116,18 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
   showBuildGraph = not (Seq.null forestRoots)
   table time' =
     prependLines
-      ((if showBuildGraph then leftT else upperleft) <> stimes (3 ∷ Int) horizontal <> " ")
+      ((if showBuildGraph then leftT else upperleft) <> stimes (3 :: Int) horizontal <> " ")
       (vertical <> "    ")
       (lowerleft <> horizontal <> " " <> bigsum <> " ")
       $ printAlignedSep (innerTable `appendr` one (lastRow time'))
-  innerTable ∷ [NonEmpty Entry]
+  innerTable :: [NonEmpty Entry]
   innerTable = fromMaybe (one (text "")) (nonEmpty headers) : showCond showHosts printHosts
   headers =
     (cells 3 <$> optHeader showBuilds "Builds")
       <> (cells 3 <$> optHeader showDownloads "Downloads")
       <> (cells 2 <$> optHeader showUploads "Uploads")
       <> optHeader showHosts "Host"
-  optHeader cond = showCond cond . one . bold . header ∷ Text → [Entry]
+  optHeader cond = showCond cond . one . bold . header :: Text -> [Entry]
   partial_last_row =
     showCond
       showBuilds
@@ -172,11 +169,11 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
     | numFailedBuilds > 0 = markup red . ((warning <> " Exited after " <> show numFailedBuilds <> " build failures") <>)
     | not (null nixErrors) = markup red . ((warning <> " Exited with " <> show (length nixErrors) <> " errors reported by nix") <>)
     | otherwise = markup green . ("Finished" <>)
-  printHosts ∷ [NonEmpty Entry]
+  printHosts :: [NonEmpty Entry]
   printHosts =
     mapMaybe (nonEmpty . labelForHost) hostNums
    where
-    labelForHost ∷ (Host, Int) → [Entry]
+    labelForHost :: (Host, Int) -> [Entry]
     labelForHost (host, index) =
       showCond
         showBuilds
@@ -203,28 +200,28 @@ stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Windo
       downloadsRunning' = action_count_for_host host runningDownloads
       numRunningBuildsOnHost = action_count_for_host host runningBuilds
       doneBuilds = action_count_for_host host completedBuilds
-    action_count_for_host ∷ HasField "host" a Host ⇒ Host → CMap.CacheIdMap b a → Int
-    action_count_for_host host = CMap.size . CMap.filter (\x → host == x.host)
+    action_count_for_host :: HasField "host" a Host => Host -> CMap.CacheIdMap b a -> Int
+    action_count_for_host host = CMap.size . CMap.filter (\x -> host == x.host)
 
-nonZeroShowBold ∷ Text → Int → Entry
+nonZeroShowBold :: Text -> Int -> Entry
 nonZeroShowBold label' num = if num > 0 then label label' $ text (markup bold (show num)) else dummy
 
-nonZeroBold ∷ Text → Int → Entry
+nonZeroBold :: Text -> Int -> Entry
 nonZeroBold label' num = label label' $ text (markup (if num > 0 then bold else id) (show num))
 
 data TreeLocation = Root | Twig | Leaf deriving stock (Eq)
 
-printBuilds ∷
-  NOMV1State →
-  [(Host, Int)] →
-  Int →
-  AbsTime →
+printBuilds ::
+  NOMV1State ->
+  [(Host, Int)] ->
+  Int ->
+  Double ->
   NonEmpty Text
 printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
  where
-  hostLabel ∷ Bool → Host → Text
+  hostLabel :: Bool -> Host -> Text
   hostLabel color host = (if color then markup magenta else id) $ maybe (toText host) (("[" <>) . (<> "]") . show) (List.lookup host hostNums)
-  printBuildsWithTime ∷ AbsTime → NonEmpty Text
+  printBuildsWithTime :: Double -> NonEmpty Text
   printBuildsWithTime now = (graphHeader :|) $ showForest $ fmap (fmap ($ now)) preparedPrintForest
   num_raw_roots = length forestRoots
   num_roots = length preparedPrintForest
@@ -234,48 +231,48 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
     | num_raw_roots <= 1 = graphTitle
     | num_raw_roots == num_roots = unwords [graphTitle, "with", show num_roots, "roots"]
     | otherwise = unwords [graphTitle, "showing", show num_roots, "of", show num_raw_roots, "roots"]
-  preparedPrintForest ∷ Forest (AbsTime → Text)
+  preparedPrintForest :: Forest (Double -> Text)
   preparedPrintForest = mapRootsTwigsAndLeafs (printTreeNode Root) (printTreeNode Twig) (printTreeNode Leaf) <$> buildForest
-  printTreeNode ∷ TreeLocation → DerivationInfo → AbsTime → Text
+  printTreeNode :: TreeLocation -> DerivationInfo -> Double -> Text
   printTreeNode location drvInfo =
     let ~summary = showSummary drvInfo.dependencySummary
         (planned, display_drv) = printDerivation drvInfo (get' (inputStorePaths drvInfo))
         displayed_summary = showCond (location == Leaf && planned && not (Text.null summary)) (markup grey " waiting for " <> summary)
-     in \now → display_drv now <> displayed_summary
+     in \now -> display_drv now <> displayed_summary
 
-  buildForest ∷ Forest DerivationInfo
+  buildForest :: Forest DerivationInfo
   buildForest = evalState (goBuildForest forestRoots) mempty
 
-  goBuildForest ∷ Seq DerivationId → State DerivationSet (Forest DerivationInfo)
+  goBuildForest :: Seq DerivationId -> State DerivationSet (Forest DerivationInfo)
   goBuildForest = \case
-    (thisDrv Seq.:<| restDrvs) → do
-      seen_ids ← get
+    (thisDrv Seq.:<| restDrvs) -> do
+      seen_ids <- get
       let mkNode
             | not (CSet.member thisDrv seen_ids) && CSet.member thisDrv derivationsToShow = do
                 let drvInfo = get' (getDerivationInfos thisDrv)
                     childs = children thisDrv
                 modify (CSet.insert thisDrv)
-                subforest ← goBuildForest childs
+                subforest <- goBuildForest childs
                 pure (Node drvInfo subforest :)
             | otherwise = pure id
-      prepend_node ← mkNode
+      prepend_node <- mkNode
       prepend_node <$> goBuildForest restDrvs
-    _ → pure []
-  derivationsToShow ∷ DerivationSet
+    _ -> pure []
+  derivationsToShow :: DerivationSet
   derivationsToShow =
     let should_be_shown (index, (can_be_hidden, _, _)) = not can_be_hidden || index < maxHeight
         (_, sorted_set) = execState (goDerivationsToShow forestRoots) mempty
      in CSet.fromFoldable $
-          fmap (\(_, (_, _, drvId)) → drvId) $
+          fmap (\(_, (_, _, drvId)) -> drvId) $
             takeWhile should_be_shown $
               itoList $
                 Set.toAscList sorted_set
 
-  children ∷ DerivationId → Seq DerivationId
-  children drv_id = fmap fst $ (.inputDerivations) $ get' $ getDerivationInfos drv_id
+  children :: DerivationId -> Seq DerivationId
+  children drv_id = fmap (.derivation) $ (.inputDerivations) $ get' $ getDerivationInfos drv_id
 
-  goDerivationsToShow ∷
-    Seq DerivationId →
+  goDerivationsToShow ::
+    Seq DerivationId ->
     State
       ( DerivationSet -- seenIds
       , Set
@@ -286,12 +283,12 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
       )
       ()
   goDerivationsToShow = \case
-    (thisDrv Seq.:<| restDrvs) → do
-      (seen_ids, sorted_set) ← get
+    (thisDrv Seq.:<| restDrvs) -> do
+      (seen_ids, sorted_set) <- get
       let ~sort_key = sortKey nomState thisDrv
           summary@MkDependencySummary{..} = get' (summaryIncludingRoot thisDrv)
           ~runningTransfers = CMap.keysSet runningDownloads <> CMap.keysSet runningUploads
-          ~nodesOfRunningTransfers = flip foldMap (CSet.toList runningTransfers) \path →
+          ~nodesOfRunningTransfers = flip foldMap (CSet.toList runningTransfers) \path ->
             let infos = get' (getStorePathInfos path)
              in infos.inputFor <> CSet.fromFoldable infos.producer
           ~may_hide = CSet.isSubsetOf (nodesOfRunningTransfers <> CMap.keysSet failedBuilds <> CMap.keysSet runningBuilds) seen_ids
@@ -307,12 +304,12 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
           ~new_sorted_set = Set.insert (may_hide, sort_key, thisDrv) sorted_set
       when show_this_node $ put (new_seen_ids, new_sorted_set) >> goDerivationsToShow (children thisDrv)
       goDerivationsToShow restDrvs
-    _ → pass
+    _ -> pass
 
-  get' ∷ NOMState b → b
+  get' :: NOMState b -> b
   get' procedure = evalState procedure nomState
 
-  showSummary ∷ DependencySummary → Text
+  showSummary :: DependencySummary -> Text
   showSummary MkDependencySummary{..} =
     unwords $
       join
@@ -336,37 +333,37 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
             [markup blue $ show (CSet.size plannedDownloads) <> " " <> down <> " " <> todo]
         ]
 
-  hostMarkup ∷ Bool → Host → [Text]
+  hostMarkup :: Bool -> Host -> [Text]
   hostMarkup _ Localhost = mempty
   hostMarkup color host = ["on", hostLabel color host]
 
-  print_hosts ∷ Bool → Text → [Host] → [Text]
+  print_hosts :: Bool -> Text -> [Host] -> [Text]
   print_hosts color direction_label hosts
     | null hosts || length hostNums <= 2 = []
     | otherwise = direction_label : (hostLabel color <$> hosts)
   print_hosts_down color = print_hosts color "from"
   print_hosts_up color = print_hosts color "to"
 
-  printDerivation ∷ DerivationInfo → Map Text StorePathId → (Bool, AbsTime → Text)
+  printDerivation :: DerivationInfo -> Map Text StorePathId -> (Bool, Double -> Text)
   printDerivation drvInfo _input_store_paths = do
-    let store_paths_in ∷ StorePathSet → Bool
+    let store_paths_in :: StorePathSet -> Bool
         store_paths_in some_set = not $ Map.null $ Map.filter (`CSet.member` some_set) drvInfo.outputs
-        store_paths_in_map ∷ StorePathMap (TransferInfo a) → [TransferInfo a]
+        store_paths_in_map :: StorePathMap (TransferInfo a) -> [TransferInfo a]
         store_paths_in_map info_map = toList $ Map.mapMaybe (`CMap.lookup` info_map) drvInfo.outputs
-        hosts ∷ [TransferInfo a] → [Host]
+        hosts :: [TransferInfo a] -> [Host]
         hosts = toList . Set.fromList . fmap (.host)
-        earliest_start ∷ [TransferInfo a] → AbsTime
+        earliest_start :: [TransferInfo a] -> Double
         earliest_start = Unsafe.minimum . fmap (.start)
-        build_sum ∷ [TransferInfo (Maybe AbsTime)] → NominalDiffTime
-        build_sum = relTimeToSeconds . sum . fmap (\transfer_info → maybe 0 (diffAbsTime transfer_info.start) transfer_info.end)
-        if_time_diff_relevant ∷ AbsTime → AbsTime → ([Text] → [Text]) → [Text]
-        if_time_diff_relevant to from = if_time_dur_relevant (relTimeToSeconds $ diffAbsTime to from)
-        if_time_dur_relevant ∷ NominalDiffTime → ([Text] → [Text]) → [Text]
+        build_sum :: [TransferInfo (Strict.Maybe Double)] -> NominalDiffTime
+        build_sum = sum . fmap (\transfer_info -> realToFrac $ Strict.maybe 0 (transfer_info.start -) transfer_info.end)
+        if_time_diff_relevant :: Double -> Double -> ([Text] -> [Text]) -> [Text]
+        if_time_diff_relevant to from = if_time_dur_relevant $ realToFrac (to - from)
+        if_time_dur_relevant :: NominalDiffTime -> ([Text] -> [Text]) -> [Text]
         if_time_dur_relevant dur mod' = memptyIfFalse (dur > 1) (mod' [clock, printDuration dur])
         phaseMay activityId' = do
-          activityId ← activityId'
-          (_, phase, _) ← IntMap.lookup activityId.value nomState.activities
-          phase
+          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
         downloadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningDownloads
         uploadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningUploads
@@ -384,18 +381,18 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
 
         case drvInfo.buildStatus of
           _
-            | not $ null downloadingOutputs →
+            | not $ null downloadingOutputs ->
                 ( False
-                , \now →
+                , \now ->
                     unwords $
                       markups [bold, yellow] (down <> " " <> running <> " " <> drvName)
                         : ( print_hosts_down True (hosts downloadingOutputs)
                               <> if_time_diff_relevant now (earliest_start downloadingOutputs) id
                           )
                 )
-            | not $ null uploadingOutputs →
+            | not $ null uploadingOutputs ->
                 ( False
-                , \now →
+                , \now ->
                     unwords $
                       markups [bold, yellow] (up <> " " <> running <> " " <> drvName)
                         : ( print_hosts_up True (hosts uploadingOutputs)
@@ -403,8 +400,8 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
                           )
                 )
           Unknown
-            | plannedDownloads → (True, const $ markup blue (down <> " " <> todo <> " " <> drvName))
-            | not $ null downloadedOutputs →
+            | plannedDownloads -> (True, const $ markup blue (down <> " " <> todo <> " " <> drvName))
+            | not $ null downloadedOutputs ->
                 ( False
                 , const $
                     unwords $
@@ -415,7 +412,7 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
                               <> if_time_dur_relevant (build_sum downloadedOutputs) id
                           )
                 )
-            | not $ null uploadedOutputs →
+            | not $ null uploadedOutputs ->
                 ( False
                 , const $
                     unwords $
@@ -426,30 +423,30 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
                               <> if_time_dur_relevant (build_sum uploadedOutputs) id
                           )
                 )
-            | otherwise → (False, const drvName)
-          Planned → (True, const $ markup blue (todo <> " " <> drvName))
-          Building buildInfo →
+            | otherwise -> (False, const drvName)
+          Planned -> (True, const $ markup blue (todo <> " " <> drvName))
+          Building buildInfo ->
             let phaseList = case phaseMay buildInfo.activityId of
-                  Nothing → []
-                  Just phase → [markup bold ("(" <> phase <> ")")]
+                  Nothing -> []
+                  Just phase -> [markup bold ("(" <> phase <> ")")]
                 before_time =
                   [markups [yellow, bold] (running <> " " <> drvName)]
                     <> hostMarkup True buildInfo.host
                     <> phaseList
-                after_time = maybe [] (\x → ["(" <> average <> " " <> timeDiffSeconds x <> ")"]) buildInfo.estimate
-             in (False, \now → unwords $ before_time <> if_time_diff_relevant now buildInfo.start (<> after_time))
-          Failed buildInfo →
-            let (endTime, failType) = buildInfo.end
+                after_time = Strict.maybe [] (\x -> ["(" <> average <> " " <> timeDiffSeconds x <> ")"]) buildInfo.estimate
+             in (False, \now -> unwords $ before_time <> if_time_diff_relevant now buildInfo.start (<> after_time))
+          Failed buildInfo ->
+            let MkBuildFail endTime failType = buildInfo.end
                 phaseInfo = case phaseMay buildInfo.activityId of
-                  Nothing → []
-                  Just phase → ["in", phase]
+                  Nothing -> []
+                  Just phase -> ["in", phase]
              in ( False
                 , const
                     . markups [red, bold]
                     . unwords
                     $ [warning, drvName] <> hostMarkup False buildInfo.host <> ["failed with", printFailType failType, "after", clock, timeDiff endTime buildInfo.start] <> phaseInfo
                 )
-          Built buildInfo →
+          Built buildInfo ->
             ( False
             , const $
                 markup green (done <> " " <> drvName)
@@ -461,16 +458,16 @@ printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime
                      )
             )
 
-printFailType ∷ FailType → Text
+printFailType :: FailType -> Text
 printFailType = \case
-  ExitCode i → "exit code " <> show i
-  HashMismatch → "hash mismatch"
+  ExitCode i -> "exit code " <> show i
+  HashMismatch -> "hash mismatch"
 
-timeDiff ∷ AbsTime → AbsTime → Text
+timeDiff :: Double -> Double -> Text
 timeDiff x =
-  printDuration . relTimeToSeconds . diffAbsTime x
+  printDuration . realToFrac . (x -)
 
-printDuration ∷ NominalDiffTime → Text
+printDuration :: NominalDiffTime -> Text
 printDuration diff
   | diff < 60 = p "%Ss"
   | diff < 60 * 60 = p "%Mm%Ss"
@@ -478,5 +475,5 @@ printDuration diff
  where
   p x = toText $ formatTime defaultTimeLocale x diff
 
-timeDiffSeconds ∷ Int → Text
+timeDiffSeconds :: Int -> Text
 timeDiffSeconds = printDuration . fromIntegral

lib/NOM/Print/Table.hs

@@ -21,15 +21,15 @@ module NOM.Print.Table (
   displayWidthBS,
 ) where
 
-import Relude hiding (truncate)
-
 import Control.Exception (assert)
-import Data.Text qualified as Text
-
 -- wcwidth
-import Data.Char.WCWidth (wcwidth)
 
 -- ansi-terminal
+
+import Data.ByteString.Char8 qualified as ByteString
+import Data.Char.WCWidth (wcwidth)
+import Data.Text qualified as Text
+import Relude hiding (truncate)
 import System.Console.ANSI (
   Color (Black, Blue, Green, Magenta, Red, Yellow),
   ColorIntensity (Dull, Vivid),
@@ -39,8 +39,6 @@ import System.Console.ANSI (
   setSGRCode,
  )
 
-import Data.ByteString.Char8 qualified as ByteString
-
 data Entry = Entry
   { codes :: [SGR]
   , lcontent :: Text
@@ -90,8 +88,10 @@ cells width e = e{width}
 
 label :: Text -> Entry -> Entry
 label t e = e{lcontent = t}
+
 addCode :: SGR -> Entry -> Entry
 addCode code e = e{codes = code : e.codes}
+
 addColor :: Color -> Entry -> Entry
 addColor = addCode . SetColor Foreground Dull
 
@@ -133,10 +133,13 @@ nextWidth :: Text -> NonEmpty (NonEmpty Entry) -> (Int, [NonEmpty Entry])
 nextWidth sep rows = (width, chopWidthFromRows sep width rows)
  where
   width = getWidthForNextColumn rows
+
 getWidthForNextColumn :: NonEmpty (NonEmpty Entry) -> Int
 getWidthForNextColumn = getWidthForColumn . fmap head
+
 getWidthForColumn :: NonEmpty Entry -> Int
 getWidthForColumn = foldl' max 0 . fmap getRelevantWidthForEntry
+
 getRelevantWidthForEntry :: Entry -> Int
 getRelevantWidthForEntry entry
   | entry.width == 1 = entryWidth entry
@@ -147,6 +150,7 @@ entryWidth Entry{lcontent, rcontent} = displayWidth lcontent + displayWidth rcon
 
 chopWidthFromRows :: Text -> Int -> NonEmpty (NonEmpty Entry) -> [NonEmpty Entry]
 chopWidthFromRows sep width = mapMaybe (nonEmpty . chopWidthFromRow sep width) . toList
+
 chopWidthFromRow :: Text -> Int -> NonEmpty Entry -> [Entry]
 chopWidthFromRow sep targetWidth (entry@Entry{width} :| rest)
   | width > 1 = entry{width = width - 1, lcontent = "", rcontent = mtimesDefault (max 0 (entryWidth entry - targetWidth - displayWidth sep)) " "} : rest

lib/NOM/Print/Tree.hs

@@ -1,10 +1,8 @@
 module NOM.Print.Tree (showForest) where
 
-import Relude
-
 import Data.Tree (Forest, Tree (..))
-
 import NOM.Print.Table (blue, markup)
+import Relude
 
 showForest :: Forest Text -> [Text]
 showForest = reverse . go False

lib/NOM/State.hs

@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
 module NOM.State (
   ProgressState (..),
   RunningBuildInfo,
@@ -14,8 +17,11 @@ module NOM.State (
   DerivationSet,
   DerivationMap,
   TransferInfo (..),
+  BuildFail (..),
   NOMState,
   NOMV1State (..),
+  ActivityStatus (..),
+  InputDerivation (..),
   getDerivationInfos,
   initalStateFromBuildPlatform,
   updateSummaryForStorePath,
@@ -36,6 +42,7 @@ module NOM.State (
 
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
+import Data.Strict qualified as Strict
 import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..))
 import NOM.NixMessage.JSON (Activity, ActivityId, ActivityProgress)
 import NOM.State.CacheId (CacheId)
@@ -52,7 +59,15 @@ import NOM.Update.Monad (
 import NOM.Util (foldMapEndo)
 import Optics (gfield, (%~))
 import Relude
-import Streamly.Internal.Data.Time.Units (AbsTime)
+import Type.Strict qualified as StrictType
+
+instance StrictType.StrictType seen v => StrictType.StrictType seen (IntMap v)
+
+instance StrictType.StrictType seen v => StrictType.StrictType seen (Map k v)
+
+instance StrictType.StrictType seen IntSet
+
+instance StrictType.StrictType seen v => StrictType.StrictType seen (Seq v)
 
 data StorePathState
   = DownloadPlanned
@@ -62,17 +77,23 @@ data StorePathState
   | Uploaded CompletedTransferInfo
   deriving stock (Show, Eq, Ord, Generic)
 
+data InputDerivation = MkInputDerivation
+  { derivation :: DerivationId
+  , outputs :: Set Text
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
 data DerivationInfo = MkDerivationInfo
-  { name ∷ Derivation
-  , outputs ∷ Map Text StorePathId
-  , inputDerivations ∷ Seq (DerivationId, Set Text)
-  , inputSources ∷ StorePathSet
-  , buildStatus ∷ BuildStatus
-  , dependencySummary ∷ DependencySummary
-  , cached ∷ Bool
-  , derivationParents ∷ DerivationSet
-  , pname ∷ Maybe Text
-  , platform ∷ Maybe Text
+  { name :: Derivation
+  , outputs :: Map Text StorePathId
+  , inputDerivations :: Seq InputDerivation
+  , inputSources :: StorePathSet
+  , buildStatus :: BuildStatus
+  , dependencySummary :: DependencySummary
+  , cached :: Bool
+  , derivationParents :: DerivationSet
+  , pname :: Strict.Maybe Text
+  , platform :: Strict.Maybe Text
   }
   deriving stock (Show, Eq, Ord, Generic)
 
@@ -89,84 +110,97 @@ type StorePathSet = CacheIdSet StorePath
 type DerivationSet = CacheIdSet Derivation
 
 data StorePathInfo = MkStorePathInfo
-  { name ∷ StorePath
-  , states ∷ Set StorePathState
-  , producer ∷ Maybe DerivationId
-  , inputFor ∷ DerivationSet
+  { name :: StorePath
+  , states :: Set StorePathState
+  , producer :: Strict.Maybe DerivationId
+  , inputFor :: DerivationSet
   }
   deriving stock (Show, Eq, Ord, Generic)
 
 type RunningBuildInfo = BuildInfo ()
 
-type CompletedBuildInfo = BuildInfo AbsTime
+type CompletedBuildInfo = BuildInfo Double
 
 type RunningTransferInfo = TransferInfo ()
 
-type CompletedTransferInfo = TransferInfo (Maybe AbsTime)
+type CompletedTransferInfo = TransferInfo (Strict.Maybe Double)
 
-type FailedBuildInfo = BuildInfo (AbsTime, FailType)
+type FailedBuildInfo = BuildInfo BuildFail
 
 data DependencySummary = MkDependencySummary
-  { plannedBuilds ∷ DerivationSet
-  , runningBuilds ∷ DerivationMap RunningBuildInfo
-  , completedBuilds ∷ DerivationMap CompletedBuildInfo
-  , failedBuilds ∷ DerivationMap FailedBuildInfo
-  , plannedDownloads ∷ StorePathSet
-  , completedDownloads ∷ StorePathMap CompletedTransferInfo
-  , completedUploads ∷ StorePathMap CompletedTransferInfo
-  , runningDownloads ∷ StorePathMap RunningTransferInfo
-  , runningUploads ∷ StorePathMap RunningTransferInfo
+  { plannedBuilds :: DerivationSet
+  , runningBuilds :: DerivationMap RunningBuildInfo
+  , completedBuilds :: DerivationMap CompletedBuildInfo
+  , failedBuilds :: DerivationMap FailedBuildInfo
+  , plannedDownloads :: StorePathSet
+  , completedDownloads :: StorePathMap CompletedTransferInfo
+  , completedUploads :: StorePathMap CompletedTransferInfo
+  , runningDownloads :: StorePathMap RunningTransferInfo
+  , runningUploads :: StorePathMap RunningTransferInfo
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+data ActivityStatus = MkActivityStatus
+  { activity :: Activity
+  , phase :: Strict.Maybe Text
+  , progress :: Strict.Maybe ActivityProgress
   }
   deriving stock (Show, Eq, Ord, Generic)
 
 data NOMV1State = MkNOMV1State
-  { derivationInfos ∷ DerivationMap DerivationInfo
-  , storePathInfos ∷ StorePathMap StorePathInfo
-  , fullSummary ∷ DependencySummary
-  , forestRoots ∷ Seq DerivationId
-  , buildReports ∷ BuildReportMap
-  , startTime ∷ AbsTime
-  , progressState ∷ ProgressState
-  , storePathIds ∷ Map StorePath StorePathId
-  , derivationIds ∷ Map Derivation DerivationId
-  , touchedIds ∷ DerivationSet
-  , activities ∷ IntMap (Activity, Maybe Text, Maybe ActivityProgress)
-  , nixErrors ∷ [Text]
-  , buildPlatform ∷ Maybe Text
+  { derivationInfos :: DerivationMap DerivationInfo
+  , storePathInfos :: StorePathMap StorePathInfo
+  , fullSummary :: DependencySummary
+  , forestRoots :: Seq DerivationId
+  , buildReports :: BuildReportMap
+  , startTime :: Double
+  , progressState :: ProgressState
+  , storePathIds :: Map StorePath StorePathId
+  , derivationIds :: Map Derivation DerivationId
+  , touchedIds :: DerivationSet
+  , activities :: IntMap ActivityStatus
+  , nixErrors :: Seq Text
+  , buildPlatform :: Strict.Maybe Text
   }
   deriving stock (Show, Eq, Ord, Generic)
 
 data ProgressState = JustStarted | InputReceived | Finished
   deriving stock (Show, Eq, Ord, Generic)
 
+data BuildFail = MkBuildFail
+  { at :: Double
+  , failType :: FailType
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
 data BuildStatus
   = Unknown
   | Planned
   | Building (BuildInfo ())
-  | Failed (BuildInfo (AbsTime, FailType)) -- End
-  | Built (BuildInfo AbsTime) -- End
+  | Failed (BuildInfo BuildFail) -- End
+  | Built (BuildInfo Double) -- End
   deriving stock (Show, Eq, Ord, Generic)
 
 data BuildInfo a = MkBuildInfo
-  { start ∷ AbsTime
-  , host ∷ Host
-  , estimate ∷ Maybe Int
-  , activityId ∷ Maybe ActivityId
-  , end ∷ a
+  { start :: Double
+  , host :: Host
+  , estimate :: Strict.Maybe Int
+  , activityId :: Strict.Maybe ActivityId
+  , end :: a
   }
   deriving stock (Show, Eq, Ord, Generic, Functor)
 
 data TransferInfo a = MkTransferInfo
-  { host ∷ Host
-  , start ∷ AbsTime
-  , end ∷ a
+  { host :: Host
+  , start :: Double
+  , end :: a
   }
   deriving stock (Show, Eq, Ord, Generic, Functor)
 
-initalStateFromBuildPlatform ∷ (MonadCacheBuildReports m, MonadNow m) ⇒ Maybe Text → m NOMV1State
+initalStateFromBuildPlatform :: (MonadCacheBuildReports m, MonadNow m) => Maybe Text -> m NOMV1State
 initalStateFromBuildPlatform platform = do
-  now ← getNow
-  buildReports ← getCachedBuildReports
+  now <- getNow
+  buildReports <- getCachedBuildReports
   pure $
     MkNOMV1State
       mempty
@@ -181,7 +215,7 @@ initalStateFromBuildPlatform platform = do
       mempty
       mempty
       mempty
-      platform
+      (Strict.toStrict platform)
 
 instance Semigroup DependencySummary where
   (MkDependencySummary ls1 lm2 lm3 lm4 ls5 lm6 lm7 lm8 lm9) <> (MkDependencySummary rs1 rm2 rm3 rm4 rs5 rm6 rm7 rm8 rm9) = MkDependencySummary (ls1 <> rs1) (lm2 <> rm2) (lm3 <> rm3) (lm4 <> rm4) (ls5 <> rs5) (lm6 <> rm6) (lm7 <> rm7) (lm8 <> rm8) (lm9 <> rm9)
@@ -189,60 +223,60 @@ instance Semigroup DependencySummary where
 instance Monoid DependencySummary where
   mempty = MkDependencySummary mempty mempty mempty mempty mempty mempty mempty mempty mempty
 
-getRunningBuilds ∷ NOMState (DerivationMap RunningBuildInfo)
+getRunningBuilds :: NOMState (DerivationMap RunningBuildInfo)
 getRunningBuilds = gets (.fullSummary.runningBuilds)
 
-getRunningBuildsByHost ∷ Host → NOMState (DerivationMap RunningBuildInfo)
-getRunningBuildsByHost host = CMap.filter (\x → x.host == host) <$> getRunningBuilds
+getRunningBuildsByHost :: Host -> NOMState (DerivationMap RunningBuildInfo)
+getRunningBuildsByHost host = CMap.filter (\x -> x.host == host) <$> getRunningBuilds
 
-lookupStorePathId ∷ StorePathId → NOMState StorePath
+lookupStorePathId :: StorePathId -> NOMState StorePath
 lookupStorePathId pathId = (.name) <$> getStorePathInfos pathId
 
-type NOMState a = ∀ m. MonadState NOMV1State m ⇒ m a
+type NOMState a = forall m. MonadState NOMV1State m => m a
 
-type NOMStateT m a = MonadState NOMV1State m ⇒ m a
+type NOMStateT m a = MonadState NOMV1State m => m a
 
-emptyStorePathInfo ∷ StorePath → StorePathInfo
-emptyStorePathInfo path = MkStorePathInfo path mempty Nothing mempty
+emptyStorePathInfo :: StorePath -> StorePathInfo
+emptyStorePathInfo path = MkStorePathInfo path mempty Strict.Nothing mempty
 
-emptyDerivationInfo ∷ Derivation → DerivationInfo
-emptyDerivationInfo drv = MkDerivationInfo drv mempty mempty mempty Unknown mempty False mempty Nothing Nothing
+emptyDerivationInfo :: Derivation -> DerivationInfo
+emptyDerivationInfo drv = MkDerivationInfo drv mempty mempty mempty Unknown mempty False mempty Strict.Nothing Strict.Nothing
 
-getStorePathId ∷ StorePath → NOMState StorePathId
+getStorePathId :: StorePath -> NOMState StorePathId
 getStorePathId path = do
   let newId = do
-        key ← gets (CMap.nextKey . (.storePathInfos))
+        key <- gets (CMap.nextKey . (.storePathInfos))
         modify (gfield @"storePathInfos" %~ CMap.insert key (emptyStorePathInfo path))
         modify (gfield @"storePathIds" %~ Map.insert path key)
         pure key
   gets (Map.lookup path . (.storePathIds)) >>= maybe newId pure
 
-getDerivationId ∷ Derivation → NOMState DerivationId
+getDerivationId :: Derivation -> NOMState DerivationId
 getDerivationId drv = do
   let newId = do
-        key ← gets (CMap.nextKey . (.derivationInfos))
+        key <- gets (CMap.nextKey . (.derivationInfos))
         modify (gfield @"derivationInfos" %~ CMap.insert key (emptyDerivationInfo drv))
         modify (gfield @"derivationIds" %~ Map.insert drv key)
         pure key
   gets (Map.lookup drv . (.derivationIds)) >>= maybe newId pure
 
-inputStorePaths ∷ DerivationInfo → NOMState (Map Text StorePathId)
+inputStorePaths :: DerivationInfo -> NOMState (Map Text StorePathId)
 inputStorePaths drv_info = do
-  inputs ← forM (CSet.toList drv_info.inputSources) \source → do
-    store_path_infos ← getStorePathInfos source
+  inputs <- forM (CSet.toList drv_info.inputSources) \source -> do
+    store_path_infos <- getStorePathInfos source
     pure (store_path_infos.name.name, source)
   pure $ Map.fromList inputs
 
-derivationToAnyOutPath ∷ DerivationId → NOMState (Maybe StorePath)
+derivationToAnyOutPath :: DerivationId -> NOMState (Maybe StorePath)
 derivationToAnyOutPath drv =
   gets (CMap.lookup drv . (.derivationInfos) >=> listToMaybe . Map.elems . (.outputs))
-    >>= mapM (\pathId → lookupStorePathId pathId)
+    >>= mapM (\pathId -> lookupStorePathId pathId)
 
-outPathToDerivation ∷ StorePathId → NOMState (Maybe DerivationId)
-outPathToDerivation path = gets (CMap.lookup path . (.storePathInfos) >=> (.producer))
+outPathToDerivation :: StorePathId -> NOMState (Maybe DerivationId)
+outPathToDerivation path = gets (CMap.lookup path . (.storePathInfos) >=> Strict.toLazy . (.producer))
 
 -- Only do this with derivationIds that you got via lookupDerivation
-getDerivationInfos ∷ DerivationId → NOMState DerivationInfo
+getDerivationInfos :: DerivationId -> NOMState DerivationInfo
 getDerivationInfos drvId =
   fromMaybe (error "BUG: drvId is no key in derivationInfos")
     . CMap.lookup drvId
@@ -250,52 +284,52 @@ getDerivationInfos drvId =
     <$> get
 
 -- Only do this with derivationIds that you got via lookupDerivation
-getStorePathInfos ∷ StorePathId → NOMState StorePathInfo
+getStorePathInfos :: StorePathId -> NOMState StorePathInfo
 getStorePathInfos storePathId =
   fromMaybe (error "BUG: storePathId is no key in storePathInfos")
     . CMap.lookup storePathId
     . (.storePathInfos)
     <$> get
 
-clearDerivationIdFromSummary ∷ BuildStatus → DerivationId → DependencySummary → DependencySummary
+clearDerivationIdFromSummary :: BuildStatus -> DerivationId -> DependencySummary -> DependencySummary
 clearDerivationIdFromSummary oldStatus drvId = case oldStatus of
-  Unknown → id
-  Planned → gfield @"plannedBuilds" %~ CSet.delete drvId
-  Building _ → gfield @"runningBuilds" %~ CMap.delete drvId
-  Failed _ → gfield @"failedBuilds" %~ CMap.delete drvId
-  Built _ → gfield @"completedBuilds" %~ CMap.delete drvId
+  Unknown -> id
+  Planned -> gfield @"plannedBuilds" %~ CSet.delete drvId
+  Building _ -> gfield @"runningBuilds" %~ CMap.delete drvId
+  Failed _ -> gfield @"failedBuilds" %~ CMap.delete drvId
+  Built _ -> gfield @"completedBuilds" %~ CMap.delete drvId
 
-updateSummaryForDerivation ∷ BuildStatus → BuildStatus → DerivationId → DependencySummary → DependencySummary
+updateSummaryForDerivation :: BuildStatus -> BuildStatus -> DerivationId -> DependencySummary -> DependencySummary
 updateSummaryForDerivation oldStatus newStatus drvId =
   clearDerivationIdFromSummary oldStatus drvId . case newStatus of
-    Unknown → id
-    Planned → gfield @"plannedBuilds" %~ CSet.insert drvId
-    Building bi → gfield @"runningBuilds" %~ CMap.insert drvId (void bi)
-    Failed bi → gfield @"failedBuilds" %~ CMap.insert drvId bi
-    Built bi → gfield @"completedBuilds" %~ CMap.insert drvId bi
+    Unknown -> id
+    Planned -> gfield @"plannedBuilds" %~ CSet.insert drvId
+    Building bi -> gfield @"runningBuilds" %~ CMap.insert drvId (void bi)
+    Failed bi -> gfield @"failedBuilds" %~ CMap.insert drvId bi
+    Built bi -> gfield @"completedBuilds" %~ CMap.insert drvId bi
 
-clearStorePathsFromSummary ∷ Set StorePathState → StorePathId → DependencySummary → DependencySummary
+clearStorePathsFromSummary :: Set StorePathState -> StorePathId -> DependencySummary -> DependencySummary
 clearStorePathsFromSummary deleted_states path_id =
   foldMapEndo remove_deleted deleted_states
  where
-  remove_deleted ∷ StorePathState → DependencySummary → DependencySummary
+  remove_deleted :: StorePathState -> DependencySummary -> DependencySummary
   remove_deleted = \case
-    DownloadPlanned → gfield @"plannedDownloads" %~ CSet.delete path_id
-    Downloading _ → gfield @"runningDownloads" %~ CMap.delete path_id
-    Uploading _ → gfield @"runningUploads" %~ CMap.delete path_id
-    Downloaded _ → gfield @"completedDownloads" %~ CMap.delete path_id
-    Uploaded _ → gfield @"completedUploads" %~ CMap.delete path_id
+    DownloadPlanned -> gfield @"plannedDownloads" %~ CSet.delete path_id
+    Downloading _ -> gfield @"runningDownloads" %~ CMap.delete path_id
+    Uploading _ -> gfield @"runningUploads" %~ CMap.delete path_id
+    Downloaded _ -> gfield @"completedDownloads" %~ CMap.delete path_id
+    Uploaded _ -> gfield @"completedUploads" %~ CMap.delete path_id
 
-updateSummaryForStorePath ∷ Set StorePathState → Set StorePathState → StorePathId → DependencySummary → DependencySummary
+updateSummaryForStorePath :: Set StorePathState -> Set StorePathState -> StorePathId -> DependencySummary -> DependencySummary
 updateSummaryForStorePath old_states new_states path_id =
   foldMapEndo insert_added added_states . clearStorePathsFromSummary deleted_states path_id
  where
-  insert_added ∷ StorePathState → DependencySummary → DependencySummary
+  insert_added :: StorePathState -> DependencySummary -> DependencySummary
   insert_added = \case
-    DownloadPlanned → gfield @"plannedDownloads" %~ CSet.insert path_id
-    Downloading ho → gfield @"runningDownloads" %~ CMap.insert path_id ho
-    Uploading ho → gfield @"runningUploads" %~ CMap.insert path_id ho
-    Downloaded ho → gfield @"completedDownloads" %~ CMap.insert path_id ho
-    Uploaded ho → gfield @"completedUploads" %~ CMap.insert path_id ho
+    DownloadPlanned -> gfield @"plannedDownloads" %~ CSet.insert path_id
+    Downloading ho -> gfield @"runningDownloads" %~ CMap.insert path_id ho
+    Uploading ho -> gfield @"runningUploads" %~ CMap.insert path_id ho
+    Downloaded ho -> gfield @"completedDownloads" %~ CMap.insert path_id ho
+    Uploaded ho -> gfield @"completedUploads" %~ CMap.insert path_id ho
   deleted_states = Set.difference old_states new_states
   added_states = Set.difference new_states old_states

lib/NOM/State/CacheId.hs

@@ -1,8 +1,7 @@
 module NOM.State.CacheId (CacheId (..)) where
 
-import Relude
-
 import Data.MemoTrie (HasTrie (..))
+import Relude
 
 newtype CacheId b = MkCacheId {unCacheId :: Int}
   deriving stock (Show, Eq, Ord, Read, Generic)

lib/NOM/State/CacheId/Map.hs

@@ -12,12 +12,10 @@ module NOM.State.CacheId.Map (
   CacheIdMap,
 ) where
 
-import Relude
-
 import Data.IntMap.Strict qualified as IntMap
-
 import NOM.State.CacheId (CacheId (MkCacheId))
 import NOM.State.CacheId.Set qualified as CSet
+import Relude
 
 newtype CacheIdMap b a = MkCacheIdMap {intMap :: IntMap a}
   deriving stock (Show, Eq, Ord, Read, Generic)

lib/NOM/State/CacheId/Set.hs

@@ -13,11 +13,9 @@ module NOM.State.CacheId.Set (
   member,
 ) where
 
-import Relude hiding (head)
-
 import Data.IntSet qualified as IntSet
-
 import NOM.State.CacheId (CacheId (MkCacheId))
+import Relude hiding (head)
 
 newtype CacheIdSet b = MkCacheIdSet {ints :: IntSet}
   deriving stock (Show, Eq, Ord, Read, Generic)

lib/NOM/State/Sorting.hs

@@ -5,22 +5,19 @@ module NOM.State.Sorting (
   SortKey,
 ) where
 
-import Relude
-
 import Control.Monad.Extra (pureIf)
 import Data.List.Extra (firstJust)
 import Data.MemoTrie (memo)
-import Data.Sequence qualified as Seq
-import Optics (gfield, view, (%~), _1)
-import Safe.Foldable (minimumMay)
-
+import Data.Sequence.Strict qualified as Seq
 import NOM.State (
+  BuildFail (..),
   BuildInfo (..),
   BuildStatus (Unknown),
   DependencySummary (..),
   DerivationId,
   DerivationInfo (..),
   DerivationSet,
+  InputDerivation (..),
   NOMState,
   NOMV1State (..),
   StorePathInfo (..),
@@ -33,7 +30,9 @@ import NOM.State (
 import NOM.State.CacheId.Map qualified as CMap
 import NOM.State.CacheId.Set qualified as CSet
 import NOM.Util (foldMapEndo)
-import Streamly.Internal.Data.Time.Units (AbsTime)
+import Optics (gfield, (%~))
+import Relude
+import Safe.Foldable (minimumMay)
 
 sortDepsOfSet :: DerivationSet -> NOMState ()
 sortDepsOfSet parents = do
@@ -43,8 +42,8 @@ sortDepsOfSet parents = do
         drvInfo <- getDerivationInfos drvId
         let newDrvInfo = (gfield @"inputDerivations" %~ sort_derivations) drvInfo
         modify' (gfield @"derivationInfos" %~ CMap.insert drvId newDrvInfo)
-      sort_derivations :: Seq (DerivationId, Set Text) -> Seq (DerivationId, Set Text)
-      sort_derivations = Seq.sortOn (sort_key . fst)
+      sort_derivations :: Seq InputDerivation -> Seq InputDerivation
+      sort_derivations = Seq.sortOn (sort_key . (.derivation))
 
       sort_key :: DerivationId -> SortKey
       sort_key = memo (sortKey currentState)
@@ -62,21 +61,21 @@ type SortKey =
 
 data SortOrder
   = -- First the failed builds starting with the earliest failures
-    SFailed AbsTime
+    SFailed Double
   | -- Second the running builds starting with longest running
-    SBuilding AbsTime
+    SBuilding Double
   | -- The longer a download is running, the more it matters.
-    SDownloading AbsTime
+    SDownloading Double
   | -- The longer an upload is running, the more it matters.
-    SUploading AbsTime
+    SUploading Double
   | SWaiting
   | SDownloadWaiting
   | -- The longer a build is completed the less it matters
-    SDone (Down AbsTime)
+    SDone (Down Double)
   | -- The longer a download is completed the less it matters
-    SDownloaded (Down AbsTime)
+    SDownloaded (Down Double)
   | -- The longer an upload is completed the less it matters
-    SUploaded (Down AbsTime)
+    SUploaded (Down Double)
   | SUnknown
   deriving stock (Eq, Show, Ord)
 
@@ -102,7 +101,7 @@ sortOrder :: DependencySummary -> SortOrder
 sortOrder MkDependencySummary{..} = fromMaybe SUnknown (firstJust id sort_entries)
  where
   sort_entries =
-    [ SFailed <$> minimumMay (view _1 . (.end) <$> failedBuilds)
+    [ SFailed <$> minimumMay ((.at) . (.end) <$> failedBuilds)
     , SBuilding <$> minimumMay ((.start) <$> runningBuilds)
     , SDownloading <$> minimumMay ((.start) <$> runningDownloads)
     , SUploading <$> minimumMay ((.start) <$> runningUploads)

lib/NOM/State/Tree.hs

@@ -2,9 +2,8 @@ module NOM.State.Tree (
   mapRootsTwigsAndLeafs,
 ) where
 
-import Relude
-
 import Data.Tree (Tree (Node))
+import Relude
 
 mapRootsTwigsAndLeafs :: (a -> b) -> (a -> b) -> (a -> b) -> Tree a -> Tree b
 mapRootsTwigsAndLeafs mapRoot mapTwig mapLeaf = go True

lib/NOM/Update.hs

@@ -5,12 +5,13 @@ import Control.Monad.Writer.Strict (WriterT (runWriterT))
 import Data.ByteString.Char8 qualified as ByteString
 import Data.IntMap qualified as IntMap
 import Data.Map.Strict qualified as Map
-import Data.Sequence qualified as Seq
+import Data.Sequence.Strict qualified as Seq
 import Data.Set qualified as Set
-import Data.Text qualified as Text
-import Data.Time (NominalDiffTime)
 -- optics
 
+import Data.Strict qualified as Strict
+import Data.Text qualified as Text
+import Data.Time (NominalDiffTime)
 import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..), parseDerivation, parseIndentedStoreObject, parseStorePath)
 import NOM.Error (NOMError)
 import NOM.IO.ParseStream.Attoparsec (parseOneText, stripANSICodes)
@@ -21,6 +22,8 @@ import NOM.NixMessage.OldStyle qualified as OldStyleMessage
 import NOM.Parser qualified as Parser
 import NOM.Print.Table (blue, markup)
 import NOM.State (
+  ActivityStatus (..),
+  BuildFail (..),
   BuildInfo (..),
   BuildStatus (..),
   DependencySummary,
@@ -28,6 +31,7 @@ import NOM.State (
   DerivationInfo (..),
   DerivationMap,
   DerivationSet,
+  InputDerivation (..),
   NOMState,
   NOMStateT,
   NOMV1State (..),
@@ -60,66 +64,65 @@ import NOM.Update.Monad (
   MonadReadDerivation (..),
   UpdateMonad,
  )
-import NOM.Util (diffTime, foldMapEndo, relTimeToSeconds)
+import NOM.Util (foldMapEndo)
 import Nix.Derivation qualified as Nix
-import Optics (gconstructor, gfield, has, preview, view, (%), (%~), (.~), (?~), _1, _2, _3)
+import Optics (gconstructor, gfield, has, preview, (%), (%~), (.~))
 import Relude
-import Streamly.Internal.Data.Time.Units (AbsTime, diffAbsTime)
 import System.Console.ANSI (SGR (Reset), setSGRCode)
 
-type ProcessingT m a = UpdateMonad m ⇒ NOMStateT (WriterT [Either NOMError ByteString] m) a
+type ProcessingT m a = UpdateMonad m => NOMStateT (WriterT [Either NOMError ByteString] m) a
 
-getReportName ∷ DerivationInfo → Text
+getReportName :: DerivationInfo -> Text
 getReportName drv = case drv.pname of
-  Just pname → pname
-  Nothing → Text.dropWhileEnd (`Set.member` fromList ".1234567890-") drv.name.storePath.name
+  Strict.Just pname -> pname
+  Strict.Nothing -> Text.dropWhileEnd (`Set.member` fromList ".1234567890-") drv.name.storePath.name
 
-setInputReceived ∷ NOMState Bool
+setInputReceived :: NOMState Bool
 setInputReceived = do
-  s ← get
+  s <- get
   let change = s.progressState == JustStarted
   when change (put s{progressState = InputReceived})
   pure change
 
-maintainState ∷ NOMV1State → NOMV1State
+maintainState :: NOMV1State -> NOMV1State
 maintainState = execState $ do
-  currentState@MkNOMV1State{touchedIds} ← get
+  currentState@MkNOMV1State{touchedIds} <- get
   unless (CSet.null touchedIds) $ do
     sortDepsOfSet touchedIds
     modify (gfield @"forestRoots" %~ Seq.sortOn (sortKey currentState))
     modify (gfield @"touchedIds" .~ mempty)
 
-minTimeBetweenPollingNixStore ∷ NominalDiffTime
+minTimeBetweenPollingNixStore :: NominalDiffTime
 minTimeBetweenPollingNixStore = 0.2 -- in seconds
 
 {-# INLINE updateStateNixJSONMessage #-}
-updateStateNixJSONMessage ∷ ∀ m. UpdateMonad m ⇒ Either NOMError NixJSONMessage → NOMV1State → m (([NOMError], ByteString), Maybe NOMV1State)
+updateStateNixJSONMessage :: forall m. UpdateMonad m => Either NOMError NixJSONMessage -> NOMV1State -> m (([NOMError], ByteString), Maybe NOMV1State)
 updateStateNixJSONMessage input inputState =
   {-# SCC "updateStateNixJSONMessage" #-}
   do
     let process =
           {-# SCC "matching_message" #-}
           case input of
-            Left err → do
+            Left err -> do
               tell [Left err]
               noChange
-            Right jsonMessage → processJsonMessage jsonMessage
-    ((hasChanged, msgs), !outputState) ← {-# SCC "run_state" #-} runStateT (runWriterT (({-# SCC "input_received" #-} setInputReceived) >> {-# SCC "processing" #-} process)) inputState
+            Right jsonMessage -> processJsonMessage jsonMessage
+    ((hasChanged, msgs), outputState) <- {-# SCC "run_state" #-} runStateT (runWriterT (({-# SCC "input_received" #-} setInputReceived) >> {-# SCC "processing" #-} process)) inputState
     let retval = if hasChanged then Just outputState else Nothing
         errors = lefts msgs
     {-# SCC "emitting_new_state" #-} pure ((errors, ByteString.unlines (rights msgs)), retval)
 
-updateStateNixOldStyleMessage ∷ ∀ m. UpdateMonad m ⇒ (Maybe NixOldStyleMessage, ByteString) → (Maybe AbsTime, NOMV1State) → m (([NOMError], ByteString), (Maybe AbsTime, Maybe NOMV1State))
+updateStateNixOldStyleMessage :: forall m. UpdateMonad m => (Maybe NixOldStyleMessage, ByteString) -> (Maybe Double, NOMV1State) -> m (([NOMError], ByteString), (Maybe Double, Maybe NOMV1State))
 updateStateNixOldStyleMessage (result, input) (inputAccessTime, inputState) = do
-  now ← getNow
+  now <- getNow
 
   let processing = case result of
-        Just result' → processResult result'
-        Nothing → pure False
+        Just result' -> processResult result'
+        Nothing -> pure False
       (outputAccessTime, check)
-        | maybe True ((>= minTimeBetweenPollingNixStore) . diffTime now) inputAccessTime = (Just now, detectLocalFinishedBuilds)
+        | maybe True ((>= minTimeBetweenPollingNixStore) . realToFrac . (now -)) inputAccessTime = (Just now, detectLocalFinishedBuilds)
         | otherwise = (inputAccessTime, pure False)
-  ((!hasChanged, !msgs), outputState) ←
+  ((hasChanged, msgs), outputState) <-
     runStateT
       ( runWriterT
           ( or
@@ -140,296 +143,296 @@ updateStateNixOldStyleMessage (result, input) (inputAccessTime, inputState) = do
       errors = lefts msgs
   pure ((errors, input <> ByteString.unlines (rights msgs)), retval)
 
-derivationIsCompleted ∷ UpdateMonad m ⇒ DerivationId → NOMStateT m Bool
+derivationIsCompleted :: UpdateMonad m => DerivationId -> NOMStateT m Bool
 derivationIsCompleted drvId =
   derivationToAnyOutPath drvId >>= \case
-    Nothing → pure False -- Derivation has no "out" output.
-    Just path → storePathExists path
+    Nothing -> pure False -- Derivation has no "out" output.
+    Just path -> storePathExists path
 
-detectLocalFinishedBuilds ∷ ProcessingT m Bool
+detectLocalFinishedBuilds :: ProcessingT m Bool
 detectLocalFinishedBuilds = do
-  runningLocalBuilds ← CMap.toList <$> getRunningBuildsByHost Localhost -- .> traceShowId
-  newCompletedOutputs ← filterM (\(x, _) → derivationIsCompleted x) runningLocalBuilds
+  runningLocalBuilds <- CMap.toList <$> getRunningBuildsByHost Localhost -- .> traceShowId
+  newCompletedOutputs <- filterM (\(x, _) -> derivationIsCompleted x) runningLocalBuilds
   let anyBuildsFinished = not (null newCompletedOutputs)
   when anyBuildsFinished (finishBuilds Localhost newCompletedOutputs)
   pure anyBuildsFinished
 
-withChange ∷ Functor f ⇒ f b → f Bool
+withChange :: Functor f => f b -> f Bool
 withChange = (True <$)
 
-noChange ∷ Applicative f ⇒ f Bool
+noChange :: Applicative f => f Bool
 noChange = pure False
 
-processResult ∷ UpdateMonad m ⇒ NixOldStyleMessage → ProcessingT m Bool
+processResult :: UpdateMonad m => NixOldStyleMessage -> ProcessingT m Bool
 processResult result = do
-  now ← getNow
+  now <- getNow
   case result of
-    OldStyleMessage.Uploading path host → withChange do
-      pathId ← getStorePathId path
+    OldStyleMessage.Uploading path host -> withChange do
+      pathId <- getStorePathId path
       uploaded host pathId now
-    OldStyleMessage.Downloading path host → withChange do
-      pathId ← getStorePathId path
+    OldStyleMessage.Downloading path host -> withChange do
+      pathId <- getStorePathId path
       downloaded host pathId now
       finishBuildByPathId host pathId
-    OldStyleMessage.PlanCopies _ → noChange
-    OldStyleMessage.Build drvName host → withChange do
+    OldStyleMessage.PlanCopies _ -> noChange
+    OldStyleMessage.Build drvName host -> withChange do
       building host drvName now Nothing
-    OldStyleMessage.PlanBuilds plannedBuilds _lastBuild → withChange do
-      plannedDrvIds ← forM (toList plannedBuilds) \drv →
+    OldStyleMessage.PlanBuilds plannedBuilds _lastBuild -> withChange do
+      plannedDrvIds <- forM (toList plannedBuilds) \drv ->
         lookupDerivation drv
       planBuilds (fromList plannedDrvIds)
-    OldStyleMessage.PlanDownloads _download _unpacked plannedDownloads → withChange do
-      plannedDownloadIds ← forM (toList plannedDownloads) \path →
+    OldStyleMessage.PlanDownloads _download _unpacked plannedDownloads -> withChange do
+      plannedDownloadIds <- forM (toList plannedDownloads) \path ->
         getStorePathId path
       planDownloads (fromList plannedDownloadIds)
-    OldStyleMessage.Checking drvName → withChange do
+    OldStyleMessage.Checking drvName -> withChange do
       building Localhost drvName now Nothing
-    OldStyleMessage.Failed drv code → withChange do
-      drvId ← lookupDerivation drv
+    OldStyleMessage.Failed drv code -> withChange do
+      drvId <- lookupDerivation drv
       failedBuild now drvId code
 
-processJsonMessage ∷ UpdateMonad m ⇒ NixJSONMessage → ProcessingT m Bool
+processJsonMessage :: UpdateMonad m => NixJSONMessage -> ProcessingT m Bool
 processJsonMessage = \case
-  Message MkMessageAction{message, level} | level <= Info && level > Error → do
+  Message MkMessageAction{message, level} | level <= Info && level > Error -> do
     let message' = encodeUtf8 message
     tell [Right message']
     case parseIndentedStoreObject message of
-      Just (Right download) →
+      Just (Right download) ->
         {-# SCC "plan_download" #-}
         withChange do
-          plannedDownloadId ← getStorePathId download
+          plannedDownloadId <- getStorePathId download
           planDownloads $ one plannedDownloadId
-      Just (Left build) →
+      Just (Left build) ->
         {-# SCC "plan_build" #-}
         withChange do
-          plannedDrvId ← lookupDerivation build
+          plannedDrvId <- lookupDerivation build
           planBuilds (one plannedDrvId)
-      _ → noChange
+      _ -> noChange
   Message MkMessageAction{message, level = Error}
-    | stripped ← stripANSICodes message
-    , Text.isPrefixOf "error:" stripped →
+    | stripped <- stripANSICodes message
+    , Text.isPrefixOf "error:" stripped ->
         {-# SCC "pass_through_error" #-}
         withChange do
-          errors ← gets (.nixErrors)
+          errors <- gets (.nixErrors)
           unless (stripped `elem` errors) do
-            modify' (gfield @"nixErrors" %~ (<> [stripped]))
-            whenJust (parseOneText Parser.oldStyleParser message) \result →
+            modify' (gfield @"nixErrors" %~ (<> (stripped Seq.<| mempty)))
+            whenJust (parseOneText Parser.oldStyleParser message) \result ->
               void (processResult result)
             tell [Right (encodeUtf8 message)]
-    | stripped ← stripANSICodes message
-    , Text.isPrefixOf "note:" stripped →
+    | stripped <- stripANSICodes message
+    , Text.isPrefixOf "note:" stripped ->
         {-# SCC "pass_through_note" #-}
         do
           tell [Right (encodeUtf8 message)]
           noChange
-  Result MkResultAction{result = BuildLogLine line, id = id'} →
+  Result MkResultAction{result = BuildLogLine line, id = id'} ->
     {-# SCC "pass_through_build_line" #-}
     do
-      nomState ← get
-      prefix ← activityPrefix (view _1 <$> IntMap.lookup id'.value nomState.activities)
+      nomState <- get
+      prefix <- activityPrefix ((.activity) <$> IntMap.lookup id'.value nomState.activities)
       tell [Right (encodeUtf8 (prefix <> line))]
       noChange
-  Result MkResultAction{result = SetPhase phase, id = id'} →
-    {-# SCC "updating_phase" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (_2 ?~ phase) id'.value)
-  Result MkResultAction{result = Progress progress, id = id'} →
-    {-# SCC "updating_progress" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (_3 ?~ progress) id'.value)
-  Start startAction@MkStartAction{id = id'} →
+  Result MkResultAction{result = SetPhase phase, id = id'} ->
+    {-# SCC "updating_phase" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (gfield @"phase" .~ Strict.Just phase) id'.value)
+  Result MkResultAction{result = Progress progress, id = id'} ->
+    {-# SCC "updating_progress" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (gfield @"progress" .~ Strict.Just progress) id'.value)
+  Start startAction@MkStartAction{id = id'} ->
     {-# SCC "starting_action" #-}
     withChange do
-      prefix ← activityPrefix $ Just startAction.activity
+      prefix <- activityPrefix $ Just startAction.activity
       when (not (Text.null startAction.text) && startAction.level <= Info) $ tell [Right . encodeUtf8 $ prefix <> startAction.text]
-      modify' (gfield @"activities" %~ IntMap.insert id'.value (startAction.activity, Nothing, Nothing))
+      modify' (gfield @"activities" %~ IntMap.insert id'.value (MkActivityStatus startAction.activity Strict.Nothing Strict.Nothing))
       case startAction.activity of
-        JSON.Build drvName host → do
-          now ← getNow
+        JSON.Build drvName host -> do
+          now <- getNow
           building host drvName now (Just id')
-        JSON.CopyPath path from Localhost → do
-          now ← getNow
-          pathId ← getStorePathId path
+        JSON.CopyPath path from Localhost -> do
+          now <- getNow
+          pathId <- getStorePathId path
           downloading from pathId now
-        JSON.CopyPath path Localhost to → do
-          now ← getNow
-          pathId ← getStorePathId path
+        JSON.CopyPath path Localhost to -> do
+          now <- getNow
+          pathId <- getStorePathId path
           uploading to pathId now
-        _ → pass -- tell [Right (encodeUtf8 (markup yellow "unused activity: " <> show startAction.id <> " " <> show startAction.activity))]
-  Stop MkStopAction{id = id'} →
+        _ -> pass -- tell [Right (encodeUtf8 (markup yellow "unused activity: " <> show startAction.id <> " " <> show startAction.activity))]
+  Stop MkStopAction{id = id'} ->
     {-# SCC "stoping_action" #-}
     do
-      activity ← gets (\s → IntMap.lookup id'.value s.activities)
+      activity <- gets (\s -> IntMap.lookup id'.value s.activities)
       case activity of
-        Just (JSON.CopyPath path from Localhost, _, _) → withChange do
-          now ← getNow
-          pathId ← getStorePathId path
+        Just (MkActivityStatus{activity = JSON.CopyPath path from Localhost}) -> withChange do
+          now <- getNow
+          pathId <- getStorePathId path
           downloaded from pathId now
-        Just (JSON.CopyPath path Localhost to, _, _) → withChange do
-          now ← getNow
-          pathId ← getStorePathId path
+        Just (MkActivityStatus{activity = JSON.CopyPath path Localhost to}) -> withChange do
+          now <- getNow
+          pathId <- getStorePathId path
           uploaded to pathId now
-        Just (JSON.Build drv host, _, _) → do
-          drvId ← lookupDerivation drv
-          isCompleted ← derivationIsCompleted drvId
+        Just (MkActivityStatus{activity = JSON.Build drv host}) -> do
+          drvId <- lookupDerivation drv
+          isCompleted <- derivationIsCompleted drvId
           if isCompleted then withChange $ finishBuildByDrvId host drvId else noChange
-        _ → noChange
-  _other → do
+        _ -> noChange
+  _other -> do
     -- tell [Right (encodeUtf8 (markup yellow "unused message: " <> show _other))]
     noChange
 
-appendDifferingPlatform ∷ NOMV1State → DerivationInfo → Text → Text
+appendDifferingPlatform :: NOMV1State -> DerivationInfo -> Text -> Text
 appendDifferingPlatform nomState drvInfo = case (nomState.buildPlatform, drvInfo.platform) of
-  (Just p1, Just p2) | p1 /= p2 → (<> "-" <> p2)
-  _ → id
+  (Strict.Just p1, Strict.Just p2) | p1 /= p2 -> (<> "-" <> p2)
+  _ -> id
 
-activityPrefix ∷ Maybe Activity → ProcessingT m Text
+activityPrefix :: Maybe Activity -> ProcessingT m Text
 activityPrefix activities = do
   case activities of
-    Just (JSON.Build derivation _) → do
-      drvInfo ← lookupDerivationInfos derivation
-      nomState ← get
+    Just (JSON.Build derivation _) -> do
+      drvInfo <- lookupDerivationInfos derivation
+      nomState <- get
       pure $ toText (setSGRCode [Reset]) <> markup blue (appendDifferingPlatform nomState drvInfo (getReportName drvInfo) <> "> ")
-    _ → pure ""
+    _ -> pure ""
 
-movingAverage ∷ Double
+movingAverage :: Double
 movingAverage = 0.5
 
-reportFinishingBuilds ∷ (MonadCacheBuildReports m, MonadNow m) ⇒ Host → NonEmpty (DerivationInfo, AbsTime) → m BuildReportMap
+reportFinishingBuilds :: (MonadCacheBuildReports m, MonadNow m) => Host -> NonEmpty (DerivationInfo, Double) -> m BuildReportMap
 reportFinishingBuilds host builds = do
-  now ← getNow
+  now <- getNow
   updateBuildReports (modifyBuildReports host (timeDiffInt now <<$>> builds))
 
 -- | time difference in seconds rounded down
-timeDiffInt ∷ AbsTime → AbsTime → Int
-timeDiffInt = fmap (floor . relTimeToSeconds) . diffAbsTime
+timeDiffInt :: Double -> Double -> Int
+timeDiffInt = fmap floor . (-)
 
-finishBuilds ∷ Host → [(DerivationId, BuildInfo ())] → ProcessingT m ()
+finishBuilds :: Host -> [(DerivationId, BuildInfo ())] -> ProcessingT m ()
 finishBuilds host builds = do
-  derivationsWithNames ← forM builds \(drvId, buildInfo) →
+  derivationsWithNames <- forM builds \(drvId, buildInfo) ->
     (,buildInfo.start) <$> getDerivationInfos drvId
   ( \case
-      Nothing → pass
-      Just finishedBuilds → do
-        newBuildReports ← reportFinishingBuilds host finishedBuilds
+      Nothing -> pass
+      Just finishedBuilds -> do
+        newBuildReports <- reportFinishingBuilds host finishedBuilds
         modify (gfield @"buildReports" .~ newBuildReports)
     )
     $ nonEmpty derivationsWithNames
-  now ← getNow
-  forM_ builds \(drv, info) → updateDerivationState drv (const (Built (info $> now)))
+  now <- getNow
+  forM_ builds \(drv, info) -> updateDerivationState drv (const (Built (info $> now)))
 
-modifyBuildReports ∷ Host → NonEmpty (DerivationInfo, Int) → BuildReportMap → BuildReportMap
+modifyBuildReports :: Host -> NonEmpty (DerivationInfo, Int) -> BuildReportMap -> BuildReportMap
 modifyBuildReports host = foldMapEndo (uncurry insertBuildReport)
  where
   insertBuildReport name =
     Map.insertWith
-      (\new old → floor (movingAverage * fromIntegral new + (1 - movingAverage) * fromIntegral old))
+      (\new old -> floor (movingAverage * fromIntegral new + (1 - movingAverage) * fromIntegral old))
       (host, getReportName name)
 
-failedBuild ∷ AbsTime → DerivationId → FailType → NOMState ()
+failedBuild :: Double -> DerivationId -> FailType -> NOMState ()
 failedBuild now drv code = updateDerivationState drv update
  where
   update = \case
-    Built a → State.Failed (a $> (now, code))
-    Building a → State.Failed (a $> (now, code))
-    x → x
+    Built a -> State.Failed (a $> MkBuildFail now code)
+    Building a -> State.Failed (a $> MkBuildFail now code)
+    x -> x
 
-lookupDerivation ∷ Derivation → ProcessingT m DerivationId
+lookupDerivation :: Derivation -> ProcessingT m DerivationId
 lookupDerivation drv = do
-  drvId ← getDerivationId drv
-  isCached ← gets (maybe False (.cached) . CMap.lookup drvId . (.derivationInfos))
+  drvId <- getDerivationId drv
+  isCached <- gets (maybe False (.cached) . CMap.lookup drvId . (.derivationInfos))
   unless isCached $
     getDerivation drv >>= \case
-      Left err → tell [Left err]
-      Right parsedDrv → insertDerivation parsedDrv drvId
+      Left err -> tell [Left err]
+      Right parsedDrv -> insertDerivation parsedDrv drvId
   pure drvId
 
-lookupDerivationInfos ∷ Derivation → ProcessingT m DerivationInfo
+lookupDerivationInfos :: Derivation -> ProcessingT m DerivationInfo
 lookupDerivationInfos drvName = do
-  drvId ← lookupDerivation drvName
+  drvId <- lookupDerivation drvName
   getDerivationInfos drvId
 
-insertDerivation ∷ Nix.Derivation FilePath Text → DerivationId → ProcessingT m ()
+insertDerivation :: Nix.Derivation FilePath Text -> DerivationId -> ProcessingT m ()
 insertDerivation derivation drvId = do
-  outputs' ←
-    derivation.outputs & Map.traverseMaybeWithKey \_ path → do
-      parseStorePath (toText (Nix.path path)) & mapM \pathName → do
-        pathId ← getStorePathId pathName
-        modify (gfield @"storePathInfos" %~ CMap.adjust (gfield @"producer" ?~ drvId) pathId)
+  outputs' <-
+    derivation.outputs & Map.traverseMaybeWithKey \_ path -> do
+      parseStorePath (toText (Nix.path path)) & mapM \pathName -> do
+        pathId <- getStorePathId pathName
+        modify (gfield @"storePathInfos" %~ CMap.adjust (gfield @"producer" .~ Strict.Just drvId) pathId)
         pure pathId
-  inputSources ←
-    derivation.inputSrcs & flip foldlM mempty \acc path → do
-      pathIdMay ←
-        parseStorePath (toText path) & mapM \pathName → do
-          pathId ← getStorePathId pathName
+  inputSources <-
+    derivation.inputSrcs & flip foldlM mempty \acc path -> do
+      pathIdMay <-
+        parseStorePath (toText path) & mapM \pathName -> do
+          pathId <- getStorePathId pathName
           modify (gfield @"storePathInfos" %~ CMap.adjust (gfield @"inputFor" %~ CSet.insert drvId) pathId)
           pure pathId
       pure $ maybe id CSet.insert pathIdMay acc
-  inputDerivationsList ←
-    derivation.inputDrvs & Map.toList & mapMaybeM \(drvPath, outs) → do
-      depIdMay ←
-        parseDerivation (toText drvPath) & mapM \depName → do
-          depId ← lookupDerivation depName
+  inputDerivationsList <-
+    derivation.inputDrvs & Map.toList & mapMaybeM \(drvPath, outs) -> do
+      depIdMay <-
+        parseDerivation (toText drvPath) & mapM \depName -> do
+          depId <- lookupDerivation depName
           modify (gfield @"derivationInfos" %~ CMap.adjust (gfield @"derivationParents" %~ CSet.insert drvId) depId)
           modify (gfield @"forestRoots" %~ Seq.filter (/= depId))
           pure depId
-      pure $ (,outs) <$> depIdMay
+      pure $ (\derivation_id -> MkInputDerivation{derivation = derivation_id, outputs = outs}) <$> depIdMay
   let inputDerivations = Seq.fromList inputDerivationsList
-  modify (gfield @"derivationInfos" %~ CMap.adjust (\i → i{outputs = outputs', inputSources, inputDerivations, cached = True, platform = Just derivation.platform, pname = Map.lookup "pname" derivation.env}) drvId)
-  noParents ← CSet.null . (.derivationParents) <$> getDerivationInfos drvId
+  modify (gfield @"derivationInfos" %~ CMap.adjust (\i -> i{outputs = outputs', inputSources, inputDerivations, cached = True, platform = Strict.Just derivation.platform, pname = Strict.toStrict (Map.lookup "pname" derivation.env)}) drvId)
+  noParents <- CSet.null . (.derivationParents) <$> getDerivationInfos drvId
   when noParents $ modify (gfield @"forestRoots" %~ (drvId Seq.<|))
 
-planBuilds ∷ Set DerivationId → NOMState ()
-planBuilds drvIds = forM_ drvIds \drvId →
+planBuilds :: Set DerivationId -> NOMState ()
+planBuilds drvIds = forM_ drvIds \drvId ->
   updateDerivationState drvId (const Planned)
 
-planDownloads ∷ Set StorePathId → NOMState ()
-planDownloads pathIds = forM_ pathIds \pathId →
+planDownloads :: Set StorePathId -> NOMState ()
+planDownloads pathIds = forM_ pathIds \pathId ->
   insertStorePathState pathId DownloadPlanned Nothing
 
-finishBuildByDrvId ∷ Host → DerivationId → ProcessingT m ()
+finishBuildByDrvId :: Host -> DerivationId -> ProcessingT m ()
 finishBuildByDrvId host drvId = do
-  buildInfoMay ← getBuildInfoIfRunning drvId
-  whenJust buildInfoMay \buildInfo → finishBuilds host [(drvId, buildInfo)]
+  buildInfoMay <- getBuildInfoIfRunning drvId
+  whenJust buildInfoMay \buildInfo -> finishBuilds host [(drvId, buildInfo)]
 
-finishBuildByPathId ∷ Host → StorePathId → ProcessingT m ()
+finishBuildByPathId :: Host -> StorePathId -> ProcessingT m ()
 finishBuildByPathId host pathId = do
-  drvIdMay ← outPathToDerivation pathId
-  whenJust drvIdMay (\x → finishBuildByDrvId host x)
+  drvIdMay <- outPathToDerivation pathId
+  whenJust drvIdMay (\x -> finishBuildByDrvId host x)
 
-downloading ∷ Host → StorePathId → AbsTime → NOMState ()
+downloading :: Host -> StorePathId -> Double -> NOMState ()
 downloading host pathId start = do
   insertStorePathState pathId (State.Downloading MkTransferInfo{host, start, end = ()}) Nothing
 
-getBuildInfoIfRunning ∷ DerivationId → NOMState (Maybe RunningBuildInfo)
+getBuildInfoIfRunning :: DerivationId -> NOMState (Maybe RunningBuildInfo)
 getBuildInfoIfRunning drvId =
   runMaybeT $ do
-    drvInfos ← MaybeT (gets (CMap.lookup drvId . (.derivationInfos)))
+    drvInfos <- MaybeT (gets (CMap.lookup drvId . (.derivationInfos)))
     MaybeT (pure ((() <$) <$> preview (gfield @"buildStatus" % gconstructor @"Building") drvInfos))
 
-downloaded ∷ Host → StorePathId → AbsTime → NOMState ()
+downloaded :: Host -> StorePathId -> Double -> NOMState ()
 downloaded host pathId end = do
-  insertStorePathState pathId (Downloaded MkTransferInfo{host, start = end, end = Nothing}) $ Just \case
-    State.Downloading transfer_info | transfer_info.host == host → Downloaded (transfer_info $> Just end)
-    other → other
+  insertStorePathState pathId (Downloaded MkTransferInfo{host, start = end, end = Strict.Nothing}) $ Just \case
+    State.Downloading transfer_info | transfer_info.host == host -> Downloaded (transfer_info $> Strict.Just end)
+    other -> other
 
-uploading ∷ Host → StorePathId → AbsTime → NOMState ()
+uploading :: Host -> StorePathId -> Double -> NOMState ()
 uploading host pathId start =
   insertStorePathState pathId (State.Uploading MkTransferInfo{host, start, end = ()}) Nothing
 
-uploaded ∷ Host → StorePathId → AbsTime → NOMState ()
+uploaded :: Host -> StorePathId -> Double -> NOMState ()
 uploaded host pathId end =
-  insertStorePathState pathId (Uploaded MkTransferInfo{host, start = end, end = Nothing}) $ Just \case
-    State.Uploading transfer_info | transfer_info.host == host → Uploaded (transfer_info $> Just end)
-    other → other
+  insertStorePathState pathId (Uploaded MkTransferInfo{host, start = end, end = Strict.Nothing}) $ Just \case
+    State.Uploading transfer_info | transfer_info.host == host -> Uploaded (transfer_info $> Strict.Just end)
+    other -> other
 
-building ∷ Host → Derivation → AbsTime → Maybe ActivityId → ProcessingT m ()
+building :: Host -> Derivation -> Double -> Maybe ActivityId -> ProcessingT m ()
 building host drvName now activityId = do
-  reportName ← getReportName <$> lookupDerivationInfos drvName
-  lastNeeded ← Map.lookup (host, reportName) . (.buildReports) <$> get
-  drvId ← lookupDerivation drvName
-  updateDerivationState drvId (const (Building (MkBuildInfo now host lastNeeded activityId ())))
+  reportName <- getReportName <$> lookupDerivationInfos drvName
+  lastNeeded <- Map.lookup (host, reportName) . (.buildReports) <$> get
+  drvId <- lookupDerivation drvName
+  updateDerivationState drvId (const (Building (MkBuildInfo now host (Strict.toStrict lastNeeded) (Strict.toStrict activityId) ())))
 
-updateDerivationState ∷ DerivationId → (BuildStatus → BuildStatus) → NOMState ()
+updateDerivationState :: DerivationId -> (BuildStatus -> BuildStatus) -> NOMState ()
 updateDerivationState drvId updateStatus = do
   -- Update derivationInfo for this Derivation
-  derivation_infos ← getDerivationInfos drvId
+  derivation_infos <- getDerivationInfos drvId
   let oldStatus = derivation_infos.buildStatus
       newStatus = updateStatus oldStatus
   when (oldStatus /= newStatus) do
@@ -443,10 +446,10 @@ updateDerivationState drvId updateStatus = do
     -- Update fullSummary
     modify (gfield @"fullSummary" %~ update_summary)
 
-updateParents ∷ Bool → (DependencySummary → DependencySummary) → (DependencySummary → DependencySummary) → DerivationSet → NOMState ()
+updateParents :: Bool -> (DependencySummary -> DependencySummary) -> (DependencySummary -> DependencySummary) -> DerivationSet -> NOMState ()
 updateParents force_direct update_func clear_func direct_parents = do
-  relevant_parents ← (if force_direct then CSet.union direct_parents else id) <$> collect_parents True mempty direct_parents
-  parents ← collect_parents False mempty direct_parents
+  relevant_parents <- (if force_direct then CSet.union direct_parents else id) <$> collect_parents True mempty direct_parents
+  parents <- collect_parents False mempty direct_parents
   modify
     ( gfield @"derivationInfos"
         %~ apply_to_all_summaries update_func relevant_parents
@@ -454,45 +457,45 @@ updateParents force_direct update_func clear_func direct_parents = do
     )
   modify (gfield @"touchedIds" %~ CSet.union parents)
  where
-  apply_to_all_summaries ∷
-    (DependencySummary → DependencySummary) →
-    DerivationSet →
-    DerivationMap DerivationInfo →
+  apply_to_all_summaries ::
+    (DependencySummary -> DependencySummary) ->
+    DerivationSet ->
+    DerivationMap DerivationInfo ->
     DerivationMap DerivationInfo
   apply_to_all_summaries func = foldMapEndo (CMap.adjust (gfield @"dependencySummary" %~ func)) . CSet.toList
-  collect_parents ∷ Bool → DerivationSet → DerivationSet → NOMState DerivationSet
+  collect_parents :: Bool -> DerivationSet -> DerivationSet -> NOMState DerivationSet
   collect_parents no_irrelevant collected_parents parents_to_scan = case CSet.maxView parents_to_scan of
-    Nothing → pure collected_parents
-    Just (current_parent, rest_to_scan) → do
-      drv_infos ← getDerivationInfos current_parent
-      transfer_states ← fold <$> forM (Map.lookup "out" drv_infos.outputs) (fmap (.states) . \x → getStorePathInfos x)
-      let all_transfers_completed = all (\x → has (gconstructor @"Downloaded") x || has (gconstructor @"Uploaded") x) transfer_states
+    Nothing -> pure collected_parents
+    Just (current_parent, rest_to_scan) -> do
+      drv_infos <- getDerivationInfos current_parent
+      transfer_states <- fold <$> forM (Map.lookup "out" drv_infos.outputs) (fmap (.states) . \x -> getStorePathInfos x)
+      let all_transfers_completed = all (\x -> has (gconstructor @"Downloaded") x || has (gconstructor @"Uploaded") x) transfer_states
           is_irrelevant = all_transfers_completed && has (gconstructor @"Unknown") drv_infos.buildStatus || has (gconstructor @"Built") drv_infos.buildStatus
           proceed = collect_parents no_irrelevant
       if is_irrelevant && no_irrelevant
         then proceed collected_parents rest_to_scan
         else proceed (CSet.insert current_parent collected_parents) (CSet.union (CSet.difference drv_infos.derivationParents collected_parents) rest_to_scan)
 
-updateStorePathStates ∷ StorePathState → Maybe (StorePathState → StorePathState) → Set StorePathState → Set StorePathState
+updateStorePathStates :: StorePathState -> Maybe (StorePathState -> StorePathState) -> Set StorePathState -> Set StorePathState
 updateStorePathStates new_state update_state =
   Set.insert new_state
     . localFilter
     . ( case update_state of
-          Just update_func → Set.fromList . fmap update_func . Set.toList
-          Nothing → id
+          Just update_func -> Set.fromList . fmap update_func . Set.toList
+          Nothing -> id
       )
  where
   localFilter = case new_state of
-    DownloadPlanned → id
-    State.Downloading _ → Set.filter (DownloadPlanned /=)
-    Downloaded _ → Set.filter (DownloadPlanned /=) -- We don‘t need to filter downloading state because that has already been handled by the update_state function
-    State.Uploading _ → id
-    Uploaded _ → id -- Analogous to downloaded
+    DownloadPlanned -> id
+    State.Downloading _ -> Set.filter (DownloadPlanned /=)
+    Downloaded _ -> Set.filter (DownloadPlanned /=) -- We don‘t need to filter downloading state because that has already been handled by the update_state function
+    State.Uploading _ -> id
+    Uploaded _ -> id -- Analogous to downloaded
 
-insertStorePathState ∷ StorePathId → StorePathState → Maybe (StorePathState → StorePathState) → NOMState ()
+insertStorePathState :: StorePathId -> StorePathState -> Maybe (StorePathState -> StorePathState) -> NOMState ()
 insertStorePathState storePathId new_store_path_state update_store_path_state = do
   -- Update storePathInfos for this Storepath
-  store_path_info ← getStorePathInfos storePathId
+  store_path_info <- getStorePathInfos storePathId
   let oldStatus = store_path_info.states
       newStatus = updateStorePathStates new_store_path_state update_store_path_state oldStatus
   modify (gfield @"storePathInfos" %~ CMap.adjust (gfield @"states" .~ newStatus) storePathId)
@@ -501,7 +504,7 @@ insertStorePathState storePathId new_store_path_state update_store_path_state =
       clear_summary = clearStorePathsFromSummary oldStatus storePathId
 
   -- Update summaries of all parents
-  updateParents True update_summary clear_summary (maybe id CSet.insert store_path_info.producer store_path_info.inputFor)
+  updateParents True update_summary clear_summary (Strict.maybe id CSet.insert store_path_info.producer store_path_info.inputFor)
 
   -- Update fullSummary
   modify (gfield @"fullSummary" %~ update_summary)

lib/NOM/Update/Monad.hs

@@ -6,36 +6,32 @@ module NOM.Update.Monad (
   module NOM.Update.Monad.CacheBuildReports,
 ) where
 
-import Relude
-
 import Control.Exception (try)
 import Control.Monad.Writer.Strict (WriterT)
-import Data.Text.IO qualified as TextIO
-import System.Directory (doesPathExist)
-
 -- attoparsec
 import Data.Attoparsec.Text (eitherResult, parse)
-
+import Data.Text.IO qualified as TextIO
 -- nix-derivation
-import Nix.Derivation qualified as Nix
 
+import GHC.Clock qualified
 import NOM.Builds (Derivation, StorePath)
 import NOM.Error (NOMError (..))
 import NOM.Update.Monad.CacheBuildReports
-import Streamly.Internal.Data.Time.Clock (getTime)
-import Streamly.Internal.Data.Time.Clock.Type (Clock (Monotonic))
-import Streamly.Internal.Data.Time.Units (AbsTime)
+import Nix.Derivation qualified as Nix
+import Relude
+import System.Directory (doesPathExist)
 
 type UpdateMonad m = (Monad m, MonadNow m, MonadReadDerivation m, MonadCacheBuildReports m, MonadCheckStorePath m)
 
 class Monad m => MonadNow m where
-  getNow :: m AbsTime
+  getNow :: m Double
 
 instance MonadNow IO where
-  getNow = getTime Monotonic
+  getNow = GHC.Clock.getMonotonicTime
 
 instance MonadNow m => MonadNow (StateT a m) where
   getNow = lift getNow
+
 instance (Monoid a, MonadNow m) => MonadNow (WriterT a m) where
   getNow = lift getNow
 
@@ -54,8 +50,10 @@ instance MonadReadDerivation IO where
 
 instance MonadReadDerivation m => MonadReadDerivation (StateT a m) where
   getDerivation = lift . getDerivation
+
 instance MonadReadDerivation m => MonadReadDerivation (ExceptT a m) where
   getDerivation = lift . getDerivation
+
 instance (Monoid a, MonadReadDerivation m) => MonadReadDerivation (WriterT a m) where
   getDerivation = lift . getDerivation
 
@@ -64,7 +62,9 @@ class Monad m => MonadCheckStorePath m where
 
 instance MonadCheckStorePath IO where
   storePathExists = doesPathExist . toString
+
 instance MonadCheckStorePath m => MonadCheckStorePath (StateT a m) where
   storePathExists = lift . storePathExists
+
 instance (Monoid a, MonadCheckStorePath m) => MonadCheckStorePath (WriterT a m) where
   storePathExists = lift . storePathExists

lib/NOM/Update/Monad/CacheBuildReports.hs

@@ -6,23 +6,21 @@ module NOM.Update.Monad.CacheBuildReports (
   BuildReportMap,
 ) where
 
-import Relude
-
 import Control.Exception (IOException, catch)
 import Control.Monad.Writer.Strict (WriterT)
-import Data.Map.Strict qualified as Map
-import System.Directory (XdgDirectory (XdgCache), createDirectoryIfMissing, getXdgDirectory, removeFile)
-
 -- cassava
 import Data.Csv (FromRecord, HasHeader (NoHeader), ToRecord, decode, encode)
-
 -- data-default
 import Data.Default (def)
-
+import Data.Map.Strict qualified as Map
 -- filepath
-import System.FilePath ((</>))
 
 -- lock-file
+
+import NOM.Builds (Host (..))
+import Relude
+import System.Directory (XdgDirectory (XdgCache), createDirectoryIfMissing, getXdgDirectory, removeFile)
+import System.FilePath ((</>))
 import System.IO.LockFile (
   LockingException (CaughtIOException, UnableToAcquireLockFile),
   LockingParameters (retryToAcquireLock, sleepBetweenRetries),
@@ -31,8 +29,6 @@ import System.IO.LockFile (
   withLockFile,
  )
 
-import NOM.Builds (Host (..))
-
 -- Exposed functions
 
 class Monad m => MonadCacheBuildReports m where
@@ -58,6 +54,7 @@ instance MonadCacheBuildReports IO where
 instance MonadCacheBuildReports m => MonadCacheBuildReports (StateT a m) where
   getCachedBuildReports = lift getCachedBuildReports
   updateBuildReports = lift . updateBuildReports
+
 instance (Monoid a, MonadCacheBuildReports m) => MonadCacheBuildReports (WriterT a m) where
   getCachedBuildReports = lift getCachedBuildReports
   updateBuildReports = lift . updateBuildReports
@@ -75,7 +72,7 @@ tryUpdateBuildReports updateFunc = do
 
 updateBuildReportsUnlocked :: (BuildReportMap -> BuildReportMap) -> FilePath -> IO BuildReportMap
 updateBuildReportsUnlocked updateFunc dir = do
-  !reports <- updateFunc <$> loadBuildReports dir
+  reports <- updateFunc <$> loadBuildReports dir
   reports <$ saveBuildReports dir reports
 
 memptyOnLockFail :: Monoid b => LockingException -> IO b

lib/NOM/Util.hs

@@ -1,15 +1,9 @@
-module NOM.Util (foldMapEndo, forMaybeM, diffTime, relTimeToSeconds) where
+module NOM.Util (foldMapEndo, forMaybeM) where
 
-import Data.Time (NominalDiffTime)
 import Relude
-import Streamly.Internal.Data.Time.Units (AbsTime, MilliSecond64 (..), RelTime, diffAbsTime, fromRelTime)
 
 foldMapEndo :: Foldable f => (b -> a -> a) -> f b -> a -> a
 foldMapEndo f = appEndo . foldMap (Endo . f)
 
 forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]
 forMaybeM = flip mapMaybeM
-
-relTimeToSeconds :: RelTime -> NominalDiffTime
-relTimeToSeconds rel_time = case fromRelTime rel_time of
-  MilliSecond64 milli_sec -> fromInteger $ toInteger milli_sec `div` 1000

nix-output-monitor.cabal

@@ -69,6 +69,8 @@ common common-config
     , safe
     , stm
     , streamly
+    , strict
+    , strict-types
     , terminal-size
     , text
     , time
@@ -87,6 +89,7 @@ library
   import:          common-config
   hs-source-dirs:  lib
   exposed-modules:
+    Data.Sequence.Strict
     NOM.Builds
     NOM.Error
     NOM.IO

test/Golden.hs

@@ -1,22 +1,7 @@
 module Main (main) where
 
-import Relude
-
-import Data.Text qualified as Text
-import System.Environment qualified
-import System.Process (readProcessWithExitCode)
-import System.Random (randomIO)
-import Test.HUnit (
-  Counts (errors, failures),
-  Test,
-  Testable (test),
-  assertBool,
-  assertEqual,
-  runTestTT,
-  (~:),
- )
-
 import Control.Monad.Writer.Strict (WriterT (runWriterT))
+import Data.Text qualified as Text
 import NOM.Builds (parseStorePath)
 import NOM.IO (processTextStream)
 import NOM.IO.ParseStream.Attoparsec (parseStreamAttoparsec)
@@ -39,6 +24,19 @@ import NOM.Update (
  )
 import NOM.Update.Monad (UpdateMonad)
 import NOM.Util (forMaybeM)
+import Relude
+import System.Environment qualified
+import System.Process (readProcessWithExitCode)
+import System.Random (randomIO)
+import Test.HUnit (
+  Counts (errors, failures),
+  Test,
+  Testable (test),
+  assertBool,
+  assertEqual,
+  runTestTT,
+  (~:),
+ )
 
 tests :: [Bool -> Test]
 tests = [golden1]

test/Property.hs

@@ -1,13 +1,11 @@
-import Relude
-import Relude.Unsafe qualified as Unsafe
-
 import Data.Attoparsec.ByteString (IResult (Done), parse)
 import Data.Set (singleton)
-import Test.HUnit
-
 import NOM.Builds
 import NOM.NixMessage.OldStyle (NixOldStyleMessage (..))
 import NOM.Parser
+import Relude
+import Relude.Unsafe qualified as Unsafe
+import Test.HUnit
 
 assertOldStyleParse :: ByteString -> IO (ByteString, NixOldStyleMessage)
 assertOldStyleParse input = do