{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module HaskellCI.Auxiliary (
    Auxiliary (..),
    auxiliary,
    pkgNameDirVariable',
    pkgNameDirVariable,
) where

import HaskellCI.Prelude
import Prelude           (head)

import qualified Data.Set                                     as S
import qualified Distribution.CabalSpecVersion                as C
import qualified Distribution.FieldGrammar.Pretty             as C
import qualified Distribution.Fields.Pretty                   as C
import qualified Distribution.Pretty                          as C
import qualified Distribution.Types.GenericPackageDescription as C
import qualified Distribution.Types.VersionRange              as C
import qualified Network.URI                                  as URI
import qualified Text.PrettyPrint                             as PP

import Cabal.Optimization
import Cabal.Project
import Cabal.SourceRepo
import HaskellCI.Compiler
import HaskellCI.Config
import HaskellCI.Config.Components
import HaskellCI.Config.CopyFields
import HaskellCI.Config.Docspec
import HaskellCI.Config.Doctest
import HaskellCI.Jobs
import HaskellCI.List
import HaskellCI.Package

-- | Auxiliary definitions, probably useful for all backends
data Auxiliary = Auxiliary
    { Auxiliary -> [Package]
pkgs                    :: [Package]
    , Auxiliary -> [URI]
uris                    :: [URI]
    , Auxiliary -> [Char]
projectName             :: String
    , Auxiliary -> Bool
doctestEnabled          :: Bool
    , Auxiliary -> Bool
docspecEnabled          :: Bool
    , Auxiliary -> CompilerRange
hasTests                :: CompilerRange
    , Auxiliary -> Bool
hasLibrary              :: Bool
    , Auxiliary -> [Char] -> [PrettyField ()]
extraCabalProjectFields :: FilePath -> [C.PrettyField ()]
    , Auxiliary -> [Char]
testShowDetails         :: String
    , Auxiliary -> Bool
anyJobUsesHeadHackage   :: Bool
    , Auxiliary -> Bool
runHaddock              :: Bool
    , Auxiliary -> [Char]
haddockFlags            :: String
    }

auxiliary :: Config -> Project URI Void Package -> JobVersions -> Auxiliary
auxiliary :: Config -> Project URI Void Package -> JobVersions -> Auxiliary
auxiliary Config {Bool
Natural
[Char]
[[Char]]
[PackageName]
[PrettyField ()]
[Installed]
[ConstraintSet]
Maybe [Char]
Maybe Version
Maybe Jobs
VersionRange
Version
Set [Char]
Set Fold
Map Version [Char]
Ubuntu
PackageScope
HLintConfig
DoctestConfig
DocspecConfig
CopyFields
Components
TestedWithJobs
cfgTimeoutMinutes :: Config -> Natural
cfgGitHubActionName :: Config -> Maybe [Char]
cfgRawTravis :: Config -> [Char]
cfgRawProject :: Config -> [PrettyField ()]
cfgConstraintSets :: Config -> [ConstraintSet]
cfgHLint :: Config -> HLintConfig
cfgDocspec :: Config -> DocspecConfig
cfgDoctest :: Config -> DoctestConfig
cfgErrorMissingMethods :: Config -> PackageScope
cfgInsertVersion :: Config -> Bool
cfgGitHubPatches :: Config -> [[Char]]
cfgTravisPatches :: Config -> [[Char]]
cfgApt :: Config -> Set [Char]
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 [Char]
cfgGoogleChrome :: Config -> Bool
cfgPostgres :: Config -> Bool
cfgGhcHead :: Config -> Bool
cfgFolds :: Config -> Set Fold
cfgProjectName :: Config -> Maybe [Char]
cfgEmailNotifications :: Config -> Bool
cfgIrcIfInOriginRepo :: Config -> Bool
cfgIrcPassword :: Config -> Maybe [Char]
cfgIrcNickname :: Config -> Maybe [Char]
cfgIrcChannels :: Config -> [[Char]]
cfgOnlyBranches :: Config -> [[Char]]
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 -> [[Char]]
cfgCopyFields :: Config -> CopyFields
cfgEnabledJobs :: Config -> VersionRange
cfgTestedWith :: Config -> TestedWithJobs
cfgUbuntu :: Config -> Ubuntu
cfgJobs :: Config -> Maybe Jobs
cfgCabalInstallVersion :: Config -> Maybe Version
cfgTimeoutMinutes :: Natural
cfgGitHubActionName :: Maybe [Char]
cfgRawTravis :: [Char]
cfgRawProject :: [PrettyField ()]
cfgConstraintSets :: [ConstraintSet]
cfgHLint :: HLintConfig
cfgDocspec :: DocspecConfig
cfgDoctest :: DoctestConfig
cfgErrorMissingMethods :: PackageScope
cfgInsertVersion :: Bool
cfgGitHubPatches :: [[Char]]
cfgTravisPatches :: [[Char]]
cfgApt :: Set [Char]
cfgGhcupVersion :: Version
cfgGhcupJobs :: VersionRange
cfgGhcupCabal :: Bool
cfgMacosJobs :: VersionRange
cfgLinuxJobs :: VersionRange
cfgLastInSeries :: Bool
cfgAllowFailures :: VersionRange
cfgEnv :: Map Version [Char]
cfgGoogleChrome :: Bool
cfgPostgres :: Bool
cfgGhcHead :: Bool
cfgFolds :: Set Fold
cfgProjectName :: Maybe [Char]
cfgEmailNotifications :: Bool
cfgIrcIfInOriginRepo :: Bool
cfgIrcPassword :: Maybe [Char]
cfgIrcNickname :: Maybe [Char]
cfgIrcChannels :: [[Char]]
cfgOnlyBranches :: [[Char]]
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 :: [[Char]]
cfgCopyFields :: CopyFields
cfgEnabledJobs :: VersionRange
cfgTestedWith :: TestedWithJobs
cfgUbuntu :: Ubuntu
cfgJobs :: Maybe Jobs
cfgCabalInstallVersion :: Maybe Version
..} Project URI Void Package
prj JobVersions {Set CompilerVersion
macosVersions :: JobVersions -> Set CompilerVersion
linuxVersions :: JobVersions -> Set CompilerVersion
allVersions :: JobVersions -> Set CompilerVersion
macosVersions :: Set CompilerVersion
linuxVersions :: Set CompilerVersion
allVersions :: Set CompilerVersion
..} = Auxiliary {Bool
[Char]
[URI]
[Package]
CompilerRange
[Char] -> [PrettyField ()]
anyJobUsesHeadHackage :: Bool
extraCabalProjectFields :: [Char] -> [PrettyField ()]
haddockFlags :: [Char]
runHaddock :: Bool
hasLibrary :: Bool
hasTests :: CompilerRange
testShowDetails :: [Char]
docspecEnabled :: Bool
doctestEnabled :: Bool
projectName :: [Char]
uris :: [URI]
pkgs :: [Package]
haddockFlags :: [Char]
runHaddock :: Bool
anyJobUsesHeadHackage :: Bool
testShowDetails :: [Char]
extraCabalProjectFields :: [Char] -> [PrettyField ()]
hasLibrary :: Bool
hasTests :: CompilerRange
docspecEnabled :: Bool
doctestEnabled :: Bool
projectName :: [Char]
uris :: [URI]
pkgs :: [Package]
..}
  where
    pkgs :: [Package]
pkgs = forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project URI Void Package
prj
    uris :: [URI]
uris = forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project URI Void Package
prj
    projectName :: [Char]
projectName = forall a. a -> Maybe a -> a
fromMaybe (Package -> [Char]
pkgName forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
Prelude.head [Package]
pkgs) Maybe [Char]
cfgProjectName

    doctestEnabled :: Bool
doctestEnabled = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. a -> (Version -> a) -> CompilerVersion -> a
maybeGHC Bool
False (Version -> VersionRange -> Bool
`C.withinRange` DoctestConfig -> VersionRange
cfgDoctestEnabled DoctestConfig
cfgDoctest)) Set CompilerVersion
linuxVersions
    docspecEnabled :: Bool
