ParserTests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Tests for the project file parser
module Tests.ParserTests (parserTests) where

import Control.Monad.IO.Class
  ( MonadIO (liftIO)
  )
import Data.Either (fromRight)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Distribution.Client.BuildReports.Types (ReportLevel (..))
import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (..))
import Distribution.Client.Dependency.Types (PreSolver (..))
import Distribution.Client.DistDirLayout
import Distribution.Client.HttpUtils
import Distribution.Client.IndexUtils.ActiveRepos (ActiveRepoEntry (..), ActiveRepos (..), CombineStrategy (..))
import Distribution.Client.IndexUtils.IndexState (RepoIndexState (..), headTotalIndexState, insertIndexState)
import Distribution.Client.ProjectConfig
import Distribution.Client.RebuildMonad (runRebuild)
import Distribution.Client.Targets (readUserConstraint)
import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDepMod (..), RelaxDepScope (..), RelaxDepSubject (..), RelaxDeps (..), RelaxedDep (..))
import Distribution.Client.Types.InstallMethod (InstallMethod (..))
import Distribution.Client.Types.OverwritePolicy (OverwritePolicy (..))
import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), asPosixPath)
import Distribution.Client.Types.RepoName (RepoName (..))
import Distribution.Client.Types.SourceRepo
import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy (..))
import Distribution.Compat.Prelude
import Distribution.Compiler (CompilerFlavor (..))
import Distribution.Parsec (simpleParsec)
import Distribution.Simple.Compiler (DebugInfoLevel (..), OptimisationLevel (..), PackageDBX (..), ProfDetailLevel (..))
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs (InstallDirs (..), toPathTemplate)
import Distribution.Simple.Setup (DumpBuildInfo (..), HaddockTarget (..), TestShowDetails (..))
import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath (..))
import Distribution.Solver.Types.Settings
  ( AllowBootLibInstalls (..)
  , CountConflicts (..)
  , FineGrainedConflicts (..)
  , IndependentGoals (..)
  , MinimizeConflictSet (..)
  , OnlyConstrained (..)
  , PreferOldest (..)
  , ReorderGoals (..)
  , StrongFlags (..)
  )
import Distribution.Solver.Types.Stage (Stage (..))
import Distribution.System (OS (..), buildOS)
import Distribution.Types.CondTree (CondTree (..))
import Distribution.Types.Flag (mkFlagAssignment)
import Distribution.Types.PackageId (PackageIdentifier (..))
import Distribution.Types.PackageName
import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
import Distribution.Types.SourceRepo (KnownRepoType (..), RepoType (..))
import Distribution.Types.Version (mkVersion)
import Distribution.Types.VersionRange.Internal (VersionRange (..))
import Distribution.Utils.NubList
import Distribution.Verbosity
import Network.URI (parseURI)
import System.Directory (canonicalizePath, doesFileExist)
import System.FilePath ((</>))
import Prelude ()

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase)

parserTests :: TestTree
parserTests =
  testGroup
    "project files parsec tests"
    [ testCase "read packages" testPackages
    , testCase "read optional-packages" testOptionalPackages
    , testCase "read extra-packages" testExtraPackages
    , testCase "read source-repository-package" testSourceRepoList
    , testCase "read project-config-build-only" testProjectConfigBuildOnly
    , testCase "read project-config-shared" testProjectConfigShared
    , testCase "read install-dirs" testInstallDirs
    , testCase "read remote-repos" testRemoteRepos
    , testCase "read local-no-index-repos" testLocalNoIndexRepos
    , testCase "set explicit provenance" testProjectConfigProvenance
    , testCase "read project-config-local-packages" testProjectConfigLocalPackages
    , testCase "read project-config-all-packages" testProjectConfigAllPackages
    , testCase "read project-config-specific-packages" testProjectConfigSpecificPackages
    , testCase "read project-config-stage-packages" testProjectConfigStagePackages
    , testCase "test projectConfigAllPackages concatenation" testAllPackagesConcat
    , testCase "test projectConfigSpecificPackages concatenation" testSpecificPackagesConcat
    , testCase "test program-locations concatenation" testProgramLocationsConcat
    , testCase "test program-options concatenation" testProgramOptionsConcat
    , testCase "test allow-newer and allow-older concatenation" testRelaxDepsConcat
    , testCase "test library-coverage overwrites coverage" testLibraryCoverage
    , testCase "test haddock-all flag" testHaddockAll
    , testCase "test override haddock-all: True" testHaddockAllOverwriteTrue
    , testCase "test override haddock-all: False" testHaddockAllOverwriteFalse
    ]

