Refactor for ghc 9.0 compat

.hlint.yaml

@@ -0,0 +1,2 @@
+ - ignore: {name: Avoid lambda}
+ - ignore: {name: Avoid lambda using `infix`}

flake.lock

@@ -48,11 +48,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1646254136,
-        "narHash": "sha256-8nQx02tTzgYO21BP/dy5BCRopE8OwE8Drsw98j+Qoaw=",
+        "lastModified": 1647297614,
+        "narHash": "sha256-ulGq3W5XsrBMU/u5k9d4oPy65pQTkunR4HKKtTq0RwY=",
         "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "3e072546ea98db00c2364b81491b893673267827",
+        "rev": "73ad5f9e147c0d2a2061f1d4bd91e05078dc0b58",
         "type": "github"
       },
       "original": {

flake.nix

@@ -55,7 +55,7 @@
         };
         devShell = haskellPackages.shellFor {
           packages = _: [defaultPackage];
-          buildInputs = [inputs.pre-commit-hooks.defaultPackage.${system}];
+          buildInputs = [inputs.pre-commit-hooks.defaultPackage.${system} haskellPackages.haskell-language-server];
           withHoogle = true;
           inherit (self.checks.${system}.pre-commit-check) shellHook;
         };

lib/NOM/IO.hs

@@ -8,7 +8,7 @@ import Control.Concurrent.STM (check, modifyTVar, swapTVar)
 import Control.Exception (IOException, try)
 import qualified Data.Text as Text
 import Data.Time (ZonedTime, getZonedTime)
-import System.IO (hFlush)
+import qualified System.IO
 
 import Streamly (SerialT) -- Keep this import for streamly < 0.8 compat
 import qualified Streamly.Data.Fold as FL
@@ -42,7 +42,7 @@ parseStream (parse -> parseFresh) = S.concatMap snd . S.scanl' step (Nothing, me
     Stream update ->
     Result update ->
     (Maybe (Text -> Result update), Stream update)
-  process = \parseRest acc -> \case
+  process parseRest acc = \case
     Done "" result -> (Nothing, acc <> pure result)
     Done rest result -> parseRest (acc <> pure result) (parseFresh rest)
     Fail{} -> (Nothing, acc)
@@ -107,7 +107,7 @@ writeStateToScreen linesVar stateVar bufferVar maintenance printer = do
   -- Write new output to screen.
   ByteString.putStr buffer
   when (linesToWrite > 0) $ putTextLn output
-  hFlush stdout
+  System.IO.hFlush stdout
 
 interact ::
   forall update state.

lib/NOM/Print.hs

@@ -255,7 +255,7 @@ printBuilds nomState@MkNOMV1State{..} maxHeight = printBuildsWithTime
     _ -> pass
 
   get' :: NOMState b -> b
-  get' = flip evalState nomState
+  get' procedure = evalState procedure nomState
 
   showSummary :: DependencySummary -> Text
   showSummary MkDependencySummary{..} =

lib/NOM/State.hs

@@ -20,7 +20,7 @@ import NOM.Update.Monad (
   MonadNow,
   getNow,
  )
-import NOM.Util (foldMapEndo, (.>), (<.>>), (<|>>), (|>))
+import NOM.Util (foldMapEndo, (.>), (<|>>), (|>))
 
 data StorePathState = DownloadPlanned | Downloading Host | Uploading Host | Downloaded Host | Uploaded Host
   deriving stock (Show, Eq, Ord, Read, Generic)
@@ -147,10 +147,10 @@ getRunningBuildsByHost :: Host -> NOMState (DerivationMap RunningBuildInfo)
 getRunningBuildsByHost host = getRunningBuilds <|>> CMap.filter (buildHost .> (== host))
 
 lookupStorePathId :: StorePathId -> NOMState StorePath
-lookupStorePathId = getStorePathInfos <.>> storePathName
+lookupStorePathId pathId = getStorePathInfos pathId <|>> storePathName
 
 lookupDerivationId :: DerivationId -> NOMState Derivation
