    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -----------------------------------------------------------------------------
    {-# OPTIONS_GHC -fno-warn-deprecations #-}

    -- |
    -- Module      :  Distribution.Simple.ConfigureScript
    -- Copyright   :  Isaac Jones 2003-2005
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    module Distribution.Simple.ConfigureScript
      ( runConfigureScript
      ) where

    import Distribution.Compat.Prelude
    import Prelude ()

    -- local
    import Distribution.PackageDescription
    import Distribution.Pretty
    import Distribution.Simple.Errors
    import Distribution.Simple.LocalBuildInfo
    import Distribution.Simple.Program
    import Distribution.Simple.Program.Db
    import Distribution.Simple.Setup.Common
    import Distribution.Simple.Setup.Config
    import Distribution.Simple.Utils
    import Distribution.System (buildPlatform)
    import Distribution.Utils.NubList
    import Distribution.Verbosity

    -- Base
    import System.FilePath
      ( dropDrive
      , searchPathSeparator
      , splitDirectories
      , takeDirectory
      , (</>)
      )
    #ifdef mingw32_HOST_OS
    import System.FilePath    (normalise, splitDrive)
    #endif
    import Distribution.Compat.Directory (makeAbsolute)
    import Distribution.Compat.Environment (getEnvironment)
    import Distribution.Compat.GetShortPathName (getShortPathName)

    import qualified Data.List.NonEmpty as NonEmpty
    import qualified Data.Map as Map

    runConfigureScript
      :: Verbosity
      -> ConfigFlags
      -> LocalBuildInfo
      -> IO ()
    runConfigureScript :: Verbosity -> ConfigFlags -> LocalBuildInfo -> IO ()
    runConfigureScript Verbosity
    verbosity ConfigFlags
    flags LocalBuildInfo
    lbi = do
      env <- IO [(String, String)]
    getEnvironment
      let programDb = LocalBuildInfo -> ProgramDb
    withPrograms LocalBuildInfo
    lbi
      (ccProg, ccFlags) <- configureCCompiler verbosity programDb
      ccProgShort <- getShortPathName ccProg
      -- The C compiler's compilation and linker flags (e.g.
      -- "C compiler flags" and "Gcc Linker flags" from GHC) have already
      -- been merged into ccFlags, so we set both CFLAGS and LDFLAGS
      -- to ccFlags
      -- We don't try and tell configure which ld to use, as we don't have
      -- a way to pass its flags too
      configureFile <-
        makeAbsolute $
          fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure"
      -- autoconf is fussy about filenames, and has a set of forbidden
      -- characters that can't appear in the build directory, etc:
      -- https://www.gnu.org/software/autoconf/manual/autoconf.html#File-System-Conventions
      --
      -- This has caused hard-to-debug failures in the past (#5368), so we
      -- detect some cases early and warn with a clear message. Windows's
      -- use of backslashes is problematic here, so we'll switch to
      -- slashes, but we do still want to fail on backslashes in POSIX
      -- paths.
      --
      -- TODO: We don't check for colons, tildes or leading dashes. We
      -- also should check the builddir's path, destdir, and all other
      -- paths as well.
      let configureFile' = String -> String
    toUnix String
    configureFile
      for_ badAutoconfCharacters $ \(Char
    c, String
    cname) ->
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String -> String
    dropDrive String
    configureFile') (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
              [ String
    "The path to the './configure' script, '"
              , String
    configureFile'
              , String
    "', contains the character '"
              , [Char
    c]
              , String
    "' ("
              , String
    cname
              , String
    ")."
              , String
    " This may cause the script to fail with an obscure error, or for"
              , String
    " building the package to fail later."
              ]

      let
        -- Convert a flag name to name of environment variable to represent its
        -- value for the configure script.
        flagEnvVar :: FlagName -> String
        flagEnvVar FlagName
    flag = String
    "CABAL_FLAG_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    f (FlagName -> String
    unFlagName FlagName
    flag)
          where
            f :: Char -> Char
    f Char
    c
              | Char -> Bool
    isAlphaNum Char
    c = Char
    c
              | Bool
    otherwise = Char
    '_'
        -- A map from such env vars to every flag name and value where the name
        -- name maps to that that env var.
        cabalFlagMap :: Map String (NonEmpty (FlagName, Bool))
        cabalFlagMap =
          (NonEmpty (FlagName, Bool)
     -> NonEmpty (FlagName, Bool) -> NonEmpty (FlagName, Bool))
    -> [(String, NonEmpty (FlagName, Bool))]
    -> Map String (NonEmpty (FlagName, Bool))
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith
            NonEmpty (FlagName, Bool)
    -> NonEmpty (FlagName, Bool) -> NonEmpty (FlagName, Bool)
    forall a. Semigroup a => a -> a -> a
    (<>)
            [ (FlagName -> String
    flagEnvVar FlagName
    flag, (FlagName
    flag, Bool
    bool) (FlagName, Bool) -> [(FlagName, Bool)] -> NonEmpty (FlagName, Bool)
    forall a. a -> [a] -> NonEmpty a
    :| [])
            | (FlagName
    flag, Bool
    bool) <- FlagAssignment -> [(FlagName, Bool)]
    unFlagAssignment (FlagAssignment -> [(FlagName, Bool)])
    -> FlagAssignment -> [(FlagName, Bool)]
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> FlagAssignment
    flagAssignment LocalBuildInfo
    lbi
            ]
      -- A map from env vars to flag names to the single flag we will go with
      cabalFlagMapDeconflicted :: Map String (FlagName, Bool) <-
        flip Map.traverseWithKey cabalFlagMap $ \String
    envVar -> \case
          -- No conflict: no problem
          (FlagName, Bool)
    singleFlag :| [] -> (FlagName, Bool) -> IO (FlagName, Bool)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FlagName, Bool)
    singleFlag
          -- Conflict: warn and discard all but first
          collidingFlags :: NonEmpty (FlagName, Bool)
    collidingFlags@((FlagName, Bool)
    firstFlag :| (FlagName, Bool)
    _ : [(FlagName, Bool)]
    _) -> do
            let quote :: String -> String
    quote String
    s = String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
                toName :: (FlagName, b) -> String
    toName = String -> String
    quote (String -> String)
    -> ((FlagName, b) -> String) -> (FlagName, b) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FlagName -> String
    unFlagName (FlagName -> String)
    -> ((FlagName, b) -> FlagName) -> (FlagName, b) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FlagName, b) -> FlagName
    forall a b. (a, b) -> a
    fst
                renderedList :: String
    renderedList = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ NonEmpty String -> [String]
    forall a. NonEmpty a -> [a]
    NonEmpty.toList (NonEmpty String -> [String]) -> NonEmpty String -> [String]
    forall a b. (a -> b) -> a -> b
    $ (FlagName, Bool) -> String
    forall {b}. (FlagName, b) -> String
    toName ((FlagName, Bool) -> String)
    -> NonEmpty (FlagName, Bool) -> NonEmpty String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty (FlagName, Bool)
    collidingFlags
            Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              [String] -> String
    unwords
                [ String
    "Flags"
                , String
    renderedList
                , String
    "all map to the same environment variable"
                , String -> String
    quote String
    envVar
                , String
    "causing a collision."
                , String
    "The value first flag"
                , (FlagName, Bool) -> String
    forall {b}. (FlagName, b) -> String
    toName (FlagName, Bool)
    firstFlag
                , String
    "will be used."
                ]
            (FlagName, Bool) -> IO (FlagName, Bool)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FlagName, Bool)
    firstFlag

      let cabalFlagEnv =
            [ (String
    envVar, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    val)
            | (String
    envVar, (FlagName
    _, Bool
    bool)) <- Map String (FlagName, Bool) -> [(String, (FlagName, Bool))]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map String (FlagName, Bool)
    cabalFlagMapDeconflicted
            , let val :: String
    val = if Bool
    bool then String
    "1" else String
    "0"
            ]
              [(String, Maybe String)]
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a. [a] -> [a] -> [a]
    ++ [
                   ( String
    "CABAL_FLAGS"
                   , String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [(FlagName, Bool) -> String
    showFlagValue (FlagName, Bool)
    fv | (FlagName, Bool)
    fv <- FlagAssignment -> [(FlagName, Bool)]
    unFlagAssignment (FlagAssignment -> [(FlagName, Bool)])
    -> FlagAssignment -> [(FlagName, Bool)]
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> FlagAssignment
    flagAssignment LocalBuildInfo
    lbi]
                   )
                 ]
      let extraPath = NubList String -> [String]
    forall a. NubList a -> [a]
    fromNubList (NubList String -> [String]) -> NubList String -> [String]
    forall a b. (a -> b) -> a -> b
    $ ConfigFlags -> NubList String
    configProgramPathExtra ConfigFlags
    flags
      let cflagsEnv =
            String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([String] -> String
    unwords [String]
    ccFlags) (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    ccFlags)) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $
              String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "CFLAGS" [(String, String)]
    env
          spSep = [Char
    searchPathSeparator]
          pathEnv =
            String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
              (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    spSep [String]
    extraPath)
              ((String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    spSep [String]
    extraPath String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    spSep) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
              (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "PATH" [(String, String)]
    env
          overEnv =
            (String
    "CFLAGS", String -> Maybe String
    forall a. a -> Maybe a
    Just String
    cflagsEnv)
              (String, Maybe String)
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a. a -> [a] -> [a]
    : [(String
    "PATH", String -> Maybe String
    forall a. a -> Maybe a
    Just String
    pathEnv) | Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    extraPath)]
              [(String, Maybe String)]
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Maybe String)]
    cabalFlagEnv
          hp = LocalBuildInfo -> Platform
    hostPlatform LocalBuildInfo
    lbi
          maybeHostFlag = if Platform
    hp Platform -> Platform -> Bool
    forall a. Eq a => a -> a -> Bool
    == Platform
    buildPlatform then [] else [String
    "--host=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    forall a. Show a => a -> String
    show (Platform -> Doc
    forall a. Pretty a => a -> Doc
    pretty Platform
    hp)]
          args' = String
    configureFile' String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    args [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "CC=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ccProgShort] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    maybeHostFlag
          shProg = String -> Program
    simpleProgram String
    "sh"
      progDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb
      shConfiguredProg <-
        lookupProgram shProg
          `fmap` configureProgram verbosity shProg progDb
      case shConfiguredProg of
        Just ConfiguredProgram
    sh ->
          Verbosity -> ProgramInvocation -> IO ()
    runProgramInvocation Verbosity
    verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            (ConfiguredProgram -> [String] -> ProgramInvocation
    programInvocation (ConfiguredProgram
    sh{programOverrideEnv = overEnv}) [String]
    args')
              { progInvokeCwd = Just (buildDir lbi)
              }
        Maybe ConfiguredProgram
    Nothing -> Verbosity -> CabalException -> IO ()
    forall a1 a.
    (HasCallStack, Show a1, Typeable a1,
     Exception (VerboseException a1)) =>
    Verbosity -> a1 -> IO a
    dieWithException Verbosity
    verbosity CabalException
    NotFoundMsg
      where
        args :: [String]
    args = Bool -> ConfigFlags -> [String]
    configureArgs Bool
    backwardsCompatHack ConfigFlags
    flags
        backwardsCompatHack :: Bool
    backwardsCompatHack = Bool
    False

    -- | Convert Windows path to Unix ones
    toUnix :: String -> String
    #ifdef mingw32_HOST_OS
    toUnix s = let tmp = normalise s
                   (l, rest) = case splitDrive tmp of
                                 ([],  x) -> ("/"      , x)
                                 (h:_, x) -> ('/':h:"/", x)
                   parts = splitDirectories rest
               in  l ++ intercalate "/" parts
    #else
    toUnix :: String -> String
    toUnix String
    s = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "/" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    splitDirectories String
    s
    #endif

    badAutoconfCharacters :: [(Char, String)]
    badAutoconfCharacters :: [(Char, String)]
    badAutoconfCharacters =
      [ (Char
    ' ', String
    "space")
      , (Char
    '\t', String
    "tab")
      , (Char
    '\n', String
    "newline")
      , (Char
    '\0', String
    "null")
      , (Char
    '"', String
    "double quote")
      , (Char
    '#', String
    "hash")
      , (Char
    '$', String
    "dollar sign")
      , (Char
    '&', String
    "ampersand")
      , (Char
    '\'', String
    "single quote")
      , (Char
    '(', String
    "left bracket")
      , (Char
    ')', String
    "right bracket")
      , (Char
    '*', String
    "star")
      , (Char
    ';', String
    "semicolon")
      , (Char
    '<', String
    "less-than sign")
      , (Char
    '=', String
    "equals sign")
      , (Char
    '>', String
    "greater-than sign")
      , (Char
    '?', String
    "question mark")
      , (Char
    '[', String
    "left square bracket")
      , (Char
    '\\', String
    "backslash")
      , (Char
    '`', String
    "backtick")
      , (Char
    '|', String
    "pipe")
      ]