{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | Build-specific types.


module Stack.Types.Build
    (StackBuildException(..)
    ,FlagSource(..)
    ,UnusedFlags(..)
    ,InstallLocation(..)
    ,Installed(..)
    ,psVersion
    ,Task(..)
    ,taskIsTarget
    ,taskLocation
    ,taskTargetIsMutable
    ,LocalPackage(..)
    ,BaseConfigOpts(..)
    ,Plan(..)
    ,TestOpts(..)
    ,BenchmarkOpts(..)
    ,FileWatchOpts(..)
    ,BuildOpts(..)
    ,BuildSubset(..)
    ,defaultBuildOpts
    ,TaskType(..)
    ,IsMutable(..)
    ,installLocationIsMutable
    ,TaskConfigOpts(..)
    ,BuildCache(..)
    ,ConfigCache(..)
    ,configureOpts
    ,CachePkgSrc (..)
    ,toCachePkgSrc
    ,isStackOpt
    ,wantedLocalPackages
    ,FileCacheInfo (..)
    ,ConfigureOpts (..)
    ,PrecompiledCache (..)
    )
    where

import           Stack.Prelude
import           Data.Aeson                      (ToJSON, FromJSON)
import qualified Data.ByteString                 as S
import           Data.Char                       (isSpace)
import           Data.List.Extra
import qualified Data.Map                        as Map
import qualified Data.Set                        as Set
import qualified Data.Text                       as T
import           Database.Persist.Sql            (PersistField(..)
                                                 ,PersistFieldSql(..)
                                                 ,PersistValue(PersistText)
                                                 ,SqlType(SqlString))
import           Distribution.PackageDescription (TestSuiteInterface)
import           Distribution.System             (Arch)
import qualified Distribution.Text               as C
import           Distribution.Version            (mkVersion)
import           Path                            (parseRelDir, (</>), parent)
import           Path.Extra                      (toFilePathNoTrailingSep)
import           Stack.Constants
import           Stack.Types.Compiler
import           Stack.Types.CompilerBuild
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.Package
import           Stack.Types.Version
import           System.FilePath                 (pathSeparator)
import           RIO.Process                     (showProcessArgDebug)

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

-- Exceptions

data StackBuildException
  = Couldn'tFindPkgId PackageName
  | CompilerVersionMismatch
        (Maybe (ActualCompiler, Arch)) -- found

        (WantedCompiler, Arch) -- expected

        GHCVariant -- expected

        CompilerBuild -- expected

        VersionCheck
        (Maybe (Path Abs File)) -- Path to the stack.yaml file

        Text -- recommended resolution

  | Couldn'tParseTargets [Text]
  | UnknownTargets
    (Set PackageName) -- no known version

    (Map PackageName Version) -- not in snapshot, here's the most recent version in the index

    (Path Abs File) -- stack.yaml

  | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString
  | TestSuiteTypeUnsupported TestSuiteInterface
  | ConstructPlanFailed String
  | CabalExitedUnsuccessfully
        ExitCode
        PackageIdentifier
        (Path Abs File)  -- cabal Executable

        [String]         -- cabal arguments

        (Maybe (Path Abs File)) -- logfiles location

        [Text]     -- log contents

  | SetupHsBuildFailure
        ExitCode
        (Maybe PackageIdentifier) -- which package's custom setup, is simple setup if Nothing

        (Path Abs File)  -- ghc Executable

        [String]         -- ghc arguments

        (Maybe (Path Abs File)) -- logfiles location

        [Text]     -- log contents

  | ExecutionFailure [SomeException]
  | LocalPackageDoesn'tMatchTarget
        PackageName
        Version -- local version

        Version -- version specified on command line

  | NoSetupHsFound (Path Abs Dir)
  | InvalidFlagSpecification (Set UnusedFlags)
  | InvalidGhcOptionsSpecification [PackageName]
  | TargetParseException [Text]
  | SomeTargetsNotBuildable [(PackageName, NamedComponent)]
  | TestSuiteExeMissing Bool String String String
  | CabalCopyFailed Bool String
  | LocalPackagesPresent [PackageIdentifier]
  | CouldNotLockDistDir !(Path Abs File)
  deriving Typeable

data FlagSource = FSCommandLine | FSStackYaml
    deriving (Int -> FlagSource -> ShowS
[FlagSource] -> ShowS
FlagSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagSource] -> ShowS
$cshowList :: [FlagSource] -> ShowS
show :: FlagSource -> String
$cshow :: FlagSource -> String
showsPrec :: Int -> FlagSource -> ShowS
$cshowsPrec :: Int -> FlagSource -> ShowS
Show, FlagSource -> FlagSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagSource -> FlagSource -> Bool
$c/= :: FlagSource -> FlagSource -> Bool
== :: FlagSource -> FlagSource -> Bool
$c== :: FlagSource -> FlagSource -> Bool
Eq, Eq FlagSource
FlagSource -> FlagSource -> Bool
FlagSource -> FlagSource -> Ordering
FlagSource -> FlagSource -> FlagSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FlagSource -> FlagSource -> FlagSource
$cmin :: FlagSource -> FlagSource -> FlagSource
max :: FlagSource -> FlagSource -> FlagSource
$cmax :: FlagSource -> FlagSource -> FlagSource
>= :: FlagSource -> FlagSource -> Bool
$c>= :: FlagSource -> FlagSource -> Bool
> :: FlagSource -> FlagSource -> Bool
$c> :: FlagSource -> FlagSource -> Bool
<= :: FlagSource -> FlagSource -> Bool
$c<= :: FlagSource -> FlagSource -> Bool
< :: FlagSource -> FlagSource -> Bool
$c< :: FlagSource -> FlagSource -> Bool
compare :: FlagSource -> FlagSource -> Ordering
$ccompare :: FlagSource -> FlagSource -> Ordering
Ord)

data UnusedFlags = UFNoPackage FlagSource PackageName
                 | UFFlagsNotDefined
                       FlagSource
                       PackageName
                       (Set FlagName) -- defined in package

                       (Set FlagName) -- not defined

                 | UFSnapshot PackageName
    deriving (Int -> UnusedFlags -> ShowS
[UnusedFlags] -> ShowS
UnusedFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnusedFlags] -> ShowS
$cshowList :: [UnusedFlags] -> ShowS
show :: UnusedFlags -> String
$cshow :: UnusedFlags -> String
showsPrec :: Int -> UnusedFlags -> ShowS
$cshowsPrec :: Int -> UnusedFlags -> ShowS
Show, UnusedFlags -> UnusedFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnusedFlags -> UnusedFlags -> Bool
$c/= :: UnusedFlags -> UnusedFlags -> Bool
== :: UnusedFlags -> UnusedFlags -> Bool
$c== :: UnusedFlags -> UnusedFlags -> Bool
Eq, Eq UnusedFlags
UnusedFlags -> UnusedFlags -> Bool
UnusedFlags -> UnusedFlags -> Ordering
UnusedFlags -> UnusedFlags -> UnusedFlags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnusedFlags -> UnusedFlags -> UnusedFlags
$cmin :: UnusedFlags -> UnusedFlags -> UnusedFlags
max :: UnusedFlags -> UnusedFlags -> UnusedFlags
$cmax :: UnusedFlags -> UnusedFlags -> UnusedFlags
>= :: UnusedFlags -> UnusedFlags -> Bool
$c>= :: UnusedFlags -> UnusedFlags -> Bool
> :: UnusedFlags -> UnusedFlags -> Bool
$c> :: UnusedFlags -> UnusedFlags -> Bool
<= :: UnusedFlags -> UnusedFlags -> Bool
$c<= :: UnusedFlags -> UnusedFlags -> Bool
< :: UnusedFlags -> UnusedFlags -> Bool
$c< :: UnusedFlags -> UnusedFlags -> Bool
compare :: UnusedFlags -> UnusedFlags -> Ordering
$ccompare :: UnusedFlags -> UnusedFlags -> Ordering
Ord)

