{-# LANGUAGE RecordWildCards #-} -- | Which jobs to generate. Also helper for diagnostics output. module HaskellCI.Jobs ( JobVersions (..), describeJobs, makeJobVersions, ) where import HaskellCI.Prelude import qualified Data.Set as S import HaskellCI.Compiler import HaskellCI.Config import HaskellCI.Diagnostics import HaskellCI.Package import HaskellCI.TestedWith data JobVersions = JobVersions { allVersions :: Set CompilerVersion -- ^ all versions (useful for Travis) , linuxVersions :: Set CompilerVersion -- ^ linux jobs , macosVersions :: Set CompilerVersion -- ^ macos jobs } describeJobs :: MonadDiagnostics m => String -- ^ config -> TestedWithJobs -> JobVersions -> [Package] -> m () describeJobs typ twj JobVersions {..} pkgs = do putStrLnInfo $ "Generating " ++ typ ++ " for testing for GHC versions: " ++ ghcVersions case twj of TestedWithUniform -> pure () TestedWithAny -> traverse_ putStrLnInfo $ table' [ pkgName pkg : "": map (showPkgVersion (pkgJobs pkg)) (S.toList allVersions) | pkg <- pkgs ] unless (null macosVersions) $ do putStrLnInfo $ "Also macos jobs for: " ++ ghcmacosVersions where showPkgVersion :: Set CompilerVersion -> CompilerVersion -> String showPkgVersion vs v | S.member v vs = dispGhcVersionShort v | otherwise = "" showVersions :: Set CompilerVersion -> String showVersions = unwords . map dispGhcVersionShort . S.toList ghcVersions :: String ghcVersions = showVersions linuxVersions ghcmacosVersions :: String ghcmacosVersions = showVersions macosVersions makeJobVersions :: Config -> Set CompilerVersion -> JobVersions makeJobVersions Config {..} versions' = JobVersions {..} where -- All jobs versions :: Set CompilerVersion versions | cfgGhcHead = S.insert GHCHead versions' | otherwise = versions' allVersions :: Set CompilerVersion allVersions = S.filter (`compilerWithinRange` range) versions linuxVersions :: Set CompilerVersion linuxVersions = S.filter (`compilerWithinRange` linuxRange) allVersions macosVersions :: Set CompilerVersion macosVersions = S.filter (`compilerWithinRange` macosRange) allVersions range, linuxRange, macosRange :: CompilerRange range = Range cfgEnabledJobs linuxRange = Range cfgLinuxJobs macosRange = RangeGHC /\ Range cfgMacosJobs -- https://oleg.fi/gists/posts/2019-04-28-tabular.html table' :: [[String]] -> [String] table' cells = rows where cols :: Int rowWidths :: [Int] rows :: [String] (cols, rowWidths, rows) = foldr go (0, repeat 0, []) cells go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String]) go xs (c, w, yss) = ( max c (length xs) , zipWith max w (map length xs ++ repeat 0) , unwords (take cols (zipWith fill xs rowWidths)) : yss ) fill :: String -> Int -> String fill s n = s ++ replicate (n - length s) ' '