docspecEnabled = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. a -> (Version -> a) -> CompilerVersion -> a
maybeGHC Bool
False (Version -> VersionRange -> Bool
`C.withinRange` DocspecConfig -> VersionRange
cfgDocspecEnabled DocspecConfig
cfgDocspec)) Set CompilerVersion
linuxVersions

    testShowDetails :: [Char]
testShowDetails
        | Bool
cfgTestOutputDirect = [Char]
" --test-show-details=direct"
        | Bool
otherwise           = [Char]
""

    -- version range which has tests
    hasTests :: CompilerRange
    hasTests :: CompilerRange
hasTests = Set CompilerVersion -> CompilerRange
RangePoints forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions
        [ Set CompilerVersion
pkgJobs
        | Pkg{GenericPackageDescription
pkgGpd :: Package -> GenericPackageDescription
pkgGpd :: GenericPackageDescription
pkgGpd,Set CompilerVersion
pkgJobs :: Package -> Set CompilerVersion
pkgJobs :: Set CompilerVersion
pkgJobs} <- [Package]
pkgs
        , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
C.condTestSuites GenericPackageDescription
pkgGpd
        ]

    hasLibrary :: Bool
hasLibrary = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Pkg{GenericPackageDescription
pkgGpd :: GenericPackageDescription
pkgGpd :: Package -> GenericPackageDescription
pkgGpd} -> forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
C.condLibrary GenericPackageDescription
pkgGpd) [Package]
pkgs

    runHaddock :: Bool
runHaddock = Bool -> Bool
not (VersionRange -> VersionRange -> Bool
equivVersionRanges VersionRange
C.noVersion VersionRange
cfgHaddock)
        Bool -> Bool -> Bool
&& case Components
cfgHaddockComponents of
            Components
ComponentsAll  -> Bool
True
            Components
ComponentsLibs -> Bool
hasLibrary

    haddockFlags :: [Char]