instance Show StackBuildException where
    show :: StackBuildException -> String
show (Couldn'tFindPkgId PackageName
name) =
              String
"After installing " forall a. Semigroup a => a -> a -> a
<> PackageName -> String
packageNameString PackageName
name forall a. Semigroup a => a -> a -> a
<>
               String
", the package id couldn't be found " forall a. Semigroup a => a -> a -> a
<> String
"(via ghc-pkg describe " forall a. Semigroup a => a -> a -> a
<>
               PackageName -> String
packageNameString PackageName
name forall a. Semigroup a => a -> a -> a
<> String
"). This shouldn't happen, " forall a. Semigroup a => a -> a -> a
<>
               String
"please report as a bug"
    show (CompilerVersionMismatch Maybe (ActualCompiler, Arch)
mactual (WantedCompiler
expected, Arch
eArch) GHCVariant
ghcVariant CompilerBuild
ghcBuild VersionCheck
check Maybe (Path Abs File)
mstack Text
resolution) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ case Maybe (ActualCompiler, Arch)
mactual of
                    Maybe (ActualCompiler, Arch)
Nothing -> String
"No compiler found, expected "
                    Just (ActualCompiler
actual, Arch
arch) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                        [ String
"Compiler version mismatched, found "
                        , ActualCompiler -> String
compilerVersionString ActualCompiler
actual
                        , String
" ("
                        , forall a. Pretty a => a -> String
C.display Arch
arch
                        , String
")"
                        , String
", but expected "
                        ]
                , case VersionCheck
check of
                    VersionCheck
MatchMinor -> String
"minor version match with "
                    VersionCheck
MatchExact -> String
"exact version "
                    VersionCheck
NewerMinor -> String
"minor version match or newer with "
                , Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display WantedCompiler
expected
                , String
" ("
                , forall a. Pretty a => a -> String
C.display Arch
eArch
                , GHCVariant -> String
ghcVariantSuffix GHCVariant
ghcVariant
                , CompilerBuild -> String
compilerBuildSuffix CompilerBuild
ghcBuild
                , String
") (based on "
                , case Maybe (Path Abs File)
mstack of
                    Maybe (Path Abs File)
Nothing -> String
"command line arguments"
                    Just Path Abs File
stack -> String
"resolver setting in " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
stack
                , String
").\n"
                , Text -> String
T.unpack Text
resolution
                ]
    show (Couldn'tParseTargets [Text]
targets) = [String] -> String
unlines
                forall a b. (a -> b) -> a -> b
$ String
"The following targets could not be parsed as package names or directories:"
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
targets
    show (UnknownTargets Set PackageName
noKnown Map PackageName Version
notInSnapshot Path Abs File
stackYaml) =
        [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [String]
noKnown' forall a. [a] -> [a] -> [a]
++ [String]
notInSnapshot'
      where
        noKnown' :: [String]
noKnown'
            | forall a. Set a -> Bool
Set.null Set PackageName
noKnown = []
            | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                String
"The following target packages were not found: " forall a. [a] -> [a] -> [a]
++
                forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map PackageName -> String
packageNameString forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set PackageName
noKnown) forall a. [a] -> [a] -> [a]
++
                String
"\nSee https://docs.haskellstack.org/en/stable/build_command/#target-syntax for details."
        notInSnapshot' :: [String]
notInSnapshot'
            | forall k a. Map k a -> Bool
Map.null Map PackageName Version
notInSnapshot = []
            | Bool
otherwise =
                  String
"The following packages are not in your snapshot, but exist"
                forall a. a -> [a] -> [a]
: String
"in your package index. Recommended action: add them to your"
                forall a. a -> [a] -> [a]
: (String
"extra-deps in " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
stackYaml)
                forall a. a -> [a] -> [a]
: String
"(Note: these are the most recent versions,"
                forall a. a -> [a] -> [a]
: String
"but there's no guarantee that they'll build together)."
                forall a. a -> [a] -> [a]
: String
""
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map
                    (\(PackageName
name, Version
version') -> String
"- " forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
packageIdentifierString
                        (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version'))
                    (forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName Version
notInSnapshot)
    show (TestSuiteFailure PackageIdentifier
ident Map Text (Maybe ExitCode)
codes Maybe (Path Abs File)
mlogFile ByteString
bs) = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [String
"Test suite failure for package " forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident]
        , forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Map k a -> [(k, a)]
Map.toList Map Text (Maybe ExitCode)
codes) forall a b. (a -> b) -> a -> b
$ \(Text
name, Maybe ExitCode
mcode) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"    "
            , Text -> String
T.unpack Text
name
            , String
": "
            , case Maybe ExitCode
mcode of
                Maybe ExitCode
Nothing -> String
" executable not found"
                Just ExitCode
ec -> String
" exited with: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ExitCode
ec
            ]
        , forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Path Abs File)
mlogFile of
            Maybe (Path Abs File)
Nothing -> String
"Logs printed to console"
            -- TODO Should we load up the full error output and print it here?

            Just Path Abs File
logFile -> String
"Full log available at " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
logFile
        , if ByteString -> Bool
S.null ByteString
bs
            then []
            else [String
"", String
"", ShowS
doubleIndent forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
bs]
        ]
         where
          indent :: ShowS
indent = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
line -> String
"  " forall a. [a] -> [a] -> [a]
++ String
line) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
          doubleIndent :: ShowS
doubleIndent = ShowS
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
indent
    show (TestSuiteTypeUnsupported TestSuiteInterface
interface) =
              String
"Unsupported test suite type: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TestSuiteInterface
interface
     -- Suppressing duplicate output

    show (CabalExitedUnsuccessfully ExitCode
exitCode PackageIdentifier
taskProvides' Path Abs File
execName [String]
fullArgs Maybe (Path Abs File)
logFiles [Text]
bss) =
      Bool