testPackages :: Assertion
testPackages = do
  let expected = [".", "packages/packages.cabal"]
  (config, legacy) <- readConfigDefault "packages"
  assertConfigEquals expected config legacy (projectPackages . snd . condTreeData)

testOptionalPackages :: Assertion
testOptionalPackages = do
  let expected = [".", "packages/packages.cabal"]
  (config, legacy) <- readConfigDefault "optional-packages"
  assertConfigEquals expected config legacy (projectPackagesOptional . snd . condTreeData)

testSourceRepoList :: Assertion
testSourceRepoList = do
  (config, legacy) <- readConfigDefault "source-repository-packages"
  assertConfigEquals expected config legacy (projectPackagesRepo . snd . condTreeData)
  where
    expected =
      [ SourceRepositoryPackage
          { srpType = KnownRepoType Git
          , srpLocation = "https://example.com/Project.git"
          , srpTag = Just "1234"
          , srpBranch = Nothing
          , srpSubdir = []
          , srpCommand = []
          }
      , SourceRepositoryPackage
          { srpType = KnownRepoType Git
          , srpLocation = "https://example.com/example-dir/"
          , srpTag = Just "12345"
          , srpBranch = Nothing
          , srpSubdir = ["subproject"]
          , srpCommand = []
          }
      ]

testExtraPackages :: Assertion
testExtraPackages = do
  (config, legacy) <- readConfigDefault "extra-packages"
  assertConfigEquals expected config legacy (projectPackagesNamed . snd . condTreeData)
  where
    expected =
      [ PackageVersionConstraint (mkPackageName "a") (OrLaterVersion (mkVersion [0]))
      , PackageVersionConstraint (mkPackageName "b") (IntersectVersionRanges (OrLaterVersion (mkVersion [0, 7, 3])) (EarlierVersion (mkVersion [0, 9])))
      ]

testProjectConfigBuildOnly :: Assertion
testProjectConfigBuildOnly = do
  (config, legacy) <- readConfigDefault "project-config-build-only"
  assertConfigEquals expected config legacy (projectConfigBuildOnly . snd . condTreeData)
  where
    expected = ProjectConfigBuildOnly{..}
    projectConfigVerbosity = toFlag (mkVerbosityFlags Verbose)
    projectConfigDryRun = mempty -- cli only
    projectConfigOnlyDeps = mempty -- cli only
    projectConfigOnlyDownload = mempty -- cli only
    projectConfigSummaryFile = toNubList [toPathTemplate "summaryFile", toPathTemplate "summaryFile2"]
    projectConfigLogFile = toFlag $ toPathTemplate "myLog.log"
    projectConfigBuildReports = toFlag DetailedReports
    projectConfigReportPlanningFailure = toFlag True
    projectConfigSymlinkBinDir = toFlag "some-bindir"
    projectConfigNumJobs = toFlag $ Just 4
    projectConfigUseSemaphore = toFlag True
    projectConfigKeepGoing = toFlag True
    projectConfigOfflineMode = toFlag True
    projectConfigKeepTempFiles = toFlag True
    projectConfigHttpTransport = toFlag "wget"
    projectConfigIgnoreExpiry = toFlag True
    projectConfigCacheDir = toFlag "some-cache-dir"
    projectConfigLogsDir = toFlag "logs-directory"
    projectConfigClientInstallFlags =
      ClientInstallFlags
        { cinstInstallLibs = Flag True
        , cinstEnvironmentPath = Flag "path/to/env"
        , cinstOverwritePolicy = Flag AlwaysOverwrite
        , cinstInstallMethod = Flag InstallMethodSymlink
        , cinstInstalldir = Flag "path/to/installdir"
        }

