-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.Builtin
-- Copyright   :  Isaac Jones 2006, Duncan Coutts 2007-2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- The module defines all the known built-in 'Program's.
--
-- Where possible we try to find their version numbers.
module Distribution.Simple.Program.Builtin
  ( -- * The collection of unconfigured and configured programs
    builtinPrograms

    -- * Programs that Cabal knows about
  , ghcProgram
  , ghcPkgProgram
  , runghcProgram
  , ghcjsProgram
  , ghcjsPkgProgram
  , hmakeProgram
  , jhcProgram
  , haskellSuiteProgram
  , haskellSuitePkgProgram
  , uhcProgram
  , gccProgram
  , arProgram
  , stripProgram
  , happyProgram
  , alexProgram
  , hsc2hsProgram
  , c2hsProgram
  , cpphsProgram
  , hscolourProgram
  , doctestProgram
  , haddockProgram
  , greencardProgram
  , ldProgram
  , tarProgram
  , cppProgram
  , pkgConfigProgram
  , hpcProgram
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Simple.Program.Find
import Distribution.Simple.Program.GHC
import Distribution.Simple.Program.Internal
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Version

import qualified Data.Map as Map

-- ------------------------------------------------------------

-- * Known programs

-- ------------------------------------------------------------

-- | The default list of programs.
-- These programs are typically used internally to Cabal.
builtinPrograms :: [Program]
builtinPrograms :: [Program]
builtinPrograms =
  [ -- compilers and related progs
    Program
ghcProgram
  , Program
runghcProgram
  , Program
ghcPkgProgram
  , Program
ghcjsProgram
  , Program
ghcjsPkgProgram
  , Program
haskellSuiteProgram
  , Program
haskellSuitePkgProgram
  , Program
hmakeProgram
  , Program
jhcProgram
  , Program
uhcProgram
  , Program
hpcProgram
  , -- preprocessors
    Program
hscolourProgram
  , Program
doctestProgram
  , Program
haddockProgram
  , Program
happyProgram
  , Program
alexProgram
  , Program
hsc2hsProgram
  , Program
c2hsProgram
  , Program
cpphsProgram
  , Program
greencardProgram
  , -- platform toolchain
    Program
gccProgram
  , Program
arProgram
  , Program
stripProgram
  , Program
ldProgram
  , Program
tarProgram
  , -- configuration tools
    Program
pkgConfigProgram
  ]

ghcProgram :: Program
ghcProgram :: Program
ghcProgram =
  (String -> Program
simpleProgram String
"ghc")
    { programFindVersion = findProgramVersion "--numeric-version" id
    , -- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/8825
      -- (spurious warning on non-english locales)
      programPostConf = \Verbosity
_verbosity ConfiguredProgram
ghcProg ->
        do
          let ghcProg' :: ConfiguredProgram
ghcProg' =
                ConfiguredProgram
ghcProg
                  { programOverrideEnv =
                      ("LANGUAGE", Just "en")
                        : programOverrideEnv ghcProg
                  }
              -- Only the 7.8 branch seems to be affected. Fixed in 7.8.4.
              affectedVersionRange :: VersionRange
affectedVersionRange =
                VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
                  (Version -> VersionRange
laterVersion (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
7, Int
8, Int
0])
                  (Version -> VersionRange
earlierVersion (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
7, Int
8, Int
4])
          ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredProgram -> IO ConfiguredProgram)
-> ConfiguredProgram -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$
            ConfiguredProgram
-> (Version -> ConfiguredProgram)
-> Maybe Version
-> ConfiguredProgram
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              ConfiguredProgram
ghcProg
              ( \Version
v ->
                  if Version -> VersionRange -> Bool
withinRange Version
v VersionRange
affectedVersionRange
                    then ConfiguredProgram
ghcProg'
                    else ConfiguredProgram
ghcProg
              )
              (ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcProg)
    , programNormaliseArgs = normaliseGhcArgs
    }