-> ExitCode
-> Maybe PackageIdentifier
-> Path Abs File
-> [String]
-> Maybe (Path Abs File)
-> [Text]
-> String
showBuildError Bool
False ExitCode
exitCode (forall a. a -> Maybe a
Just PackageIdentifier
taskProvides') Path Abs File
execName [String]
fullArgs Maybe (Path Abs File)
logFiles [Text]
bss
    show (SetupHsBuildFailure ExitCode
exitCode Maybe PackageIdentifier
mtaskProvides Path Abs File
execName [String]
fullArgs Maybe (Path Abs File)
logFiles [Text]
bss) =
      Bool
-> ExitCode
-> Maybe PackageIdentifier
-> Path Abs File
-> [String]
-> Maybe (Path Abs File)
-> [Text]
-> String
showBuildError Bool
True ExitCode
exitCode Maybe PackageIdentifier
mtaskProvides Path Abs File
execName [String]
fullArgs Maybe (Path Abs File)
logFiles [Text]
bss
    show (ExecutionFailure [SomeException]
es) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [SomeException]
es
    show (LocalPackageDoesn'tMatchTarget PackageName
name Version
localV Version
requestedV) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Version for local package "
        , PackageName -> String
packageNameString PackageName
name
        , String
" is "
        , Version -> String
versionString Version
localV
        , String
", but you asked for "
        , Version -> String
versionString Version
requestedV
        , String
" on the command line"
        ]
    show (NoSetupHsFound Path Abs Dir
dir) =
        String
"No Setup.hs or Setup.lhs file found in " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs Dir
dir
    show (InvalidFlagSpecification Set UnusedFlags
unused) = [String] -> String
unlines
        forall a b. (a -> b) -> a -> b
$ String
"Invalid flag specification:"
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map UnusedFlags -> String
go (forall a. Set a -> [a]
Set.toList Set UnusedFlags
unused)
      where
        showFlagSrc :: FlagSource -> String
        showFlagSrc :: FlagSource -> String
showFlagSrc FlagSource
FSCommandLine = String
" (specified on command line)"
        showFlagSrc FlagSource
FSStackYaml = String
" (specified in stack.yaml)"

        go :: UnusedFlags -> String
        go :: UnusedFlags -> String
go (UFNoPackage FlagSource
src PackageName
name) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"- Package '"
            , PackageName -> String
packageNameString PackageName
name
            , String
"' not found"
            , FlagSource -> String
showFlagSrc FlagSource
src
            ]
        go (UFFlagsNotDefined FlagSource
src PackageName
pname Set FlagName
pkgFlags Set FlagName
flags) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"- Package '"
            , String
name
            , String
"' does not define the following flags"
            , FlagSource -> String
showFlagSrc FlagSource
src
            , String
":\n"
            , forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
                          (forall a b. (a -> b) -> [a] -> [b]
map (\FlagName
flag -> String
"  " forall a. [a] -> [a] -> [a]
++ FlagName -> String
flagNameString FlagName
flag)
                               (forall a. Set a -> [a]
Set.toList Set FlagName
flags))
            , String
"\n- Flags defined by package '" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"':\n"
            , forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
                          (forall a b. (a -> b) -> [a] -> [b]
map (\FlagName
flag -> String
"  " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ FlagName -> String
flagNameString FlagName
flag)
                               (forall a. Set a -> [a]
Set.toList Set FlagName
pkgFlags))
            ]
          where name :: String
name = PackageName -> String
packageNameString PackageName
pname
        go (UFSnapshot PackageName
name) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"- Attempted to set flag on snapshot package "
            , PackageName -> String
packageNameString PackageName
name
            , String
", please add to extra-deps"
            ]
    show (InvalidGhcOptionsSpecification [PackageName]
unused) = [String] -> String
unlines
        forall a b. (a -> b) -> a -> b
$ String
"Invalid GHC options specification:"
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map PackageName -> String
showGhcOptionSrc [PackageName]
unused
      where
        showGhcOptionSrc :: PackageName -> String
showGhcOptionSrc PackageName
name = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"- Package '"
            , PackageName -> String
packageNameString PackageName
name
            , String
"' not found"
            ]
    show (TargetParseException [Text
err]) = String
"Error parsing targets: " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
err
    show (TargetParseException [Text]
errs) = [String] -> String
unlines
        forall a b. (a -> b) -> a -> b
$ String
"The following errors occurred while parsing the build targets:"
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((String
"- " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
errs

    show (SomeTargetsNotBuildable [(PackageName, NamedComponent)]
xs) =
        String
"The following components have 'buildable: False' set in the cabal configuration, and so cannot be targets:\n    " forall a. [a] -> [a] -> [a]
++
        Text -> String
T.unpack ([(PackageName, NamedComponent)] -> Text
renderPkgComponents [(PackageName, NamedComponent)]
xs) forall a. [a] -> [a] -> [a]
++
        String
"\nTo resolve this, either provide flags such that these components are buildable, or only specify buildable targets."
    show (TestSuiteExeMissing Bool
isSimpleBuildType String
exeName String
pkgName' String
testName) =
        Bool -> ShowS
missingExeError Bool
isSimpleBuildType forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Test suite executable \""
            , String
exeName
            , String
" not found for "
            , String
pkgName'
            , String
":test:"
            , String
testName
            ]
    show (CabalCopyFailed Bool
isSimpleBuildType String
innerMsg) =
        Bool -> ShowS
missingExeError Bool
isSimpleBuildType forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"'cabal copy' failed.  Error message:\n"
            , String
innerMsg
            , String
"\n"
            ]
    show (ConstructPlanFailed String
msg) = String
msg
    show (LocalPackagesPresent [PackageIdentifier]
locals) = [String] -> String
unlines
      forall a b. (a -> b) -> a -> b
$ String
"Local packages are not allowed when using the script command. Packages found:"
      forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\PackageIdentifier
ident -> String
"- " forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident) [PackageIdentifier]
locals
    show (CouldNotLockDistDir Path Abs File
lockFile) = [String] -> String
unlines
      [ String
"Locking the dist directory failed, try to lock file:"
      , String
"  " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
lockFile
      , String
"Maybe you're running another copy of Stack?"
      ]

missingExeError :: Bool -> String -> String
missingExeError :: Bool -> ShowS
missingExeError Bool
isSimpleBuildType String
msg =
    [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
msg forall a. a -> [a] -> [a]
: String
"Possible causes of this issue:" forall a. a -> [a] -> [a]
:
              forall a b. (a -> b) -> [a] -> [b]
map (String
"* " forall a. Semigroup a => a -> a -> a
<>) [String]
possibleCauses
  where
    possibleCauses :: [String]
possibleCauses =
        String
"No module named \"Main\". The 'main-is' source file should usually \
        \have a header indicating that it's a 'Main' module." forall a. a -> [a] -> [a]
:

        String
"A cabal file that refers to nonexistent other files (e.g. a \
        \license-file that doesn't exist). Running 'cabal check' may point \
        \out these issues." forall a. a -> [a] -> [a]
:

        if Bool
isSimpleBuildType
            then []
            else [String
"The Setup.hs file is changing the installation target dir."]

showBuildError
  :: Bool
  -> ExitCode
  -> Maybe PackageIdentifier
  -> Path Abs File
  -> [String]
  -> Maybe (Path Abs File)
  -> [Text]
  -> String
showBuildError :: Bool
-> ExitCode
-> Maybe PackageIdentifier
-> Path Abs File
-> [String]
-> Maybe (Path Abs File)
-> [Text]
-> String
showBuildError Bool
isBuildingSetup ExitCode
exitCode Maybe PackageIdentifier
mtaskProvides Path Abs File
execName [String]
fullArgs Maybe (Path Abs File)
logFiles [Text]
bss =
  let fullCmd :: String
fullCmd = [String] -> String
unwords
              forall a b. (a -> b) -> a -> b
$ ShowS
dropQuotes (forall b t. Path b t -> String
toFilePath Path Abs File
execName)
              forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
showProcessArgDebug) [String]
fullArgs
      logLocations :: String
