diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..0449f0e --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,2 @@ + - ignore: {name: Avoid lambda} + - ignore: {name: Avoid lambda using `infix`} diff --git a/flake.lock b/flake.lock index 58672fc..2b9891d 100644 --- a/flake.lock +++ b/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": { diff --git a/flake.nix b/flake.nix index 44a98c3..9b1b980 100644 --- a/flake.nix +++ b/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; }; diff --git a/lib/NOM/IO.hs b/lib/NOM/IO.hs index 86f9f81..096ee7e 100644 --- a/lib/NOM/IO.hs +++ b/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. diff --git a/lib/NOM/Print.hs b/lib/NOM/Print.hs index 7fedfd3..07ce039 100644 --- a/lib/NOM/Print.hs +++ b/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{..} = diff --git a/lib/NOM/State.hs b/lib/NOM/State.hs index faa845f..14207e1 100644 --- a/lib/NOM/State.hs +++ b/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) diff --git a/lib/NOM/State/Sorting.hs b/lib/NOM/State/Sorting.hs index 7a4f717..c491106 100644 --- a/lib/NOM/State/Sorting.hs +++ b/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 = diff --git a/lib/NOM/Update.hs b/lib/NOM/Update.hs index 1aa9739..26a8451 100644 --- a/lib/NOM/Update.hs +++ b/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 diff --git a/test/Golden.hs b/test/Golden.hs index 41d6faa..daf7900 100644 --- a/test/Golden.hs +++ b/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))