testProjectConfigShared :: Assertion
testProjectConfigShared = do
  (config, legacy) <- readConfigDefault "project-config-shared"
  assertConfigEquals expected config legacy (projectConfigShared . snd . condTreeData)
  where
    expected = ProjectConfigShared{..}
    projectConfigToolchain = ProjectConfigToolchain{..}
    projectConfigDistDir = toFlag "something"
    projectConfigConfigFile = mempty -- cli only
    projectConfigProjectFileParser = mempty -- cli only
    projectConfigProjectDir = toFlag "my-project-dir"
    projectConfigProjectFile = toFlag "my-project"
    projectConfigIgnoreProject = toFlag False
    projectConfigHcFlavor = toFlag (OtherCompiler "ghcjs")
    projectConfigHcPath = toFlag "/some/path/to/compiler"
    projectConfigHcPkg = toFlag "/some/path/to/ghc-pkg"
    projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
    projectConfigBuildHcFlavor = toFlag (OtherCompiler "ghcjs")
    projectConfigBuildHcPath = toFlag "/some/path/to/compiler"
    projectConfigBuildHcPkg = toFlag "/some/path/to/ghc-pkg"
    projectConfigBuildPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
    projectConfigHaddockIndex = toFlag $ toPathTemplate "/path/to/haddock-index"
    projectConfigInstallDirs = mempty -- tested below in testInstallDirs
    projectConfigRemoteRepos = mempty -- tested below in testRemoteRepos
    projectConfigLocalNoIndexRepos = mempty -- tested below in testLocalNoIndexRepos
    projectConfigActiveRepos = Flag (ActiveRepos [ActiveRepo (RepoName "hackage.haskell.org") CombineStrategyMerge, ActiveRepo (RepoName "my-repository") CombineStrategyOverride])
    projectConfigIndexState =
      let
        hackageState = IndexStateTime $ fromJust $ simpleParsec "2020-05-06T22:33:27Z"
        indexState' = insertIndexState (RepoName "hackage.haskell.org") hackageState headTotalIndexState
        headHackageState = IndexStateTime $ fromJust $ simpleParsec "2020-04-29T04:11:05Z"
        indexState'' = insertIndexState (RepoName "head.hackage") headHackageState indexState'
       in
        toFlag indexState''
    projectConfigStoreDir = toFlag "a/store/dir/path" -- cli only
    projectConfigConstraints =
      let
        bar = fromRight (error "error parsing bar") $ readUserConstraint "bar == 2.1"
        barFlags = fromRight (error "error parsing bar flags") $ readUserConstraint "bar +foo -baz"
        source = ConstraintSourceProjectConfig $ ProjectConfigPath $ "cabal.project" :| []
       in
        [(bar, source), (barFlags, source)]
    projectConfigPreferences = [PackageVersionConstraint (mkPackageName "foo") (ThisVersion (mkVersion [0, 9])), PackageVersionConstraint (mkPackageName "baz") (LaterVersion (mkVersion [2, 0]))]
    projectConfigCabalVersion = Flag (mkVersion [1, 24, 0, 1])
    projectConfigSolver = Flag AlwaysModular
    projectConfigAllowOlder = Just (AllowOlder $ RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep")), RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkga") (mkVersion [1, 1, 2]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkg"))])
    projectConfigAllowNewer = Just (AllowNewer $ RelaxDepsSome [RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkgb") (mkVersion [1, 2, 3]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkgb")), RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "importantlib"))])
    projectConfigWriteGhcEnvironmentFilesPolicy = Flag AlwaysWriteGhcEnvironmentFiles
    projectConfigMaxBackjumps = toFlag 42
    projectConfigReorderGoals = Flag (ReorderGoals True)
    projectConfigCountConflicts = Flag (CountConflicts False)
    projectConfigFineGrainedConflicts = Flag (FineGrainedConflicts False)
    projectConfigMinimizeConflictSet = Flag (MinimizeConflictSet True)
    projectConfigStrongFlags = Flag (StrongFlags True)
    projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls True)
    projectConfigOnlyConstrained = Flag OnlyConstrainedAll
    projectConfigPerComponent = Flag True
    projectConfigIndependentGoals = Flag (IndependentGoals True)
    projectConfigPreferOldest = Flag (PreferOldest True)
    projectConfigProgPathExtra = toNubList ["/foo/bar", "/baz/quux"]
    projectConfigMultiRepl = toFlag True