logLocations = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Path Abs File
fp -> String
"\n    Logs have been written to: " forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
fp) Maybe (Path Abs File)
logFiles
  in String
"\n--  While building " forall a. [a] -> [a] -> [a]
++
     (case (Bool
isBuildingSetup, Maybe PackageIdentifier
mtaskProvides) of
       (Bool
False, Maybe PackageIdentifier
Nothing) -> forall a. HasCallStack => String -> a
error String
"Invariant violated: unexpected case in showBuildError"
       (Bool
False, Just PackageIdentifier
taskProvides') -> String
"package " forall a. [a] -> [a] -> [a]
++ ShowS
dropQuotes (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
taskProvides')
       (Bool
True, Maybe PackageIdentifier
Nothing) -> String
"simple Setup.hs"
       (Bool
True, Just PackageIdentifier
taskProvides') -> String
"custom Setup.hs for package " forall a. [a] -> [a] -> [a]
++ ShowS
dropQuotes (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
taskProvides')
     ) forall a. [a] -> [a] -> [a]
++
     String
" (scroll up to its section to see the error) using:\n      " forall a. [a] -> [a] -> [a]
++ String
fullCmd forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
     String
"    Process exited with code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ExitCode
exitCode forall a. [a] -> [a] -> [a]
++
     (if ExitCode
exitCode forall a. Eq a => a -> a -> Bool
== Int -> ExitCode
ExitFailure (-Int
9)
          then String
" (THIS MAY INDICATE OUT OF MEMORY)"
          else String
"") forall a. [a] -> [a] -> [a]
++
     String
logLocations forall a. [a] -> [a] -> [a]
++
     (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
bss
          then String
""
          else String
"\n\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
removeTrailingSpaces (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
bss))
   where
    removeTrailingSpaces :: [String] -> String
removeTrailingSpaces = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
    dropQuotes :: ShowS
dropQuotes = forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'\"' forall a. Eq a => a -> a -> Bool
/=)

instance Exception StackBuildException

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


-- | Package dependency oracle.

newtype PkgDepsOracle =
    PkgDeps PackageName
    deriving (Int -> PkgDepsOracle -> ShowS
[PkgDepsOracle] -> ShowS
PkgDepsOracle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgDepsOracle] -> ShowS
$cshowList :: [PkgDepsOracle] -> ShowS
show :: PkgDepsOracle -> String
$cshow :: PkgDepsOracle -> String
showsPrec :: Int -> PkgDepsOracle -> ShowS
$cshowsPrec :: Int -> PkgDepsOracle -> ShowS
Show,Typeable,PkgDepsOracle -> PkgDepsOracle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgDepsOracle -> PkgDepsOracle -> Bool
$c/= :: PkgDepsOracle -> PkgDepsOracle -> Bool
== :: PkgDepsOracle -> PkgDepsOracle -> Bool
$c== :: PkgDepsOracle -> PkgDepsOracle -> Bool
Eq,PkgDepsOracle -> ()
forall a. (a -> ()) -> NFData a
rnf :: PkgDepsOracle -> ()
$crnf :: PkgDepsOracle -> ()
NFData)

-- | Stored on disk to know whether the files have changed.

newtype BuildCache = BuildCache
    { BuildCache -> Map String FileCacheInfo
buildCacheTimes :: Map FilePath FileCacheInfo
      -- ^ Modification times of files.

    }
    deriving (forall x. Rep BuildCache x -> BuildCache
forall x. BuildCache -> Rep BuildCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildCache x -> BuildCache
$cfrom :: forall x. BuildCache -> Rep BuildCache x
Generic, BuildCache -> BuildCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildCache -> BuildCache -> Bool
$c/= :: BuildCache -> BuildCache -> Bool
== :: BuildCache -> BuildCache -> Bool
$c== :: BuildCache -> BuildCache -> Bool
Eq, Int -> BuildCache -> ShowS
[BuildCache] -> ShowS
BuildCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildCache] -> ShowS
$cshowList :: [BuildCache] -> ShowS
show :: BuildCache -> String
$cshow :: BuildCache -> String
showsPrec :: Int -> BuildCache -> ShowS
$cshowsPrec :: Int -> BuildCache -> ShowS
Show, Typeable, [BuildCache] -> Value
[BuildCache] -> Encoding
BuildCache -> Value
BuildCache -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BuildCache] -> Encoding
$ctoEncodingList :: [BuildCache] -> Encoding
toJSONList :: [BuildCache] -> Value
$ctoJSONList :: [BuildCache] -> Value
toEncoding :: BuildCache -> Encoding
$ctoEncoding :: BuildCache -> Encoding
toJSON :: BuildCache -> Value
$ctoJSON :: BuildCache -> Value
ToJSON, Value -> Parser [BuildCache]
Value -> Parser BuildCache
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BuildCache]
$cparseJSONList :: Value -> Parser [BuildCache]
parseJSON :: Value -> Parser BuildCache
$cparseJSON :: Value -> Parser BuildCache
FromJSON)
instance NFData BuildCache

-- | Stored on disk to know whether the flags have changed.

