varcila/jungle
1
0
Fork 0
forked from rarias/jungle
Code Pull Requests Activity

Add error handling to oneapi update script

Browse Source 
Reviewed-by: Rodrigo Arias Mallo <rodrigo.arias@bsc.es>
This commit is contained in:
Aleix Boné
2026-03-21 16:34:40 +01:00
parent f15b272c41
commit 9f9f7b0d6e
1 changed files with 126 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

213
pkgs/intel-oneapi/deb/update.hs
View File

@@ -1,30 +1,32 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main (main) where module Main (main) where
import Control.Arrow (second, (&&&)) import Control.Arrow (second, (&&&))
import Control.Monad (when)
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
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as TIO import qualified Data.Text.IO as TIO
import Data.Char (isAlpha, isNumber) import Data.Char (isAlpha)
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 (catMaybes, maybeToList) import Data.Maybe (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, traceShow) import Debug.Trace (trace)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (stderr) import System.IO (stderr)
import Text.Printf (PrintfType, hPrintf, printf) import Text.Printf (hPrintf, printf)
type Str = T.Text type Str = T.Text
type Data = Map Str [Package] type Data = Map Str [Package]
type Version = [Int] type Version = [Int]
type Err a = Either Str a
data Package = Package data Package = Package
{ name :: Str { name :: Str
@@ -41,67 +43,90 @@ data Dependency = Dependency
} }
deriving (Show, Eq) deriving (Show, Eq)
data Kit = Kit
{ kitMajorVersion, kitFullVersion :: Version
, kitPackages :: [Package]
}
deriving (Show, Eq)
-- Standard Ordering cannot represent GE or LE, we have to cook our own -- Standard Ordering cannot represent GE or LE, we have to cook our own
data Ordering' = GT' | LT' | EQ' | GE' | LE' deriving (Show, Eq) data Ordering' = GT' | LT' | EQ' | GE' | LE' deriving (Show, Eq)
-- PARSING -- PARSING
parse :: Str -> Data parse :: Str -> Err Data
parse = parse =
M.map (sortOn (Down . version)) fmap (M.map (sortOn (Down . version)) . M.fromListWith (++) . fmap (second pure))
. M.fromListWith (++) . mapM parsePackage
. fmap (second pure) . ( init
. catMaybes . fmap
. fmap ( M.fromList
( (parsePackage . M.fromList) . ( fmap (second (T.strip . T.drop 1) . T.breakOn ":")
. fmap (second (T.strip . T.drop 1) . T.breakOn ":") . T.lines
. T.lines . T.strip
. T.strip )
) )
. T.splitOn "\n\n" . T.splitOn "\n\n"
)
parseDependency :: Str -> Dependency parseDependency :: Str -> Err Dependency
parseDependency t = case (T.words t) of parseDependency t = case (T.breakOn "(" t) of
(a : b : c : []) -> mkPkg a b c (a, "") -> Right $ Dependency (T.strip a) Nothing
(a : c : []) -> let (a', b) = T.breakOn "(" a in mkPkg a' b c -- workaround for packages that don't have a space between the name and the version parenthesis (a, b) -> do
(a : []) -> Dependency a Nothing let (o, v) = T.span (`elem` ("<=>" :: String)) $ T.tail b
(b) -> traceShow b $ undefined o' <- toOrd' o
v' <- parseVersion . T.strip $ T.dropEnd 1 v
return . Dependency (T.strip a) $ Just (o', v')
where where
mkPkg a b c = Dependency a (Just ((toOrd' $ T.drop 1 b), (parseVersion $ T.dropEnd 1 c))) toOrd' :: Str -> Err Ordering'
toOrd' ">>" = Right GT'
toOrd' :: Str -> Ordering' toOrd' "<<" = Right LT'
toOrd' ">>" = GT' toOrd' "=" = Right EQ'
toOrd' "<<" = LT' toOrd' ">=" = Right GE'
toOrd' "=" = EQ' toOrd' "<=" = Right LE'
toOrd' ">=" = GE' toOrd' r = Left $ T.unwords ["could not parse dependency", quote t, "(unknown constraint type", quote r <> ")"]
toOrd' "<=" = LE'
toOrd' t = traceShow t $ undefined
dropEmpty :: [Str] -> [Str] dropEmpty :: [Str] -> [Str]
dropEmpty = Prelude.filter (not . T.null) dropEmpty = filter (not . T.null)
parseVersion :: Str -> Version tshow :: (Show a) => a -> Str
parseVersion = fmap (unwrapEither . decimal) . dropEmpty . T.split (not . isNumber) tshow = T.pack . show
quote :: Str -> Str
quote = ("\"" <>) . (<> "\"")
parseVersion :: Str -> Err Version
parseVersion = (>>= validateVersion) . mapM (unwrapDecimal . decimal) . dropEmpty . T.split (`elem` ("-._~" :: String))
where where
unwrapEither (Right (a, "")) = a unwrapDecimal (Left err) = Left . T.pack $ "version parsing failed with error: " <> err
-- should never fail, since we filtered non numbers for the split and removed empty strings unwrapDecimal (Right (a, "")) = Right a
unwrapEither (Left err) = trace err $ undefined unwrapDecimal (Right (a, b)) =
unwrapEither (Right (_, b)) = trace (T.unpack b) $ undefined Left $ T.unwords ["version parsing failed, parsed", quote $ tshow a, "(leftover:", quote b <> ")"]
parsePackage :: Map Str Str -> Maybe (Str, Package) validateVersion [] = Left "version is empty"
validateVersion v = Right v
parsePackage :: Map Str Str -> Err (Str, Package)
parsePackage d = parsePackage d =
(,) (,)
<$> package <$> package
<*> ( Package <*> ( Package
<$> package <$> package
<*> (parseVersion <$> d M.!? "Version") <*> (d !? "Version" >>= parseVersion)
<*> (d M.!? "Filename") <*> (d !? "Filename")
<*> (d M.!? "SHA256") <*> (d !? "SHA256")
<*> (read . T.unpack <$> (d M.!? "Installed-Size")) <*> (read . T.unpack <$> (d !? "Installed-Size"))
<*> (pure $ fmap parseDependency $ dropEmpty $ (>>= T.splitOn ",") $ maybeToList $ d M.!? "Depends") <*> (mapM parseDependency . dropEmpty . (>>= T.splitOn ",") . maybeToList $ d M.!? "Depends")
) )
where where
package = d M.!? "Package" package = d !? "Package"
(!?) :: (Show a) => Map Str a -> Str -> Err a
m !? k = maybeToEither ("missing key " <> quote k <> " in:\n" <> tshow m) $ m M.!? k
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither _ (Just b) = Right b
maybeToEither a Nothing = Left a
-- DEPENDENCY SOLVER -- DEPENDENCY SOLVER
@@ -125,7 +150,8 @@ compareVersions :: Maybe (Ordering', Version) -> Version -> Bool
compareVersions Nothing _ = True compareVersions Nothing _ = True
compareVersions (Just (kind, want)) got compareVersions (Just (kind, want)) got
| null want = True | null want = True
| kind == GE' = and (Prelude.take 2 $ zipWith (==) got want) && result | kind == GE' = and (take 2 $ zipWith (==) got want) && result
| kind == EQ' = and $ zipWith (==) want got -- Only compare up to the smallest list
| otherwise = result | otherwise = result
where where
result = matches (compare got want) kind result = matches (compare got want) kind
@@ -136,32 +162,39 @@ compareVersions (Just (kind, want)) got
matches GT b = b `elem` [GT', GE'] matches GT b = b `elem` [GT', GE']
findMatching :: Data -> Dependency -> Maybe Package findMatching :: Data -> Dependency -> Maybe Package
findMatching pkgList (Dependency name ver) = pkgList M.!? name >>= find (compareVersions (ver) . version) findMatching pkgList (Dependency n v) = pkgList M.!? n >>= find (compareVersions v . version)
getHpckit :: Data -> Version -> Maybe Package findMatchingTraced :: Data -> Dependency -> [Package]
getHpckit d v = findMatching d (Dependency "intel-hpckit" (Just (GE', v))) 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]
-- TODO: replace maybeToList with proper error handling. Right now, if a
-- dependency is not found it is silently skipped.
solveDeps :: Data -> Package -> [Package] solveDeps :: Data -> Package -> [Package]
solveDeps d p = removeDupes $ go ([], [p]) solveDeps d p = removeDupes $ go [] [p]
where where
go (done, todo) go done todo
| null todo = done' | null todo = done'
| otherwise = go (done', todo') | otherwise = go done' todo'
where where
done' = filter (not . isBlacklisted) $ nub $ done ++ (filter isMetaPackage todo) done' = filter (not . isBlacklisted) . nub $ done ++ (filter (not . isMetaPackage) todo)
todo' = concatMap depends todo >>= maybeToList . findMatching d todo' = todo >>= depends >>= findMatchingTraced d
isMetaPackage = ((/= 0) . size) -- Packages with size 0 isMetaPackage = ((== 0) . size) -- Meta Packages are only used to pull dependencies
removeDupes :: [Package] -> [Package] removeDupes :: [Package] -> [Package]
removeDupes l = fmap snd . MS.toList $ MS.fromListWith (getLatest) $ (cleanName . name &&& id) <$> l removeDupes = fmap snd . MS.toList . MS.fromListWith getLatest . fmap (cleanName . name &&& id)
getLatest a b getLatest a b
| version a > version b = a | version a > version b = a
| otherwise = b | otherwise = b
-- Remove trailing version information from package name -- Remove trailing version information from package name
cleanName :: T.Text -> T.Text cleanName :: Str -> Str
cleanName = T.dropWhileEnd (not . isAlpha) cleanName = T.dropWhileEnd (not . isAlpha)
isBlacklisted :: Package -> Bool isBlacklisted :: Package -> Bool
@@ -189,36 +222,42 @@ isBlacklisted = (`elem` blacklist) . cleanName . name
, "intel-oneapi-vtune-eclipse-plugin-vtune" , "intel-oneapi-vtune-eclipse-plugin-vtune"
] ]
application :: [String] -> Str -> Err [Kit]
application args contents = do
v <- mapM (parseVersion . T.pack) $ case args of
[] -> ["2025"]
_ -> args
d <- parse contents
mapM (processKit d) v
processKit :: Data -> Version -> Err Kit
processKit d v = do
kit <- findHpckit "intel-hpckit"
return $ Kit v (version kit) (solveDeps d kit)
where
findHpckit pName =
maybeToEither (T.unwords ["package not found:", pName, "=", showVer v]) $
findMatching d (Dependency pName (Just (EQ', v)))
-- OUTPUT -- OUTPUT
showVer, showVerDash :: [Int] -> T.Text showVer, showVerDash :: [Int] -> Str
showVer = T.dropEnd 1 . T.concat . zipWith (flip (<>)) ([".", ".", "-"] ++ repeat ".") . fmap (T.pack . show) showVer = T.dropEnd 1 . T.concat . zipWith (flip (<>)) ([".", ".", "-"] ++ repeat ".") . fmap tshow
showVerDash = T.intercalate "-" . fmap (T.pack . show) showVerDash = T.intercalate "-" . fmap tshow
displayTOML :: (PrintfType t) => Version -> Package -> t -- Reads Debian Package List from apt repo from stdin and outputs TOML with
displayTOML kit (Package n v f h _ _) = printf "[[hpckit-%s]]\nname=\"%s\"\nversion=\"%s\"\nfile=\"%s\"\nsha256=\"%s\"\n\n" (showVerDash kit) (cleanName n) (showVer v) f h
-- Reads debian Package List from apt repo from stdin and outputs TOML with
-- hpckit versions passed as arguments -- hpckit versions passed as arguments
main :: IO () main :: IO ()
main = do main =
args <- fmap T.pack <$> getArgs application <$> getArgs <*> TIO.getContents >>= \case
Left err -> hPrintf stderr "[ERROR]: %s\n" err *> exitFailure
let v = case args of Right l -> mapM_ (TIO.putStrLn) $ l >>= formatKit
[] -> ["2025"]
_ -> args
d <- parse <$> TIO.getContents
mapM_ (processHpcKit d . parseVersion) v
where where
processHpcKit :: Data -> Version -> IO () formatKit (Kit majorVer fullVer pkgs) =
processHpcKit d v = T.pack
case (getHpckit d v) of <$> (printf "[meta.hpckit-%s]\nversion=%s\n" (showVerDash majorVer) (quote $ showVer fullVer))
Nothing -> hPrintf stderr "[WARN]: Could not find hpckit with version %s [SKIPPED]\n" (show v) : ((formatPackage) <$> pkgs)
(Just kit) -> do where
-- Save resolved hpckit version information formatPackage (Package n v f h _ _) =
printf "[meta.hpckit-%s]\nversion=\"%s\"\n\n" (showVerDash v) (showVer $ version kit) printf "[[hpckit-%s]]\nname=%s\nversion=%s\nfile=%s\nsha256=%s\n" (showVerDash majorVer) (quote $ cleanName n) (quote $ showVer v) (quote f) (quote h)
let deps = solveDeps d kit
when (null deps) $ hPrintf stderr "[WARN]: Empty hpckit? (hpckit-%s)\n" (show v)
mapM_ (displayTOML v) deps