haddockFlags = case Components
cfgHaddockComponents of
        Components
ComponentsAll  -> [Char]
" --haddock-all"
        Components
ComponentsLibs -> [Char]
""

    extraCabalProjectFields :: FilePath -> [C.PrettyField ()]
    extraCabalProjectFields :: [Char] -> [PrettyField ()]
extraCabalProjectFields [Char]
rootdir = forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$ do
        -- generate package fields for URI packages.
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [URI]
uris forall a b. (a -> b) -> a -> b
$ \URI
uri ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"packages" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text forall a b. (a -> b) -> a -> b
$ case URI -> [Char]
URI.uriScheme URI
uri of
                [Char]
"file:" -> [Char]
rootdir forall a. [a] -> [a] -> [a]
++ URI -> [Char]
URI.uriPath URI
uri
                [Char]
_       -> ([Char] -> [Char]) -> URI -> [Char] -> [Char]
uriToString forall a. a -> a
id URI
uri [Char]
""

        -- copy fields from original cabal.project
        case CopyFields
cfgCopyFields of
            CopyFields
CopyFieldsNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            CopyFields
CopyFieldsSome -> ListBuilder (PrettyField ()) ()
copyFieldsSome
            CopyFields
CopyFieldsAll  -> ListBuilder (PrettyField ()) ()
copyFieldsSome forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall x. x -> ListBuilder x ()
item (forall uri opt pkg. Project uri opt pkg -> [PrettyField ()]
prjOtherFields Project URI Void Package
prj)

        -- local ghc-options
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
cfgLocalGhcOptions) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Package]
pkgs forall a b. (a -> b) -> a -> b
$ \Pkg{[Char]
pkgName :: [Char]
pkgName :: Package -> [Char]
pkgName} -> do
            let s :: [Char]
s = [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc
C.showToken) [[Char]]
cfgLocalGhcOptions
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
C.PrettySection () FieldName
"package" [[Char] -> Doc
PP.text [Char]
pkgName] forall a b. (a -> b) -> a -> b
$ forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"ghc-options" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text [Char]
s

        -- raw-project is after local-ghc-options so we can override per package.
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall x. x -> ListBuilder x ()
item [PrettyField ()]
cfgRawProject
      where
        copyFieldsSome :: ListBuilder (C.PrettyField ()) ()
        copyFieldsSome :: ListBuilder (PrettyField ()) ()
copyFieldsSome = do
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project URI Void Package
prj) forall a b. (a -> b) -> a -> b
$ \[Char]
xs -> do
                let s :: [Char]
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]]
lines [Char]
xs)
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"constraints" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text [Char]
s

            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project URI Void Package
prj) forall a b. (a -> b) -> a -> b
$ \[Char]
xs -> do
                let s :: [Char]
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]]
lines [Char]
xs)
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"allow-newer" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text [Char]
s

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project URI Void Package
prj) forall a b. (a -> b) -> a -> b
$
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"reorder-goals" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text [Char]
"True"

            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project URI Void Package
prj) forall a b. (a -> b) -> a -> b
$ \Int
bj ->
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"max-backjumps" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
bj

            case forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project URI Void Package
prj of
                Optimization
OptimizationOn      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Optimization
OptimizationOff     -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"optimization" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text [Char]
"False"
                OptimizationLevel Int
l -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> Doc -> PrettyField ann
C.PrettyField () FieldName
"optimization" forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
l

            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project URI Void Package
prj) forall a b. (a -> b) -> a -> b
$ \SourceRepositoryPackage Maybe
repo ->
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
C.PrettySection () FieldName
"source-repository-package" [] forall a b. (a -> b) -> a -> b
$
                    forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
C.prettyFieldGrammar CabalSpecVersion
C.cabalSpecLatest forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (List NoCommaFSep FilePathNT [Char]), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar (forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x)
-> SourceRepositoryPackage f -> SourceRepositoryPackage g
srpHoist forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SourceRepositoryPackage Maybe
repo)

    -- GHC versions which need head.hackage
    headGhcVers :: Set CompilerVersion
    headGhcVers :: Set CompilerVersion
headGhcVers = forall a. (a -> Bool) -> Set a -> Set a
S.filter (VersionRange -> CompilerVersion -> Bool
previewGHC VersionRange
cfgHeadHackage) Set CompilerVersion
allVersions

    anyJobUsesHeadHackage :: Bool
    anyJobUsesHeadHackage :: Bool
anyJobUsesHeadHackage = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Set CompilerVersion
allVersions forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set CompilerVersion
headGhcVers

pkgNameDirVariable' :: String -> String
pkgNameDirVariable' :: [Char] -> [Char]
pkgNameDirVariable' [Char]
n = [Char]
"PKGDIR_" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f [Char]
n where
    f :: Char -> Char
f Char
'-' = Char
'_'
    f Char
c   = Char
c

pkgNameDirVariable :: String -> String
pkgNameDirVariable :: [Char] -> [Char]
pkgNameDirVariable [Char]
n = [Char]
"${" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
pkgNameDirVariable' [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
"}"