data ConfigCache = ConfigCache
    { ConfigCache -> ConfigureOpts
configCacheOpts :: !ConfigureOpts
      -- ^ All options used for this package.

    , ConfigCache -> Set GhcPkgId
configCacheDeps :: !(Set GhcPkgId)
      -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take

      -- the complete GhcPkgId (only a PackageIdentifier) in the configure

      -- options, just using the previous value is insufficient to know if

      -- dependencies have changed.

    , ConfigCache -> Set ByteString
configCacheComponents :: !(Set S.ByteString)
      -- ^ The components to be built. It's a bit of a hack to include this in

      -- here, as it's not a configure option (just a build option), but this

      -- is a convenient way to force compilation when the components change.

    , ConfigCache -> Bool
configCacheHaddock :: !Bool
      -- ^ Are haddocks to be built?

    , ConfigCache -> CachePkgSrc
configCachePkgSrc :: !CachePkgSrc
    , ConfigCache -> Text
configCachePathEnvVar :: !Text
    -- ^ Value of the PATH env var, see <https://github.com/commercialhaskell/stack/issues/3138>

    }
    deriving (forall x. Rep ConfigCache x -> ConfigCache
forall x. ConfigCache -> Rep ConfigCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigCache x -> ConfigCache
$cfrom :: forall x. ConfigCache -> Rep ConfigCache x
Generic, ConfigCache -> ConfigCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigCache -> ConfigCache -> Bool
$c/= :: ConfigCache -> ConfigCache -> Bool
== :: ConfigCache -> ConfigCache -> Bool
$c== :: ConfigCache -> ConfigCache -> Bool
Eq, Int -> ConfigCache -> ShowS
[ConfigCache] -> ShowS
ConfigCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigCache] -> ShowS
$cshowList :: [ConfigCache] -> ShowS
show :: ConfigCache -> String
$cshow :: ConfigCache -> String
showsPrec :: Int -> ConfigCache -> ShowS
$cshowsPrec :: Int -> ConfigCache -> ShowS
Show, Typeable ConfigCache
ConfigCache -> DataType
ConfigCache -> Constr
(forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
gmapT :: (forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
$cgmapT :: (forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
dataTypeOf :: ConfigCache -> DataType
$cdataTypeOf :: ConfigCache -> DataType
toConstr :: ConfigCache -> Constr
$ctoConstr :: ConfigCache -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
Data, Typeable)
instance NFData ConfigCache

data CachePkgSrc = CacheSrcUpstream | CacheSrcLocal FilePath
    deriving (forall x. Rep CachePkgSrc x -> CachePkgSrc
forall x. CachePkgSrc -> Rep CachePkgSrc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CachePkgSrc x -> CachePkgSrc
$cfrom :: forall x. CachePkgSrc -> Rep CachePkgSrc x
Generic, CachePkgSrc -> CachePkgSrc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CachePkgSrc -> CachePkgSrc -> Bool
$c/= :: CachePkgSrc -> CachePkgSrc -> Bool
== :: CachePkgSrc -> CachePkgSrc -> Bool
$c== :: CachePkgSrc -> CachePkgSrc -> Bool
Eq, ReadPrec [CachePkgSrc]
ReadPrec CachePkgSrc
Int -> ReadS CachePkgSrc
ReadS [CachePkgSrc]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CachePkgSrc]
$creadListPrec :: ReadPrec [CachePkgSrc]
readPrec :: ReadPrec CachePkgSrc
$creadPrec :: ReadPrec CachePkgSrc
readList :: ReadS [CachePkgSrc]
$creadList :: ReadS [CachePkgSrc]
readsPrec :: Int -> ReadS CachePkgSrc
$creadsPrec :: Int -> ReadS CachePkgSrc
Read, Int -> CachePkgSrc -> ShowS
[CachePkgSrc] -> ShowS
CachePkgSrc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachePkgSrc] -> ShowS
$cshowList :: [CachePkgSrc] -> ShowS
show :: CachePkgSrc -> String
$cshow :: CachePkgSrc -> String
showsPrec :: Int -> CachePkgSrc -> ShowS
$cshowsPrec :: Int -> CachePkgSrc -> ShowS
Show, Typeable CachePkgSrc
CachePkgSrc -> DataType
CachePkgSrc -> Constr
(forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
gmapT :: (forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
$cgmapT :: (forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
dataTypeOf :: CachePkgSrc -> DataType
$cdataTypeOf :: CachePkgSrc -> DataType
toConstr :: CachePkgSrc -> Constr
$ctoConstr :: CachePkgSrc -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
Data, Typeable)
instance NFData CachePkgSrc

instance PersistField CachePkgSrc where
    toPersistValue :: CachePkgSrc -> PersistValue
toPersistValue CachePkgSrc
CacheSrcUpstream = Text -> PersistValue
PersistText Text
"upstream"
    toPersistValue (CacheSrcLocal String
fp) = Text -> PersistValue
PersistText (Text
"local:" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp)
    fromPersistValue :: PersistValue -> Either Text CachePkgSrc
fromPersistValue (PersistText Text
t) = do
        if Text
t forall a. Eq a => a -> a -> Bool
== Text
"upstream"
            then forall a b. b -> Either a b
Right CachePkgSrc
CacheSrcUpstream
            else case Text -> Text -> Maybe Text
T.stripPrefix Text
"local:" Text
t of
                Just Text
fp -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> CachePkgSrc
CacheSrcLocal (Text -> String
T.unpack Text
fp)
                Maybe Text
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unexpected CachePkgSrc value: " forall a. Semigroup a => a -> a -> a
<> Text
t
    fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected CachePkgSrc type"

instance PersistFieldSql CachePkgSrc where
    sqlType :: Proxy CachePkgSrc -> SqlType
sqlType Proxy CachePkgSrc
_ = SqlType
SqlString

toCachePkgSrc :: PackageSource -> CachePkgSrc
toCachePkgSrc :: PackageSource -> CachePkgSrc
toCachePkgSrc (PSFilePath LocalPackage
lp) = String -> CachePkgSrc
CacheSrcLocal (forall b t. Path b t -> String
toFilePath (forall b t. Path b t -> Path b Dir
parent (LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp)))
toCachePkgSrc PSRemote{} = CachePkgSrc
CacheSrcUpstream

-- | A task to perform when building

data Task = Task
    { Task -> PackageIdentifier
taskProvides        :: !PackageIdentifier -- FIXME turn this into a function on taskType?

    -- ^ the package/version to be built

    , Task -> TaskType
taskType            :: !TaskType
    -- ^ the task type, telling us how to build this

    , Task -> TaskConfigOpts
taskConfigOpts      :: !TaskConfigOpts
    , Task -> Bool
taskBuildHaddock    :: !Bool
    , Task -> Map PackageIdentifier GhcPkgId
taskPresent         :: !(Map PackageIdentifier GhcPkgId)
    -- ^ GhcPkgIds of already-installed dependencies

    , Task -> Bool
taskAllInOne        :: !Bool
    -- ^ indicates that the package can be built in one step

    , Task -> CachePkgSrc
taskCachePkgSrc     :: !CachePkgSrc
    , Task -> Bool
taskAnyMissing      :: !Bool
    -- ^ Were any of the dependencies missing? The reason this is

    -- necessary is... hairy. And as you may expect, a bug in

    -- Cabal. See:

    -- <https://github.com/haskell/cabal/issues/4728#issuecomment-337937673>. The

    -- problem is that Cabal may end up generating the same package ID

    -- for a dependency, even if the ABI has changed. As a result,

    -- without this field, Stack would think that a reconfigure is

    -- unnecessary, when in fact we _do_ need to reconfigure. The

    -- details here suck. We really need proper hashes for package

    -- identifiers.

    , Task -> Bool
taskBuildTypeConfig :: !Bool
    -- ^ Is the build type of this package Configure. Check out

    -- ensureConfigureScript in Stack.Build.Execute for the motivation

    }
    deriving Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Show

-- | Given the IDs of any missing packages, produce the configure options

data TaskConfigOpts = TaskConfigOpts
    { TaskConfigOpts -> Set PackageIdentifier
tcoMissing :: !(Set PackageIdentifier)
      -- ^ Dependencies for which we don't yet have an GhcPkgId

    , TaskConfigOpts -> Map PackageIdentifier GhcPkgId -> ConfigureOpts
tcoOpts    :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts)
      -- ^ Produce the list of options given the missing @GhcPkgId@s

    }
instance Show TaskConfigOpts where
    show :: TaskConfigOpts -> String
show (TaskConfigOpts Set PackageIdentifier
missing Map PackageIdentifier GhcPkgId -> ConfigureOpts
f) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Missing: "
        , forall a. Show a => a -> String
show Set PackageIdentifier
missing
        , String
". Without those: "
        , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Map PackageIdentifier GhcPkgId -> ConfigureOpts
f forall k a. Map k a
Map.empty
        ]

-- | The type of a task, either building local code or something from the

-- package index (upstream)

data TaskType
  = TTLocalMutable LocalPackage
  | TTRemotePackage IsMutable Package PackageLocationImmutable
    deriving Int -> TaskType -> ShowS
[TaskType] -> ShowS
TaskType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaskType] -> ShowS
$cshowList :: [TaskType] -> ShowS
show :: TaskType -> String
$cshow :: TaskType -> String
showsPrec :: Int -> TaskType -> ShowS
$cshowsPrec :: Int -> TaskType -> ShowS
Show