testInstallDirs :: Assertion
testInstallDirs = do
  (config, legacy) <- readConfigDefault "install-dirs"
  assertConfigEquals expected config legacy (projectConfigInstallDirs . projectConfigShared . snd . condTreeData)
  where
    expected =
      InstallDirs
        { prefix = Flag $ toPathTemplate "my/prefix-path"
        , bindir = Flag $ toPathTemplate "bin/dir/"
        , libdir = Flag $ toPathTemplate "lib/dir/path"
        , libsubdir = Flag $ toPathTemplate "/lib/sub/dir"
        , dynlibdir = Flag $ toPathTemplate "dyn/lib/dir/path"
        , bytecodelibdir = Flag $ toPathTemplate "bytecode/lib/dir/path"
        , flibdir = mempty
        , libexecdir = Flag $ toPathTemplate "lib/exec/dir/"
        , libexecsubdir = Flag $ toPathTemplate "libexec/subdir"
        , includedir = mempty
        , datadir = Flag $ toPathTemplate "path/to/datadir/"
        , datasubdir = Flag $ toPathTemplate "a/datadir/subdir"
        , docdir = Flag $ toPathTemplate "path/to/docs"
        , mandir = mempty
        , htmldir = Flag $ toPathTemplate "dir/html/"
        , haddockdir = Flag $ toPathTemplate "haddock/dir"
        , sysconfdir = Flag $ toPathTemplate "sys/conf/dir"
        }

testRemoteRepos :: Assertion
testRemoteRepos = do
  (config, legacy) <- readConfigDefault "remote-repos"
  let actualRemoteRepos = (fromNubList . projectConfigRemoteRepos . projectConfigShared . snd . condTreeData) config
  assertBool "Expected RemoteRepos do not match parsed values" $ compareLists expected actualRemoteRepos compareRemoteRepos
  assertConfigEquals mempty config legacy (projectConfigLocalNoIndexRepos . projectConfigShared . snd . condTreeData)
  where
    expected = [packagesRepository, morePackagesRepository, secureLocalRepository]
    packagesRepository =
      RemoteRepo
        { remoteRepoName = RepoName "packages.example.org"
        , remoteRepoURI = fromJust $ parseURI "http://packages.example.org/"
        , remoteRepoSecure = pure True
        , remoteRepoRootKeys = ["21", "42"]
        , remoteRepoKeyThreshold = 2
        , remoteRepoShouldTryHttps = False
        }
    morePackagesRepository =
      RemoteRepo
        { remoteRepoName = RepoName "more-packages.example.org"
        , remoteRepoURI = fromJust $ parseURI "https://more-packages.example.org/"
        , remoteRepoSecure = pure True
        , remoteRepoRootKeys = ["foo", "bar"]
        , remoteRepoKeyThreshold = 1
        , remoteRepoShouldTryHttps = False
        }
    secureLocalRepository =
      RemoteRepo
        { remoteRepoName = RepoName "my-secure-local-repository"
        , remoteRepoURI = fromJust $ parseURI "file:/path/to/secure/repo"
        , remoteRepoSecure = pure True
        , remoteRepoRootKeys = ["123"]
        , remoteRepoKeyThreshold = 1
        , remoteRepoShouldTryHttps = False
        }

testLocalNoIndexRepos :: Assertion
testLocalNoIndexRepos = do
  (config, legacy) <- readConfigDefault "local-no-index-repos"
  let actualLocalRepos = (fromNubList . projectConfigLocalNoIndexRepos . projectConfigShared . snd . condTreeData) config
  assertBool "Expected LocalNoIndexRepos do not match parsed values" $ compareLists expected actualLocalRepos compareLocalRepos
  assertConfigEquals mempty config legacy (projectConfigRemoteRepos . projectConfigShared . snd . condTreeData)
  where
    expected = [myRepository, mySecureRepository]
    myRepository =
      LocalRepo
        { localRepoName = RepoName "my-repository"
        , localRepoPath = normalisePath "/absolute/path/to/directory"
        , localRepoSharedCache = False
        }
    mySecureRepository =
      LocalRepo
        { localRepoName = RepoName "my-other-repository"
        , localRepoPath = normalisePath "/another/path/to/repository"
        , localRepoSharedCache = False
        }
    normalisePath path = case buildOS of
      Windows -> asPosixPath path
      _ -> path

