diff --git a/haskell-ci.cabal b/haskell-ci.cabal index 61e3b5e0..37d2db6a 100644 --- a/haskell-ci.cabal +++ b/haskell-ci.cabal @@ -121,9 +121,13 @@ library haskell-ci-internal HaskellCI.Config.Doctest HaskellCI.Config.Dump HaskellCI.Config.Empty + HaskellCI.Config.Grammar + HaskellCI.Config.History + HaskellCI.Config.Initial HaskellCI.Config.Installed HaskellCI.Config.Jobs HaskellCI.Config.PackageScope + HaskellCI.Config.Type HaskellCI.Config.Ubuntu HaskellCI.Config.Validity HaskellCI.Diagnostics @@ -132,6 +136,7 @@ library haskell-ci-internal HaskellCI.GitConfig HaskellCI.GitHub HaskellCI.GitHub.Yaml + HaskellCI.GrammarDefault HaskellCI.HeadHackage HaskellCI.Jobs HaskellCI.List diff --git a/src/HaskellCI/Cabal.hs b/src/HaskellCI/Cabal.hs index bfc0a334..f480e97c 100644 --- a/src/HaskellCI/Cabal.hs +++ b/src/HaskellCI/Cabal.hs @@ -4,9 +4,6 @@ import HaskellCI.Prelude import qualified Distribution.Version as C -defaultCabalInstallVersion :: Maybe Version -defaultCabalInstallVersion = Just (C.mkVersion [3,10]) - -- | Convert cabal-install version to a version ghcup understands. cabalGhcupVersion :: Version -> Version cabalGhcupVersion ver = case C.versionNumbers ver of diff --git a/src/HaskellCI/Config.hs b/src/HaskellCI/Config.hs index b3b99bb7..9b41e4de 100644 --- a/src/HaskellCI/Config.hs +++ b/src/HaskellCI/Config.hs @@ -4,242 +4,33 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -module HaskellCI.Config where +module HaskellCI.Config ( + Config (..), + configGrammar, + emptyConfig, + readConfigFile, +) where import HaskellCI.Prelude -import qualified Data.ByteString as BS -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Distribution.CabalSpecVersion as C -import qualified Distribution.Compat.CharParsing as C -import qualified Distribution.Compat.Newtype as C -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Fields as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Distribution.Types.PackageName as C -import qualified Distribution.Types.VersionRange as C -import qualified Text.PrettyPrint as PP +import qualified Data.ByteString as BS +import qualified Distribution.CabalSpecVersion as C +import qualified Distribution.FieldGrammar as C +import qualified Distribution.Fields as C +import qualified Distribution.Parsec as C -import HaskellCI.Cabal -import HaskellCI.Config.Components import HaskellCI.Config.ConstraintSet -import HaskellCI.Config.CopyFields -import HaskellCI.Config.Docspec -import HaskellCI.Config.Doctest import HaskellCI.Config.Empty -import HaskellCI.Config.Installed -import HaskellCI.Config.Jobs -import HaskellCI.Config.PackageScope +import HaskellCI.Config.Grammar +import HaskellCI.Config.Type import HaskellCI.Config.Ubuntu -import HaskellCI.Ghcup -import HaskellCI.HeadHackage -import HaskellCI.Newtypes -import HaskellCI.OptionsGrammar import HaskellCI.ParsecUtils -import HaskellCI.TestedWith - -------------------------------------------------------------------------------- --- Config -------------------------------------------------------------------------------- - --- TODO: split other blocks like DoctestConfig -data Config = Config - { 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 :: ![C.PackageName] - , cfgTestOutputDirect :: !Bool - , cfgCheck :: !Bool - , cfgOnlyBranches :: [String] - , cfgIrcChannels :: [String] - , cfgIrcNickname :: Maybe String - , cfgIrcPassword :: Maybe String - , cfgIrcIfInOriginRepo :: Bool - , cfgEmailNotifications :: Bool - , cfgProjectName :: Maybe String - , cfgGhcHead :: !Bool - , cfgPostgres :: !Bool - , cfgGoogleChrome :: !Bool - , cfgEnv :: M.Map Version String - , cfgAllowFailures :: !VersionRange - , cfgLastInSeries :: !Bool - , cfgLinuxJobs :: !VersionRange - , cfgMacosJobs :: !VersionRange - , cfgGhcupCabal :: !Bool - , cfgGhcupJobs :: !VersionRange - , cfgGhcupVersion :: !Version - , cfgApt :: S.Set String - , cfgTravisPatches :: [FilePath] - , cfgGitHubPatches :: [FilePath] - , cfgInsertVersion :: !Bool - , cfgErrorMissingMethods :: !PackageScope - , cfgDoctest :: !DoctestConfig - , cfgDocspec :: !DocspecConfig - , cfgConstraintSets :: [ConstraintSet] - , cfgRawProject :: [C.PrettyField ()] - , cfgRawTravis :: !String - , cfgGitHubActionName :: !(Maybe String) - , cfgTimeoutMinutes :: !Natural - } - deriving (Generic) emptyConfig :: Config emptyConfig = case runEG configGrammar of Left xs -> error $ "Required fields: " ++ show xs Right x -> postprocessConfig x -------------------------------------------------------------------------------- --- Grammar -------------------------------------------------------------------------------- - -configGrammar - :: ( OptionsGrammar c g, Applicative (g Config) - , c Components - , c CopyFields - , c CopyFields - , c Env - , c HeadVersion - , c Jobs - , c Natural - , c PackageScope - , c TestedWithJobs - , c Ubuntu - , c Version - , c (C.List C.FSep (Identity Installed) Installed) - , Applicative (g DoctestConfig) - , Applicative (g DocspecConfig) - ) - => g Config Config -configGrammar = Config - <$> C.optionalFieldDefAla "cabal-install-version" HeadVersion (field @"cfgCabalInstallVersion") defaultCabalInstallVersion - ^^^ metahelp "VERSION" "cabal-install version for all jobs" - <*> C.optionalField "jobs" (field @"cfgJobs") - ^^^ metahelp "JOBS" "jobs (N:M - cabal:ghc)" - <*> C.optionalFieldDef "distribution" (field @"cfgUbuntu") Jammy - ^^^ metahelp "DIST" (concat - [ "distribution version (" - , intercalate ", " $ map showUbuntu [minBound..maxBound] - , ")" - ]) - <*> C.optionalFieldDef "jobs-selection" (field @"cfgTestedWith") TestedWithUniform - ^^^ metahelp "uniform|any" "Jobs selection across packages" - <*> rangeField "enabled" (field @"cfgEnabledJobs") anyVersion - ^^^ metahelp "RANGE" "Restrict jobs selection futher from per package tested-with" - <*> C.optionalFieldDef "copy-fields" (field @"cfgCopyFields") CopyFieldsSome - ^^^ metahelp "none|some|all" "Copy ? fields from cabal.project fields" - <*> C.monoidalFieldAla "local-ghc-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgLocalGhcOptions") - ^^^ metahelp "OPTS" "--ghc-options for local packages" - <*> C.booleanFieldDef "submodules" (field @"cfgSubmodules") False - ^^^ help "Clone submodules, i.e. recursively" - <*> C.booleanFieldDef "cache" (field @"cfgCache") True - ^^^ help "Disable caching" - <*> C.booleanFieldDef "install-dependencies" (field @"cfgInstallDeps") True - ^^^ help "Skip separate dependency installation step" - <*> C.monoidalFieldAla "installed" (C.alaList C.FSep) (field @"cfgInstalled") - ^^^ metahelp "+/-PKG" "Specify 'constraint: ... installed' packages" - <*> rangeField "tests" (field @"cfgTests") anyVersion - ^^^ metahelp "RANGE" "Build tests with" - <*> rangeField "run-tests" (field @"cfgRunTests") anyVersion - ^^^ metahelp "RANGE" "Run tests with (note: only built tests are run)" - <*> rangeField "benchmarks" (field @"cfgBenchmarks") anyVersion - ^^^ metahelp "RANGE" "Build benchmarks" - <*> rangeField "haddock" (field @"cfgHaddock") anyVersion - ^^^ metahelp "RANGE" "Haddock step" - <*> C.optionalFieldDef "haddock-components" (field @"cfgHaddockComponents") ComponentsAll - ^^^ metahelp "all|libs" "Haddock components" - <*> rangeField "no-tests-no-benchmarks" (field @"cfgNoTestsNoBench") anyVersion - ^^^ metahelp "RANGE" "Build without tests and benchmarks" - <*> rangeField "unconstrained" (field @"cfgUnconstrainted") anyVersion - ^^^ metahelp "RANGE" "Make unconstrained build" - <*> rangeField "head-hackage" (field @"cfgHeadHackage") defaultHeadHackage - ^^^ metahelp "RANGE" "Use head.hackage repository. Also marks as allow-failures" - <*> C.booleanFieldDef "head-hackage-override" (field @"cfgHeadHackageOverride") True - ^^^ help "Use :override for head.hackage repository" - <*> C.booleanFieldDef "ghcjs-tests" (field @"cfgGhcjsTests") False - ^^^ help "Run tests with GHCJS (experimental, relies on cabal-plan finding test-suites)" - <*> C.monoidalFieldAla "ghcjs-tools" (C.alaList C.FSep) (field @"cfgGhcjsTools") --- ^^^ metahelp "TOOL" "Additional host tools to install with GHCJS" - <*> C.booleanFieldDef "test-output-direct" (field @"cfgTestOutputDirect") True - ^^^ help "Use --test-show-details=direct, may cause problems with build-type: Custom" - <*> C.booleanFieldDef "cabal-check" (field @"cfgCheck") True - ^^^ help "Disable cabal check run" - <*> C.monoidalFieldAla "branches" (C.alaList' C.FSep C.Token') (field @"cfgOnlyBranches") - ^^^ metahelp "BRANCH" "Enable builds only for specific branches" - <*> C.monoidalFieldAla "irc-channels" (C.alaList' C.FSep C.Token') (field @"cfgIrcChannels") - ^^^ metahelp "IRC" "Enable IRC notifications to given channel (e.g. 'irc.libera.chat#haskell-lens')" - <*> C.freeTextField "irc-nickname" (field @"cfgIrcNickname") - ^^^ metahelp "NICKNAME" "Nickname with which to authenticate to an IRC server. Only used if `irc-channels` are set." - <*> C.freeTextField "irc-password" (field @"cfgIrcPassword") - ^^^ metahelp "PASSWORD" "Password with which to authenticate to an IRC server. Only used if `irc-channels` are set." - <*> C.booleanFieldDef "irc-if-in-origin-repo" (field @"cfgIrcIfInOriginRepo") False - ^^^ help "Only send IRC notifications if run from the original remote (GitHub Actions only)" - <*> C.booleanFieldDef "email-notifications" (field @"cfgEmailNotifications") True - ^^^ help "Disable email notifications" - <*> C.optionalFieldAla "project-name" C.Token' (field @"cfgProjectName") - ^^^ metahelp "NAME" "Project name (used for IRC notifications), defaults to package name or name of first package listed in cabal.project file" - <*> C.booleanFieldDef "ghc-head" (field @"cfgGhcHead") False - ^^^ help "Add ghc-head job" - <*> C.booleanFieldDef "postgresql" (field @"cfgPostgres") False - ^^^ help "Add postgresql service" - <*> C.booleanFieldDef "google-chrome" (field @"cfgGoogleChrome") False - ^^^ help "Add google-chrome service" - <*> C.monoidalFieldAla "env" Env (field @"cfgEnv") - ^^^ metahelp "ENV" "Environment variables per job (e.g. `8.0.2:HADDOCK=false`)" - <*> C.optionalFieldDefAla "allow-failures" Range (field @"cfgAllowFailures") noVersion - ^^^ metahelp "JOB" "Allow failures of particular GHC version" - <*> C.booleanFieldDef "last-in-series" (field @"cfgLastInSeries") False - ^^^ help "[Discouraged] Assume there are only GHCs last in major series: 8.2.* will match only 8.2.2" - <*> rangeField "linux-jobs" (field @"cfgLinuxJobs") anyVersion - ^^^ metahelp "RANGE" "Jobs to build on Linux" - <*> rangeField "macos-jobs" (field @"cfgMacosJobs") noVersion - ^^^ metahelp "RANGE" "Jobs to additionally build with OSX" - <*> C.booleanFieldDef "ghcup-cabal" (field @"cfgGhcupCabal") True - ^^^ help "Use (or don't) ghcup to install cabal" - <*> rangeField "ghcup-jobs" (field @"cfgGhcupJobs") (C.unionVersionRanges (C.intersectVersionRanges (C.laterVersion (mkVersion [8,10,4])) (C.earlierVersion (mkVersion [9]))) (C.laterVersion (mkVersion [9,0,1]))) - ^^^ metahelp "RANGE" "(Linux) jobs to use ghcup to install tools" - <*> C.optionalFieldDef "ghcup-version" (field @"cfgGhcupVersion") defaultGhcupVersion - ^^^ metahelp "VERSION" "ghcup version" - <*> C.monoidalFieldAla "apt" (alaSet' C.NoCommaFSep C.Token') (field @"cfgApt") - ^^^ metahelp "PKG" "Additional apt packages to install" - <*> C.monoidalFieldAla "travis-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgTravisPatches") - ^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated Travis YAML file" - <*> C.monoidalFieldAla "github-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgGitHubPatches") - ^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated GitHub Actions YAML file" - <*> C.booleanFieldDef "insert-version" (field @"cfgInsertVersion") True - ^^^ help "Don't insert the haskell-ci version into the generated Travis YAML file" - <*> C.optionalFieldDef "error-missing-methods" (field @"cfgErrorMissingMethods") PackageScopeLocal - ^^^ metahelp "PKGSCOPE" "Insert -Werror=missing-methods for package scope (none, local, all)" - <*> C.blurFieldGrammar (field @"cfgDoctest") doctestConfigGrammar - <*> C.blurFieldGrammar (field @"cfgDocspec") docspecConfigGrammar - <*> pure [] -- constraint sets - <*> pure [] -- raw project fields - <*> C.freeTextFieldDef "raw-travis" (field @"cfgRawTravis") - ^^^ help "Raw travis commands which will be run at the very end of the script" - <*> C.freeTextField "github-action-name" (field @"cfgGitHubActionName") - ^^^ help "The name of GitHub Action" - <*> C.optionalFieldDef "timeout-minutes" (field @"cfgTimeoutMinutes") 60 - ^^^ metahelp "MINUTES" "The maximum number of minutes to let a job run" - ------------------------------------------------------------------------------- -- Reading ------------------------------------------------------------------------------- @@ -275,25 +66,6 @@ postprocessConfig cfg | cfgUbuntu cfg >= Jammy = cfg { cfgGhcupJobs = anyVersion } | otherwise = cfg -------------------------------------------------------------------------------- --- Env -------------------------------------------------------------------------------- - -newtype Env = Env (M.Map Version String) - deriving anyclass (C.Newtype (M.Map Version String)) - -instance C.Parsec Env where - parsec = Env . M.fromList <$> C.parsecLeadingCommaList p where - p = do - v <- C.parsec - _ <- C.char ':' - s <- C.munch1 $ \c -> c /= ',' - return (v, s) - -instance C.Pretty Env where - pretty (Env m) = PP.fsep . PP.punctuate PP.comma . map p . M.toList $ m where - p (v, s) = C.pretty v PP.<> PP.colon PP.<> PP.text s - ------------------------------------------------------------------------------- -- From Cabal ------------------------------------------------------------------------------- diff --git a/src/HaskellCI/Config/ConstraintSet.hs b/src/HaskellCI/Config/ConstraintSet.hs index 69417fc6..c5ab7d76 100644 --- a/src/HaskellCI/Config/ConstraintSet.hs +++ b/src/HaskellCI/Config/ConstraintSet.hs @@ -5,7 +5,7 @@ module HaskellCI.Config.ConstraintSet where import HaskellCI.Prelude -import qualified Distribution.FieldGrammar as C +import qualified Distribution.FieldGrammar as C import HaskellCI.Newtypes import HaskellCI.OptionsGrammar diff --git a/src/HaskellCI/Config/Docspec.hs b/src/HaskellCI/Config/Docspec.hs index 750ed654..0733d5e5 100644 --- a/src/HaskellCI/Config/Docspec.hs +++ b/src/HaskellCI/Config/Docspec.hs @@ -4,12 +4,14 @@ module HaskellCI.Config.Docspec ( DocspecConfig (..), docspecConfigGrammar, + defaultDocspecConfig, ) where import HaskellCI.Prelude -import qualified Distribution.FieldGrammar as C +import qualified Distribution.FieldGrammar as C +import HaskellCI.GrammarDefault import HaskellCI.OptionsGrammar data DocspecConfig = DocspecConfig @@ -36,15 +38,13 @@ defaultDocspecConfig = DocspecConfig -- Grammar ------------------------------------------------------------------------------- -docspecConfigGrammar - :: (OptionsGrammar c g, Applicative (g DocspecConfig)) - => g DocspecConfig DocspecConfig +docspecConfigGrammar :: OptionsGrammar c g => g DocspecConfig DocspecConfig docspecConfigGrammar = DocspecConfig - <$> rangeField "docspec" (field @"cfgDocspecEnabled") (cfgDocspecEnabled defaultDocspecConfig) + <$> rangeField "docspec" (field @"cfgDocspecEnabled") defaultDocspecConfig ^^^ help "Enable Docspec job" - <*> C.monoidalFieldAla "docspec-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgDocspecOptions") + <*> monoidalFieldAla "docspec-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgDocspecOptions") ^^^ metahelp "OPTS" "Additional Docspec options" - <*> C.optionalFieldDefAla "docspec-url" C.Token' (field @"cfgDocspecUrl") (cfgDocspecUrl defaultDocspecConfig) + <*> optionalFieldDefAla "docspec-url" C.Token' (field @"cfgDocspecUrl") defaultDocspecConfig ^^^ metahelp "URL" "URL to download cabal-docspec" - <*> C.optionalFieldDefAla "docspec-hash" C.Token' (field @"cfgDocspecHash") (cfgDocspecHash defaultDocspecConfig) + <*> optionalFieldDefAla "docspec-hash" C.Token' (field @"cfgDocspecHash") defaultDocspecConfig ^^^ metahelp "HASH" "SHA256 of cabal-docspec" diff --git a/src/HaskellCI/Config/Doctest.hs b/src/HaskellCI/Config/Doctest.hs index 92fce2b5..c981f805 100644 --- a/src/HaskellCI/Config/Doctest.hs +++ b/src/HaskellCI/Config/Doctest.hs @@ -1,7 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -module HaskellCI.Config.Doctest where +module HaskellCI.Config.Doctest ( + DoctestConfig (..), + initialDoctestConfig, + doctestConfigGrammar, +) where import HaskellCI.Prelude @@ -10,6 +14,7 @@ import Distribution.Version (majorBoundVersion) import qualified Distribution.FieldGrammar as C import qualified Distribution.Types.PackageName as C +import HaskellCI.GrammarDefault import HaskellCI.OptionsGrammar data DoctestConfig = DoctestConfig @@ -25,24 +30,28 @@ data DoctestConfig = DoctestConfig -- Default ------------------------------------------------------------------------------- -defaultDoctestVersion :: VersionRange -defaultDoctestVersion = majorBoundVersion (mkVersion [0,22,0]) +initialDoctestConfig :: DoctestConfig +initialDoctestConfig = DoctestConfig + { cfgDoctestEnabled = noVersion + , cfgDoctestOptions = [] + , cfgDoctestVersion = majorBoundVersion (mkVersion [0,22,0]) + , cfgDoctestFilterEnvPkgs = [] + , cfgDoctestFilterSrcPkgs = [] + } ------------------------------------------------------------------------------- -- Grammar ------------------------------------------------------------------------------- -doctestConfigGrammar - :: (OptionsGrammar c g, Applicative (g DoctestConfig)) - => g DoctestConfig DoctestConfig +doctestConfigGrammar :: OptionsGrammar c g => g DoctestConfig DoctestConfig doctestConfigGrammar = DoctestConfig - <$> rangeField "doctest" (field @"cfgDoctestEnabled") noVersion + <$> rangeField "doctest" (field @"cfgDoctestEnabled") initialDoctestConfig ^^^ help "Enable Doctest job" - <*> C.monoidalFieldAla "doctest-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgDoctestOptions") + <*> monoidalFieldAla "doctest-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgDoctestOptions") ^^^ metahelp "OPTS" "Additional Doctest options" - <*> C.optionalFieldDef "doctest-version" (field @"cfgDoctestVersion") defaultDoctestVersion + <*> optionalFieldDef "doctest-version" (field @"cfgDoctestVersion") initialDoctestConfig ^^^ metahelp "RANGE" "Doctest version" - <*> C.monoidalFieldAla "doctest-filter-packages" (C.alaList C.NoCommaFSep) (field @"cfgDoctestFilterEnvPkgs") + <*> monoidalFieldAla "doctest-filter-packages" (C.alaList C.NoCommaFSep) (field @"cfgDoctestFilterEnvPkgs") ^^^ metahelp "PKGS" "Filter packages from .ghc.environment file" - <*> C.monoidalFieldAla "doctest-skip" (C.alaList C.NoCommaFSep) (field @"cfgDoctestFilterSrcPkgs") + <*> monoidalFieldAla "doctest-skip" (C.alaList C.NoCommaFSep) (field @"cfgDoctestFilterSrcPkgs") ^^^ metahelp "PKGS" "Skip doctests for these packages" diff --git a/src/HaskellCI/Config/Dump.hs b/src/HaskellCI/Config/Dump.hs index efa3bab3..faeb1d2b 100644 --- a/src/HaskellCI/Config/Dump.hs +++ b/src/HaskellCI/Config/Dump.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FunctionalDependencies #-} module HaskellCI.Config.Dump where import HaskellCI.Prelude diff --git a/src/HaskellCI/Config/Empty.hs b/src/HaskellCI/Config/Empty.hs index 8883973f..e57822ab 100644 --- a/src/HaskellCI/Config/Empty.hs +++ b/src/HaskellCI/Config/Empty.hs @@ -3,8 +3,8 @@ module HaskellCI.Config.Empty where import HaskellCI.Prelude -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Fields as C +import qualified Distribution.FieldGrammar as C +import qualified Distribution.Fields as C import HaskellCI.OptionsGrammar diff --git a/src/HaskellCI/Config/Grammar.hs b/src/HaskellCI/Config/Grammar.hs new file mode 100644 index 00000000..abccfb6d --- /dev/null +++ b/src/HaskellCI/Config/Grammar.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module HaskellCI.Config.Grammar where + +import HaskellCI.Prelude + +import qualified Data.Map as M +import qualified Distribution.Compat.CharParsing as C +import qualified Distribution.Compat.Newtype as C +import qualified Distribution.FieldGrammar as C +import qualified Distribution.Parsec as C +import qualified Distribution.Pretty as C +import qualified Text.PrettyPrint as PP + +import HaskellCI.Config.Components +import HaskellCI.Config.CopyFields +import HaskellCI.Config.Docspec +import HaskellCI.Config.Doctest +import HaskellCI.Config.History +import HaskellCI.Config.Installed +import HaskellCI.Config.Jobs +import HaskellCI.Config.PackageScope +import HaskellCI.Config.Type +import HaskellCI.Config.Ubuntu +import HaskellCI.GrammarDefault +import HaskellCI.Newtypes +import HaskellCI.OptionsGrammar +import HaskellCI.TestedWith + +------------------------------------------------------------------------------- +-- Grammar +------------------------------------------------------------------------------- + +configGrammar + :: ( OptionsGrammar c g + , c Components + , c CopyFields + , c CopyFields + , c Env + , c HeadVersion + , c Jobs + , c Natural + , c PackageScope + , c TestedWithJobs + , c Ubuntu + , c Version + , c (C.List C.FSep (Identity Installed) Installed) + , Applicative (g DoctestConfig) + , Applicative (g DocspecConfig) + ) + => g Config Config +configGrammar = Config + <$> optionalFieldDefAla "cabal-install-version" HeadVersion (field @"cfgCabalInstallVersion") defaultConfig + ^^^ metahelp "VERSION" "cabal-install version for all jobs" + <*> optionalField "jobs" (field @"cfgJobs") + ^^^ metahelp "JOBS" "jobs (N:M - cabal:ghc)" + <*> optionalFieldDef "distribution" (field @"cfgUbuntu") defaultConfig + ^^^ metahelp "DIST" (concat + [ "distribution version (" + , intercalate ", " $ map showUbuntu [minBound..maxBound] + , ")" + ]) + <*> optionalFieldDef "jobs-selection" (field @"cfgTestedWith") defaultConfig + ^^^ metahelp "uniform|any" "Jobs selection across packages" + <*> rangeField "enabled" (field @"cfgEnabledJobs") defaultConfig + ^^^ metahelp "RANGE" "Restrict jobs selection futher from per package tested-with" + <*> optionalFieldDef "copy-fields" (field @"cfgCopyFields") defaultConfig + ^^^ metahelp "none|some|all" "Copy ? fields from cabal.project fields" + <*> monoidalFieldAla "local-ghc-options" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgLocalGhcOptions") + ^^^ metahelp "OPTS" "--ghc-options for local packages" + <*> booleanFieldDef "submodules" (field @"cfgSubmodules") defaultConfig + ^^^ help "Clone submodules, i.e. recursively" + <*> booleanFieldDef "cache" (field @"cfgCache") defaultConfig + ^^^ help "Disable caching" + <*> booleanFieldDef "install-dependencies" (field @"cfgInstallDeps") defaultConfig + ^^^ help "Skip separate dependency installation step" + <*> monoidalFieldAla "installed" (C.alaList C.FSep) (field @"cfgInstalled") + ^^^ metahelp "+/-PKG" "Specify 'constraint: ... installed' packages" + <*> rangeField "tests" (field @"cfgTests") defaultConfig + ^^^ metahelp "RANGE" "Build tests with" + <*> rangeField "run-tests" (field @"cfgRunTests") defaultConfig + ^^^ metahelp "RANGE" "Run tests with (note: only built tests are run)" + <*> rangeField "benchmarks" (field @"cfgBenchmarks") defaultConfig + ^^^ metahelp "RANGE" "Build benchmarks" + <*> rangeField "haddock" (field @"cfgHaddock") defaultConfig + ^^^ metahelp "RANGE" "Haddock step" + <*> optionalFieldDef "haddock-components" (field @"cfgHaddockComponents") defaultConfig + ^^^ metahelp "all|libs" "Haddock components" + <*> rangeField "no-tests-no-benchmarks" (field @"cfgNoTestsNoBench") defaultConfig + ^^^ metahelp "RANGE" "Build without tests and benchmarks" + <*> rangeField "unconstrained" (field @"cfgUnconstrainted") defaultConfig + ^^^ metahelp "RANGE" "Make unconstrained build" + <*> rangeField "head-hackage" (field @"cfgHeadHackage") defaultConfig + ^^^ metahelp "RANGE" "Use head.hackage repository. Also marks as allow-failures" + <*> booleanFieldDef "head-hackage-override" (field @"cfgHeadHackageOverride") defaultConfig + ^^^ help "Use :override for head.hackage repository" + <*> booleanFieldDef "ghcjs-tests" (field @"cfgGhcjsTests") defaultConfig + ^^^ help "Run tests with GHCJS (experimental, relies on cabal-plan finding test-suites)" + <*> monoidalFieldAla "ghcjs-tools" (C.alaList C.FSep) (field @"cfgGhcjsTools") +-- ^^^ metahelp "TOOL" "Additional host tools to install with GHCJS" + <*> booleanFieldDef "test-output-direct" (field @"cfgTestOutputDirect") defaultConfig + ^^^ help "Use --test-show-details=direct, may cause problems with build-type: Custom" + <*> booleanFieldDef "cabal-check" (field @"cfgCheck") defaultConfig + ^^^ help "Disable cabal check run" + <*> monoidalFieldAla "branches" (C.alaList' C.FSep C.Token') (field @"cfgOnlyBranches") + ^^^ metahelp "BRANCH" "Enable builds only for specific branches" + <*> monoidalFieldAla "irc-channels" (C.alaList' C.FSep C.Token') (field @"cfgIrcChannels") + ^^^ metahelp "IRC" "Enable IRC notifications to given channel (e.g. 'irc.libera.chat#haskell-lens')" + <*> freeTextField "irc-nickname" (field @"cfgIrcNickname") + ^^^ metahelp "NICKNAME" "Nickname with which to authenticate to an IRC server. Only used if `irc-channels` are set." + <*> freeTextField "irc-password" (field @"cfgIrcPassword") + ^^^ metahelp "PASSWORD" "Password with which to authenticate to an IRC server. Only used if `irc-channels` are set." + <*> booleanFieldDef "irc-if-in-origin-repo" (field @"cfgIrcIfInOriginRepo") defaultConfig + ^^^ help "Only send IRC notifications if run from the original remote (GitHub Actions only)" + <*> booleanFieldDef "email-notifications" (field @"cfgEmailNotifications") defaultConfig + ^^^ help "Disable email notifications" + <*> optionalFieldAla "project-name" C.Token' (field @"cfgProjectName") + ^^^ metahelp "NAME" "Project name (used for IRC notifications), defaults to package name or name of first package listed in cabal.project file" + <*> booleanFieldDef "ghc-head" (field @"cfgGhcHead") defaultConfig + ^^^ help "Add ghc-head job" + <*> booleanFieldDef "postgresql" (field @"cfgPostgres") defaultConfig + ^^^ help "Add postgresql service" + <*> booleanFieldDef "google-chrome" (field @"cfgGoogleChrome") defaultConfig + ^^^ help "Add google-chrome service" + <*> monoidalFieldAla "env" Env (field @"cfgEnv") + ^^^ metahelp "ENV" "Environment variables per job (e.g. `8.0.2:HADDOCK=false`)" + <*> optionalFieldDefAla "allow-failures" Range (field @"cfgAllowFailures") defaultConfig + ^^^ metahelp "JOB" "Allow failures of particular GHC version" + <*> booleanFieldDef "last-in-series" (field @"cfgLastInSeries") defaultConfig + ^^^ help "[Discouraged] Assume there are only GHCs last in major series: 8.2.* will match only 8.2.2" + <*> rangeField "linux-jobs" (field @"cfgLinuxJobs") defaultConfig + ^^^ metahelp "RANGE" "Jobs to build on Linux" + <*> rangeField "macos-jobs" (field @"cfgMacosJobs") defaultConfig + ^^^ metahelp "RANGE" "Jobs to additionally build with OSX" + <*> booleanFieldDef "ghcup-cabal" (field @"cfgGhcupCabal") defaultConfig + ^^^ help "Use (or don't) ghcup to install cabal" + <*> rangeField "ghcup-jobs" (field @"cfgGhcupJobs") defaultConfig + ^^^ metahelp "RANGE" "(Linux) jobs to use ghcup to install tools" + <*> optionalFieldDef "ghcup-version" (field @"cfgGhcupVersion") defaultConfig + ^^^ metahelp "VERSION" "ghcup version" + <*> monoidalFieldAla "apt" (alaSet' C.NoCommaFSep C.Token') (field @"cfgApt") + ^^^ metahelp "PKG" "Additional apt packages to install" + <*> monoidalFieldAla "travis-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgTravisPatches") + ^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated Travis YAML file" + <*> monoidalFieldAla "github-patches" (C.alaList' C.NoCommaFSep C.Token') (field @"cfgGitHubPatches") + ^^^ metaActionHelp "PATCH" "file" ".patch files to apply to the generated GitHub Actions YAML file" + <*> booleanFieldDef "insert-version" (field @"cfgInsertVersion") defaultConfig + ^^^ help "Don't insert the haskell-ci version into the generated Travis YAML file" + <*> optionalFieldDef "error-missing-methods" (field @"cfgErrorMissingMethods") defaultConfig + ^^^ metahelp "PKGSCOPE" "Insert -Werror=missing-methods for package scope (none, local, all)" + <*> C.blurFieldGrammar (field @"cfgDoctest") doctestConfigGrammar + <*> C.blurFieldGrammar (field @"cfgDocspec") docspecConfigGrammar + <*> pure [] -- constraint sets + <*> pure [] -- raw project fields + <*> freeTextFieldDef "raw-travis" (field @"cfgRawTravis") + ^^^ help "Raw travis commands which will be run at the very end of the script" + <*> freeTextField "github-action-name" (field @"cfgGitHubActionName") + ^^^ help "The name of GitHub Action" + <*> optionalFieldDef "timeout-minutes" (field @"cfgTimeoutMinutes") defaultConfig + ^^^ metahelp "MINUTES" "The maximum number of minutes to let a job run" + +------------------------------------------------------------------------------- +-- Env +------------------------------------------------------------------------------- + +newtype Env = Env (M.Map Version String) + deriving anyclass (C.Newtype (M.Map Version String)) + +instance C.Parsec Env where + parsec = Env . M.fromList <$> C.parsecLeadingCommaList p where + p = do + v <- C.parsec + _ <- C.char ':' + s <- C.munch1 $ \c -> c /= ',' + return (v, s) + +instance C.Pretty Env where + pretty (Env m) = PP.fsep . PP.punctuate PP.comma . map p . M.toList $ m where + p (v, s) = C.pretty v PP.<> PP.colon PP.<> PP.text s diff --git a/src/HaskellCI/Config/History.hs b/src/HaskellCI/Config/History.hs new file mode 100644 index 00000000..16fa18ce --- /dev/null +++ b/src/HaskellCI/Config/History.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +module HaskellCI.Config.History where + +import HaskellCI.Config.Initial +import HaskellCI.Config.Type +import HaskellCI.Config.Ubuntu +import HaskellCI.Prelude + +configHistory :: [([Int], Config -> Config)] +configHistory = + [ ver 0 19 20240414 := \cfg -> cfg + -- https://github.com/haskell-CI/haskell-ci/pull/713/files (docspec) + , ver 0 19 20240420 := \cfg -> cfg + & field @"cfgUbuntu" .~ Jammy + , ver 0 19 20240513 := \cfg -> cfg + -- defaultHeadHackage = C.orLaterVersion (C.mkVersion [9,11]) + ] + where + ver x y z = [x, y, z] + +defaultConfig :: Config +defaultConfig = foldl' f initialConfig configHistory + where + f !cfg (_, g) = g cfg diff --git a/src/HaskellCI/Config/Initial.hs b/src/HaskellCI/Config/Initial.hs new file mode 100644 index 00000000..eb425979 --- /dev/null +++ b/src/HaskellCI/Config/Initial.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +module HaskellCI.Config.Initial where + +import HaskellCI.Prelude + +import qualified Distribution.Version as C + +import HaskellCI.Config.Components +import HaskellCI.Config.CopyFields +import HaskellCI.Config.Docspec +import HaskellCI.Config.Doctest +import HaskellCI.Config.PackageScope +import HaskellCI.Config.Type +import HaskellCI.Config.Ubuntu +import HaskellCI.Ghcup +import HaskellCI.HeadHackage +import HaskellCI.TestedWith + +-- | This is an "initial" configuration. It's meant to stay immutable. +-- All changes to defaults should be done in History. +initialConfig :: Config +initialConfig = Config + { cfgCabalInstallVersion = Just (C.mkVersion [3,10]) + , cfgJobs = Nothing + , cfgUbuntu = Bionic + , cfgTestedWith = TestedWithUniform + , cfgEnabledJobs = anyVersion + , cfgCopyFields = CopyFieldsSome + , cfgLocalGhcOptions = [] + , cfgSubmodules = False + , cfgCache = True + , cfgInstallDeps = True + , cfgInstalled = [] + , cfgTests = anyVersion + , cfgRunTests = anyVersion + , cfgBenchmarks = anyVersion + , cfgHaddock = anyVersion + , cfgHaddockComponents = ComponentsAll + , cfgNoTestsNoBench = anyVersion + , cfgUnconstrainted = anyVersion + , cfgHeadHackage = defaultHeadHackage + , cfgHeadHackageOverride = True + , cfgGhcjsTests = False + , cfgGhcjsTools = [] + , cfgTestOutputDirect = True + , cfgCheck = True + , cfgOnlyBranches = [] + , cfgIrcChannels = [] + , cfgIrcNickname = Nothing + , cfgIrcPassword = Nothing + , cfgIrcIfInOriginRepo = False + , cfgEmailNotifications = True + , cfgProjectName = Nothing + , cfgGhcHead = False + , cfgPostgres = False + , cfgGoogleChrome = False + , cfgEnv = mempty + , cfgAllowFailures = noVersion + , cfgLastInSeries = False + , cfgLinuxJobs = anyVersion + , cfgMacosJobs = noVersion + , cfgGhcupCabal = True + , cfgGhcupJobs = C.unionVersionRanges (C.intersectVersionRanges (C.laterVersion (mkVersion [8,10,4])) (C.earlierVersion (mkVersion [9]))) (C.laterVersion (mkVersion [9,0,1])) + , cfgGhcupVersion = defaultGhcupVersion + , cfgApt = mempty + , cfgTravisPatches = [] + , cfgGitHubPatches = [] + , cfgInsertVersion = True + , cfgErrorMissingMethods = PackageScopeLocal + , cfgDoctest = initialDoctestConfig + , cfgDocspec = defaultDocspecConfig + , cfgConstraintSets = [] + , cfgRawProject = [] + , cfgRawTravis = "" + , cfgGitHubActionName = Nothing + , cfgTimeoutMinutes = 60 + } diff --git a/src/HaskellCI/Config/PackageScope.hs b/src/HaskellCI/Config/PackageScope.hs index 19fc72a1..d31e7cc6 100644 --- a/src/HaskellCI/Config/PackageScope.hs +++ b/src/HaskellCI/Config/PackageScope.hs @@ -14,7 +14,7 @@ data PackageScope deriving (Eq, Show) instance C.Parsec PackageScope where - parsec = + parsec = PackageScopeNone <$ C.string "none" <|> PackageScopeLocal <$ C.string "local" <|> PackageScopeAll <$ C.string "all" diff --git a/src/HaskellCI/Config/Type.hs b/src/HaskellCI/Config/Type.hs new file mode 100644 index 00000000..70de036e --- /dev/null +++ b/src/HaskellCI/Config/Type.hs @@ -0,0 +1,82 @@ +module HaskellCI.Config.Type where + +import HaskellCI.Prelude + +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Distribution.Fields as C +import qualified Distribution.Types.PackageName as C + +import HaskellCI.Config.Components +import HaskellCI.Config.ConstraintSet +import HaskellCI.Config.CopyFields +import HaskellCI.Config.Docspec +import HaskellCI.Config.Doctest +import HaskellCI.Config.Installed +import HaskellCI.Config.Jobs +import HaskellCI.Config.PackageScope +import HaskellCI.Config.Ubuntu +import HaskellCI.TestedWith + +------------------------------------------------------------------------------- +-- Config +------------------------------------------------------------------------------- + +-- TODO: split other blocks like DoctestConfig +data Config = Config + { 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 :: ![C.PackageName] + , cfgTestOutputDirect :: !Bool + , cfgCheck :: !Bool + , cfgOnlyBranches :: [String] + , cfgIrcChannels :: [String] + , cfgIrcNickname :: Maybe String + , cfgIrcPassword :: Maybe String + , cfgIrcIfInOriginRepo :: Bool + , cfgEmailNotifications :: Bool + , cfgProjectName :: Maybe String + , cfgGhcHead :: !Bool + , cfgPostgres :: !Bool + , cfgGoogleChrome :: !Bool + , cfgEnv :: M.Map Version String + , cfgAllowFailures :: !VersionRange + , cfgLastInSeries :: !Bool + , cfgLinuxJobs :: !VersionRange + , cfgMacosJobs :: !VersionRange + , cfgGhcupCabal :: !Bool + , cfgGhcupJobs :: !VersionRange + , cfgGhcupVersion :: !Version + , cfgApt :: S.Set String + , cfgTravisPatches :: [FilePath] + , cfgGitHubPatches :: [FilePath] + , cfgInsertVersion :: !Bool + , cfgErrorMissingMethods :: !PackageScope + , cfgDoctest :: !DoctestConfig + , cfgDocspec :: !DocspecConfig + , cfgConstraintSets :: [ConstraintSet] + , cfgRawProject :: [C.PrettyField ()] + , cfgRawTravis :: !String + , cfgGitHubActionName :: !(Maybe String) + , cfgTimeoutMinutes :: !Natural + } + deriving (Generic) diff --git a/src/HaskellCI/Config/Ubuntu.hs b/src/HaskellCI/Config/Ubuntu.hs index abef3c31..86271e19 100644 --- a/src/HaskellCI/Config/Ubuntu.hs +++ b/src/HaskellCI/Config/Ubuntu.hs @@ -6,13 +6,20 @@ import qualified Distribution.Parsec as C import qualified Distribution.Pretty as C import qualified Text.PrettyPrint as PP -data Ubuntu = Focal | Jammy | Noble +data Ubuntu + = Xenial + | Bionic + | Focal + | Jammy + | Noble deriving (Eq, Ord, Show, Enum, Bounded) instance C.Parsec Ubuntu where parsec = do t <- C.parsecToken case t of + "xenial" -> return Xenial + "bionic" -> return Bionic "focal" -> return Focal "jammy" -> return Jammy "noble" -> return Noble @@ -22,6 +29,8 @@ instance C.Pretty Ubuntu where pretty = PP.text . showUbuntu showUbuntu :: Ubuntu -> String +showUbuntu Xenial = "xenial" +showUbuntu Bionic = "bionic" showUbuntu Focal = "focal" showUbuntu Jammy = "jammy" showUbuntu Noble = "noble" diff --git a/src/HaskellCI/Config/Validity.hs b/src/HaskellCI/Config/Validity.hs index 252b5935..fb5e0b7d 100644 --- a/src/HaskellCI/Config/Validity.hs +++ b/src/HaskellCI/Config/Validity.hs @@ -5,17 +5,13 @@ module HaskellCI.Config.Validity where import HaskellCI.Prelude 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 _ _ = do - return () -{- - when (anyGHCJS && cfgUbuntu > Bionic) $ - throwErr $ ValidationError $ "Using GHCJS requires Ubuntu 16.04 (Xenial) or 18.04 (Bionic)." - where - anyGHCJS = any isGHCJS linuxVersions --} +checkConfigValidity Config {..} _ = do + unless (cfgUbuntu >= Focal) $ + throwErr $ ValidationError $ prettyShow cfgUbuntu ++ "distribution is not supported" diff --git a/src/HaskellCI/GitConfig.hs b/src/HaskellCI/GitConfig.hs index 1f513ce8..85230f1f 100644 --- a/src/HaskellCI/GitConfig.hs +++ b/src/HaskellCI/GitConfig.hs @@ -54,4 +54,4 @@ sectionP = do remote <- Atto.takeWhile (/= '"') _ <- Atto.char '"' return remote - + diff --git a/src/HaskellCI/GitHub.hs b/src/HaskellCI/GitHub.hs index 7c8c99e8..52f6940c 100644 --- a/src/HaskellCI/GitHub.hs +++ b/src/HaskellCI/GitHub.hs @@ -30,6 +30,7 @@ import qualified Distribution.Version as C import Cabal.Project import HaskellCI.Auxiliary +import HaskellCI.Cabal import HaskellCI.Compiler import HaskellCI.Config import HaskellCI.Config.ConstraintSet @@ -40,7 +41,6 @@ import HaskellCI.Config.Jobs import HaskellCI.Config.PackageScope import HaskellCI.Config.Ubuntu import HaskellCI.Config.Validity -import HaskellCI.Cabal import HaskellCI.GitConfig import HaskellCI.GitHub.Yaml import HaskellCI.HeadHackage diff --git a/src/HaskellCI/GrammarDefault.hs b/src/HaskellCI/GrammarDefault.hs new file mode 100644 index 00000000..8514b816 --- /dev/null +++ b/src/HaskellCI/GrammarDefault.hs @@ -0,0 +1,37 @@ +module HaskellCI.GrammarDefault where + +import HaskellCI.Prelude + +import qualified Distribution.Compat.Lens as C +import qualified Distribution.Compat.Newtype as C +import qualified Distribution.FieldGrammar as C +import qualified Distribution.Fields as C + +import HaskellCI.OptionsGrammar + +blurFieldGrammar :: OptionsGrammar c g => C.ALens' a b -> g b d -> g a d +blurFieldGrammar = C.blurFieldGrammar + +monoidalFieldAla :: (OptionsGrammar c g, C.Newtype a b, c b, Monoid a) => C.FieldName -> (a -> b) -> C.ALens' s a -> g s a +monoidalFieldAla = C.monoidalFieldAla + +freeTextField :: OptionsGrammar c g => C.FieldName -> C.ALens' s (Maybe String) -> g s (Maybe String) +freeTextField = C.freeTextField + +freeTextFieldDef :: OptionsGrammar c g => C.FieldName -> C.ALens' s String -> g s String +freeTextFieldDef = C.freeTextFieldDef + +booleanFieldDef :: (OptionsGrammar c g) => C.FieldName -> C.ALens' s Bool -> s -> g s Bool +booleanFieldDef fn l s = C.booleanFieldDef fn l (C.aview l s) + +optionalField :: (OptionsGrammar c g, c a) => C.FieldName -> C.ALens' s (Maybe a) -> g s (Maybe a) +optionalField fn l = C.optionalField fn l + +optionalFieldAla :: (OptionsGrammar c g, C.Newtype a b, c b) => C.FieldName -> (a -> b) -> C.ALens' s (Maybe a) -> g s (Maybe a) +optionalFieldAla fn pack l = C.optionalFieldAla fn pack l + +optionalFieldDef :: (OptionsGrammar c g, c a, Eq a) => C.FieldName -> C.ALens' s a -> s -> g s a +optionalFieldDef fn l s = C.optionalFieldDef fn l (C.aview l s) + +optionalFieldDefAla :: (OptionsGrammar c g, C.Newtype a b, c b, Eq a) => C.FieldName -> (a -> b) -> C.ALens' s a -> s -> g s a +optionalFieldDefAla fn pack l s = C.optionalFieldDefAla fn pack l (C.aview l s) diff --git a/src/HaskellCI/HeadHackage.hs b/src/HaskellCI/HeadHackage.hs index 35a1da14..3f48e34a 100644 --- a/src/HaskellCI/HeadHackage.hs +++ b/src/HaskellCI/HeadHackage.hs @@ -16,7 +16,7 @@ headHackageRepoStanza override = , " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" , " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" , " key-threshold: 3" - ] ++ + ] ++ activeRepositories where activeRepositories diff --git a/src/HaskellCI/OptionsGrammar.hs b/src/HaskellCI/OptionsGrammar.hs index 0f08fa78..ee509479 100644 --- a/src/HaskellCI/OptionsGrammar.hs +++ b/src/HaskellCI/OptionsGrammar.hs @@ -57,8 +57,8 @@ class help _ = id -- we treat range fields specially in options - rangeField :: C.FieldName -> C.ALens' s C.VersionRange -> C.VersionRange -> p s C.VersionRange - rangeField fn = C.optionalFieldDefAla fn Range + rangeField :: C.FieldName -> C.ALens' s C.VersionRange -> s -> p s C.VersionRange + rangeField fn l s = C.optionalFieldDefAla fn Range l (C.aview l s) metaActionHelp :: OptionsGrammar c p => MetaVar -> BashCompletionAction -> Help -> p s a -> p s a metaActionHelp m a = metaCompleterHelp m (O.bashCompleter a) diff --git a/src/HaskellCI/OptparseGrammar.hs b/src/HaskellCI/OptparseGrammar.hs index 4643b40b..a864f54e 100644 --- a/src/HaskellCI/OptparseGrammar.hs +++ b/src/HaskellCI/OptparseGrammar.hs @@ -108,12 +108,13 @@ instance OptionsGrammar ParsecPretty OptparseGrammar where -- -- where the --no-tests has help, because it's not default. -- - rangeField fn l def = OG + rangeField fn l s = OG [ SP $ \_m _c h -> setOG l $ O.flag' C.anyVersion $ flagMods fn (th h) , SP $ \_m _c h -> setOG l $ O.flag' C.noVersion $ flagMods ("no-" <> fn) (fh h) , SP $ \_m _c _h -> setOG l $ O.option readMParsec $ O.long (fromUTF8BS $ fn <> "-jobs") <> O.metavar "RANGE" ] where + def = C.aview l s th h = if equivVersionRanges def C.anyVersion then Nothing else h fh h = if equivVersionRanges def C.anyVersion then h else Nothing diff --git a/src/HaskellCI/Prelude.hs b/src/HaskellCI/Prelude.hs index 7d844aef..f2e4dbd5 100644 --- a/src/HaskellCI/Prelude.hs +++ b/src/HaskellCI/Prelude.hs @@ -1,10 +1,11 @@ +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} module HaskellCI.Prelude ( module Prelude.Compat, module X, module HaskellCI.Prelude, - ) where +) where import Prelude.Compat hiding (head, tail) @@ -113,3 +114,10 @@ instance C.Parsec Natural where instance C.Pretty Natural where pretty = PP.text . show + +type a := b = (a, b) + +pattern (:=) :: a -> b -> a := b +pattern a := b = (a, b) + +infixr 0 := diff --git a/src/HaskellCI/ShVersionRange.hs b/src/HaskellCI/ShVersionRange.hs index 7767e164..3a32e5dd 100644 --- a/src/HaskellCI/ShVersionRange.hs +++ b/src/HaskellCI/ShVersionRange.hs @@ -6,8 +6,8 @@ module HaskellCI.ShVersionRange ( import HaskellCI.Prelude -import Algebra.Lattice (joins) import Algebra.Heyting.Free (Free (..)) +import Algebra.Lattice (joins) import qualified Algebra.Heyting.Free as F import qualified Data.Set as S diff --git a/src/HaskellCI/TestedWith.hs b/src/HaskellCI/TestedWith.hs index 2268ac15..83ae3af5 100644 --- a/src/HaskellCI/TestedWith.hs +++ b/src/HaskellCI/TestedWith.hs @@ -6,8 +6,8 @@ module HaskellCI.TestedWith ( import Prelude () import Prelude.Compat -import Control.Applicative ((<|>)) -import Data.List (intercalate) +import Control.Applicative ((<|>)) +import Data.List (intercalate) import qualified Data.Foldable as F import qualified Data.Set as S diff --git a/src/HaskellCI/VersionInfo.hs b/src/HaskellCI/VersionInfo.hs index 9b1a3233..fa8b1cc4 100644 --- a/src/HaskellCI/VersionInfo.hs +++ b/src/HaskellCI/VersionInfo.hs @@ -6,7 +6,7 @@ module HaskellCI.VersionInfo ( import HaskellCI.Prelude -import Data.Map (Map) +import Data.Map (Map) import qualified Data.Map as Map diff --git a/src/HaskellCI/YamlSyntax.hs b/src/HaskellCI/YamlSyntax.hs index 1eb91caf..5301dfb0 100644 --- a/src/HaskellCI/YamlSyntax.hs +++ b/src/HaskellCI/YamlSyntax.hs @@ -26,13 +26,13 @@ import Data.Char (isControl, isPrint, ord) import Data.List (dropWhileEnd) import Data.Monoid (Endo (..)) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Encoding as AE +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encoding as AE #if MIN_VERSION_aeson(2,0,0) -import qualified Data.Aeson.Key as AK -import qualified Data.Aeson.KeyMap as AKM +import qualified Data.Aeson.Key as AK +import qualified Data.Aeson.KeyMap as AKM #else -import qualified Data.HashMap.Strict as HM +import qualified Data.HashMap.Strict as HM #endif import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M