Log missing deps on update.hs without Debug.Trace
All checks were successful
CI / build:cross (pull_request) Successful in 8s
CI / build:all (pull_request) Successful in 33s

This commit is contained in:
2026-03-22 20:43:02 +01:00
parent 3497618923
commit c475151b7a

View File

@@ -3,7 +3,8 @@
module Main (main) where
import Control.Arrow (second, (&&&))
import Control.Arrow (first, second, (&&&))
import Control.Monad.Writer
import qualified Data.Map.Lazy as M
import qualified Data.Map.Strict as MS
@@ -11,13 +12,13 @@ import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Char (isAlpha)
import Data.Functor (($>))
import Data.List (find, nub, sortOn)
import Data.Map.Lazy (Map)
import Data.Maybe (maybeToList)
import Data.Maybe (catMaybes, maybeToList)
import Data.Ord (Down (Down))
import Data.Text.Read (decimal)
import Debug.Trace (trace)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (stderr)
@@ -164,28 +165,22 @@ compareVersions (Just (kind, want)) got
findMatching :: Data -> Dependency -> Maybe Package
findMatching pkgList (Dependency n v) = pkgList M.!? n >>= find (compareVersions v . version)
findMatchingTraced :: Data -> Dependency -> [Package]
findMatchingTraced l d@(Dependency n v) = case findMatching l d of
Nothing ->
trace
( unwords $
["[WARN]: dependency:", T.unpack n]
++ (case v of Nothing -> []; Just v' -> [show v'])
++ ["not found"]
)
[]
Just a -> [a]
findMatchingTraced :: Data -> Dependency -> Writer [Dependency] (Maybe Package)
findMatchingTraced l d = case findMatching l d of
Nothing -> tell [d] $> Nothing
Just a -> pure $ Just a
solveDeps :: Data -> Package -> [Package]
solveDeps d p = removeDupes $ go [] [p]
solveDeps :: Data -> Package -> ([Package], [Dependency])
solveDeps d p = first removeDupes $ runWriter $ go [] [p]
where
go done todo
| null todo = done'
| otherwise = go done' todo'
where
done' = filter (not . isBlacklisted) . nub $ done ++ (filter (not . isMetaPackage) todo)
todo' = todo >>= depends >>= findMatchingTraced d
isMetaPackage = ((== 0) . size) -- Meta Packages are only used to pull dependencies
go :: [Package] -> [Package] -> Writer [Dependency] [Package]
go done [] = pure done
go done todo = do
let done' = filter (not . isBlacklisted) . nub $ done ++ (filter (not . isMetaPackage) todo)
todo' <- catMaybes <$> mapM (findMatchingTraced d) (todo >>= depends)
go done' todo'
isMetaPackage = ((== 0) . size) -- Meta Packages are only used to pull dependencies
removeDupes :: [Package] -> [Package]
removeDupes = fmap snd . MS.toList . MS.fromListWith getLatest . fmap (cleanName . name &&& id)
@@ -222,19 +217,20 @@ isBlacklisted = (`elem` blacklist) . cleanName . name
, "intel-oneapi-vtune-eclipse-plugin-vtune"
]
application :: [String] -> Str -> Err [Kit]
application :: [String] -> Str -> Err ([Dependency], [Kit])
application args contents = do
v <- mapM (parseVersion . T.pack) $ case args of
[] -> ["2025"]
_ -> args
d <- parse contents
mapM (processKit d) v
first concat . unzip <$> mapM (processKit d) v
processKit :: Data -> Version -> Err Kit
processKit :: Data -> Version -> Err ([Dependency], Kit)
processKit d v = do
kit <- findHpckit "intel-hpckit"
return $ Kit v (version kit) (solveDeps d kit)
let (deps, missing) = solveDeps d kit
return $ (missing, Kit v (version kit) deps)
where
findHpckit pName =
maybeToEither (T.unwords ["package not found:", pName, "=", showVer v]) $
@@ -252,7 +248,9 @@ main :: IO ()
main =
application <$> getArgs <*> TIO.getContents >>= \case
Left err -> hPrintf stderr "[ERROR]: %s\n" err *> exitFailure
Right l -> mapM_ (TIO.putStrLn) $ l >>= formatKit
Right (missing, kits) -> do
mapM_ (hPrintf stderr "[WARN] missing dependency: %s\n" . show) $ nub missing
mapM_ (TIO.putStrLn) $ kits >>= formatKit
where
formatKit (Kit majorVer fullVer pkgs) =
T.pack