runghcProgram :: Program
runghcProgram :: Program
runghcProgram =
  (String -> Program
simpleProgram String
"runghc")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- "runghc 7.10.3"
          (String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

ghcPkgProgram :: Program
ghcPkgProgram :: Program
ghcPkgProgram =
  (String -> Program
simpleProgram String
"ghc-pkg")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "ghc-pkg --version" gives a string like
        -- "GHC package manager version 6.4.1"
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

ghcjsProgram :: Program
ghcjsProgram :: Program
ghcjsProgram =
  (String -> Program
simpleProgram String
"ghcjs")
    { programFindVersion = findProgramVersion "--numeric-ghcjs-version" id
    }

-- note: version is the version number of the GHC version that ghcjs-pkg was built with
ghcjsPkgProgram :: Program
ghcjsPkgProgram :: Program
ghcjsPkgProgram =
  (String -> Program
simpleProgram String
"ghcjs-pkg")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "ghcjs-pkg --version" gives a string like
        -- "GHCJS package manager version 6.4.1"
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

hmakeProgram :: Program
hmakeProgram :: Program
hmakeProgram =
  (String -> Program
simpleProgram String
"hmake")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "hmake --version" gives a string line
        -- "/usr/local/bin/hmake: 3.13 (2006-11-01)"
        case String -> [String]
words String
str of
          (String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

jhcProgram :: Program
jhcProgram :: Program
jhcProgram =
  (String -> Program
simpleProgram String
"jhc")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- invoking "jhc --version" gives a string like
        -- "jhc 0.3.20080208 (wubgipkamcep-2)
        -- compiled by ghc-6.8 on a x86_64 running linux"
        case String -> [String]
words String
str of
          (String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

uhcProgram :: Program
uhcProgram :: Program
uhcProgram =
  (String -> Program
simpleProgram String
"uhc")
    { programFindVersion = findProgramVersion "--version-dotted" id
    }

hpcProgram :: Program
hpcProgram :: Program
hpcProgram =
  (String -> Program
simpleProgram String
"hpc")
    { programFindVersion = findProgramVersion "version" $ \String
str ->
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

-- This represents a haskell-suite compiler. Of course, the compiler
-- itself probably is not called "haskell-suite", so this is not a real
-- program. (But we don't know statically the name of the actual compiler,
-- so this is the best we can do.)
--
-- Having this Program value serves two purposes:
--
-- 1. We can accept options for the compiler in the form of
--
--   --haskell-suite-option(s)=...
--
-- 2. We can find a program later using this static id (with
-- requireProgram).
--
-- The path to the real compiler is found and recorded in the ProgramDb
-- during the configure phase.
haskellSuiteProgram :: Program
haskellSuiteProgram :: Program
haskellSuiteProgram =
  (String -> Program
simpleProgram String
"haskell-suite")
    { -- pretend that the program exists, otherwise it won't be in the
      -- "configured" state
      programFindLocation = \Verbosity
_verbosity ProgramSearchPath
_searchPath ->
        Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, [String]) -> IO (Maybe (String, [String])))
-> Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
"haskell-suite-dummy-location", [])
    }

-- This represent a haskell-suite package manager. See the comments for
-- haskellSuiteProgram.
haskellSuitePkgProgram :: Program
haskellSuitePkgProgram :: Program
haskellSuitePkgProgram =
  (String -> Program
simpleProgram String
"haskell-suite-pkg")
    { programFindLocation = \Verbosity
_verbosity ProgramSearchPath
_searchPath ->
        Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, [String]) -> IO (Maybe (String, [String])))
-> Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
"haskell-suite-pkg-dummy-location", [])
    }

happyProgram :: Program
happyProgram :: Program
happyProgram =
  (String -> Program
simpleProgram String
"happy")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "happy --version" gives a string like
        -- "Happy Version 1.16 Copyright (c) ...."
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

alexProgram :: Program
alexProgram :: Program
alexProgram =
  (String -> Program
simpleProgram String
"alex")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "alex --version" gives a string like
        -- "Alex version 2.1.0, (c) 2003 Chris Dornan and Simon Marlow"
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
ver : [String]
_) -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
ver
          [String]
_ -> String
""
    }

gccProgram :: Program
gccProgram :: Program
gccProgram =
  (String -> Program
simpleProgram String
"gcc")
    { programFindVersion = findProgramVersion "-dumpversion" id
    }

arProgram :: Program
arProgram :: Program
arProgram = String -> Program
simpleProgram String
"ar"

stripProgram :: Program
stripProgram :: Program
stripProgram =
  (String -> Program
simpleProgram String
"strip")
    { programFindVersion = \Verbosity
verbosity ->
        String
-> (String -> String) -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" String -> String
stripExtractVersion (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity)
    }

hsc2hsProgram :: Program
hsc2hsProgram :: Program
hsc2hsProgram =
  (String -> Program
simpleProgram String
"hsc2hs")
    { programFindVersion =
        findProgramVersion "--version" $ \String
str ->
          -- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
          case String -> [String]
words String
str of
            (String
_ : String
_ : String
ver : [String]
_) -> String
ver
            [String]
_ -> String
""
    }

c2hsProgram :: Program
c2hsProgram :: Program
c2hsProgram =
  (String -> Program
simpleProgram String
"c2hs")
    { programFindVersion = findProgramVersion "--numeric-version" id
    }

cpphsProgram :: Program
cpphsProgram :: Program
cpphsProgram =
  (String -> Program
simpleProgram String
"cpphs")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "cpphs --version" gives a string like "cpphs 1.3"
        case String -> [String]
