{-# 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
    { JobVersions -> Set CompilerVersion
allVersions   :: Set CompilerVersion  -- ^ all versions (useful for Travis)
    , JobVersions -> Set CompilerVersion
linuxVersions :: Set CompilerVersion  -- ^ linux jobs
    , JobVersions -> Set CompilerVersion
macosVersions :: Set CompilerVersion  -- ^ macos jobs
    }

describeJobs
    :: MonadDiagnostics m
    => String          -- ^ config
    -> TestedWithJobs
    -> JobVersions
    -> [Package] -> m ()
describeJobs :: forall (m :: * -> *).
MonadDiagnostics m =>
String -> TestedWithJobs -> JobVersions -> [Package] -> m ()
describeJobs String
typ TestedWithJobs
twj JobVersions {Set CompilerVersion
macosVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
allVersions :: Set CompilerVersion
macosVersions :: JobVersions -> Set CompilerVersion
linuxVersions :: JobVersions -> Set CompilerVersion
allVersions :: JobVersions -> Set CompilerVersion
..} [Package]
pkgs = do
    forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnInfo forall a b. (a -> b) -> a -> b
$ String
"Generating " forall a. [a] -> [a] -> [a]
++ String
typ forall a. [a] -> [a] -> [a]
++ String
" for testing for GHC versions: " forall a. [a] -> [a] -> [a]
++ String
ghcVersions
    case TestedWithJobs
twj of
        TestedWithJobs
TestedWithUniform -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        TestedWithJobs
TestedWithAny     -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnInfo forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
table'
            [ Package -> String
pkgName Package
pkg forall a. a -> [a] -> [a]
: String
""forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Set CompilerVersion -> CompilerVersion -> String
showPkgVersion (Package -> Set CompilerVersion
pkgJobs Package
pkg)) (forall a. Set a -> [a]
S.toList Set CompilerVersion
allVersions)
            | Package
pkg <- [Package]
pkgs
            ]

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set CompilerVersion
macosVersions) forall a b. (a -> b) -> a -> b
$  do
        forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnInfo forall a b. (a -> b) -> a -> b
$ String
"Also macos jobs for: " forall a. [a] -> [a] -> [a]
++ String
ghcmacosVersions
  where
    showPkgVersion :: Set CompilerVersion -> CompilerVersion -> String
    showPkgVersion :: Set CompilerVersion -> CompilerVersion -> String
showPkgVersion Set CompilerVersion
vs CompilerVersion
v
        | forall a. Ord a => a -> Set a -> Bool
S.member CompilerVersion
v Set CompilerVersion
vs = CompilerVersion -> String
dispGhcVersionShort CompilerVersion
v
        | Bool
otherwise     = String
""

    showVersions :: Set CompilerVersion -> String
    showVersions :: Set CompilerVersion -> String
showVersions = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CompilerVersion -> String
dispGhcVersionShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList

    ghcVersions :: String
    ghcVersions :: String
ghcVersions = Set CompilerVersion -> String
showVersions Set CompilerVersion
linuxVersions

    ghcmacosVersions :: String
    ghcmacosVersions :: String
ghcmacosVersions = Set CompilerVersion -> String
showVersions Set CompilerVersion
macosVersions

