{-# LANGUAGE RecordWildCards #-}
-- | Which jobs to generate. Also helper for diagnostics output.
module HaskellCI.Jobs where

import HaskellCI.Prelude

import qualified Data.Set            as S
import qualified Distribution.Pretty as C

import HaskellCI.Compiler
import HaskellCI.Config
import HaskellCI.Diagnostics
import HaskellCI.Package
import HaskellCI.TestedWith

data JobVersions = JobVersions
    { JobVersions -> Set CompilerVersion
versions           :: Set CompilerVersion  -- ^ all jobs
    , JobVersions -> Set Version
osxVersions        :: Set Version          -- ^ osx jobs: GHC only
    , JobVersions -> Set Version
omittedOsxVersions :: Set Version
    }

describeJobs
    :: MonadDiagnostics m
    => String          -- ^ config
    -> TestedWithJobs
    -> JobVersions
    -> [Package] -> m ()
describeJobs :: String -> TestedWithJobs -> JobVersions -> [Package] -> m ()
describeJobs String
typ TestedWithJobs
twj JobVersions {Set Version
Set CompilerVersion
omittedOsxVersions :: Set Version
osxVersions :: Set Version
versions :: Set CompilerVersion
omittedOsxVersions :: JobVersions -> Set Version
osxVersions :: JobVersions -> Set Version
versions :: JobVersions -> 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
        TestedWithJobs
TestedWithAny     -> [Package] -> (Package -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Package]
pkgs ((Package -> m ()) -> m ()) -> (Package -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Package
pkg -> do
            -- this omits HEAD version.
            let vr :: Set CompilerVersion
vr = Package -> Set CompilerVersion
pkgJobs Package
pkg
            let vs :: String
vs = Set CompilerVersion -> String
showVersions Set CompilerVersion
vr
            String -> m ()
forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnInfo (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Package -> String
pkgName Package
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vs

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Version -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Version
osxVersions) (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 OSX jobs for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcOsxVersions
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Version -> Bool
forall a. Set a -> Bool
S.null Set Version
omittedOsxVersions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            String -> m ()
forall (m :: * -> *). MonadDiagnostics m => String -> m ()
putStrLnWarn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Not all GHC versions specified with --osx are generated: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcOmittedOsxVersions
  where
    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

    showVersionsV :: Set Version -> String
    showVersionsV :: Set Version -> String
showVersionsV = [String] -> String
unwords ([String] -> String)
-> (Set Version -> [String]) -> Set Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Version -> String
forall a. Pretty a => a -> String
C.prettyShow ([Version] -> [String])
-> (Set Version -> [Version]) -> Set Version -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Version -> [Version]
forall a. Set a -> [a]
S.toList

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

    ghcOsxVersions :: String
    ghcOsxVersions :: String
ghcOsxVersions = Set Version -> String
showVersionsV Set Version
osxVersions

    ghcOmittedOsxVersions :: String
    ghcOmittedOsxVersions :: String
ghcOmittedOsxVersions = Set Version -> String
showVersionsV Set Version
omittedOsxVersions

makeJobVersions :: Config -> Set CompilerVersion -> JobVersions
makeJobVersions :: Config -> Set CompilerVersion -> JobVersions
makeJobVersions Config {Bool
String
[String]
[PrettyField ()]
[PackageName]
[Installed]
[ConstraintSet]
Maybe String
Maybe Version
Maybe Jobs
VersionRange
Set String
Set Version
Set Fold
Map Version String
Ubuntu
PackageScope
HLintConfig
DoctestConfig
DocspecConfig
CopyFields
TestedWithJobs
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
cfgOsx :: Config -> Set Version
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
cfgIrcChannels :: Config -> [String]
cfgOnlyBranches :: Config -> [String]
cfgCheck :: Config -> Bool
cfgTestOutputDirect :: Config -> Bool
cfgGhcjsTools :: Config -> [PackageName]
cfgGhcjsTests :: Config -> Bool
cfgHeadHackage :: Config -> VersionRange
cfgUnconstrainted :: Config -> VersionRange
cfgNoTestsNoBench :: Config -> VersionRange
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
cfgTestedWith :: Config -> TestedWithJobs
cfgUbuntu :: Config -> Ubuntu
cfgJobs :: Config -> Maybe Jobs
cfgCabalInstallVersion :: Config -> Maybe Version
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
cfgOsx :: Set Version
cfgLastInSeries :: Bool
cfgAllowFailures :: VersionRange
cfgEnv :: Map Version String
cfgGoogleChrome :: Bool
cfgPostgres :: Bool
cfgGhcHead :: Bool
cfgFolds :: Set Fold
cfgProjectName :: Maybe String
cfgEmailNotifications :: Bool
cfgIrcIfInOriginRepo :: Bool
cfgIrcChannels :: [String]
cfgOnlyBranches :: [String]
cfgCheck :: Bool
cfgTestOutputDirect :: Bool
cfgGhcjsTools :: [PackageName]
cfgGhcjsTests :: Bool
cfgHeadHackage :: VersionRange
cfgUnconstrainted :: VersionRange
cfgNoTestsNoBench :: VersionRange
cfgHaddock :: VersionRange
cfgBenchmarks :: VersionRange
cfgRunTests :: VersionRange
cfgTests :: VersionRange
cfgInstalled :: [Installed]
cfgInstallDeps :: Bool
cfgCache :: Bool
cfgSubmodules :: Bool
cfgLocalGhcOptions :: [String]
cfgCopyFields :: CopyFields
cfgTestedWith :: TestedWithJobs
cfgUbuntu :: Ubuntu
cfgJobs :: Maybe Jobs
cfgCabalInstallVersion :: Maybe Version
..} Set CompilerVersion
versions' = JobVersions :: Set CompilerVersion -> Set Version -> Set Version -> JobVersions
JobVersions {Set Version
Set CompilerVersion
omittedOsxVersions :: Set Version
osxVersions :: Set Version
versions :: Set CompilerVersion
omittedOsxVersions :: Set Version
osxVersions :: Set Version
versions :: 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'

    osxVersions' :: Set Version
    osxVersions' :: Set Version
osxVersions' = Set Version
cfgOsx

    osxVersions, omittedOsxVersions :: Set Version
    (Set Version
osxVersions, Set Version
omittedOsxVersions) = (Version -> Bool) -> Set Version -> (Set Version, Set Version)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition (\Version
x -> Version -> CompilerVersion
GHC Version
x CompilerVersion -> Set CompilerVersion -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set CompilerVersion
versions') Set Version
osxVersions'