module Stack.Types.Build
(StackBuildException(..)
,FlagSource(..)
,UnusedFlags(..)
,InstallLocation(..)
,ModTime
,modTime
,Installed(..)
,PackageInstallInfo(..)
,Task(..)
,taskLocation
,LocalPackage(..)
,BaseConfigOpts(..)
,Plan(..)
,TestOpts(..)
,BenchmarkOpts(..)
,FileWatchOpts(..)
,BuildOpts(..)
,BuildSubset(..)
,defaultBuildOpts
,TaskType(..)
,TaskConfigOpts(..)
,ConfigCache(..)
,ConstructPlanException(..)
,configureOpts
,BadDependency(..)
,wantedLocalPackages
,FileCacheInfo (..)
,ConfigureOpts (..)
,PrecompiledCache (..))
where
import Control.DeepSeq
import Control.Exception
import Data.Binary (getWord8, putWord8, gput, gget)
import Data.Binary.VersionTagged
import qualified Data.ByteString as S
import Data.Char (isSpace)
import Data.Data
import Data.Hashable
import Data.List (dropWhileEnd, nub, intercalate)
import qualified Data.Map as Map
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Time.Calendar
import Data.Time.Clock
import Distribution.System (Arch)
import Distribution.PackageDescription (TestSuiteInterface)
import Distribution.Text (display)
import GHC.Generics
import Path (Path, Abs, File, Dir, mkRelDir, toFilePath, parseRelDir, (</>))
import Path.Extra (toFilePathNoTrailingSep)
import Prelude
import Stack.Types.FlagName
import Stack.Types.GhcPkgId
import Stack.Types.Compiler
import Stack.Types.Config
import Stack.Types.Package
import Stack.Types.PackageIdentifier
import Stack.Types.PackageName
import Stack.Types.Version
import System.Exit (ExitCode (ExitFailure))
import System.FilePath (pathSeparator)
import System.Process.Log (showProcessArgDebug)
data StackBuildException
= Couldn'tFindPkgId PackageName
| CompilerVersionMismatch
(Maybe (CompilerVersion, Arch))
(CompilerVersion, Arch)
GHCVariant
VersionCheck
(Maybe (Path Abs File))
Text
| Couldn'tParseTargets [Text]
| UnknownTargets
(Set PackageName)
(Map PackageName Version)
(Path Abs File)
| TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString
| TestSuiteTypeUnsupported TestSuiteInterface
| ConstructPlanExceptions
[ConstructPlanException]
(Path Abs File)
| CabalExitedUnsuccessfully
ExitCode
PackageIdentifier
(Path Abs File)
[String]
(Maybe (Path Abs File))
[Text]
| ExecutionFailure [SomeException]
| LocalPackageDoesn'tMatchTarget
PackageName
Version
Version
| NoSetupHsFound (Path Abs Dir)
| InvalidFlagSpecification (Set UnusedFlags)
| TargetParseException [Text]
| DuplicateLocalPackageNames [(PackageName, [Path Abs Dir])]
| SolverGiveUp String
| SolverMissingCabalInstall
| SomeTargetsNotBuildable [(PackageName, NamedComponent)]
deriving Typeable
data FlagSource = FSCommandLine | FSStackYaml
deriving (Show, Eq, Ord)
data UnusedFlags = UFNoPackage FlagSource PackageName
| UFFlagsNotDefined FlagSource Package (Set FlagName)
| UFSnapshot PackageName
deriving (Show, Eq, Ord)
instance Show StackBuildException where
show (Couldn'tFindPkgId name) =
("After installing " <> packageNameString name <>
", the package id couldn't be found " <> "(via ghc-pkg describe " <>
packageNameString name <> "). This shouldn't happen, " <>
"please report as a bug")
show (CompilerVersionMismatch mactual (expected, earch) ghcVariant check mstack resolution) = concat
[ case mactual of
Nothing -> "No compiler found, expected "
Just (actual, arch) -> concat
[ "Compiler version mismatched, found "
, compilerVersionString actual
, " ("
, display arch
, ")"
, ", but expected "
]
, case check of
MatchMinor -> "minor version match with "
MatchExact -> "exact version "
NewerMinor -> "minor version match or newer with "
, compilerVersionString expected
, " ("
, display earch
, ghcVariantSuffix ghcVariant
, ") (based on "
, case mstack of
Nothing -> "command line arguments"
Just stack -> "resolver setting in " ++ toFilePath stack
, ").\n"
, T.unpack resolution
]
show (Couldn'tParseTargets targets) = unlines
$ "The following targets could not be parsed as package names or directories:"
: map T.unpack targets
show (UnknownTargets noKnown notInSnapshot stackYaml) =
unlines $ noKnown' ++ notInSnapshot'
where
noKnown'
| Set.null noKnown = []
| otherwise = return $
"The following target packages were not found: " ++
intercalate ", " (map packageNameString $ Set.toList noKnown)
notInSnapshot'
| Map.null notInSnapshot = []
| otherwise =
"The following packages are not in your snapshot, but exist"
: "in your package index. Recommended action: add them to your"
: ("extra-deps in " ++ toFilePath stackYaml)
: "(Note: these are the most recent versions,"
: "but there's no guarantee that they'll build together)."
: ""
: map
(\(name, version) -> "- " ++ packageIdentifierString
(PackageIdentifier name version))
(Map.toList notInSnapshot)
show (TestSuiteFailure ident codes mlogFile bs) = unlines $ concat
[ ["Test suite failure for package " ++ packageIdentifierString ident]
, flip map (Map.toList codes) $ \(name, mcode) -> concat
[ " "
, T.unpack name
, ": "
, case mcode of
Nothing -> " executable not found"
Just ec -> " exited with: " ++ show ec
]
, return $ case mlogFile of
Nothing -> "Logs printed to console"
Just logFile -> "Full log available at " ++ toFilePath logFile
, if S.null bs
then []
else ["", "", doubleIndent $ T.unpack $ decodeUtf8With lenientDecode bs]
]
where
indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines
doubleIndent = indent . indent
show (TestSuiteTypeUnsupported interface) =
("Unsupported test suite type: " <> show interface)
show (ConstructPlanExceptions exceptions stackYaml) =
"While constructing the BuildPlan the following exceptions were encountered:" ++
appendExceptions exceptions' ++
if Map.null extras then "" else (unlines
$ ("\n\nRecommended action: try adding the following to your extra-deps in "
++ toFilePath stackYaml)
: map (\(name, version) -> concat
[ "- "
, packageNameString name
, "-"
, versionString version
]) (Map.toList extras)
++ ["", "You may also want to try the 'stack solver' command"]
)
where
exceptions' = removeDuplicates exceptions
appendExceptions = foldr (\e -> (++) ("\n\n--" ++ show e)) ""
removeDuplicates = nub
extras = Map.unions $ map getExtras exceptions'
getExtras (DependencyCycleDetected _) = Map.empty
getExtras (UnknownPackage _) = Map.empty
getExtras (DependencyPlanFailures _ m) =
Map.unions $ map go $ Map.toList m
where
go (name, (_range, Just version, NotInBuildPlan)) =
Map.singleton name version
go _ = Map.empty
show (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) =
let fullCmd = unwords
$ dropQuotes (toFilePath execName)
: map (T.unpack . showProcessArgDebug) fullArgs
logLocations = maybe "" (\fp -> "\n Logs have been written to: " ++ toFilePath fp) logFiles
in "\n-- While building package " ++ dropQuotes (show taskProvides') ++ " using:\n" ++
" " ++ fullCmd ++ "\n" ++
" Process exited with code: " ++ show exitCode ++
(if exitCode == ExitFailure (9)
then " (THIS MAY INDICATE OUT OF MEMORY)"
else "") ++
logLocations ++
(if null bss
then ""
else "\n\n" ++ doubleIndent (map T.unpack bss))
where
doubleIndent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line)
dropQuotes = filter ('\"' /=)
show (ExecutionFailure es) = intercalate "\n\n" $ map show es
show (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat
[ "Version for local package "
, packageNameString name
, " is "
, versionString localV
, ", but you asked for "
, versionString requestedV
, " on the command line"
]
show (NoSetupHsFound dir) =
"No Setup.hs or Setup.lhs file found in " ++ toFilePath dir
show (InvalidFlagSpecification unused) = unlines
$ "Invalid flag specification:"
: map go (Set.toList unused)
where
showFlagSrc :: FlagSource -> String
showFlagSrc FSCommandLine = " (specified on command line)"
showFlagSrc FSStackYaml = " (specified in stack.yaml)"
go :: UnusedFlags -> String
go (UFNoPackage src name) = concat
[ "- Package '"
, packageNameString name
, "' not found"
, showFlagSrc src
]
go (UFFlagsNotDefined src pkg flags) = concat
[ "- Package '"
, name
, "' does not define the following flags"
, showFlagSrc src
, ":\n"
, intercalate "\n"
(map (\flag -> " " ++ flagNameString flag)
(Set.toList flags))
, "\n- Flags defined by package '" ++ name ++ "':\n"
, intercalate "\n"
(map (\flag -> " " ++ name ++ ":" ++ flagNameString flag)
(Set.toList pkgFlags))
]
where name = packageNameString (packageName pkg)
pkgFlags = packageDefinedFlags pkg
go (UFSnapshot name) = concat
[ "- Attempted to set flag on snapshot package "
, packageNameString name
, ", please add to extra-deps"
]
show (TargetParseException [err]) = "Error parsing targets: " ++ T.unpack err
show (TargetParseException errs) = unlines
$ "The following errors occurred while parsing the build targets:"
: map (("- " ++) . T.unpack) errs
show (DuplicateLocalPackageNames pairs) = concat
$ "The same package name is used in multiple local packages\n"
: map go pairs
where
go (name, dirs) = unlines
$ ""
: (packageNameString name ++ " used in:")
: map goDir dirs
goDir dir = "- " ++ toFilePath dir
show (SolverGiveUp msg) = concat
[ "\nSolver could not resolve package dependencies.\n"
, "You can try the following:\n"
, msg
]
show SolverMissingCabalInstall = unlines
[ "Solver requires that cabal be on your PATH"
, "Try running 'stack install cabal-install'"
]
show (SomeTargetsNotBuildable xs) =
"The following components have 'buildable: False' set in the cabal configuration, and so cannot be targets:\n " ++
T.unpack (renderPkgComponents xs) ++
"\nTo resolve this, either provide flags such that these components are buildable, or only specify buildable targets."
instance Exception StackBuildException
data ConstructPlanException
= DependencyCycleDetected [PackageName]
| DependencyPlanFailures Package (Map PackageName (VersionRange, LatestApplicableVersion, BadDependency))
| UnknownPackage PackageName
deriving (Typeable, Eq)
type LatestApplicableVersion = Maybe Version
data BadDependency
= NotInBuildPlan
| Couldn'tResolveItsDependencies
| DependencyMismatch Version
deriving (Typeable, Eq)
instance Show ConstructPlanException where
show e =
let details = case e of
(DependencyCycleDetected pNames) ->
"While checking call stack,\n" ++
" dependency cycle detected in packages:" ++ indent (appendLines pNames)
(DependencyPlanFailures pkg (Map.toList -> pDeps)) ->
"Failure when adding dependencies:" ++ doubleIndent (appendDeps pDeps) ++ "\n" ++
" needed for package " ++ packageIdentifierString (packageIdentifier pkg) ++
appendFlags (packageFlags pkg)
(UnknownPackage pName) ->
"While attempting to add dependency,\n" ++
" Could not find package " ++ show pName ++ " in known packages"
in indent details
where
appendLines = foldr (\pName-> (++) ("\n" ++ show pName)) ""
indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines
doubleIndent = indent . indent
appendFlags flags =
if Map.null flags
then ""
else " with flags:\n" ++
(doubleIndent . intercalate "\n" . map showFlag . Map.toList) flags
showFlag (name, bool) = show name ++ ": " ++ show bool
appendDeps = foldr (\dep-> (++) ("\n" ++ showDep dep)) ""
showDep (name, (range, mlatestApplicable, badDep)) = concat
[ show name
, ": needed ("
, display range
, ")"
, ", "
, let latestApplicableStr =
case mlatestApplicable of
Nothing -> ""
Just la -> " (latest applicable is " ++ versionString la ++ ")"
in case badDep of
NotInBuildPlan -> "stack configuration has no specified version" ++ latestApplicableStr
Couldn'tResolveItsDependencies -> "couldn't resolve its dependencies"
DependencyMismatch version ->
case mlatestApplicable of
Just la
| la == version ->
versionString version ++
" found (latest applicable version available)"
_ -> versionString version ++ " found" ++ latestApplicableStr
]
data BuildSubset
= BSAll
| BSOnlySnapshot
| BSOnlyDependencies
deriving (Show, Eq)
data BuildOpts =
BuildOpts {boptsTargets :: ![Text]
,boptsLibProfile :: !Bool
,boptsExeProfile :: !Bool
,boptsHaddock :: !Bool
,boptsHaddockDeps :: !(Maybe Bool)
,boptsDryrun :: !Bool
,boptsGhcOptions :: ![Text]
,boptsFlags :: !(Map (Maybe PackageName) (Map FlagName Bool))
,boptsInstallExes :: !Bool
,boptsPreFetch :: !Bool
,boptsBuildSubset :: !BuildSubset
,boptsFileWatch :: !FileWatchOpts
,boptsKeepGoing :: !(Maybe Bool)
,boptsForceDirty :: !Bool
,boptsTests :: !Bool
,boptsTestOpts :: !TestOpts
,boptsBenchmarks :: !Bool
,boptsBenchmarkOpts :: !BenchmarkOpts
,boptsExec :: ![(String, [String])]
,boptsOnlyConfigure :: !Bool
,boptsReconfigure :: !Bool
,boptsCabalVerbose :: !Bool
}
deriving (Show)
defaultBuildOpts :: BuildOpts
defaultBuildOpts = BuildOpts
{ boptsTargets = []
, boptsLibProfile = False
, boptsExeProfile = False
, boptsHaddock = False
, boptsHaddockDeps = Nothing
, boptsDryrun = False
, boptsGhcOptions = []
, boptsFlags = Map.empty
, boptsInstallExes = False
, boptsPreFetch = False
, boptsBuildSubset = BSAll
, boptsFileWatch = NoFileWatch
, boptsKeepGoing = Nothing
, boptsForceDirty = False
, boptsTests = False
, boptsTestOpts = defaultTestOpts
, boptsBenchmarks = False
, boptsBenchmarkOpts = defaultBenchmarkOpts
, boptsExec = []
, boptsOnlyConfigure = False
, boptsReconfigure = False
, boptsCabalVerbose = False
}
data TestOpts =
TestOpts {toRerunTests :: !Bool
,toAdditionalArgs :: ![String]
,toCoverage :: !Bool
,toDisableRun :: !Bool
} deriving (Eq,Show)
defaultTestOpts :: TestOpts
defaultTestOpts = TestOpts
{ toRerunTests = True
, toAdditionalArgs = []
, toCoverage = False
, toDisableRun = False
}
data BenchmarkOpts =
BenchmarkOpts {beoAdditionalArgs :: !(Maybe String)
,beoDisableRun :: !Bool
} deriving (Eq,Show)
defaultBenchmarkOpts :: BenchmarkOpts
defaultBenchmarkOpts = BenchmarkOpts
{ beoAdditionalArgs = Nothing
, beoDisableRun = False
}
data FileWatchOpts
= NoFileWatch
| FileWatch
| FileWatchPoll
deriving (Show,Eq)
newtype PkgDepsOracle =
PkgDeps PackageName
deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
data ConfigCache = ConfigCache
{ configCacheOpts :: !ConfigureOpts
, configCacheDeps :: !(Set GhcPkgId)
, configCacheComponents :: !(Set S.ByteString)
, configCacheHaddock :: !Bool
}
deriving (Generic,Eq,Show)
instance Binary ConfigCache where
put x = do
putWord8 1
putWord8 3
putWord8 4
putWord8 8
gput $ from x
get = do
1 <- getWord8
3 <- getWord8
4 <- getWord8
8 <- getWord8
fmap to gget
instance NFData ConfigCache
instance HasStructuralInfo ConfigCache
instance HasSemanticVersion ConfigCache
data Task = Task
{ taskProvides :: !PackageIdentifier
, taskType :: !TaskType
, taskConfigOpts :: !TaskConfigOpts
, taskPresent :: !(Map PackageIdentifier GhcPkgId)
, taskAllInOne :: !Bool
}
deriving Show
data TaskConfigOpts = TaskConfigOpts
{ tcoMissing :: !(Set PackageIdentifier)
, tcoOpts :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts)
}
instance Show TaskConfigOpts where
show (TaskConfigOpts missing f) = concat
[ "Missing: "
, show missing
, ". Without those: "
, show $ f Map.empty
]
data TaskType = TTLocal LocalPackage
| TTUpstream Package InstallLocation
deriving Show
taskLocation :: Task -> InstallLocation
taskLocation task =
case taskType task of
TTLocal _ -> Local
TTUpstream _ loc -> loc
data Plan = Plan
{ planTasks :: !(Map PackageName Task)
, planFinals :: !(Map PackageName Task)
, planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Maybe Text))
, planInstallExes :: !(Map Text InstallLocation)
}
deriving Show
data BaseConfigOpts = BaseConfigOpts
{ bcoSnapDB :: !(Path Abs Dir)
, bcoLocalDB :: !(Path Abs Dir)
, bcoSnapInstallRoot :: !(Path Abs Dir)
, bcoLocalInstallRoot :: !(Path Abs Dir)
, bcoBuildOpts :: !BuildOpts
, bcoExtraDBs :: ![(Path Abs Dir)]
}
configureOpts :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Bool
-> InstallLocation
-> Package
-> ConfigureOpts
configureOpts econfig bco deps wanted isLocal loc package = ConfigureOpts
{ coDirs = configureOptsDirs bco loc package
, coNoDirs = configureOptsNoDir econfig bco deps wanted isLocal package
}
configureOptsDirs :: BaseConfigOpts
-> InstallLocation
-> Package
-> [String]
configureOptsDirs bco loc package = concat
[ ["--user", "--package-db=clear", "--package-db=global"]
, map (("--package-db=" ++) . toFilePathNoTrailingSep) $ case loc of
Snap -> bcoExtraDBs bco ++ [bcoSnapDB bco]
Local -> bcoExtraDBs bco ++ [bcoSnapDB bco] ++ [bcoLocalDB bco]
, [ "--libdir=" ++ toFilePathNoTrailingSep (installRoot </> $(mkRelDir "lib"))
, "--bindir=" ++ toFilePathNoTrailingSep (installRoot </> bindirSuffix)
, "--datadir=" ++ toFilePathNoTrailingSep (installRoot </> $(mkRelDir "share"))
, "--libexecdir=" ++ toFilePathNoTrailingSep (installRoot </> $(mkRelDir "libexec"))
, "--sysconfdir=" ++ toFilePathNoTrailingSep (installRoot </> $(mkRelDir "etc"))
, "--docdir=" ++ toFilePathNoTrailingSep docDir
, "--htmldir=" ++ toFilePathNoTrailingSep docDir
, "--haddockdir=" ++ toFilePathNoTrailingSep docDir]
]
where
installRoot =
case loc of
Snap -> bcoSnapInstallRoot bco
Local -> bcoLocalInstallRoot bco
docDir =
case pkgVerDir of
Nothing -> installRoot </> docDirSuffix
Just dir -> installRoot </> docDirSuffix </> dir
pkgVerDir =
parseRelDir (packageIdentifierString (PackageIdentifier (packageName package)
(packageVersion package)) ++
[pathSeparator])
configureOptsNoDir :: EnvConfig
-> BaseConfigOpts
-> Map PackageIdentifier GhcPkgId
-> Bool
-> Bool
-> Package
-> [String]
configureOptsNoDir econfig bco deps wanted isLocal package = concat
[ depOptions
, ["--enable-library-profiling" | boptsLibProfile bopts || boptsExeProfile bopts]
, ["--enable-executable-profiling" | boptsExeProfile bopts]
, map (\(name,enabled) ->
"-f" <>
(if enabled
then ""
else "-") <>
flagNameString name)
(Map.toList (packageFlags package))
, concatMap (\x -> ["--ghc-options", T.unpack x]) allGhcOptions
, map (("--extra-include-dirs=" ++) . T.unpack) (Set.toList (configExtraIncludeDirs config))
, map (("--extra-lib-dirs=" ++) . T.unpack) (Set.toList (configExtraLibDirs config))
, if whichCompiler (envConfigCompilerVersion econfig) == Ghcjs
then ["--ghcjs"]
else []
]
where
config = getConfig econfig
bopts = bcoBuildOpts bco
depOptions = map (uncurry toDepOption) $ Map.toList deps
where
toDepOption =
if envConfigCabalVersion econfig >= $(mkVersion "1.22")
then toDepOption1_22
else toDepOption1_18
toDepOption1_22 ident gid = concat
[ "--dependency="
, packageNameString $ packageIdentifierName ident
, "="
, ghcPkgIdString gid
]
toDepOption1_18 ident _gid = concat
[ "--constraint="
, packageNameString name
, "=="
, versionString version
]
where
PackageIdentifier name version = ident
allGhcOptions = concat
[ Map.findWithDefault [] Nothing (configGhcOptions config)
, Map.findWithDefault [] (Just $ packageName package) (configGhcOptions config)
, concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)]
, if includeExtraOptions
then boptsGhcOptions bopts
else []
]
includeExtraOptions =
case configApplyGhcOptions config of
AGOTargets -> wanted
AGOLocals -> isLocal
AGOEverything -> True
wantedLocalPackages :: [LocalPackage] -> Set PackageName
wantedLocalPackages = Set.fromList . map (packageName . lpPackage) . filter lpWanted
modTime :: UTCTime -> ModTime
modTime x =
ModTime
( toModifiedJulianDay
(utctDay x)
, toRational
(utctDayTime x))
data ConfigureOpts = ConfigureOpts
{ coDirs :: ![String]
, coNoDirs :: ![String]
}
deriving (Show, Eq, Generic)
instance Binary ConfigureOpts
instance HasStructuralInfo ConfigureOpts
instance NFData ConfigureOpts
data PrecompiledCache = PrecompiledCache
{ pcLibrary :: !(Maybe FilePath)
, pcExes :: ![FilePath]
}
deriving (Show, Eq, Generic)
instance Binary PrecompiledCache
instance HasSemanticVersion PrecompiledCache
instance HasStructuralInfo PrecompiledCache
instance NFData PrecompiledCache