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

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set CompilerVersion -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set CompilerVersion
macosVersions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  do
        String -> m ()
forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnInfo (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Also macos jobs for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcmacosVersions
  where
    showPkgVersion :: Set CompilerVersion -> CompilerVersion -> String
    showPkgVersion :: Set CompilerVersion -> CompilerVersion -> String
showPkgVersion Set CompilerVersion
vs CompilerVersion
v
        | CompilerVersion -> Set CompilerVersion -> Bool
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 ([String] -> String)
-> (Set CompilerVersion -> [String])
-> Set CompilerVersion
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerVersion -> String) -> [CompilerVersion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CompilerVersion -> String
dispGhcVersionShort ([CompilerVersion] -> [String])
-> (Set CompilerVersion -> [CompilerVersion])
-> Set CompilerVersion
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set CompilerVersion -> [CompilerVersion]
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]
[PrettyField ()]
[PackageName]
[Installed]
[ConstraintSet]
Maybe String
Maybe Version
Maybe Jobs
Set String
Set Fold
Map Version String
Version
VersionRange
Ubuntu
PackageScope
HLintConfig
DoctestConfig
DocspecConfig
CopyFields
Components
TestedWithJobs
cfgCabalInstallVersion :: Maybe Version
cfgJobs :: Maybe Jobs
cfgUbuntu :: Ubuntu
cfgTestedWith :: TestedWithJobs
cfgEnabledJobs :: VersionRange
cfgCopyFields :: CopyFields
cfgLocalGhcOptions :: [String]
cfgSubmodules :: Bool
cfgCache :: Bool
cfgInstallDeps :: Bool
cfgInstalled :: [Installed]
cfgTests :: VersionRange
cfgRunTests :: VersionRange
cfgBenchmarks :: VersionRange
cfgHaddock :: VersionRange
cfgHaddockComponents :: Components
cfgNoTestsNoBench :: VersionRange
cfgUnconstrainted :: VersionRange
cfgHeadHackage :: VersionRange
cfgHeadHackageOverride :: Bool
cfgGhcjsTests :: Bool
cfgGhcjsTools :: [PackageName]
cfgTestOutputDirect :: Bool
cfgCheck :: Bool
cfgOnlyBranches :: [String]
cfgIrcChannels :: [String]
cfgIrcNickname :: Maybe String
cfgIrcPassword :: Maybe String
cfgIrcIfInOriginRepo :: Bool
cfgEmailNotifications :: Bool
cfgProjectName :: Maybe String
cfgFolds :: Set Fold
cfgGhcHead :: Bool
cfgPostgres :: Bool
cfgGoogleChrome :: Bool
cfgEnv :: Map Version String
cfgAllowFailures :: VersionRange
cfgLastInSeries :: Bool
cfgLinuxJobs :: VersionRange
cfgMacosJobs :: VersionRange
cfgGhcupCabal :: Bool
cfgGhcupJobs :: VersionRange
cfgGhcupVersion :: Version
cfgApt :: Set String
cfgTravisPatches :: [String]
cfgGitHubPatches :: [String]
cfgInsertVersion :: Bool
cfgErrorMissingMethods :: PackageScope
cfgDoctest :: DoctestConfig
cfgDocspec :: DocspecConfig
cfgHLint :: HLintConfig
cfgConstraintSets :: [ConstraintSet]
cfgRawProject :: [PrettyField ()]
cfgRawTravis :: String
cfgGitHubActionName :: Maybe String
cfgTimeoutMinutes :: Natural
cfgCabalInstallVersion :: Config -> Maybe Version
cfgJobs :: Config -> Maybe Jobs
cfgUbuntu :: Config -> Ubuntu
cfgTestedWith :: Config -> TestedWithJobs
cfgEnabledJobs :: Config -> VersionRange
cfgCopyFields :: Config -> CopyFields
cfgLocalGhcOptions :: Config -> [String]
cfgSubmodules :: Config -> Bool
cfgCache :: Config -> Bool
cfgInstallDeps :: Config -> Bool
cfgInstalled :: Config -> [Installed]
cfgTests :: Config -> VersionRange
cfgRunTests :: Config -> VersionRange
cfgBenchmarks :: Config -> VersionRange
cfgHaddock :: Config -> VersionRange
cfgHaddockComponents :: Config -> Components
cfgNoTestsNoBench :: Config -> VersionRange
cfgUnconstrainted :: Config -> VersionRange
cfgHeadHackage :: Config -> VersionRange
cfgHeadHackageOverride :: Config -> Bool
cfgGhcjsTests :: Config -> Bool
cfgGhcjsTools :: Config -> [PackageName]
cfgTestOutputDirect :: Config -> Bool
cfgCheck :: Config -> Bool
cfgOnlyBranches :: Config -> [String]
cfgIrcChannels :: Config -> [String]
cfgIrcNickname :: Config -> Maybe String
cfgIrcPassword :: Config -> Maybe String
cfgIrcIfInOriginRepo :: Config -> Bool
cfgEmailNotifications :: Config -> Bool
cfgProjectName :: Config -> Maybe String
cfgFolds :: Config -> Set Fold
cfgGhcHead :: Config -> Bool
cfgPostgres :: Config -> Bool
cfgGoogleChrome :: Config -> Bool
cfgEnv :: Config -> Map Version String
cfgAllowFailures :: Config -> VersionRange
cfgLastInSeries :: Config -> Bool
cfgLinuxJobs :: Config -> VersionRange
cfgMacosJobs :: Config -> VersionRange
cfgGhcupCabal :: Config -> Bool
cfgGhcupJobs :: Config -> VersionRange
cfgGhcupVersion :: Config -> Version
cfgApt :: Config -> Set String
cfgTravisPatches :: Config -> [String]
cfgGitHubPatches :: Config -> [String]
cfgInsertVersion :: Config -> Bool
cfgErrorMissingMethods :: Config -> PackageScope
cfgDoctest :: Config -> DoctestConfig
cfgDocspec :: Config -> DocspecConfig
cfgHLint :: Config -> HLintConfig
cfgConstraintSets :: Config -> [ConstraintSet]
cfgRawProject :: Config -> [PrettyField ()]
cfgRawTravis :: Config -> String
cfgGitHubActionName :: Config -> Maybe String
cfgTimeoutMinutes :: Config -> Natural
..} Set CompilerVersion
versions' = JobVersions {Set CompilerVersion
allVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
macosVersions :: Set CompilerVersion
allVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
macosVersions :: Set CompilerVersion
..} where
    -- All jobs
    versions :: Set CompilerVersion
    versions :: Set CompilerVersion
versions
        | Bool
cfgGhcHead = CompilerVersion -> Set CompilerVersion -> Set CompilerVersion
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 = (CompilerVersion -> Bool)
-> Set CompilerVersion -> Set CompilerVersion
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 = (CompilerVersion -> Bool)
-> Set CompilerVersion -> Set CompilerVersion
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 = (CompilerVersion -> Bool)
-> Set CompilerVersion -> Set CompilerVersion
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 CompilerRange -> CompilerRange -> CompilerRange
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) = ([String] -> (Int, [Int], [String]) -> (Int, [Int], [String]))
-> (Int, [Int], [String]) -> [[String]] -> (Int, [Int], [String])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
go (Int
0, Int -> [Int]
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) =
        ( Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
c ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs)
        , (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max [Int]
w ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
        , [String] -> String
unwords (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
cols ((String -> Int -> String) -> [String] -> [Int] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Int -> String
fill [String]
xs [Int]
rowWidths))
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
yss
        )

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