-- |
--
-- This modules provides functions for working with both the legacy
-- "build-tools" field, and its replacement, "build-tool-depends". Prefer using
-- the functions contained to access those fields directly.
module Distribution.Simple.BuildToolDepends where

import Distribution.Compat.Prelude
import Prelude ()

import qualified Data.Map as Map

import Distribution.Package
import Distribution.PackageDescription

-- | Same as 'desugarBuildTool', but requires atomic informations (package
-- name, executable names) instead of a whole 'PackageDescription'.
desugarBuildToolSimple
  :: PackageName
  -> [UnqualComponentName]
  -> LegacyExeDependency
  -> Maybe ExeDependency
desugarBuildToolSimple :: PackageName
-> [UnqualComponentName]
-> LegacyExeDependency
-> Maybe ExeDependency
desugarBuildToolSimple PackageName
pname [UnqualComponentName]
exeNames (LegacyExeDependency String
name VersionRange
reqVer)
  | Bool
foundLocal = ExeDependency -> Maybe ExeDependency
forall a. a -> Maybe a
Just (ExeDependency -> Maybe ExeDependency)
-> ExeDependency -> Maybe ExeDependency
forall a b. (a -> b) -> a -> b
$ PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
ExeDependency PackageName
pname UnqualComponentName
toolName VersionRange
reqVer
  | Bool
otherwise = String -> Map String ExeDependency -> Maybe ExeDependency
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String ExeDependency
allowMap
  where
    toolName :: UnqualComponentName
toolName = String -> UnqualComponentName
mkUnqualComponentName String
name
    foundLocal :: Bool
foundLocal = UnqualComponentName
toolName UnqualComponentName -> [UnqualComponentName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnqualComponentName]
exeNames
    allowlist :: [String]
allowlist =
      [ String
"hscolour"
      , String
"haddock"
      , String
"happy"
      , String
"alex"
      , String
"hsc2hs"
      , String
"c2hs"
      , String
"cpphs"
      , String
"greencard"
      , String
"hspec-discover"
      ]
    allowMap :: Map String ExeDependency
allowMap = [(String, ExeDependency)] -> Map String ExeDependency
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, ExeDependency)] -> Map String ExeDependency)
-> [(String, ExeDependency)] -> Map String ExeDependency
forall a b. (a -> b) -> a -> b
$ ((String -> (String, ExeDependency))
 -> [String] -> [(String, ExeDependency)])
-> [String]
-> (String -> (String, ExeDependency))
-> [(String, ExeDependency)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (String, ExeDependency))
-> [String] -> [(String, ExeDependency)]
forall a b. (a -> b) -> [a] -> [b]
map [String]
allowlist ((String -> (String, ExeDependency)) -> [(String, ExeDependency)])
-> (String -> (String, ExeDependency)) -> [(String, ExeDependency)]
forall a b. (a -> b) -> a -> b
$ \String
n ->
      (String
n, PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
ExeDependency (String -> PackageName
mkPackageName String
n) (String -> UnqualComponentName
mkUnqualComponentName String
n) VersionRange
reqVer)

-- | Desugar a "build-tools" entry into a proper executable dependency if
-- possible.
--
-- An entry can be so desugared in two cases:
--
-- 1. The name in build-tools matches a locally defined executable.  The
--    executable dependency produced is on that exe in the current package.
--
-- 2. The name in build-tools matches a hard-coded set of known tools.  For now,
--    the executable dependency produced is one an executable in a package of
--    the same, but the hard-coding could just as well be per-key.
--
-- The first cases matches first.
desugarBuildTool
  :: PackageDescription
  -> LegacyExeDependency
  -> Maybe ExeDependency
desugarBuildTool :: PackageDescription -> LegacyExeDependency -> Maybe ExeDependency
desugarBuildTool PackageDescription
pkg LegacyExeDependency
led =
  PackageName
-> [UnqualComponentName]
-> LegacyExeDependency
-> Maybe ExeDependency
desugarBuildToolSimple
    (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
    ((Executable -> UnqualComponentName)
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName ([Executable] -> [UnqualComponentName])
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg)
    LegacyExeDependency
led

-- | Get everything from "build-tool-depends", along with entries from
-- "build-tools" that we know how to desugar.
--
-- This should almost always be used instead of just accessing the
-- `buildToolDepends` field directly.
getAllToolDependencies
  :: PackageDescription
  -> BuildInfo
  -> [ExeDependency]
getAllToolDependencies :: PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg BuildInfo
bi =
  BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
bi [ExeDependency] -> [ExeDependency] -> [ExeDependency]
forall a. [a] -> [a] -> [a]
++ (LegacyExeDependency -> Maybe ExeDependency)
-> [LegacyExeDependency] -> [ExeDependency]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageDescription -> LegacyExeDependency -> Maybe ExeDependency
desugarBuildTool PackageDescription
pkg) (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)

-- | Does the given executable dependency map to this current package?
--
-- This is a tiny function, but used in a number of places.
--
-- This function is only sound to call on `BuildInfo`s from the given package
-- description. This is because it just filters the package names of each
-- dependency, and does not check whether version bounds in fact exclude the
-- current package, or the referenced components in fact exist in the current
-- package.
--
-- This is OK because when a package is loaded, it is checked (in
-- `Distribution.Package.Check`) that dependencies matching internal components
-- do indeed have version bounds accepting the current package, and any
-- depended-on component in the current package actually exists. In fact this
-- check is performed by gathering the internal tool dependencies of each
-- component of the package according to this module, and ensuring those
-- properties on each so-gathered dependency.
--
-- version bounds and components of the package are unchecked. This is because
-- we sanitize exe deps so that the matching name implies these other
-- conditions.
isInternal :: PackageDescription -> ExeDependency -> Bool
isInternal :: PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg (ExeDependency PackageName
n UnqualComponentName
_ VersionRange
_) = PackageName
n PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg

-- | Get internal "build-tool-depends", along with internal "build-tools"
--
-- This is a tiny function, but used in a number of places. The same
-- restrictions that apply to `isInternal` also apply to this function.
getAllInternalToolDependencies
  :: PackageDescription
  -> BuildInfo
  -> [UnqualComponentName]
getAllInternalToolDependencies :: PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg BuildInfo
bi =
  [ UnqualComponentName
toolname
  | dep :: ExeDependency
dep@(ExeDependency PackageName
_ UnqualComponentName
toolname VersionRange
_) <- PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg BuildInfo
bi
  , PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg ExeDependency
dep
  ]