words String
str of
          (String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

hscolourProgram :: Program
hscolourProgram :: Program
hscolourProgram =
  (String -> Program
simpleProgram String
"hscolour")
    { programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p String
"HsColour"
    , programFindVersion = findProgramVersion "-version" $ \String
str ->
        -- Invoking "HsColour -version" gives a string like "HsColour 1.7"
        case String -> [String]
words String
str of
          (String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

-- TODO: Ensure that doctest is built against the same GHC as the one
--       that's being used.  Same for haddock.  @phadej pointed this out.
doctestProgram :: Program
doctestProgram :: Program
doctestProgram =
  (String -> Program
simpleProgram String
"doctest")
    { programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p String
"doctest"
    , programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- "doctest version 0.11.2"
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

haddockProgram :: Program
haddockProgram :: Program
haddockProgram =
  (String -> Program
simpleProgram String
"haddock")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        -- Invoking "haddock --version" gives a string like
        -- "Haddock version 0.8, (c) Simon Marlow 2006"
        case String -> [String]
words String
str of
          (String
_ : String
_ : String
ver : [String]
_) -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
'0' .. Char
'9'])) String
ver
          [String]
_ -> String
""
    , programNormaliseArgs = \Maybe Version
_ PackageDescription
_ [String]
args -> [String]
args
    }

greencardProgram :: Program
greencardProgram :: Program
greencardProgram = String -> Program
simpleProgram String
"greencard"

ldProgram :: Program
ldProgram :: Program
ldProgram =
  (String -> Program
simpleProgram String
"ld")
    { programPostConf = \Verbosity
verbosity ConfiguredProgram
ldProg -> do
        -- The `lld` linker cannot create merge (relocatable) objects so we
        -- want to detect this.
        -- If the linker does support relocatable objects, we want to use that
        -- to create partially pre-linked objects for GHCi, so we get much
        -- faster loading as we do not have to do the separate loading and
        -- in-memory linking the static linker in GHC does, but can offload
        -- parts of this process to a pre-linking step.
        -- However this requires the linker to support this features. Not all
        -- linkers do, and notably as of this writing `lld` which is a popular
        -- choice for windows linking does not support this feature. However
        -- if using binutils ld or another linker that supports --relocatable,
        -- we should still be good to generate pre-linked objects.
        String
ldHelpOutput <-
          Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput
            Verbosity
verbosity
            (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
ldProg [String
"--help"])
            -- In case the linker does not support '--help'. Eg the LLVM linker,
            -- `lld` only accepts `-help`.
            IO String -> (IOException -> IO String) -> IO String
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
        let k :: String
k = String
"Supports relocatable output"
            -- Standard GNU `ld` uses `--relocatable` while `ld.gold` uses
            -- `-relocatable` (single `-`).
            v :: String
v
              | String
"-relocatable" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
ldHelpOutput = String
"YES"
              -- ld64 on macOS has this lovely response for "--help"
              --
              --   ld64: For information on command line options please use 'man ld'.
              --
              -- it does however support -r, if you read the manpage
              -- (e.g. https://www.manpagez.com/man/1/ld64/)
              | String
"ld64:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ldHelpOutput = String
"YES"
              | Bool
otherwise = String
"NO"

            m :: Map String String
m = String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k String
v (ConfiguredProgram -> Map String String
programProperties ConfiguredProgram
ldProg)
        ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredProgram -> IO ConfiguredProgram)
-> ConfiguredProgram -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram
ldProg{programProperties = m}
    }

tarProgram :: Program
tarProgram :: Program
tarProgram =
  (String -> Program
simpleProgram String
"tar")
    { -- See #1901. Some versions of 'tar' (OpenBSD, NetBSD, ...) don't support the
      -- '--format' option.
      programPostConf = \Verbosity
verbosity ConfiguredProgram
tarProg -> do
        String
tarHelpOutput <-
          Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput
            Verbosity
verbosity
            (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
tarProg [String
"--help"])
            -- Some versions of tar don't support '--help'.
            IO String -> (IOException -> IO String) -> IO String
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
        let k :: String
k = String
"Supports --format"
            v :: String
v = if (String
"--format" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
tarHelpOutput) then String
"YES" else String
"NO"
            m :: Map String String
m = String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k String
v (ConfiguredProgram -> Map String String
programProperties ConfiguredProgram
tarProg)
        ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredProgram -> IO ConfiguredProgram)
-> ConfiguredProgram -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram
tarProg{programProperties = m}
    }

cppProgram :: Program
cppProgram :: Program
cppProgram = String -> Program
simpleProgram String
"cpp"

pkgConfigProgram :: Program
pkgConfigProgram :: Program
pkgConfigProgram =
  (String -> Program
simpleProgram String
"pkg-config")
    { programFindVersion = findProgramVersion "--version" id
    , programPostConf = \Verbosity
_ ConfiguredProgram
pkgConfProg ->
        let programOverrideEnv' :: [(String, Maybe String)]
programOverrideEnv' =
              ConfiguredProgram -> [(String, Maybe String)]
programOverrideEnv ConfiguredProgram
pkgConfProg
                [(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [ (String
"PKG_CONFIG_ALLOW_SYSTEM_CFLAGS", String -> Maybe String
forall a. a -> Maybe a
Just String
"1")
                   , (String
"PKG_CONFIG_ALLOW_SYSTEM_LIBS", String -> Maybe String
forall a. a -> Maybe a
Just String
"1")
                   ]
         in ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfiguredProgram -> IO ConfiguredProgram)
-> ConfiguredProgram -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram
pkgConfProg{programOverrideEnv = programOverrideEnv'}
    }