Log missing deps on update.hs without Debug.Trace
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user