-lookupDerivationId = getDerivationInfos <.>> derivationName
+lookupDerivationId drvId = getDerivationInfos drvId <|>> derivationName
 
 type NOMState a = forall m. MonadState NOMV1State m => m a
 
@@ -183,7 +183,7 @@ getDerivationId drv = do
 drv2out :: DerivationId -> NOMState (Maybe StorePath)
 drv2out drv =
   gets (derivationInfos .> CMap.lookup drv >=> outputs .> Map.lookup "out")
-    >>= mapM lookupStorePathId
+    >>= mapM (\pathId -> lookupStorePathId pathId)
 
 out2drv :: StorePathId -> NOMState (Maybe DerivationId)
 out2drv path = gets (storePathInfos .> CMap.lookup path >=> storePathProducer)

lib/NOM/State/Sorting.hs

@@ -40,7 +40,7 @@ sortDepsOfSet parents = do
 
       sort_key :: DerivationId -> SortKey
       sort_key = memo (sortKey currentState)
-  parents |> CSet.toList .> mapM_ sort_parent
+  parents |> CSet.toList .> mapM_ \drvId -> sort_parent drvId
 
 -- We order by type and disambiguate by the number of a) waiting builds, b) running builds
 type SortKey =

lib/NOM/Update.hs

@@ -69,7 +69,9 @@ updateState result (inputAccessTime, inputState) = do
             [ -- First check if we this is the first time that we receive input (for error messages)
               setInputReceived
             , -- Update the state if any changes where parsed.
-              maybe (pure False) processResult result
+              case result of
+                Just result' -> processResult result'
+                Nothing -> pure False
             , -- Check if any local builds have finished, because nix-build would not tell us.
               -- If we haven‘t done so in the last 200ms.
               check
@@ -98,29 +100,31 @@ processResult result = do
       noChange = pure False
   now <- getNow
   case result of
-    Parser.Uploading path host ->
-      withChange $
-        getStorePathId path >>= uploaded host
-    Parser.Downloading path host ->
-      withChange $
-        getStorePathId path
-          >>= downloaded host
-          >>= maybeToList
-          .> finishBuilds host
+    Parser.Uploading path host -> withChange do
+      pathId <- getStorePathId path
+      uploaded host pathId
+    Parser.Downloading path host -> withChange do
+      pathId <- getStorePathId path
+      finishedRemoteBuild <- downloaded host pathId
+      whenJust finishedRemoteBuild \build -> finishBuilds host [build]
     PlanCopies _ -> noChange
     Build drv host -> withChange do
-      lookupDerivation drv >>= flip (building host) now
+      drvId <- lookupDerivation drv
+      building host drvId now
     PlanBuilds plannedBuilds _lastBuild -> withChange do
-      mapM lookupDerivation (toList plannedBuilds) >>= fromList .> planBuilds
-    PlanDownloads _download _unpacked plannedDownloads ->
-      withChange $
-        mapM getStorePathId (toList plannedDownloads) >>= fromList .> planDownloads
-    Checking drv ->
-      withChange $
-        lookupDerivation drv >>= flip (building Localhost) now
-    Parser.Failed drv code ->
-      withChange $
-        lookupDerivation drv >>= flip (failedBuild now) code
+      plannedDrvIds <- forM (toList plannedBuilds) \drv ->
+        lookupDerivation drv
+      planBuilds (fromList plannedDrvIds)
+    PlanDownloads _download _unpacked plannedDownloads -> withChange do
+      plannedDownloadIds <- forM (toList plannedDownloads) \path ->
+        getStorePathId path
+      planDownloads (fromList plannedDownloadIds)
+    Checking drv -> withChange do
+      drvId <- lookupDerivation drv
+      building Localhost drvId now
+    Parser.Failed drv code -> withChange do
+      drvId <- lookupDerivation drv
+      failedBuild now drvId code
 
 movingAverage :: Double
 movingAverage = 0.5
@@ -164,8 +168,8 @@ lookupDerivation :: MonadReadDerivation m => Derivation -> NOMStateT m Derivatio
 lookupDerivation drv = do
   drvId <- getDerivationId drv
   isCached <- gets (derivationInfos .> CMap.lookup drvId .> maybe False cached)
-  unless isCached $
-    either reportError pure =<< runExceptT do
+  unless isCached do
+    potentialError <- runExceptT do
       parsedDerivation <- getDerivation drv >>= liftEither
       outputs <-
         Nix.outputs parsedDerivation |> Map.traverseMaybeWithKey \_ path -> do
@@ -194,6 +198,7 @@ lookupDerivation drv = do
       modify (field @"derivationInfos" %~ CMap.adjust (\i -> i{outputs, inputSources, inputDerivations, cached = True}) drvId)
       noParents <- getDerivationInfos drvId <|>> derivationParents .> CSet.null
       when noParents $ modify (field @"forestRoots" %~ (drvId Seq.<|))
+    whenLeft_ potentialError \error' -> reportError error'
   pure drvId
 
 parseStorePath :: FilePath -> Maybe StorePath
@@ -203,10 +208,12 @@ parseDerivation :: FilePath -> Maybe Derivation
 parseDerivation = hush . parseOnly (Parser.derivation <* endOfInput) . fromString
 
 planBuilds :: Set DerivationId -> NOMState ()
-planBuilds = mapM_ \drv -> updateDerivationState drv (const Planned)
+planBuilds drvIds = forM_ drvIds \drvId ->
+  updateDerivationState drvId (const Planned)
 
 planDownloads :: Set StorePathId -> NOMState ()
-planDownloads = mapM_ (`insertStorePathState` DownloadPlanned)
+planDownloads pathIds = forM_ pathIds \pathId ->
+  insertStorePathState pathId DownloadPlanned
 
 downloaded :: Host -> StorePathId -> NOMState (Maybe (DerivationId, RunningBuildInfo))
 downloaded host pathId = do
@@ -217,7 +224,7 @@ downloaded host pathId = do
     MaybeT (pure (preview (typed @BuildStatus % _As @"Building") drvInfos <|>> (drvId,)))
 
 uploaded :: Host -> StorePathId -> NOMState ()
-uploaded host = flip insertStorePathState (Uploaded host)
+uploaded host pathId = insertStorePathState pathId (Uploaded host)
 
 building :: Host -> DerivationId -> UTCTime -> NOMState ()
 building host drv now = do
@@ -244,6 +251,7 @@ updateDerivationState drvId updateStatus = do
 updateParents :: (DependencySummary -> DependencySummary) -> DerivationSet -> NOMState ()
 updateParents update_func = go mempty
  where
+  go :: DerivationSet -> DerivationSet -> NOMState ()
   go updated_parents parentsToUpdate = case CSet.maxView parentsToUpdate of
     Nothing -> modify (field @"touchedIds" %~ CSet.union updated_parents)
     Just (parentToUpdate, restToUpdate) -> do

test/Golden.hs

@@ -3,7 +3,7 @@ module Main where
 import Relude
 
 import qualified Data.String as String
-import System.Environment (lookupEnv)
+import qualified System.Environment
 import System.Process (readProcessWithExitCode)
 import System.Random (randomIO)
 import Test.HUnit (
@@ -45,7 +45,7 @@ label withNix name = name <> if withNix then " with nix" else " with log from fi
 
 main :: IO ()
 main = do
-  withNix <- isNothing <$> lookupEnv "TESTS_FROM_FILE"
+  withNix <- isNothing <$> System.Environment.lookupEnv "TESTS_FROM_FILE"
   counts <- runTestTT $
     test $ do
       test' <- tests
@@ -94,7 +94,8 @@ golden1 = testBuild "golden1" $ \output endState@MkNOMV1State{fullSummary = MkDe
   let outputDerivations :: [DerivationId]
       outputDerivations =
         flip evalState endState $
-          forMaybeM outputStorePaths $
-            getStorePathId >=> out2drv
+          forMaybeM outputStorePaths \path -> do
+            pathId <- getStorePathId path
+            out2drv pathId
   assertEqual "Derivations for all outputs have been found" noOfBuilds (length outputDerivations)
   assertBool "All found derivations have successfully been built" (CSet.isSubsetOf (CSet.fromFoldable outputDerivations) (CMap.keysSet completedBuilds))