testProjectConfigProvenance :: Assertion
testProjectConfigProvenance = do
  let expected = Set.singleton (Explicit (ProjectConfigPath $ "cabal.project" :| []))
  (config, legacy) <- readConfigDefault "empty"
  assertConfigEquals expected config legacy (projectConfigProvenance . snd . condTreeData)

testProjectConfigLocalPackages :: Assertion
testProjectConfigLocalPackages = do
  (config, legacy) <- readConfigDefault "project-config-local-packages"
  assertConfigEquals expected config legacy (projectConfigLocalPackages . snd . condTreeData)
  where
    expected = PackageConfig{..}
    packageConfigProgramPaths = MapLast $ Map.fromList [("ghc", "/tmp/bin/ghc"), ("gcc", "/tmp/bin/gcc")]
    packageConfigProgramArgs = MapMappend $ Map.fromList [("ghc", ["-fno-state-hack", "-foo"]), ("gcc", ["-baz", "-quux"])]
    packageConfigProgramPathExtra = toNubList ["/tmp/bin/extra", "/usr/local/bin"]
    packageConfigFlagAssignment = mkFlagAssignment [("foo", True), ("bar", False)]
    packageConfigVanillaLib = Flag False
    packageConfigSharedLib = Flag True
    packageConfigStaticLib = Flag True
    packageConfigDynExe = Flag True
    packageConfigFullyStaticExe = Flag True
    packageConfigProf = Flag True
    packageConfigProfLib = Flag True
    packageConfigProfShared = Flag False
    packageConfigProfExe = Flag True
    packageConfigProfDetail = Flag ProfDetailAllFunctions
    packageConfigProfLibDetail = Flag ProfDetailExportedFunctions
    packageConfigConfigureArgs = ["-some-arg", "/some/path"]
    packageConfigOptimization = Flag MaximumOptimisation
    packageConfigProgPrefix = Flag $ toPathTemplate "another/path"
    packageConfigProgSuffix = Flag $ toPathTemplate "and/another/path"
    packageConfigExtraLibDirs = ["so", "many", "lib/dirs"]
    packageConfigExtraLibDirsStatic = ["a/few", "static/lib/dirs"]
    packageConfigExtraFrameworkDirs = ["osx/framework", "dirs"]
    packageConfigExtraIncludeDirs = ["incredible/amount", "of", "include", "directories"]
    packageConfigGHCiLib = Flag False
    packageConfigBytecodeLib = Flag False
    packageConfigSplitSections = Flag True
    packageConfigSplitObjs = Flag True
    packageConfigStripExes = Flag False
    packageConfigStripLibs = Flag False
    packageConfigTests = Flag True
    packageConfigBenchmarks = Flag True
    packageConfigCoverage = Flag True
    packageConfigRelocatable = Flag True
    packageConfigDebugInfo = Flag MaximalDebugInfo
    packageConfigDumpBuildInfo = Flag DumpBuildInfo
    packageConfigRunTests = Flag True
    packageConfigDocumentation = Flag True
    -- Haddock options
    packageConfigHaddockHoogle = Flag True
    packageConfigHaddockHtml = Flag False
    packageConfigHaddockHtmlLocation = Flag "http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html"
    packageConfigHaddockForeignLibs = Flag True
    packageConfigHaddockExecutables = Flag True
    packageConfigHaddockTestSuites = Flag True
    packageConfigHaddockBenchmarks = Flag True
    packageConfigHaddockInternal = Flag True
    packageConfigHaddockCss = Flag "some/path/to/file.css"
    packageConfigHaddockLinkedSource = Flag True
    packageConfigHaddockQuickJump = Flag True
    packageConfigHaddockHscolourCss = Flag "another/path/to/hscolour.css"
    packageConfigHaddockContents = Flag $ toPathTemplate "https://example.com/$pkg/contents"
    packageConfigHaddockIndex = Flag $ toPathTemplate "separately-generated/HTML/index"
    packageConfigHaddockBaseUrl = Flag "https://example.com/haddock-base-url"
    packageConfigHaddockResourcesDir = Flag "/haddock/static"
    packageConfigHaddockOutputDir = Flag "/haddock/output"
    packageConfigHaddockUseUnicode = Flag False
    packageConfigHaddockForHackage = Flag ForHackage
    packageConfigTestHumanLog = Flag $ toPathTemplate "human-log.log"
    packageConfigTestMachineLog = Flag $ toPathTemplate "machine.log"
    packageConfigTestShowDetails = Flag Streaming
    packageConfigTestKeepTix = Flag True
    packageConfigTestWrapper = Flag "/test-wrapper-path/"
    packageConfigTestFailWhenNoTestSuites = Flag True
    packageConfigTestTestOptions = [toPathTemplate "--some-option", toPathTemplate "42"]
    packageConfigBenchmarkOptions = [toPathTemplate "--some-benchmark-option", toPathTemplate "--another-option"]

