{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}
module HaskellCI.Config.Validity where

import HaskellCI.Prelude

import HaskellCI.Compiler
import HaskellCI.Config
import HaskellCI.Config.Ubuntu
import HaskellCI.Error
import HaskellCI.Jobs
import HaskellCI.MonadErr

-- Validity checks shared in common among all backends.
checkConfigValidity :: MonadErr HsCiError m => Config -> JobVersions -> m ()
checkConfigValidity :: forall (m :: * -> *).
MonadErr HsCiError m =>
Config -> JobVersions -> m ()
checkConfigValidity 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
..} JobVersions {Set CompilerVersion
allVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
macosVersions :: Set CompilerVersion
allVersions :: JobVersions -> Set CompilerVersion
linuxVersions :: JobVersions -> Set CompilerVersion
macosVersions :: JobVersions -> Set CompilerVersion
..} = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
anyGHCJS Bool -> Bool -> Bool
&& Ubuntu
cfgUbuntu Ubuntu -> Ubuntu -> Bool
forall a. Ord a => a -> a -> Bool
> Ubuntu
Bionic) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        HsCiError -> m ()
forall a. HsCiError -> m a
forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr (HsCiError -> m ()) -> HsCiError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> HsCiError
ValidationError (String -> HsCiError) -> String -> HsCiError
forall a b. (a -> b) -> a -> b
$ String
"Using GHCJS requires Ubuntu 16.04 (Xenial) or 18.04 (Bionic)."
  where
    anyGHCJS :: Bool
anyGHCJS = (CompilerVersion -> Bool) -> Set CompilerVersion -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CompilerVersion -> Bool
isGHCJS Set CompilerVersion
linuxVersions