data IsMutable
    = Mutable
    | Immutable
    deriving (IsMutable -> IsMutable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsMutable -> IsMutable -> Bool
$c/= :: IsMutable -> IsMutable -> Bool
== :: IsMutable -> IsMutable -> Bool
$c== :: IsMutable -> IsMutable -> Bool
Eq, Int -> IsMutable -> ShowS
[IsMutable] -> ShowS
IsMutable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsMutable] -> ShowS
$cshowList :: [IsMutable] -> ShowS
show :: IsMutable -> String
$cshow :: IsMutable -> String
showsPrec :: Int -> IsMutable -> ShowS
$cshowsPrec :: Int -> IsMutable -> ShowS
Show)

instance Semigroup IsMutable where
    IsMutable
Mutable <> :: IsMutable -> IsMutable -> IsMutable
<> IsMutable
_ = IsMutable
Mutable
    IsMutable
_ <> IsMutable
Mutable = IsMutable
Mutable
    IsMutable
Immutable <> IsMutable
Immutable = IsMutable
Immutable

instance Monoid IsMutable where
    mempty :: IsMutable
mempty = IsMutable
Immutable
    mappend :: IsMutable -> IsMutable -> IsMutable
mappend = forall a. Semigroup a => a -> a -> a
(<>)

taskIsTarget :: Task -> Bool
taskIsTarget :: Task -> Bool
taskIsTarget Task
t =
    case Task -> TaskType
taskType Task
t of
        TTLocalMutable LocalPackage
lp -> LocalPackage -> Bool
lpWanted LocalPackage
lp
        TaskType
_ -> Bool
False

taskLocation :: Task -> InstallLocation
taskLocation :: Task -> InstallLocation
taskLocation Task
task =
    case Task -> TaskType
taskType Task
task of
        TTLocalMutable LocalPackage
_ -> InstallLocation
Local
        TTRemotePackage IsMutable
Mutable Package
_ PackageLocationImmutable
_ -> InstallLocation
Local
        TTRemotePackage IsMutable
Immutable Package
_ PackageLocationImmutable
_ -> InstallLocation
Snap

taskTargetIsMutable :: Task -> IsMutable
taskTargetIsMutable :: Task -> IsMutable
taskTargetIsMutable Task
task =
    case Task -> TaskType
taskType Task
task of
        TTLocalMutable LocalPackage
_ -> IsMutable
Mutable
        TTRemotePackage IsMutable
mutable Package
_ PackageLocationImmutable
_ -> IsMutable
mutable

installLocationIsMutable :: InstallLocation -> IsMutable
installLocationIsMutable :: InstallLocation -> IsMutable
installLocationIsMutable InstallLocation
Snap = IsMutable
Immutable
installLocationIsMutable InstallLocation
Local = IsMutable
Mutable

-- | A complete plan of what needs to be built and how to do it

data Plan = Plan
    { Plan -> Map PackageName Task
planTasks :: !(Map PackageName Task)
    , Plan -> Map PackageName Task
planFinals :: !(Map PackageName Task)
    -- ^ Final actions to be taken (test, benchmark, etc)

    , Plan -> Map GhcPkgId (PackageIdentifier, Text)
planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text))
    -- ^ Text is reason we're unregistering, for display only

    , Plan -> Map Text InstallLocation
planInstallExes :: !(Map Text InstallLocation)
    -- ^ Executables that should be installed after successful building

    }
    deriving Int -> Plan -> ShowS
[Plan] -> ShowS
Plan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plan] -> ShowS
$cshowList :: [Plan] -> ShowS
show :: Plan -> String
$cshow :: Plan -> String
showsPrec :: Int -> Plan -> ShowS
$cshowsPrec :: Int -> Plan -> ShowS
Show

-- | Basic information used to calculate what the configure options are

data BaseConfigOpts = BaseConfigOpts
    { BaseConfigOpts -> Path Abs Dir
bcoSnapDB :: !(Path Abs Dir)
    , BaseConfigOpts -> Path Abs Dir
bcoLocalDB :: !(Path Abs Dir)
    , BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot :: !(Path Abs Dir)
    , BaseConfigOpts -> Path Abs Dir
bcoLocalInstallRoot :: !(Path Abs Dir)
    , BaseConfigOpts -> BuildOpts
bcoBuildOpts :: !BuildOpts
    , BaseConfigOpts -> BuildOptsCLI
bcoBuildOptsCLI :: !BuildOptsCLI
    , BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs :: ![Path Abs Dir]
    }
    deriving Int -> BaseConfigOpts -> ShowS
[BaseConfigOpts] -> ShowS
BaseConfigOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseConfigOpts] -> ShowS
$cshowList :: [BaseConfigOpts] -> ShowS
show :: BaseConfigOpts -> String
$cshow :: BaseConfigOpts -> String
showsPrec :: Int -> BaseConfigOpts -> ShowS
$cshowsPrec :: Int -> BaseConfigOpts -> ShowS
Show

-- | Render a @BaseConfigOpts@ to an actual list of options

configureOpts :: EnvConfig
              -> BaseConfigOpts
              -> Map PackageIdentifier GhcPkgId -- ^ dependencies

              -> Bool -- ^ local non-extra-dep?

              -> IsMutable
              -> Package
              -> ConfigureOpts
configureOpts :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> IsMutable
-> Package
-> ConfigureOpts
configureOpts EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal IsMutable
isMutable Package
package = ConfigureOpts
    { coDirs :: [String]
coDirs = BaseConfigOpts -> IsMutable -> Package -> [String]
configureOptsDirs BaseConfigOpts
bco IsMutable
isMutable Package
package
    , coNoDirs :: [String]
coNoDirs = EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Package
-> [String]
configureOptsNoDir EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal Package
package
    }

-- options set by stack

isStackOpt :: Text -> Bool
isStackOpt :: Text -> Bool
isStackOpt Text
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
t)
    [ Text
"--dependency="
    , Text
"--constraint="
    , Text
"--package-db="
    , Text
"--libdir="
    , Text
"--bindir="
    , Text
"--datadir="
    , Text
"--libexecdir="
    , Text
"--sysconfdir"
    , Text
"--docdir="
    , Text
"--htmldir="
    , Text
"--haddockdir="
    , Text
"--enable-tests"
    , Text
"--enable-benchmarks"
    , Text
"--exact-configuration"
    -- Treat these as causing dirtiness, to resolve

    -- https://github.com/commercialhaskell/stack/issues/2984

    --

    -- , "--enable-library-profiling"

    -- , "--enable-executable-profiling"

    -- , "--enable-profiling"

    ] Bool -> Bool -> Bool