testProjectConfigAllPackages :: Assertion
testProjectConfigAllPackages = do
  (config, legacy) <- readConfigDefault "project-config-all-packages"
  assertConfigEquals expected config legacy (projectConfigAllPackages . snd . condTreeData)
  where
    expected :: PackageConfig
    expected =
      mempty
        { packageConfigProfDetail = Flag ProfDetailAllFunctions
        , packageConfigProfLibDetail = Flag ProfDetailExportedFunctions
        }

testProjectConfigSpecificPackages :: Assertion
testProjectConfigSpecificPackages = do
  (config, legacy) <- readConfigDefault "project-config-specific-packages"
  assertConfigEquals expected config legacy (projectConfigSpecificPackage . snd . condTreeData)
  where
    expected = MapMappend $ Map.fromList [("foo", expectedFoo), ("bar", expectedBar), ("baz", expectedBaz)]
    expectedFoo :: PackageConfig
    expectedFoo =
      mempty
        { packageConfigProfDetail = Flag ProfDetailAllFunctions
        , packageConfigProfLibDetail = Flag ProfDetailExportedFunctions
        , packageConfigVanillaLib = Flag True
        }
    expectedBar :: PackageConfig
    expectedBar =
      mempty
        { packageConfigProfDetail = Flag ProfDetailTopLate
        , packageConfigProfLibDetail = Flag ProfDetailNone
        , packageConfigProgPrefix = Flag $ toPathTemplate "prefix/path"
        }
    expectedBaz :: PackageConfig
    expectedBaz =
      mempty
        { packageConfigSharedLib = Flag True
        }

testProjectConfigStagePackages :: Assertion
testProjectConfigStagePackages = do
  -- The legacy parser does not support stage-qualified package stanzas (it
  -- would reject the @build:*@ argument), so we read with the parsec parser
  -- only rather than 'readConfigDefault', which also runs the legacy parser.
  config <- readConfigParsec "project-config-stage-packages"
  assertEqual
    "Parsed Config does not match expected"
    expected
    (projectConfigStagePackages (snd (condTreeData config)))
  -- An unqualified 'package *' stanza is not stage-qualified: it lands in
  -- 'projectConfigAllPackages' (which applies to every stage) rather than in
  -- the stage map.
  assertEqual
    "Unqualified 'package *' should apply to all packages, not a single stage"
    expectedAll
    (projectConfigAllPackages (snd (condTreeData config)))
  where
    expected = MapMappend $ Map.fromList [(Build, expectedBuild), (Host, expectedHost)]
    expectedAll :: PackageConfig
    expectedAll =
      mempty
        { packageConfigStaticLib = Flag True
        }
    expectedBuild :: PackageConfig
    expectedBuild =
      mempty
        { packageConfigSharedLib = Flag False
        , packageConfigDynExe = Flag False
        }
    expectedHost :: PackageConfig
    expectedHost =
      mempty
        { packageConfigSharedLib = Flag True
        }

testAllPackagesConcat :: Assertion
testAllPackagesConcat = do
  (config, legacy) <- readConfigDefault "all-packages-concat"
  assertConfigEquals expected config legacy (projectConfigAllPackages . snd . condTreeData)
  where
    expected :: PackageConfig
    expected =
      mempty
        { packageConfigSharedLib = Flag True
        , packageConfigStaticLib = Flag True
        , packageConfigProgramArgs =
            MapMappend $
              Map.fromList
                [ ("ghc", ["-fwarn-tabs", "-optc-fno-builtin-malloc", "-Wall", "-optc-fno-builtin-realloc", "-fwrite-ide-info"])
                ]
        }