makeJobVersions :: Config -> Set CompilerVersion -> JobVersions
makeJobVersions :: Config -> Set CompilerVersion -> JobVersions
makeJobVersions Config {Bool
Natural
String
[String]
[PackageName]
[PrettyField ()]
[Installed]
[ConstraintSet]
Maybe String
Maybe Version
Maybe Jobs
VersionRange
Version
Set String
Set Fold
Map Version String
Ubuntu
PackageScope
HLintConfig
DoctestConfig
DocspecConfig
CopyFields
Components
TestedWithJobs
cfgTimeoutMinutes :: Config -> Natural
cfgGitHubActionName :: Config -> Maybe String
cfgRawTravis :: Config -> String
cfgRawProject :: Config -> [PrettyField ()]
cfgConstraintSets :: Config -> [ConstraintSet]
cfgHLint :: Config -> HLintConfig
cfgDocspec :: Config -> DocspecConfig
cfgDoctest :: Config -> DoctestConfig
cfgErrorMissingMethods :: Config -> PackageScope
cfgInsertVersion :: Config -> Bool
cfgGitHubPatches :: Config -> [String]
cfgTravisPatches :: Config -> [String]
cfgApt :: Config -> Set String
cfgGhcupVersion :: Config -> Version
cfgGhcupJobs :: Config -> VersionRange
cfgGhcupCabal :: Config -> Bool
cfgMacosJobs :: Config -> VersionRange
cfgLinuxJobs :: Config -> VersionRange
cfgLastInSeries :: Config -> Bool
cfgAllowFailures :: Config -> VersionRange
cfgEnv :: Config -> Map Version String
cfgGoogleChrome :: Config -> Bool
cfgPostgres :: Config -> Bool
cfgGhcHead :: Config -> Bool
cfgFolds :: Config -> Set Fold
cfgProjectName :: Config -> Maybe String
cfgEmailNotifications :: Config -> Bool
cfgIrcIfInOriginRepo :: Config -> Bool
cfgIrcPassword :: Config -> Maybe String
cfgIrcNickname :: Config -> Maybe String
cfgIrcChannels :: Config -> [String]
cfgOnlyBranches :: Config -> [String]
cfgCheck :: Config -> Bool
cfgTestOutputDirect :: Config -> Bool
cfgGhcjsTools :: Config -> [PackageName]
cfgGhcjsTests :: Config -> Bool
cfgHeadHackageOverride :: Config -> Bool
cfgHeadHackage :: Config -> VersionRange
cfgUnconstrainted :: Config -> VersionRange
cfgNoTestsNoBench :: Config -> VersionRange
cfgHaddockComponents :: Config -> Components
cfgHaddock :: Config -> VersionRange
cfgBenchmarks :: Config -> VersionRange
cfgRunTests :: Config -> VersionRange
cfgTests :: Config -> VersionRange
cfgInstalled :: Config -> [Installed]
cfgInstallDeps :: Config -> Bool
cfgCache :: Config -> Bool
cfgSubmodules :: Config -> Bool
cfgLocalGhcOptions :: Config -> [String]
cfgCopyFields :: Config -> CopyFields
cfgEnabledJobs :: Config -> VersionRange
cfgTestedWith :: Config -> TestedWithJobs
cfgUbuntu :: Config -> Ubuntu
cfgJobs :: Config -> Maybe Jobs
cfgCabalInstallVersion :: Config -> Maybe Version
cfgTimeoutMinutes :: Natural
cfgGitHubActionName :: Maybe String
cfgRawTravis :: String
cfgRawProject :: [PrettyField ()]
cfgConstraintSets :: [ConstraintSet]
cfgHLint :: HLintConfig
cfgDocspec :: DocspecConfig
cfgDoctest :: DoctestConfig
cfgErrorMissingMethods :: PackageScope
cfgInsertVersion :: Bool
cfgGitHubPatches :: [String]
cfgTravisPatches :: [String]
cfgApt :: Set String
cfgGhcupVersion :: Version
cfgGhcupJobs :: VersionRange
cfgGhcupCabal :: Bool
cfgMacosJobs :: VersionRange
cfgLinuxJobs :: VersionRange
cfgLastInSeries :: Bool
cfgAllowFailures :: VersionRange
cfgEnv :: Map Version String
cfgGoogleChrome :: Bool
cfgPostgres :: Bool
cfgGhcHead :: Bool
cfgFolds :: Set Fold
cfgProjectName :: Maybe String
cfgEmailNotifications :: Bool
cfgIrcIfInOriginRepo :: Bool
cfgIrcPassword :: Maybe String
cfgIrcNickname :: Maybe String
cfgIrcChannels :: [String]
cfgOnlyBranches :: [String]
cfgCheck :: Bool
cfgTestOutputDirect :: Bool
cfgGhcjsTools :: [PackageName]
cfgGhcjsTests :: Bool
cfgHeadHackageOverride :: Bool
cfgHeadHackage :: VersionRange
cfgUnconstrainted :: VersionRange
cfgNoTestsNoBench :: VersionRange
cfgHaddockComponents :: Components
cfgHaddock :: VersionRange
cfgBenchmarks :: VersionRange
cfgRunTests :: VersionRange
cfgTests :: VersionRange
cfgInstalled :: [Installed]
cfgInstallDeps :: Bool
cfgCache :: Bool
cfgSubmodules :: Bool
cfgLocalGhcOptions :: [String]
cfgCopyFields :: CopyFields
cfgEnabledJobs :: VersionRange
cfgTestedWith :: TestedWithJobs
cfgUbuntu :: Ubuntu
cfgJobs :: Maybe Jobs
cfgCabalInstallVersion :: Maybe Version
..} Set CompilerVersion
versions' = JobVersions {Set CompilerVersion
macosVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
allVersions :: Set CompilerVersion
macosVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
allVersions :: Set CompilerVersion
..} where
    -- All jobs
    versions :: Set CompilerVersion
    versions :: Set CompilerVersion