|| Text
t forall a. Eq a => a -> a -> Bool
== Text
"--user"

configureOptsDirs :: BaseConfigOpts
                  -> IsMutable
                  -> Package
                  -> [String]
configureOptsDirs :: BaseConfigOpts -> IsMutable -> Package -> [String]
configureOptsDirs BaseConfigOpts
bco IsMutable
isMutable Package
package = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [String
"--user", String
"--package-db=clear", String
"--package-db=global"]
    , forall a b. (a -> b) -> [a] -> [b]
map ((String
"--package-db=" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. Path loc Dir -> String
toFilePathNoTrailingSep) forall a b. (a -> b) -> a -> b
$ case IsMutable
isMutable of
        IsMutable
Immutable -> BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs BaseConfigOpts
bco forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
bco]
        IsMutable
Mutable -> BaseConfigOpts -> [Path Abs Dir]
bcoExtraDBs BaseConfigOpts
bco forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
bco] forall a. [a] -> [a] -> [a]
++ [BaseConfigOpts -> Path Abs Dir
bcoLocalDB BaseConfigOpts
bco]
    , [ String
"--libdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLib)
      , String
"--bindir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix)
      , String
"--datadir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirShare)
      , String
"--libexecdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLibexec)
      , String
"--sysconfdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirEtc)
      , String
"--docdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir
      , String
"--htmldir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir
      , String
"--haddockdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
docDir]
    ]
  where
    installRoot :: Path Abs Dir
installRoot =
        case IsMutable
isMutable of
            IsMutable
Immutable -> BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot BaseConfigOpts
bco
            IsMutable
Mutable -> BaseConfigOpts -> Path Abs Dir
bcoLocalInstallRoot BaseConfigOpts
bco
    docDir :: Path Abs Dir
docDir =
        case Maybe (Path Rel Dir)
pkgVerDir of
            Maybe (Path Rel Dir)
Nothing -> Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
docDirSuffix
            Just Path Rel Dir
dir -> Path Abs Dir
installRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
docDirSuffix forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
dir
    pkgVerDir :: Maybe (Path Rel Dir)
pkgVerDir =
        forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (PackageIdentifier -> String
packageIdentifierString (PackageName -> Version -> PackageIdentifier
PackageIdentifier (Package -> PackageName
packageName Package
package)
                                                                (Package -> Version
packageVersion Package
package)) forall a. [a] -> [a] -> [a]
++
                     [Char
pathSeparator])

-- | Same as 'configureOpts', but does not include directory path options

configureOptsNoDir :: EnvConfig
                   -> BaseConfigOpts
                   -> Map PackageIdentifier GhcPkgId -- ^ dependencies

                   -> Bool -- ^ is this a local, non-extra-dep?

                   -> Package
                   -> [String]
configureOptsNoDir :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Package
-> [String]
configureOptsNoDir EnvConfig
econfig BaseConfigOpts
bco Map PackageIdentifier GhcPkgId
deps Bool
isLocal Package
package = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [String]
depOptions
    , [String
"--enable-library-profiling" | BuildOpts -> Bool
boptsLibProfile BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts]
    -- Cabal < 1.21.1 does not support --enable-profiling, use --enable-executable-profiling instead

    , let profFlag :: String
profFlag = String
"--enable-" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"executable-" | Bool -> Bool
not Bool
newerCabal] forall a. Semigroup a => a -> a -> a
<> String
"profiling"
      in [ String
profFlag | BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts Bool -> Bool -> Bool
&& Bool
isLocal]
    , [String
"--enable-split-objs" | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts]
    , [String
"--disable-library-stripping" | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts]
    , [String
"--disable-executable-stripping" | Bool -> Bool
not (BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts) Bool -> Bool -> Bool
&& Bool
isLocal]
    , forall a b. (a -> b) -> [a] -> [b]
map (\(FlagName
name,Bool
enabled) ->
                       String
"-f" forall a. Semigroup a => a -> a -> a
<>
                       (if Bool
enabled
                           then String
""
                           else String
"-") forall a. Semigroup a => a -> a -> a
<>
                       FlagName -> String
flagNameString FlagName
name)
                    (forall k a. Map k a -> [(k, a)]
Map.toList Map FlagName Bool
flags)
    , forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Package -> [Text]
packageCabalConfigOpts Package
package
    , [Text] -> [String]
processGhcOptions (Package -> [Text]
packageGhcOptions Package
package)
    , forall a b. (a -> b) -> [a] -> [b]
map (String
"--extra-include-dirs=" forall a. [a] -> [a] -> [a]
++) (Config -> [String]
configExtraIncludeDirs Config
config)
    , forall a b. (a -> b) -> [a] -> [b]
map (String
"--extra-lib-dirs=" forall a. [a] -> [a] -> [a]
++) (Config -> [String]
configExtraLibDirs Config
config)
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Path Abs File
customGcc -> [String
"--with-gcc=" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> String
toFilePath Path Abs File
customGcc]) (Config -> Maybe (Path Abs File)
configOverrideGccPath Config
config)
    , [String
"--exact-configuration"]
    , [String
"--ghc-option=-fhide-source-paths" | Version -> Bool
hideSourcePaths Version
cv]
    ]
  where
    -- This function parses the GHC options that are providing in the

    -- stack.yaml file. In order to handle RTS arguments correctly, we need

    -- to provide the RTS arguments as a single argument.

    processGhcOptions :: [Text] -> [String]
    processGhcOptions :: [Text] -> [String]
processGhcOptions [Text]
args =
        let
            ([Text]
preRtsArgs, [Text]
mid) =
                forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text
"+RTS" forall a. Eq a => a -> a -> Bool
==) [Text]
args
            ([Text]
rtsArgs, [Text]
end) =
                forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text
"-RTS" forall a. Eq a => a -> a -> Bool
==) [Text]
mid
            fullRtsArgs :: [Text]
fullRtsArgs =
                case [Text]
rtsArgs of
                    [] ->
                        -- This means that we didn't have any RTS args - no

                        -- `+RTS` - and therefore no need for a `-RTS`.

                        []
                    [Text]
_ ->
                        -- In this case, we have some RTS args. `break`

                        -- puts the `"-RTS"` string in the `snd` list, so

                        -- we want to append it on the end of `rtsArgs`

                        -- here.

                        --

                        -- We're not checking that `-RTS` is the first

                        -- element of `end`. This is because the GHC RTS

                        -- allows you to omit a trailing -RTS if that's the

                        -- last of the arguments. This permits a GHC

                        -- options in stack.yaml that matches what you

                        -- might pass directly to GHC.

                        [[Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ [Text]
rtsArgs forall a. [a] -> [a] -> [a]
++ [Text
"-RTS"]]
            -- We drop the first element from `end`, because it is always

            -- either `"-RTS"` (and we don't want that as a separate

            -- argument) or the list is empty (and `drop _ [] = []`).

            postRtsArgs :: [Text]
postRtsArgs =
                forall a. Int -> [a] -> [a]
drop Int
1 [Text]
end
            newArgs :: [Text]
newArgs =
                forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]