testSpecificPackagesConcat :: Assertion
testSpecificPackagesConcat = do
  (config, legacy) <- readConfigDefault "specific-packages-concat"
  assertConfigEquals expected config legacy (projectConfigSpecificPackage . snd . condTreeData)
  where
    expected = MapMappend $ Map.fromList [("foo", expectedFoo)]
    expectedFoo :: PackageConfig
    expectedFoo =
      mempty
        { packageConfigSharedLib = Flag True
        , packageConfigStaticLib = Flag True
        , packageConfigProgramArgs = MapMappend $ Map.fromList [("ghc", ["-fno-state-hack", "-threaded"])]
        }

testProgramLocationsConcat :: Assertion
testProgramLocationsConcat = do
  (config, legacy) <- readConfigDefault "program-locations-concat"
  assertConfigEquals expected config legacy (projectConfigLocalPackages . snd . condTreeData)
  where
    expected :: PackageConfig
    expected =
      mempty
        { packageConfigProgramPaths = MapLast $ Map.fromList [("gcc", "/tmp/bin/gcc"), ("ghc", "/tmp/bin/ghc")]
        }

testProgramOptionsConcat :: Assertion
testProgramOptionsConcat = do
  (config, legacy) <- readConfigDefault "program-options-concat"
  assertConfigEquals expected config legacy (projectConfigLocalPackages . snd . condTreeData)
  where
    expected :: PackageConfig
    expected =
      mempty
        { packageConfigProgramArgs =
            MapMappend $
              Map.fromList
                [ ("ghc", ["-threaded", "-Wall", "-fno-state-hack"])
                , ("gcc", ["-baz", "-foo", "-bar"])
                , ("haddock", ["--optghc=-optP -P"])
                , ("ld", ["-Wl,--gc-sections"])
                ]
        }

testRelaxDepsConcat :: Assertion
testRelaxDepsConcat = do
  (config, legacy) <- readConfigDefault "relax-deps-concat"
  assertConfigEquals expectedAllowNewer config legacy (projectConfigAllowNewer . projectConfigShared . snd . condTreeData)
  assertConfigEquals expectedAllowOlder config legacy (projectConfigAllowOlder . projectConfigShared . snd . condTreeData)
  where
    expectedAllowNewer :: Maybe AllowNewer
    expectedAllowNewer =
      pure $
        AllowNewer $
          RelaxDepsSome
            [ RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "cassava") (mkVersion [0, 5, 2, 0]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base"))
            , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "vector-th-unbox") (mkVersion [0, 2, 1, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base"))
            , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "vector-th-unbox") (mkVersion [0, 2, 1, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "template-haskell"))
            ]
    expectedAllowOlder :: Maybe AllowOlder
    expectedAllowOlder =
      pure $
        AllowOlder $
          RelaxDepsSome
            [ RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "mtl") (mkVersion [2, 3, 1]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "base"))
            , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "aeson") (mkVersion [2, 2, 3, 0]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "bytestring"))
            , RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "containers") (mkVersion [0, 7]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "array"))
            ]

-- | Tests that if both library-coverage and coverage flags are specified, library-coverage is used.
testLibraryCoverage :: Assertion
testLibraryCoverage = do
  (config, legacy) <- readConfigDefault "library-coverage"
  assertConfigEquals (Flag False) config legacy (packageConfigCoverage . projectConfigLocalPackages . snd . condTreeData)

testHaddockAll :: Assertion
testHaddockAll = do
  (config, legacy) <- readConfigDefault "haddock-all"
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . snd . condTreeData)

-- | Tests that an explicitly set field can override a value inherited from haddock-all.
testHaddockAllOverwriteTrue :: Assertion
testHaddockAllOverwriteTrue = do
  (config, legacy) <- readConfigDefault "haddock-all-overwrite-true"
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag False) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . snd . condTreeData)

testHaddockAllOverwriteFalse :: Assertion
testHaddockAllOverwriteFalse = do
  (config, legacy) <- readConfigDefault "haddock-all-overwrite-false"
  assertConfigEquals (Flag True) config legacy (packageConfigHaddockExecutables . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag False) config legacy (packageConfigHaddockTestSuites . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag False) config legacy (packageConfigHaddockBenchmarks . projectConfigLocalPackages . snd . condTreeData)
  assertConfigEquals (Flag False) config legacy (packageConfigHaddockForeignLibs . projectConfigLocalPackages . snd . condTreeData)