versions
        | Bool
cfgGhcHead = forall a. Ord a => a -> Set a -> Set a
S.insert CompilerVersion
GHCHead Set CompilerVersion
versions'
        | Bool
otherwise  = Set CompilerVersion
versions'

    allVersions :: Set CompilerVersion
    allVersions :: Set CompilerVersion
allVersions = forall a. (a -> Bool) -> Set a -> Set a
S.filter (CompilerVersion -> CompilerRange -> Bool
`compilerWithinRange` CompilerRange
range)  Set CompilerVersion
versions

    linuxVersions :: Set CompilerVersion
    linuxVersions :: Set CompilerVersion
linuxVersions = forall a. (a -> Bool) -> Set a -> Set a
S.filter (CompilerVersion -> CompilerRange -> Bool
`compilerWithinRange` CompilerRange
linuxRange) Set CompilerVersion
allVersions

    macosVersions :: Set CompilerVersion
    macosVersions :: Set CompilerVersion
macosVersions = forall a. (a -> Bool) -> Set a -> Set a
S.filter (CompilerVersion -> CompilerRange -> Bool
`compilerWithinRange` CompilerRange
macosRange) Set CompilerVersion
allVersions

    range, linuxRange, macosRange :: CompilerRange
    range :: CompilerRange
range      = VersionRange -> CompilerRange
Range VersionRange
cfgEnabledJobs
    linuxRange :: CompilerRange
linuxRange = VersionRange -> CompilerRange
Range VersionRange
cfgLinuxJobs
    macosRange :: CompilerRange
macosRange = CompilerRange
RangeGHC forall a. Lattice a => a -> a -> a
/\ VersionRange -> CompilerRange
Range VersionRange
cfgMacosJobs

-- https://oleg.fi/gists/posts/2019-04-28-tabular.html
table' :: [[String]] -> [String]
table' :: [[String]] -> [String]
table' [[String]]
cells = [String]
rows
  where
    cols      :: Int
    rowWidths :: [Int]
    rows      :: [String]

    (Int
cols, [Int]
rowWidths, [String]
rows) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
go (Int
0, forall a. a -> [a]
repeat Int
0, []) [[String]]
cells

    go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
    go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
go [String]
xs (Int
c, [Int]
w, [String]
yss) =
        ( forall a. Ord a => a -> a -> a
max Int
c (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)
        , forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Ord a => a -> a -> a
max [Int]
w (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0)
        , [String] -> String
unwords (forall a. Int -> [a] -> [a]
take Int
cols (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Int -> String
fill [String]
xs [Int]
rowWidths))
          forall a. a -> [a] -> [a]
: [String]
yss
        )

    fill :: String -> Int -> String
    fill :: String -> Int -> String
fill String
s Int
n = String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '