{-# LANGUAGE TypeFamilies #-}

-- | Setup.hs script policy
--
-- Handling for Setup.hs scripts is a bit tricky, part of it lives in the
-- solver phase, and part in the elaboration phase. We keep the helper
-- functions for both phases together here so at least you can see all of it
-- in one place.
--
-- There are four major cases for Setup.hs handling:
--
--  1. @build-type@ Custom with a @custom-setup@ section
--  2. @build-type@ Custom without a @custom-setup@ section
--  3. @build-type@ not Custom with @cabal-version >  $our-cabal-version@
--  4. @build-type@ not Custom with @cabal-version <= $our-cabal-version@
--
-- It's also worth noting that packages specifying @cabal-version: >= 1.23@
-- or later that have @build-type@ Custom will always have a @custom-setup@
-- section. Therefore in case 2, the specified @cabal-version@ will always be
-- less than 1.23.
--
-- In cases 1 and 2 we obviously have to build an external Setup.hs script,
-- while in case 4 we can use the internal library API.
--
-- @since 3.12.0.0
module Distribution.Client.ProjectPlanning.SetupPolicy
  ( mkDefaultSetupDeps
  , packageSetupScriptStyle
  , packageSetupScriptSpecVersion
  , NonSetupLibDepSolverPlanPackage (..)
  )
where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.ProjectPlanning.Types (SetupScriptStyle (..))
import Distribution.Client.SolverInstallPlan (SolverPlanPackage)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.ResolverPackage (resolverPackageLibDeps)
import Distribution.Solver.Types.SolverId (SolverId)

import Distribution.CabalSpecVersion

import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.Compiler
import Distribution.System

import Distribution.Simple.Utils
import Distribution.Version

import Distribution.Compat.Graph (IsNode (..))
import qualified Distribution.Compat.Graph as Graph

-- | Work out the 'SetupScriptStyle' given the package description.
--
-- @since 3.12.0.0
packageSetupScriptStyle :: PackageDescription -> SetupScriptStyle
packageSetupScriptStyle :: PackageDescription -> SetupScriptStyle
packageSetupScriptStyle PackageDescription
pkg
  | PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
  , Just SetupBuildInfo
setupbi <- PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg -- does have a custom-setup stanza
  , Bool -> Bool
not (SetupBuildInfo -> Bool
defaultSetupDepends SetupBuildInfo
setupbi) -- but not one we added ourselves
    =
      SetupScriptStyle
SetupCustomExplicitDeps
  | PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
  , Just SetupBuildInfo
setupbi <- PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg -- does have a custom-setup stanza
  , SetupBuildInfo -> Bool
defaultSetupDepends SetupBuildInfo
setupbi -- that we had to add ourselves
    =
      SetupScriptStyle
SetupCustomImplicitDeps
  | PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
  , Maybe SetupBuildInfo
Nothing <- PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg -- we get this case pre-solver
    =
      SetupScriptStyle
SetupCustomImplicitDeps
  -- The specified @cabal-version@ is newer that the last we know about.
  -- Here we could fail but we are optimist and build an external setup script.
  | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
> CabalSpecVersion
cabalSpecLatest =
      SetupScriptStyle
SetupNonCustomExternalLib
  | Bool
otherwise =
      SetupScriptStyle
SetupNonCustomInternalLib

-- | Part of our Setup.hs handling policy is implemented by getting the solver
-- to work out setup dependencies for packages. The solver already handles
-- packages that explicitly specify setup dependencies, but we can also tell
-- the solver to treat other packages as if they had setup dependencies.
-- That's what this function does, it gets called by 'planPackages' for all
-- packages that don't already have setup dependencies.
--
-- The dependencies we want to add is different for each 'SetupScriptStyle'.
--
-- Note in addition to adding setup dependencies, we also use
-- 'addSetupCabalMinVersionConstraint' (in 'planPackages') to require
-- @Cabal >= 1.20@ for Setup scripts.
--
-- @since 3.12.0.0
mkDefaultSetupDeps
  :: Compiler
  -> Platform
  -> PackageDescription
  -> Maybe [Dependency]
mkDefaultSetupDeps :: Compiler -> Platform -> PackageDescription -> Maybe [Dependency]
mkDefaultSetupDeps Compiler
compiler Platform
platform PackageDescription
pkg =
  case PackageDescription -> SetupScriptStyle
packageSetupScriptStyle PackageDescription
pkg of
    -- For packages with build type custom that do not specify explicit
    -- setup dependencies, we add a dependency on Cabal and a number
    -- of other packages.
    SetupScriptStyle
SetupCustomImplicitDeps ->
      [Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just ([Dependency] -> Maybe [Dependency])
-> [Dependency] -> Maybe [Dependency]
forall a b. (a -> b) -> a -> b
$
        [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
depPkgname VersionRange
anyVersion NonEmptySet LibraryName
mainLibSet
        | PackageName
depPkgname <- Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs Compiler
compiler Platform
platform
        ]
          [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
cabalPkgname VersionRange
cabalConstraint NonEmptySet LibraryName
mainLibSet
             | PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName
cabalPkgname
             ]
      where
        -- The Cabal dep is slightly special:
        -- \* We omit the dep for the Cabal lib itself, since it bootstraps.
        -- \* We constrain it to be < 1.25
        --
        -- Note: we also add a global constraint to require Cabal >= 1.20
        -- for Setup scripts (see use addSetupCabalMinVersionConstraint).
        --
        cabalConstraint :: VersionRange
cabalConstraint =
          Version -> VersionRange
orLaterVersion (CabalSpecVersion -> Version
csvToVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))
            VersionRange -> VersionRange -> VersionRange
`intersectVersionRanges` Version -> VersionRange
earlierVersion Version
cabalCompatMaxVer
        -- The idea here is that at some point we will make significant
        -- breaking changes to the Cabal API that Setup.hs scripts use.
        -- So for old custom Setup scripts that do not specify explicit
        -- constraints, we constrain them to use a compatible Cabal version.
        cabalCompatMaxVer :: Version
cabalCompatMaxVer = [Int] -> Version
mkVersion [Int
1, Int
25]

    -- For other build types (like Simple) if we still need to compile an
    -- external Setup.hs, it'll be one of the simple ones that only depends
    -- on Cabal and base.
    SetupScriptStyle
SetupNonCustomExternalLib ->
      [Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just
        [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
cabalPkgname VersionRange
cabalConstraint NonEmptySet LibraryName
mainLibSet
        , PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
basePkgname VersionRange
anyVersion NonEmptySet LibraryName
mainLibSet
        ]
      where
        cabalConstraint :: VersionRange
cabalConstraint = Version -> VersionRange
orLaterVersion (CabalSpecVersion -> Version
csvToVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))

    -- The internal setup wrapper method has no deps at all.
    SetupScriptStyle
SetupNonCustomInternalLib -> [Dependency] -> Maybe [Dependency]
forall a. a -> Maybe a
Just []
    -- This case gets ruled out by the caller, planPackages, see the note
    -- above in the SetupCustomImplicitDeps case.
    SetupScriptStyle
SetupCustomExplicitDeps ->
      [Char] -> Maybe [Dependency]
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe [Dependency]) -> [Char] -> Maybe [Dependency]
forall a b. (a -> b) -> a -> b
$
        [Char]
"mkDefaultSetupDeps: called for a package with explicit "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"setup deps: "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg)
  where
    -- we require one less
    --
    -- This maps e.g. CabalSpecV3_0 to mkVersion [2,5]
    csvToVersion :: CabalSpecVersion -> Version
    csvToVersion :: CabalSpecVersion -> Version
csvToVersion = [Int] -> Version
mkVersion ([Int] -> Version)
-> (CabalSpecVersion -> [Int]) -> CabalSpecVersion -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> [Int]
cabalSpecMinimumLibraryVersion

-- | A newtype for 'SolverPlanPackage' for which the
-- dependency graph considers only dependencies on libraries which are
-- NOT from setup dependencies. Used to compute the set
-- of packages needed for profiling and dynamic libraries.
--
-- @since 3.12.0.0
newtype NonSetupLibDepSolverPlanPackage = NonSetupLibDepSolverPlanPackage
  {NonSetupLibDepSolverPlanPackage -> SolverPlanPackage
unNonSetupLibDepSolverPlanPackage :: SolverPlanPackage}

instance Package NonSetupLibDepSolverPlanPackage where
  packageId :: NonSetupLibDepSolverPlanPackage -> PackageIdentifier
packageId (NonSetupLibDepSolverPlanPackage SolverPlanPackage
spkg) =
    SolverPlanPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SolverPlanPackage
spkg

instance IsNode NonSetupLibDepSolverPlanPackage where
  type Key NonSetupLibDepSolverPlanPackage = SolverId

  nodeKey :: NonSetupLibDepSolverPlanPackage
-> Key NonSetupLibDepSolverPlanPackage
nodeKey (NonSetupLibDepSolverPlanPackage SolverPlanPackage
spkg) =
    SolverPlanPackage -> Key SolverPlanPackage
forall a. IsNode a => a -> Key a
nodeKey SolverPlanPackage
spkg

  nodeNeighbors :: NonSetupLibDepSolverPlanPackage
-> [Key NonSetupLibDepSolverPlanPackage]
nodeNeighbors (NonSetupLibDepSolverPlanPackage SolverPlanPackage
spkg) =
    [Key NonSetupLibDepSolverPlanPackage]
-> [Key NonSetupLibDepSolverPlanPackage]
forall a. Ord a => [a] -> [a]
ordNub ([Key NonSetupLibDepSolverPlanPackage]
 -> [Key NonSetupLibDepSolverPlanPackage])
-> [Key NonSetupLibDepSolverPlanPackage]
-> [Key NonSetupLibDepSolverPlanPackage]
forall a b. (a -> b) -> a -> b
$ ComponentDeps [SolverId] -> [SolverId]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (SolverPlanPackage -> ComponentDeps [SolverId]
forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps SolverPlanPackage
spkg)

-- | Work out which version of the Cabal we will be using to talk to the
-- Setup.hs interface for this package.
--
-- This depends somewhat on the 'SetupScriptStyle' but most cases are a result
-- of what the solver picked for us, based on the explicit setup deps or the
-- ones added implicitly by 'mkDefaultSetupDeps'.
--
-- @since 3.12.0.0
packageSetupScriptSpecVersion
  :: SetupScriptStyle
  -> PackageDescription
  -> Graph.Graph NonSetupLibDepSolverPlanPackage
  -> ComponentDeps [SolverId]
  -> Version
-- We're going to be using the internal Cabal library, so the spec version of
-- that is simply the version of the Cabal library that cabal-install has been
-- built with.
packageSetupScriptSpecVersion :: SetupScriptStyle
-> PackageDescription
-> Graph NonSetupLibDepSolverPlanPackage
-> ComponentDeps [SolverId]
-> Version
packageSetupScriptSpecVersion SetupScriptStyle
SetupNonCustomInternalLib PackageDescription
_ Graph NonSetupLibDepSolverPlanPackage
_ ComponentDeps [SolverId]
_ =
  Version
cabalVersion
-- If we happen to be building the Cabal lib itself then because that
-- bootstraps itself then we use the version of the lib we're building.
packageSetupScriptSpecVersion SetupScriptStyle
SetupCustomImplicitDeps PackageDescription
pkg Graph NonSetupLibDepSolverPlanPackage
_ ComponentDeps [SolverId]
_
  | PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
cabalPkgname =
      PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg
-- In all other cases we have a look at what version of the Cabal lib the
-- solver picked. Or if it didn't depend on Cabal at all (which is very rare)
-- then we look at the .cabal file to see what spec version it declares.
packageSetupScriptSpecVersion SetupScriptStyle
_ PackageDescription
pkg Graph NonSetupLibDepSolverPlanPackage
libDepGraph ComponentDeps [SolverId]
deps =
  case (PackageIdentifier -> Bool)
-> [PackageIdentifier] -> Maybe PackageIdentifier
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((PackageName
cabalPkgname PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
==) (PackageName -> Bool)
-> (PackageIdentifier -> PackageName) -> PackageIdentifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName) [PackageIdentifier]
setupLibDeps of
    Just PackageIdentifier
dep -> PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
dep
    Maybe PackageIdentifier
Nothing -> [Int] -> Version
mkVersion (CabalSpecVersion -> [Int]
cabalSpecMinimumLibraryVersion (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg))
  where
    setupLibDeps :: [PackageIdentifier]
setupLibDeps =
      (NonSetupLibDepSolverPlanPackage -> PackageIdentifier)
-> [NonSetupLibDepSolverPlanPackage] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map NonSetupLibDepSolverPlanPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ([NonSetupLibDepSolverPlanPackage] -> [PackageIdentifier])
-> [NonSetupLibDepSolverPlanPackage] -> [PackageIdentifier]
forall a b. (a -> b) -> a -> b
$
        [NonSetupLibDepSolverPlanPackage]
-> Maybe [NonSetupLibDepSolverPlanPackage]
-> [NonSetupLibDepSolverPlanPackage]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [NonSetupLibDepSolverPlanPackage]
 -> [NonSetupLibDepSolverPlanPackage])
-> Maybe [NonSetupLibDepSolverPlanPackage]
-> [NonSetupLibDepSolverPlanPackage]
forall a b. (a -> b) -> a -> b
$
          Graph NonSetupLibDepSolverPlanPackage
-> [Key NonSetupLibDepSolverPlanPackage]
-> Maybe [NonSetupLibDepSolverPlanPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph NonSetupLibDepSolverPlanPackage
libDepGraph (ComponentDeps [SolverId] -> [SolverId]
forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps ComponentDeps [SolverId]
deps)

cabalPkgname, basePkgname :: PackageName
cabalPkgname :: PackageName
cabalPkgname = [Char] -> PackageName
mkPackageName [Char]
"Cabal"
basePkgname :: PackageName
basePkgname = [Char] -> PackageName
mkPackageName [Char]
"base"

legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs Compiler
compiler (Platform Arch
_ OS
os) =
  ([Char] -> PackageName) -> [[Char]] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> PackageName
mkPackageName ([[Char]] -> [PackageName]) -> [[Char]] -> [PackageName]
forall a b. (a -> b) -> a -> b
$
    [ [Char]
"array"
    , [Char]
"base"
    , [Char]
"binary"
    , [Char]
"bytestring"
    , [Char]
"containers"
    , [Char]
"deepseq"
    , [Char]
"directory"
    , [Char]
"filepath"
    , [Char]
"pretty"
    , [Char]
"process"
    , [Char]
"time"
    , [Char]
"transformers"
    ]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"Win32" | OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Windows]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"unix" | OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
/= OS
Windows]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"ghc-prim" | Bool
isGHC]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"template-haskell" | Bool
isGHC]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"old-time" | Bool
notGHC710]
  where
    isGHC :: Bool
isGHC = CompilerFlavor -> Compiler -> Bool
compilerCompatFlavor CompilerFlavor
GHC Compiler
compiler
    notGHC710 :: Bool
notGHC710 = case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
compiler of
      Maybe Version
Nothing -> Bool
False
      Just Version
v -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int] -> Version
mkVersion [Int
7, Int
9]