forked from rarias/jungle
Log missing deps on update.hs without Debug.Trace
This commit is contained in:
@@ -3,7 +3,8 @@
|
|||||||
|
|
||||||
module Main (main) where
|
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.Lazy as M
|
||||||
import qualified Data.Map.Strict as MS
|
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 qualified Data.Text.IO as TIO
|
||||||
|
|
||||||
import Data.Char (isAlpha)
|
import Data.Char (isAlpha)
|
||||||
|
import Data.Functor (($>))
|
||||||
import Data.List (find, nub, sortOn)
|
import Data.List (find, nub, sortOn)
|
||||||
import Data.Map.Lazy (Map)
|
import Data.Map.Lazy (Map)
|
||||||
import Data.Maybe (maybeToList)
|
import Data.Maybe (catMaybes, maybeToList)
|
||||||
import Data.Ord (Down (Down))
|
import Data.Ord (Down (Down))
|
||||||
import Data.Text.Read (decimal)
|
import Data.Text.Read (decimal)
|
||||||
|
|
||||||
import Debug.Trace (trace)
|
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Exit (exitFailure)
|
import System.Exit (exitFailure)
|
||||||
import System.IO (stderr)
|
import System.IO (stderr)
|
||||||
@@ -164,28 +165,22 @@ compareVersions (Just (kind, want)) got
|
|||||||
findMatching :: Data -> Dependency -> Maybe Package
|
findMatching :: Data -> Dependency -> Maybe Package
|
||||||
findMatching pkgList (Dependency n v) = pkgList M.!? n >>= find (compareVersions v . version)
|
findMatching pkgList (Dependency n v) = pkgList M.!? n >>= find (compareVersions v . version)
|
||||||
|
|
||||||
findMatchingTraced :: Data -> Dependency -> [Package]
|
findMatchingTraced :: Data -> Dependency -> Writer [Dependency] (Maybe Package)
|
||||||
findMatchingTraced l d@(Dependency n v) = case findMatching l d of
|
findMatchingTraced l d = case findMatching l d of
|
||||||
Nothing ->
|
Nothing -> tell [d] $> Nothing
|
||||||
trace
|
Just a -> pure $ Just a
|
||||||
( unwords $
|
|
||||||
["[WARN]: dependency:", T.unpack n]
|
|
||||||
++ (case v of Nothing -> []; Just v' -> [show v'])
|
|
||||||
++ ["not found"]
|
|
||||||
)
|
|
||||||
[]
|
|
||||||
Just a -> [a]
|
|
||||||
|
|
||||||
solveDeps :: Data -> Package -> [Package]
|
solveDeps :: Data -> Package -> ([Package], [Dependency])
|
||||||
solveDeps d p = removeDupes $ go [] [p]
|
solveDeps d p = first removeDupes $ runWriter $ go [] [p]
|
||||||
where
|
where
|
||||||
go done todo
|
go :: [Package] -> [Package] -> Writer [Dependency] [Package]
|
||||||
| null todo = done'
|
go done [] = pure done
|
||||||
| otherwise = go done' todo'
|
go done todo = do
|
||||||
where
|
let done' = filter (not . isBlacklisted) . nub $ done ++ (filter (not . isMetaPackage) todo)
|
||||||
done' = filter (not . isBlacklisted) . nub $ done ++ (filter (not . isMetaPackage) todo)
|
todo' <- catMaybes <$> mapM (findMatchingTraced d) (todo >>= depends)
|
||||||
todo' = todo >>= depends >>= findMatchingTraced d
|
go done' todo'
|
||||||
isMetaPackage = ((== 0) . size) -- Meta Packages are only used to pull dependencies
|
|
||||||
|
isMetaPackage = ((== 0) . size) -- Meta Packages are only used to pull dependencies
|
||||||
removeDupes :: [Package] -> [Package]
|
removeDupes :: [Package] -> [Package]
|
||||||
removeDupes = fmap snd . MS.toList . MS.fromListWith getLatest . fmap (cleanName . name &&& id)
|
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"
|
, "intel-oneapi-vtune-eclipse-plugin-vtune"
|
||||||
]
|
]
|
||||||
|
|
||||||
application :: [String] -> Str -> Err [Kit]
|
application :: [String] -> Str -> Err ([Dependency], [Kit])
|
||||||
application args contents = do
|
application args contents = do
|
||||||
v <- mapM (parseVersion . T.pack) $ case args of
|
v <- mapM (parseVersion . T.pack) $ case args of
|
||||||
[] -> ["2025"]
|
[] -> ["2025"]
|
||||||
_ -> args
|
_ -> args
|
||||||
|
|
||||||
d <- parse contents
|
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
|
processKit d v = do
|
||||||
kit <- findHpckit "intel-hpckit"
|
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
|
where
|
||||||
findHpckit pName =
|
findHpckit pName =
|
||||||
maybeToEither (T.unwords ["package not found:", pName, "=", showVer v]) $
|
maybeToEither (T.unwords ["package not found:", pName, "=", showVer v]) $
|
||||||
@@ -252,7 +248,9 @@ main :: IO ()
|
|||||||
main =
|
main =
|
||||||
application <$> getArgs <*> TIO.getContents >>= \case
|
application <$> getArgs <*> TIO.getContents >>= \case
|
||||||
Left err -> hPrintf stderr "[ERROR]: %s\n" err *> exitFailure
|
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
|
where
|
||||||
formatKit (Kit majorVer fullVer pkgs) =
|
formatKit (Kit majorVer fullVer pkgs) =
|
||||||
T.pack
|
T.pack
|
||||||
|
|||||||
Reference in New Issue
Block a user