preRtsArgs, [Text]
fullRtsArgs, [Text]
postRtsArgs]
        in
            forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
x -> [WhichCompiler -> String
compilerOptionsCabalFlag WhichCompiler
wc, Text -> String
T.unpack Text
x]) [Text]
newArgs

    wc :: WhichCompiler
wc = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> WhichCompiler
whichCompiler) EnvConfig
econfig
    cv :: Version
cv = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Version
getGhcVersion) EnvConfig
econfig

    hideSourcePaths :: Version -> Bool
hideSourcePaths Version
ghcVersion = Version
ghcVersion forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
2] Bool -> Bool -> Bool
&& Config -> Bool
configHideSourcePaths Config
config

    config :: Config
config = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL EnvConfig
econfig
    bopts :: BuildOpts
bopts = BaseConfigOpts -> BuildOpts
bcoBuildOpts BaseConfigOpts
bco

    newerCabal :: Bool
newerCabal = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL EnvConfig
econfig forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
22]

    -- Unioning atop defaults is needed so that all flags are specified

    -- with --exact-configuration.

    flags :: Map FlagName Bool
flags = Package -> Map FlagName Bool
packageFlags Package
package forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Package -> Map FlagName Bool
packageDefaultFlags Package
package

    depOptions :: [String]
depOptions = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PackageIdentifier -> GhcPkgId -> String
toDepOption) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map PackageIdentifier GhcPkgId
deps
      where
        toDepOption :: PackageIdentifier -> GhcPkgId -> String
toDepOption = if Bool
newerCabal then PackageIdentifier -> GhcPkgId -> String
toDepOption1_22 else forall {p}. PackageIdentifier -> p -> String
toDepOption1_18

    toDepOption1_22 :: PackageIdentifier -> GhcPkgId -> String
toDepOption1_22 (PackageIdentifier PackageName
name Version
_) GhcPkgId
gid = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"--dependency="
        , PackageName -> String
packageNameString PackageName
name
        , String
"="
        , GhcPkgId -> String
ghcPkgIdString GhcPkgId
gid
        ]

    toDepOption1_18 :: PackageIdentifier -> p -> String
toDepOption1_18 PackageIdentifier
ident p
_gid = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"--constraint="
        , PackageName -> String
packageNameString PackageName
name
        , String
"=="
        , Version -> String
versionString Version
version'
        ]
      where
        PackageIdentifier PackageName
name Version
version' = PackageIdentifier
ident

-- | Get set of wanted package names from locals.

wantedLocalPackages :: [LocalPackage] -> Set PackageName
wantedLocalPackages :: [LocalPackage] -> Set PackageName
wantedLocalPackages = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Package -> PackageName
packageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalPackage -> Package
lpPackage) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter LocalPackage -> Bool
lpWanted

-- | Configure options to be sent to Setup.hs configure

data ConfigureOpts = ConfigureOpts
    { ConfigureOpts -> [String]
coDirs :: ![String]
    -- ^ Options related to various paths. We separate these out since they do

    -- not have an impact on the contents of the compiled binary for checking

    -- if we can use an existing precompiled cache.

    , ConfigureOpts -> [String]
coNoDirs :: ![String]
    }
    deriving (Int -> ConfigureOpts -> ShowS
[ConfigureOpts] -> ShowS
ConfigureOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigureOpts] -> ShowS
$cshowList :: [ConfigureOpts] -> ShowS
show :: ConfigureOpts -> String
$cshow :: ConfigureOpts -> String
showsPrec :: Int -> ConfigureOpts -> ShowS
$cshowsPrec :: Int -> ConfigureOpts -> ShowS
Show, ConfigureOpts -> ConfigureOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigureOpts -> ConfigureOpts -> Bool
$c/= :: ConfigureOpts -> ConfigureOpts -> Bool
== :: ConfigureOpts -> ConfigureOpts -> Bool
$c== :: ConfigureOpts -> ConfigureOpts -> Bool
Eq, forall x. Rep ConfigureOpts x -> ConfigureOpts
forall x. ConfigureOpts -> Rep ConfigureOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigureOpts x -> ConfigureOpts
$cfrom :: forall x. ConfigureOpts -> Rep ConfigureOpts x
Generic, Typeable ConfigureOpts
ConfigureOpts -> DataType
ConfigureOpts -> Constr
(forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigureOpts -> m ConfigureOpts
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigureOpts -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigureOpts -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigureOpts -> r
gmapT :: (forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
$cgmapT :: (forall b. Data b => b -> b) -> ConfigureOpts -> ConfigureOpts
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigureOpts)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigureOpts)
dataTypeOf :: ConfigureOpts -> DataType
$cdataTypeOf :: ConfigureOpts -> DataType
toConstr :: ConfigureOpts -> Constr
$ctoConstr :: ConfigureOpts -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigureOpts
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigureOpts -> c ConfigureOpts
Data, Typeable)
instance NFData ConfigureOpts

-- | Information on a compiled package: the library conf file (if relevant),

-- the sublibraries (if present) and all of the executable paths.

data PrecompiledCache base = PrecompiledCache
    { forall base. PrecompiledCache base -> Maybe (Path base File)
pcLibrary :: !(Maybe (Path base File))
    -- ^ .conf file inside the package database

    , forall base. PrecompiledCache base -> [Path base File]
pcSubLibs :: ![Path base File]
    -- ^ .conf file inside the package database, for each of the sublibraries

    , forall base. PrecompiledCache base -> [Path base File]
pcExes    :: ![Path base File]
    -- ^ Full paths to executables

    }
    deriving (Int -> PrecompiledCache base -> ShowS
forall base. Int -> PrecompiledCache base -> ShowS
forall base. [PrecompiledCache base] -> ShowS
forall base. PrecompiledCache base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrecompiledCache base] -> ShowS
$cshowList :: forall base. [PrecompiledCache base] -> ShowS
show :: PrecompiledCache base -> String
$cshow :: forall base. PrecompiledCache base -> String
showsPrec :: Int -> PrecompiledCache base -> ShowS
$cshowsPrec :: forall base. Int -> PrecompiledCache base -> ShowS
Show, PrecompiledCache base -> PrecompiledCache base -> Bool
forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrecompiledCache base -> PrecompiledCache base -> Bool
$c/= :: forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
== :: PrecompiledCache base -> PrecompiledCache base -> Bool
$c== :: forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall base x.
Rep (PrecompiledCache base) x -> PrecompiledCache base
forall base x.
PrecompiledCache base -> Rep (PrecompiledCache base) x
$cto :: forall base x.
Rep (PrecompiledCache base) x -> PrecompiledCache base
$cfrom :: forall base x.
PrecompiledCache base -> Rep (PrecompiledCache base) x
Generic, Typeable)
instance NFData (PrecompiledCache Abs)
instance NFData (PrecompiledCache Rel)