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