-------------------------------------------------------------------------------
-- Test Utilities
-------------------------------------------------------------------------------
baseDir :: FilePath
baseDir = "parser-tests" </> "Tests" </> "files"

verbosity :: Verbosity
verbosity = mkVerbosity defaultVerbosityHandles normal

readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
readConfigDefault testSubDir = readConfig testSubDir "cabal.project"

-- | Read a project config using the parsec parser only. Useful for syntax the
-- legacy parser does not support (e.g. stage-qualified package stanzas).
readConfigParsec :: FilePath -> IO ProjectConfigSkeleton
readConfigParsec testSubDir = do
  (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir "cabal.project"
  exists <- liftIO $ doesFileExist projectConfigFp
  assertBool ("projectConfig does not exist: " <> projectConfigFp) exists
  httpTransport <- liftIO $ configureTransport verbosity [] Nothing
  liftIO $
    runRebuild testRootFp $
      readProjectFileSkeletonParsec verbosity httpTransport distDirLayout "" ""

readConfig :: FilePath -> FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
readConfig testSubDir projectFileName = do
  (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir projectFileName
  exists <- liftIO $ doesFileExist projectConfigFp
  assertBool ("projectConfig does not exist: " <> projectConfigFp) exists
  httpTransport <- liftIO $ configureTransport verbosity [] Nothing
  let extensionName = ""
      extensionDescription = ""
  parsec <-
    liftIO $
      runRebuild testRootFp $
        readProjectFileSkeletonParsec verbosity httpTransport distDirLayout extensionName extensionDescription
  legacy <-
    liftIO $
      runRebuild testRootFp $
        readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription
  return (parsec, legacy)

assertConfigEquals :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> Assertion
assertConfigEquals expected config configLegacy access = do
  assertEqual "Expectation does not match result of Legacy parser" expected actualLegacy
  assertEqual "Parsed Config does not match expected" expected actual
  where
    actual = access config
    actualLegacy = access configLegacy

-- | Represents the directory structure and associated file paths for a test
data TestDir = TestDir
  { _testDirTestRootFp :: FilePath
  -- ^ Every test has a root directory in ./files/<test-title>
  , _testDirProjectConfigFp :: FilePath
  -- ^ Every test has a project config in testDirTestRootFp/cabal.project
  , _testDirDistDirLayout :: DistDirLayout
  }

testDirInfo :: FilePath -> FilePath -> IO TestDir
testDirInfo testSubDir projectFileName = do
  projectRootDir <- canonicalizePath (baseDir </> testSubDir)
  let
    projectRoot = ProjectRootExplicit projectRootDir projectFileName
    distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
    extensionName = ""
    projectConfigFp = distProjectFile distDirLayout extensionName
  return $ TestDir projectRootDir projectConfigFp distDirLayout

-- | Compares two lists element-wise using a comparison function.
compareLists :: [a] -> [a] -> (a -> a -> Bool) -> Bool
compareLists xs ys compare' = length xs == length ys && all (uncurry compare') (zip xs ys)

-- | Compares LocalRepos ignoring field 'localRepoSharedCache' because we do not parse it.
compareLocalRepos :: LocalRepo -> LocalRepo -> Bool
compareLocalRepos repo1 repo2 =
  localRepoName repo1 == localRepoName repo2
    && localRepoPath repo1 == localRepoPath repo2

-- | Compares RemoteRepos ignoring field 'remoteRepoShouldTryHttps' because we do not parse it.
compareRemoteRepos :: RemoteRepo -> RemoteRepo -> Bool
compareRemoteRepos repo1 repo2 =
  remoteRepoName repo1 == remoteRepoName repo2
    && remoteRepoURI repo1 == remoteRepoURI repo2
    && remoteRepoSecure repo1 == remoteRepoSecure repo2
    && remoteRepoRootKeys repo1 == remoteRepoRootKeys repo2
    && remoteRepoKeyThreshold repo1 == remoteRepoKeyThreshold repo2