262 lines
8.9 KiB
Haskell
262 lines
8.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main (main) where
|
|
|
|
import Control.Arrow (first, second, (&&&))
|
|
import Control.Monad.Writer
|
|
|
|
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)
|
|
import Data.Functor (($>))
|
|
import Data.List (find, nub, sortOn)
|
|
import Data.Map.Lazy (Map)
|
|
import Data.Maybe (catMaybes, maybeToList)
|
|
import Data.Ord (Down (Down))
|
|
import Data.Text.Read (decimal)
|
|
|
|
import System.Environment (getArgs)
|
|
import System.Exit (exitFailure)
|
|
import System.IO (stderr)
|
|
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
|
|
, version :: Version
|
|
, filename, sha256 :: Str
|
|
, size :: Int
|
|
, depends :: [Dependency]
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
data Dependency = Dependency
|
|
{ pkgName :: Str
|
|
, pkgVersion :: Maybe (Ordering', Version)
|
|
}
|
|
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 -> Err Data
|
|
parse =
|
|
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 -> 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
|
|
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 = filter (not . T.null)
|
|
|
|
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
|
|
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 <> ")"]
|
|
|
|
validateVersion [] = Left "version is empty"
|
|
validateVersion v = Right v
|
|
|
|
parsePackage :: Map Str Str -> Err (Str, Package)
|
|
parsePackage d =
|
|
(,)
|
|
<$> package
|
|
<*> ( Package
|
|
<$> package
|
|
<*> (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 !? "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
|
|
|
|
-- Compare versions in debian control file syntax
|
|
-- See: https://www.debian.org/doc/debian-policy/ch-relationships.html#syntax-of-relationship-fields
|
|
--
|
|
-- NOTE: this is not a proper version comparison
|
|
--
|
|
-- A proper version solver, should aggregate dependencies with the same name
|
|
-- and compute the constraint (e.g. a (>= 2) a (<< 5) -> 2 <= a << 5)
|
|
--
|
|
-- But in the intel repo, there are no such "duplicated" dependencies to specify
|
|
-- upper limits, which leads to issues when intel-hpckit-2021 depends on things
|
|
-- like intel-basekit >= 2021.1.0-2403 and we end up installing the newest
|
|
-- basekit instead of the one from 2021.1
|
|
--
|
|
-- To mitigate this, >= is set to take the latest version with matching major
|
|
-- and minor (only revision and patch are allowed to change)
|
|
|
|
compareVersions :: Maybe (Ordering', Version) -> Version -> Bool
|
|
compareVersions Nothing _ = True
|
|
compareVersions (Just (kind, want)) got
|
|
| null want = True
|
|
| 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
|
|
|
|
matches :: Ordering -> Ordering' -> Bool
|
|
matches EQ b = b `elem` [EQ', GE', LE']
|
|
matches LT b = b `elem` [LT', LE']
|
|
matches GT b = b `elem` [GT', GE']
|
|
|
|
findMatching :: Data -> Dependency -> Maybe Package
|
|
findMatching pkgList (Dependency n v) = pkgList M.!? n >>= find (compareVersions v . version)
|
|
|
|
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], [Dependency])
|
|
solveDeps d p = first removeDupes $ runWriter $ go [] [p]
|
|
where
|
|
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)
|
|
|
|
getLatest a b
|
|
| version a > version b = a
|
|
| otherwise = b
|
|
|
|
-- Remove trailing version information from package name
|
|
cleanName :: Str -> Str
|
|
cleanName = T.dropWhileEnd (not . isAlpha)
|
|
|
|
isBlacklisted :: Package -> Bool
|
|
isBlacklisted = (`elem` blacklist) . cleanName . name
|
|
where
|
|
blacklist =
|
|
[ "intel-basekit-env"
|
|
, "intel-basekit-getting-started"
|
|
, "intel-hpckit-env"
|
|
, "intel-hpckit-getting-started"
|
|
, "intel-oneapi-advisor"
|
|
, "intel-oneapi-common-licensing"
|
|
, "intel-oneapi-common-oneapi-vars"
|
|
, "intel-oneapi-common-vars"
|
|
, "intel-oneapi-compiler-cpp-eclipse-cfg"
|
|
, "intel-oneapi-compiler-dpcpp-eclipse-cfg"
|
|
, "intel-oneapi-condaindex"
|
|
, "intel-oneapi-dev-utilities-eclipse-cfg"
|
|
, "intel-oneapi-dpcpp-ct-eclipse-cfg"
|
|
, "intel-oneapi-eclipse-ide"
|
|
, "intel-oneapi-hpc-toolkit-getting-started"
|
|
, "intel-oneapi-icc-eclipse-plugin-cpp"
|
|
, "intel-oneapi-inspector"
|
|
, "intel-oneapi-vtune"
|
|
, "intel-oneapi-vtune-eclipse-plugin-vtune"
|
|
]
|
|
|
|
application :: [String] -> Str -> Err ([Dependency], [Kit])
|
|
application args contents = do
|
|
v <- mapM (parseVersion . T.pack) $ case args of
|
|
[] -> ["2025"]
|
|
_ -> args
|
|
|
|
d <- parse contents
|
|
first concat . unzip <$> mapM (processKit d) v
|
|
|
|
processKit :: Data -> Version -> Err ([Dependency], Kit)
|
|
processKit d v = do
|
|
kit <- findHpckit "intel-hpckit"
|
|
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]) $
|
|
findMatching d (Dependency pName (Just (EQ', v)))
|
|
|
|
-- OUTPUT
|
|
|
|
showVer, showVerDash :: [Int] -> Str
|
|
showVer = T.dropEnd 1 . T.concat . zipWith (flip (<>)) ([".", ".", "-"] ++ repeat ".") . fmap tshow
|
|
showVerDash = T.intercalate "-" . fmap tshow
|
|
|
|
-- Reads Debian Package List from apt repo from stdin and outputs TOML with
|
|
-- hpckit versions passed as arguments
|
|
main :: IO ()
|
|
main =
|
|
application <$> getArgs <*> TIO.getContents >>= \case
|
|
Left err -> hPrintf stderr "[ERROR]: %s\n" err *> exitFailure
|
|
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
|
|
<$> (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)
|