{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

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

-- Module      :  Distribution.Client.Errors
-- Copyright   :  Suganya Arun
-- License     :  BSD3
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable

-- A collection of Exception Types in the Cabal-Install library package

module Distribution.Client.Errors
  ( CabalInstallException (..)
  , exceptionCodeCabalInstall
  , exceptionMessageCabalInstall
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BS8
import Data.List (groupBy)
import Distribution.Client.IndexUtils.Timestamp
import Distribution.Client.Types.Repo
import Distribution.Client.Types.RepoName (RepoName (..))
import Distribution.Compat.Prelude
import Distribution.Deprecated.ParseUtils (PWarning, showPWarning)
import Distribution.Package
import Distribution.Pretty
import Distribution.Simple (VersionRange)
import Distribution.Simple.Utils
import Network.URI
import Text.Regex.Posix.ByteString (WrapError)

data CabalInstallException
  = UnpackGet
  | NotTarballDir FilePath
  | DirectoryAlreadyExists FilePath
  | FileExists FilePath
  | FileAlreadyExists FilePath
  | DirectoryExists FilePath
  | SplitRunArgs String
  | CouldNotFindExecutable
  | FoundMultipleMatchingExes
  | NoRemoteRepositories
  | NotATarDotGzFile FilePath
  | ExpectedMatchingFileName
  | NoTargetProvided
  | OneTargetRequired
  | ThisIsABug
  | NoOrMultipleTargetsGiven
  | NoTargetFound
  | MultipleTargetsFound
  | UnexpectedNamedPkgSpecifiers
  | UnexpectedSourcePkgSpecifiers
  | UnableToPerformInplaceUpdate
  | EmptyValuePagerEnvVariable
  | FileDoesntExist FilePath
  | ParseError
  | CabalFileNotFound FilePath
  | FindOpenProgramLocationErr String
  | PkgConfParseFailed String
  | ErrorPackingSdist String
  | SdistException PackageIdentifier
  | SpecifyAnExecutable
  | TestCommandDoesn'tSupport
  | ReportTargetProblems String
  | ListBinTargetException String
  | ResolveWithoutDependency String
  | CannotReadCabalFile FilePath
  | ErrorUpdatingIndex FilePath IOException
  | InternalError FilePath
  | ReadIndexCache FilePath
  | ConfigStateFileException String
  | UploadAction
  | UploadActionDocumentation
  | UploadActionOnlyArchives [FilePath]
  | FileNotFound FilePath
  | CheckAction [String]
  | ReportAction [String]
  | InitAction
  | UserConfigAction FilePath
  | SpecifySubcommand
  | UnknownUserConfigSubcommand [String]
  | ManpageAction [String]
  | UnrecognizedResponse
  | CheckTarget
  | FetchPackage
  | PlanPackages String
  | NoSupportForRunCommand
  | RunPhaseReached
  | UnknownExecutable String UnitId
  | MultipleMatchingExecutables String [String]
  | CmdRunReportTargetProblems String
  | CleanAction [String]
  | ReportCannotPruneDependencies String
  | ReplCommandDoesn'tSupport
  | ReplTakesNoArguments [String]
  | ReplTakesSingleArgument [String]
  | RenderReplTargetProblem [String]
  | GetPkgList String WrapError
  | GatherPkgInfo PackageName VersionRange
  | UnableToParseRepo String
  | NullUnknownrepos [String] [String]
  | UpdateSetupScript
  | InstalledCabalVersion PackageName VersionRange
  | FailNoConfigFile String
  | ParseFailedErr FilePath String String
  | ParseExtraLinesFailedErr String String
  | ParseExtraLinesOkError [PWarning]
  | FetchPackageErr
  | ReportParseResult String FilePath String String
  | ReportSourceRepoProblems String
  | BenchActionException
  | RenderBenchTargetProblem [String]
  | ReportUserTargetProblems [String]
  | ReportUserTargerNonexistantFile [String]
  | ReportUserTargetUnexpectedFile [String]
  | ReportUserTargetUnexpectedUriScheme [String]
  | ReportUserTargetUnrecognisedUri [String]
  | ReadTarballPackageTarget FilePath FilePath
  | ReportPackageTargetProblems [PackageName]
  | PackageNameAmbiguousErr [(PackageName, [PackageName])]
  | ExtractTarballPackageErr String
  | OutdatedAction
  | FreezeFileExistsErr FilePath
  | FinalizePDFailed
  | ProjectTargetSelector String String
  | PhaseRunSolverErr String
  | HaddockCommandDoesn'tSupport
  | CannotParseURIFragment String String
  | MakeDownload URI ByteString ByteString
  | FailedToDownloadURI URI String
  | RemoteRepoCheckHttps String String
  | TransportCheckHttps URI String
  | NoPostYet
  | WGetServerError FilePath String
  | Couldn'tEstablishHttpConnection
  | StatusParseFail URI String
  | TryUpgradeToHttps [String]
  | UnknownHttpTransportSpecified String [String]
  | CmdHaddockReportTargetProblems [String]
  | FailedExtractingScriptBlock String
  | FreezeAction [String]
  | TryFindPackageDescErr String
  | DieIfNotHaddockFailureException String
  | ConfigureInstallInternalError
  | CmdErrorMessages [String]
  | ReportTargetSelectorProblems [String]
  | UnrecognisedTarget [(String, [String], String)]
  | NoSuchTargetSelectorErr [(String, [(Maybe (String, String), String, String, [String])])]
  | TargetSelectorAmbiguousErr [(String, [(String, String)])]
  | TargetSelectorNoCurrentPackageErr String
  | TargetSelectorNoTargetsInCwdTrue
  | TargetSelectorNoTargetsInCwdFalse
  | TargetSelectorNoTargetsInProjectErr
  | TargetSelectorNoScriptErr String
  | MatchingInternalErrorErr String String String [(String, [String])]
  | ReportPlanningFailure String
  | Can'tDownloadPackagesOffline [String]
  | SomePackagesFailedToInstall [(String, String)]
  | PackageDotCabalFileNotFound FilePath
  | PkgConfParsedFailed String
  | BrokenException String
  | WithoutProject String [String]
  | PackagesAlreadyExistInEnvfile FilePath [String]
  | ConfigTests
  | ConfigBenchmarks
  | UnknownPackage String [String]
  | InstallUnitExes String
  | SelectComponentTargetError String
  | SdistActionException [String]
  | Can'tWriteMultipleTarballs
  | ImpossibleHappened String
  | CannotConvertTarballPackage String
  | Win32SelfUpgradeNotNeeded
  | FreezeException String
  | PkgSpecifierException [String]
  | CorruptedIndexCache String
  | UnusableIndexState RemoteRepo Timestamp Timestamp
  | MissingPackageList RemoteRepo
  | CmdPathAcceptsNoTargets
  | CmdPathCommandDoesn'tSupportDryRun
  deriving (Int -> CabalInstallException -> ShowS
[CabalInstallException] -> ShowS
CabalInstallException -> String
(Int -> CabalInstallException -> ShowS)
-> (CabalInstallException -> String)
-> ([CabalInstallException] -> ShowS)
-> Show CabalInstallException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalInstallException -> ShowS
showsPrec :: Int -> CabalInstallException -> ShowS
$cshow :: CabalInstallException -> String
show :: CabalInstallException -> String
$cshowList :: [CabalInstallException] -> ShowS
showList :: [CabalInstallException] -> ShowS
Show)

exceptionCodeCabalInstall :: CabalInstallException -> Int
exceptionCodeCabalInstall :: CabalInstallException -> Int
exceptionCodeCabalInstall CabalInstallException
e = case CabalInstallException
e of
  UnpackGet{} -> Int
7013
  NotTarballDir{} -> Int
7012
  DirectoryAlreadyExists{} -> Int
7014
  FileExists{} -> Int
7015
  FileAlreadyExists{} -> Int
7016
  DirectoryExists{} -> Int
7017
  SplitRunArgs{} -> Int
7018
  CouldNotFindExecutable{} -> Int
7019
  FoundMultipleMatchingExes{} -> Int
7020
  NoRemoteRepositories{} -> Int
7021
  NotATarDotGzFile{} -> Int
7022
  ExpectedMatchingFileName{} -> Int
7023
  NoTargetProvided{} -> Int
7024
  OneTargetRequired{} -> Int
7025
  CabalInstallException
ThisIsABug -> Int
7026
  NoOrMultipleTargetsGiven{} -> Int
7027
  NoTargetFound{} -> Int
7028
  MultipleTargetsFound{} -> Int
7029
  UnexpectedNamedPkgSpecifiers{} -> Int
7030
  UnexpectedSourcePkgSpecifiers{} -> Int
7031
  UnableToPerformInplaceUpdate{} -> Int
7032
  EmptyValuePagerEnvVariable{} -> Int
7033
  FileDoesntExist{} -> Int
7034
  ParseError{} -> Int
7035
  CabalFileNotFound{} -> Int
7036
  FindOpenProgramLocationErr{} -> Int
7037
  PkgConfParseFailed{} -> Int
7038
  ErrorPackingSdist{} -> Int
7039
  SdistException{} -> Int
7040
  SpecifyAnExecutable{} -> Int
7041
  TestCommandDoesn'tSupport{} -> Int
7042
  ReportTargetProblems{} -> Int
7043
  ListBinTargetException{} -> Int
7044
  ResolveWithoutDependency{} -> Int
7045
  CannotReadCabalFile{} -> Int
7046
  ErrorUpdatingIndex{} -> Int
7047
  InternalError{} -> Int
7048
  ReadIndexCache{} -> Int
7049
  ConfigStateFileException{} -> Int
7050
  UploadAction{} -> Int
7051
  UploadActionDocumentation{} -> Int
7052
  UploadActionOnlyArchives{} -> Int
7053
  FileNotFound{} -> Int
7054
  CheckAction{} -> Int
7055
  ReportAction{} -> Int
7056
  InitAction{} -> Int
7057
  UserConfigAction{} -> Int
7058
  SpecifySubcommand{} -> Int
7059
  UnknownUserConfigSubcommand{} -> Int
7060
  ManpageAction{} -> Int
7061
  UnrecognizedResponse{} -> Int
7062
  CheckTarget{} -> Int
7063
  FetchPackage{} -> Int
7064
  PlanPackages{} -> Int
7065
  NoSupportForRunCommand{} -> Int
7066
  RunPhaseReached{} -> Int
7067
  UnknownExecutable{} -> Int
7068
  MultipleMatchingExecutables{} -> Int
7069
  CmdRunReportTargetProblems{} -> Int
7070
  CleanAction{} -> Int
7071
  ReportCannotPruneDependencies{} -> Int
7072
  ReplCommandDoesn'tSupport{} -> Int
7073
  ReplTakesNoArguments{} -> Int
7074
  ReplTakesSingleArgument{} -> Int
7075
  RenderReplTargetProblem{} -> Int
7076
  GetPkgList{} -> Int
7078
  GatherPkgInfo{} -> Int
7079
  UnableToParseRepo{} -> Int
7080
  NullUnknownrepos{} -> Int
7081
  UpdateSetupScript{} -> Int
7082
  InstalledCabalVersion{} -> Int
7083
  FailNoConfigFile{} -> Int
7084
  ParseFailedErr{} -> Int
7085
  ParseExtraLinesFailedErr{} -> Int
7087
  ParseExtraLinesOkError{} -> Int
7088
  FetchPackageErr{} -> Int
7089
  ReportParseResult{} -> Int
7090
  ReportSourceRepoProblems{} -> Int
7091
  BenchActionException{} -> Int
7092
  RenderBenchTargetProblem{} -> Int
7093
  ReportUserTargetProblems{} -> Int
7094
  ReportUserTargerNonexistantFile{} -> Int
7095
  ReportUserTargetUnexpectedFile{} -> Int
7096
  ReportUserTargetUnexpectedUriScheme{} -> Int
7097
  ReportUserTargetUnrecognisedUri{} -> Int
7098
  ReadTarballPackageTarget{} -> Int
7099
  ReportPackageTargetProblems{} -> Int
7100
  PackageNameAmbiguousErr{} -> Int
7101
  ExtractTarballPackageErr{} -> Int
7102
  OutdatedAction{} -> Int
7103
  FreezeFileExistsErr{} -> Int
7104
  FinalizePDFailed{} -> Int
7105
  ProjectTargetSelector{} -> Int
7106
  PhaseRunSolverErr{} -> Int
7107
  HaddockCommandDoesn'tSupport{} -> Int
7108
  CannotParseURIFragment{} -> Int
7109
  MakeDownload{} -> Int
7110
  FailedToDownloadURI{} -> Int
7111
  RemoteRepoCheckHttps{} -> Int
7112
  TransportCheckHttps{} -> Int
7113
  NoPostYet{} -> Int
7114
  WGetServerError{} -> Int
7115
  Couldn'tEstablishHttpConnection{} -> Int
7116
  StatusParseFail{} -> Int
7117
  TryUpgradeToHttps{} -> Int
7118
  UnknownHttpTransportSpecified{} -> Int
7119
  CmdHaddockReportTargetProblems{} -> Int
7120
  FailedExtractingScriptBlock{} -> Int
7121
  FreezeAction{} -> Int
7122
  TryFindPackageDescErr{} -> Int
7124
  DieIfNotHaddockFailureException{} -> Int
7125
  ConfigureInstallInternalError{} -> Int
7126
  CmdErrorMessages{} -> Int
7127
  ReportTargetSelectorProblems{} -> Int
7128
  UnrecognisedTarget{} -> Int
7129
  NoSuchTargetSelectorErr{} -> Int
7131
  TargetSelectorAmbiguousErr{} -> Int
7132
  TargetSelectorNoCurrentPackageErr{} -> Int
7133
  TargetSelectorNoTargetsInCwdTrue{} -> Int
7134
  TargetSelectorNoTargetsInCwdFalse{} -> Int
7135
  TargetSelectorNoTargetsInProjectErr{} -> Int
7136
  TargetSelectorNoScriptErr{} -> Int
7137
  MatchingInternalErrorErr{} -> Int
7130
  ReportPlanningFailure{} -> Int
7138
  Can'tDownloadPackagesOffline{} -> Int
7139
  SomePackagesFailedToInstall{} -> Int
7140
  PackageDotCabalFileNotFound{} -> Int
7141
  PkgConfParsedFailed{} -> Int
7142
  BrokenException{} -> Int
7143
  WithoutProject{} -> Int
7144
  PackagesAlreadyExistInEnvfile{} -> Int
7145
  ConfigTests{} -> Int
7146
  ConfigBenchmarks{} -> Int
7147
  UnknownPackage{} -> Int
7148
  InstallUnitExes{} -> Int
7149
  SelectComponentTargetError{} -> Int
7150
  SdistActionException{} -> Int
7151
  Can'tWriteMultipleTarballs{} -> Int
7152
  ImpossibleHappened{} -> Int
7153
  CannotConvertTarballPackage{} -> Int
7154
  Win32SelfUpgradeNotNeeded{} -> Int
7155
  FreezeException{} -> Int
7156
  PkgSpecifierException{} -> Int
7157
  CorruptedIndexCache{} -> Int
7158
  UnusableIndexState{} -> Int
7159
  MissingPackageList{} -> Int
7160
  CmdPathAcceptsNoTargets{} -> Int
7161
  CabalInstallException
CmdPathCommandDoesn'tSupportDryRun -> Int
7163

exceptionMessageCabalInstall :: CabalInstallException -> String
exceptionMessageCabalInstall :: CabalInstallException -> String
exceptionMessageCabalInstall CabalInstallException
e = case CabalInstallException
e of
  CabalInstallException
UnpackGet ->
    String
"The 'get' command does no yet support targets "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that are remote source repositories."
  NotTarballDir String
t ->
    String
"The 'get' command is for tarball packages. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The target '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not a tarball."
  DirectoryAlreadyExists String
pkgdir' -> String
"The directory \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgdir' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" already exists and is not empty, not unpacking."
  FileExists String
pkgdir -> String
"A file \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgdir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is in the way, not unpacking."
  FileAlreadyExists String
pkgFile -> String
"The file \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgFile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" already exists, not overwriting."
  DirectoryExists String
pkgFile -> String
"A directory \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgFile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is in the way, not unpacking."
  SplitRunArgs String
err -> String
err
  CabalInstallException
CouldNotFindExecutable -> String
"run: Could not find executable in LocalBuildInfo"
  CabalInstallException
FoundMultipleMatchingExes -> String
"run: Found multiple matching exes in LocalBuildInfo"
  CabalInstallException
NoRemoteRepositories -> String
"Cannot upload. No remote repositories are configured."
  NotATarDotGzFile String
paths -> String
"Not a tar.gz file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
paths
  CabalInstallException
ExpectedMatchingFileName -> String
"Expected a file name matching the pattern <pkgid>-docs.tar.gz"
  CabalInstallException
NoTargetProvided -> String
"One target is required, none provided"
  CabalInstallException
OneTargetRequired -> String
"One target is required, given multiple"
  CabalInstallException
ThisIsABug ->
    String
"No or multiple targets given, but the run "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"phase has been reached. This is a bug."
  CabalInstallException
NoOrMultipleTargetsGiven -> String
"No or multiple targets given..."
  CabalInstallException
NoTargetFound -> String
"No target found"
  CabalInstallException
MultipleTargetsFound -> String
"Multiple targets found"
  CabalInstallException
UnexpectedNamedPkgSpecifiers ->
    String
"internal error: 'resolveUserTargets' returned "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"unexpected named package specifiers!"
  CabalInstallException
UnexpectedSourcePkgSpecifiers ->
    String
"internal error: 'resolveUserTargets' returned "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"unexpected source package specifiers!"
  CabalInstallException
UnableToPerformInplaceUpdate -> String
"local project file has conditional and/or import logic, unable to perform and automatic in-place update"
  CabalInstallException
EmptyValuePagerEnvVariable -> String
"man: empty value of the PAGER environment variable"
  FileDoesntExist String
fpath -> String
"Error Parsing: file \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" doesn't exist. Cannot continue."
  CabalInstallException
ParseError -> String
"parse error"
  CabalFileNotFound String
cabalFile -> String
"Package .cabal file not found in the tarball: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cabalFile
  FindOpenProgramLocationErr String
err -> String
err
  PkgConfParseFailed String
perror ->
    String
"Couldn't parse the output of 'setup register --gen-pkg-config':"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
perror
  ErrorPackingSdist String
err -> String
"Error packing sdist: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  SdistException PackageIdentifier
pkgIdentifier -> String
"sdist of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgIdentifier
  CabalInstallException
SpecifyAnExecutable -> String
"Please specify an executable to run"
  CabalInstallException
TestCommandDoesn'tSupport ->
    String
"The test command does not support '--only-dependencies'. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use 'test'."
  ReportTargetProblems String
problemsMsg -> String
problemsMsg
  ListBinTargetException String
errorStr -> String
errorStr
  ResolveWithoutDependency String
errorStr -> String
errorStr
  CannotReadCabalFile String
file -> String
"Cannot read .cabal file inside " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file
  ErrorUpdatingIndex String
name IOException
ioe -> String
"Error while updating index for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" repository " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
ioe
  InternalError String
msg ->
    String
"internal error when reading package index: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The package index or index cache is probably "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"corrupt. Running cabal update might fix it."
  ReadIndexCache String
paths -> ShowS
forall a. Show a => a -> String
show (String
paths)
  ConfigStateFileException String
err -> String
err
  CabalInstallException
UploadAction -> String
"the 'upload' command expects at least one .tar.gz archive."
  CabalInstallException
UploadActionDocumentation ->
    String
"the 'upload' command can only upload documentation "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for one package at a time."
  UploadActionOnlyArchives [String]
otherFiles ->
    String
"the 'upload' command expects only .tar.gz archives: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
otherFiles
  FileNotFound String
tarfile -> String
"file not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tarfile
  CheckAction [String]
extraArgs -> String
"'check' doesn't take any extra arguments: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extraArgs
  ReportAction [String]
extraArgs -> String
"'report' doesn't take any extra arguments: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extraArgs
  CabalInstallException
InitAction ->
    String
"'init' only takes a single, optional, extra "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"argument for the project root directory"
  UserConfigAction String
paths -> String
paths String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" already exists."
  CabalInstallException
SpecifySubcommand -> String
"Please specify a subcommand (see 'help user-config')"
  UnknownUserConfigSubcommand [String]
extraArgs -> String
"Unknown 'user-config' subcommand: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extraArgs
  ManpageAction [String]
extraArgs -> String
"'man' doesn't take any extra arguments: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extraArgs
  CabalInstallException
UnrecognizedResponse -> String
"unrecognized response"
  CabalInstallException
CheckTarget ->
    String
"The 'fetch' command does not yet support remote tarballs. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"In the meantime you can use the 'get' commands."
  CabalInstallException
FetchPackage ->
    String
"The 'fetch' command does not yet support remote "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"source repositories."
  PlanPackages String
errorStr -> String
errorStr
  CabalInstallException
NoSupportForRunCommand ->
    String
"The run command does not support '--only-dependencies'. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use 'run'."
  CabalInstallException
RunPhaseReached ->
    String
"No or multiple targets given, but the run "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"phase has been reached. This is a bug."
  UnknownExecutable String
exeName UnitId
selectedUnitId ->
    String
"Unknown executable "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
exeName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
selectedUnitId
  MultipleMatchingExecutables String
exeName [String]
elabUnitId ->
    String
"Multiple matching executables found matching "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
exeName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
elabUnitId
  CmdRunReportTargetProblems String
renderProb -> String
renderProb
  CleanAction [String]
notScripts ->
    String
"'clean' extra arguments should be script files: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
notScripts
  ReportCannotPruneDependencies String
renderCannotPruneDependencies -> String
renderCannotPruneDependencies
  CabalInstallException
ReplCommandDoesn'tSupport ->
    String
"The repl command does not support '--only-dependencies'. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use 'repl'."
  ReplTakesNoArguments [String]
targetStrings -> String
"'repl' takes no arguments or a script argument outside a project: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
targetStrings
  ReplTakesSingleArgument [String]
targetStrings -> String
"'repl' takes a single argument which should be a script: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
targetStrings
  RenderReplTargetProblem [String]
renderProblem -> [String] -> String
unlines [String]
renderProblem
  GetPkgList String
pat WrapError
err -> String
"Failed to compile regex " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pat String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ WrapError -> String
forall a b. (a, b) -> b
snd WrapError
err
  GatherPkgInfo PackageName
name VersionRange
verConstraint ->
    String
"There is no available version of "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" that satisfies "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ VersionRange -> String
forall a. Pretty a => a -> String
prettyShow VersionRange
verConstraint
  UnableToParseRepo String
s -> String
"'v2-update' unable to parse repo: \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  NullUnknownrepos [String]
unRepoName [String]
remoteRepoNames ->
    String
"'v2-update' repo(s): \""
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\", \"" [String]
unRepoName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" can not be found in known remote repo(s): "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
remoteRepoNames
  CabalInstallException
UpdateSetupScript -> String
"Using 'build-type: Custom' but there is no Setup.hs or Setup.lhs script."
  InstalledCabalVersion PackageName
name VersionRange
verRange ->
    String
"The package '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' requires Cabal library version "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ VersionRange -> String
forall a. Pretty a => a -> String
prettyShow VersionRange
verRange
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but no suitable version is installed."
  FailNoConfigFile String
msgNotFound ->
    [String] -> String
unlines
      [ String
msgNotFound
      , String
"(Config files can be created via the cabal-command 'user-config init'.)"
      ]
  ParseFailedErr String
configFile String
msg String
line ->
    String
"Error parsing config file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
configFile
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
  ParseExtraLinesFailedErr String
msg String
line ->
    String
"Error parsing additional config lines\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
  ParseExtraLinesOkError [PWarning]
ws -> [String] -> String
unlines ((PWarning -> String) -> [PWarning] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
showPWarning String
"Error parsing additional config lines") [PWarning]
ws)
  CabalInstallException
FetchPackageErr -> String
"fetchPackage: source repos not supported"
  ReportParseResult String
filetype String
filename String
line String
msg ->
    String
"Error parsing "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filetype
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
  ReportSourceRepoProblems String
errorStr -> String
errorStr
  CabalInstallException
BenchActionException ->
    String
"The bench command does not support '--only-dependencies'. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use 'bench'."
  RenderBenchTargetProblem [String]
errorStr -> [String] -> String
unlines [String]
errorStr
  ReportUserTargetProblems [String]
target ->
    [String] -> String
unlines
      [ String
"Unrecognised target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
target
      ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Targets can be:\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - package names, e.g. 'pkgname', 'pkgname-1.0.1', 'pkgname < 2.0'\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - cabal files 'pkgname.cabal' or package directories 'pkgname/'\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - package tarballs 'pkgname.tar.gz' or 'http://example.com/pkgname.tar.gz'"
  ReportUserTargerNonexistantFile [String]
target ->
    [String] -> String
unlines
      [ String
"The file does not exist '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
target
      ]
  ReportUserTargetUnexpectedFile [String]
target ->
    [String] -> String
unlines
      [ String
"Unrecognised file target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
target
      ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"File targets can be either package tarballs 'pkgname.tar.gz' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or cabal files 'pkgname.cabal'."
  ReportUserTargetUnexpectedUriScheme [String]
target ->
    [String] -> String
unlines
      [ String
"URL target not supported '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
target
      ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Only 'http://' and 'https://' URLs are supported."
  ReportUserTargetUnrecognisedUri [String]
target ->
    [String] -> String
unlines
      [ String
"Unrecognise URL target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
target
      ]
  ReadTarballPackageTarget String
filename String
tarballFile ->
    String
"Could not parse the cabal file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tarballFile
  ReportPackageTargetProblems [PackageName]
pkgs ->
    [String] -> String
unlines
      [ String
"There is no package named '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. "
      | PackageName
name <- [PackageName]
pkgs
      ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may need to run 'cabal update' to get the latest "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"list of available packages."
  PackageNameAmbiguousErr [(PackageName, [PackageName])]
ambiguities ->
    [String] -> String
unlines
      [ String
"There is no package named '"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ( if [PackageName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
matches Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
              then String
"However, the following package names exist: "
              else String
"However, the following package name exists: "
           )
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'" | PackageName
m <- [PackageName]
matches]
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      | (PackageName
name, [PackageName]
matches) <- [(PackageName, [PackageName])]
ambiguities
      ]
  ExtractTarballPackageErr String
err -> String
err
  CabalInstallException
OutdatedAction -> String
"--project-dir and --project-file must only be used with --v2-freeze-file."
  FreezeFileExistsErr String
freezeFile ->
    String
"Couldn't find a freeze file expected at: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
freezeFile
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"We are looking for this file because you supplied '--project-file' or '--v2-freeze-file'. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"When one of these flags is given, we try to read the dependencies from a freeze file. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"If it is undesired behaviour, you should not use these flags, otherwise please generate "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"a freeze file via 'cabal freeze'."
  CabalInstallException
FinalizePDFailed -> String
"finalizePD failed"
  ProjectTargetSelector String
input String
err -> String
"Invalid package ID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  PhaseRunSolverErr String
msg -> String
msg
  CabalInstallException
HaddockCommandDoesn'tSupport -> String
"The haddock command does not support '--only-dependencies'."
  CannotParseURIFragment String
uriFrag String
err -> String
"Cannot parse URI fragment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uriFrag String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  MakeDownload URI
uri ByteString
expected ByteString
actual ->
    [String] -> String
unwords
      [ String
"Failed to download"
      , URI -> String
forall a. Show a => a -> String
show URI
uri
      , String
": SHA256 don't match; expected:"
      , ByteString -> String
BS8.unpack (ByteString -> ByteString
Base16.encode ByteString
expected)
      , String
"actual:"
      , ByteString -> String
BS8.unpack (ByteString -> ByteString
Base16.encode ByteString
actual)
      ]
  FailedToDownloadURI URI
uri String
errCode ->
    String
"failed to download "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
uri
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : HTTP code "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errCode
  RemoteRepoCheckHttps String
unRepoName String
requiresHttpsErrorMessage ->
    String
"The remote repository '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unRepoName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' specifies a URL that "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
requiresHttpsErrorMessage
  TransportCheckHttps URI
uri String
requiresHttpsErrorMessage ->
    String
"The URL "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
uri
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
requiresHttpsErrorMessage
  CabalInstallException
NoPostYet -> String
"Posting (for report upload) is not implemented yet"
  WGetServerError String
programPath String
resp ->
    String
"'"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
programPath
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' exited with an error:\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
resp
  CabalInstallException
Couldn'tEstablishHttpConnection ->
    String
"Couldn't establish HTTP connection. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Possible cause: HTTP proxy server is down."
  StatusParseFail URI
uri String
r ->
    String
"Failed to download "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
uri
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"No Status Code could be parsed from response: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r
  TryUpgradeToHttps [String]
str ->
    String
"The builtin HTTP implementation does not support HTTPS, but using "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"HTTPS for authenticated uploads is recommended. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The transport implementations with HTTPS support are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
str
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"but they require the corresponding external program to be "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"available. You can either make one available or use plain HTTP by "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"using the global flag --http-transport=plain-http (or putting the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"equivalent in the config file). With plain HTTP, your password "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is sent using HTTP digest authentication so it cannot be easily "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"intercepted, but it is not as secure as using HTTPS."
  UnknownHttpTransportSpecified String
name [String]
str ->
    String
"Unknown HTTP transport specified: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". The supported transports are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
        String
", "
        [String]
str
  CmdHaddockReportTargetProblems [String]
str -> [String] -> String
unlines [String]
str
  FailedExtractingScriptBlock String
eStr -> String
"Failed extracting script block: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
eStr
  FreezeAction [String]
extraArgs ->
    String
"'freeze' doesn't take any extra arguments: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extraArgs
  TryFindPackageDescErr String
err -> String
err
  DieIfNotHaddockFailureException String
errorStr -> String
errorStr
  CabalInstallException
ConfigureInstallInternalError ->
    String
"internal error: configure install plan should have exactly "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"one local ready package."
  CmdErrorMessages [String]
err -> [String] -> String
unlines [String]
err
  ReportTargetSelectorProblems [String]
targets ->
    [String] -> String
unlines
      [ String
"Unrecognised target syntax for '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | String
name <- [String]
targets
      ]
  UnrecognisedTarget [(String, [String], String)]
targets ->
    [String] -> String
unlines
      [ String
"Unrecognised target '"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
target
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'.\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Expected a "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" or " [String]
expected
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", rather than '"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
got
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
      | (String
target, [String]
expected, String
got) <- [(String, [String], String)]
targets
      ]
  NoSuchTargetSelectorErr [(String, [(Maybe (String, String), String, String, [String])])]
targets ->
    [String] -> String
unlines
      [ String
"Unknown target '"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
target
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'.\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines
          [ ( case Maybe (String, String)
inside of
                Just (String
kind, String
"") ->
                  String
"The " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has no "
                Just (String
kind, String
thing) ->
                  String
"The " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has no "
                Maybe (String, String)
Nothing -> String
"There is no "
            )
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
              String
" or "
              [ ShowS
mungeThing String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
got String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
              | (String
thing, String
got, [String]
_alts) <- [(String, String, [String])]
nosuch'
              ]
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ if [(String, [String])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [String])]
alternatives
              then String
""
              else
                String
"\nPerhaps you meant "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
                    String
";\nor "
                    [ String
"the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"' or '" [String]
alts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'?"
                    | (String
thing, [String]
alts) <- [(String, [String])]
alternatives
                    ]
          | (Maybe (String, String)
inside, [(String, String, [String])]
nosuch') <- [(Maybe (String, String), String, String, [String])]
-> [(Maybe (String, String), [(String, String, [String])])]
forall {a} {b} {c}.
[(Maybe (String, String), a, b, c)]
-> [(Maybe (String, String), [(a, b, c)])]
groupByContainer [(Maybe (String, String), String, String, [String])]
nosuch
          , let alternatives :: [(String, [String])]
alternatives =
                  [ (String
thing, [String]
alts)
                  | (String
thing, String
_got, alts :: [String]
alts@(String
_ : [String]
_)) <- [(String, String, [String])]
nosuch'
                  ]
          ]
      | (String
target, [(Maybe (String, String), String, String, [String])]
nosuch) <- [(String, [(Maybe (String, String), String, String, [String])])]
targets
      , let groupByContainer :: [(Maybe (String, String), a, b, c)]
-> [(Maybe (String, String), [(a, b, c)])]
groupByContainer =
              ([(Maybe (String, String), a, b, c)]
 -> (Maybe (String, String), [(a, b, c)]))
-> [[(Maybe (String, String), a, b, c)]]
-> [(Maybe (String, String), [(a, b, c)])]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \g :: [(Maybe (String, String), a, b, c)]
g@((Maybe (String, String)
inside, a
_, b
_, c
_) : [(Maybe (String, String), a, b, c)]
_) ->
                    ( Maybe (String, String)
inside
                    , [ (a
thing, b
got, c
alts)
                      | (Maybe (String, String)
_, a
thing, b
got, c
alts) <- [(Maybe (String, String), a, b, c)]
g
                      ]
                    )
                )
                ([[(Maybe (String, String), a, b, c)]]
 -> [(Maybe (String, String), [(a, b, c)])])
-> ([(Maybe (String, String), a, b, c)]
    -> [[(Maybe (String, String), a, b, c)]])
-> [(Maybe (String, String), a, b, c)]
-> [(Maybe (String, String), [(a, b, c)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (String, String), a, b, c)
 -> (Maybe (String, String), a, b, c) -> Bool)
-> [(Maybe (String, String), a, b, c)]
-> [[(Maybe (String, String), a, b, c)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Maybe (String, String) -> Maybe (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (String, String) -> Maybe (String, String) -> Bool)
-> ((Maybe (String, String), a, b, c) -> Maybe (String, String))
-> (Maybe (String, String), a, b, c)
-> (Maybe (String, String), a, b, c)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Maybe (String, String)
x, a
_, b
_, c
_) -> Maybe (String, String)
x))
                ([(Maybe (String, String), a, b, c)]
 -> [[(Maybe (String, String), a, b, c)]])
-> ([(Maybe (String, String), a, b, c)]
    -> [(Maybe (String, String), a, b, c)])
-> [(Maybe (String, String), a, b, c)]
-> [[(Maybe (String, String), a, b, c)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (String, String), a, b, c)
 -> (Maybe (String, String), a, b, c) -> Ordering)
-> [(Maybe (String, String), a, b, c)]
-> [(Maybe (String, String), a, b, c)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Maybe (String, String) -> Maybe (String, String) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe (String, String) -> Maybe (String, String) -> Ordering)
-> ((Maybe (String, String), a, b, c) -> Maybe (String, String))
-> (Maybe (String, String), a, b, c)
-> (Maybe (String, String), a, b, c)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Maybe (String, String)
x, a
_, b
_, c
_) -> Maybe (String, String)
x))
      ]
    where
      mungeThing :: ShowS
mungeThing String
"file" = String
"file target"
      mungeThing String
thing = String
thing
  TargetSelectorAmbiguousErr [(String, [(String, String)])]
targets ->
    [String] -> String
unlines
      [ String
"Ambiguous target '"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
target
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. It could be:\n "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines
          [ String
"   "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ut
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ("
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bt
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
          | (String
ut, String
bt) <- [(String, String)]
amb
          ]
      | (String
target, [(String, String)]
amb) <- [(String, [(String, String)])]
targets
      ]
  TargetSelectorNoCurrentPackageErr String
target ->
    String
"The target '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
target
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' refers to the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"components in the package in the current directory, but there "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is no package in the current directory (or at least not listed "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"as part of the project)."
  CabalInstallException
TargetSelectorNoTargetsInCwdTrue ->
    String
"No targets given and there is no package in the current "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory. Use the target 'all' for all packages in the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"project or specify packages or components by name or location. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"See 'cabal build --help' for more details on target options."
  CabalInstallException
TargetSelectorNoTargetsInCwdFalse ->
    String
"No targets given and there is no package in the current "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory. Specify packages or components by name or location. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"See 'cabal build --help' for more details on target options."
  CabalInstallException
TargetSelectorNoTargetsInProjectErr ->
    String
"There is no <pkgname>.cabal package file or cabal.project file. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To build packages locally you need at minimum a <pkgname>.cabal "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"file. You can use 'cabal init' to create one.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"For non-trivial projects you will also want a cabal.project "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"file in the root directory of your project. This file lists the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"packages in your project and all other build configuration. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"See the Cabal user guide for full details."
  TargetSelectorNoScriptErr String
target ->
    String
"The script '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
target
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not exist, "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"and only script targets may contain whitespace characters or end "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"with ':'"
  MatchingInternalErrorErr String
t String
s String
sKind [(String, [String])]
renderingsAndMatches ->
    String
"Internal error in target matching: could not make an "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"unambiguous fully qualified target selector for '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"We made the target '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' ("
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sKind
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") that was expected to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be unambiguous but matches the following targets:\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines
        [ String
"'"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rendering
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', matching:"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            (String
"\n  - " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
            [String]
matches
        | (String
rendering, [String]
matches) <- [(String, [String])]
renderingsAndMatches
        ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nNote: Cabal expects to be able to make a single fully "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"qualified name for a target or provide a more specific error. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Our failure to do so is a bug in cabal. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Tracking issue: https://github.com/haskell/cabal/issues/8684"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\nHint: this may be caused by trying to build a package that "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"exists in the project directory but is missing from "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the 'packages' stanza in your cabal project file."
  ReportPlanningFailure String
message -> String
message
  Can'tDownloadPackagesOffline [String]
notFetched ->
    String
"Can't download packages in offline mode. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Must download the following packages to proceed:\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
notFetched
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nTry using 'cabal fetch'."
  SomePackagesFailedToInstall [(String, String)]
failed ->
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      String
"Some packages failed to install:"
        String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ String
pkgid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason
          | (String
pkgid, String
reason) <- [(String, String)]
failed
          ]
  PackageDotCabalFileNotFound String
descFilePath -> String
"Package .cabal file not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
descFilePath
  PkgConfParsedFailed String
perror ->
    String
"Couldn't parse the output of 'setup register --gen-pkg-config':"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
perror
  BrokenException String
errorStr -> String
errorStr
  WithoutProject String
str1 [String]
str2 ->
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
"Unknown package \""
      , String
str1
      , String
"\". "
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
str2
  PackagesAlreadyExistInEnvfile String
envFile [String]
name ->
    String
"Packages requested to install already exist in environment file at "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
envFile
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
name
  CabalInstallException
ConfigTests ->
    String
"--enable-tests was specified, but tests can't "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be enabled in a remote package"
  CabalInstallException
ConfigBenchmarks ->
    String
"--enable-benchmarks was specified, but benchmarks can't "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be enabled in a remote package"
  UnknownPackage String
hn [String]
name ->
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
"Unknown package \""
      , String
hn
      , String
"\". "
      , String
"Did you mean any of the following?\n"
      , [String] -> String
unlines [String]
name
      ]
  InstallUnitExes String
errorMessage -> String
errorMessage
  SelectComponentTargetError String
render -> String
render
  SdistActionException [String]
errs -> [String] -> String
unlines [String]
errs
  CabalInstallException
Can'tWriteMultipleTarballs -> String
"Can't write multiple tarballs to standard output!"
  ImpossibleHappened String
pkg -> String
"The impossible happened: a local package isn't local" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
pkg
  CannotConvertTarballPackage String
format -> String
"cannot convert tarball package to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
format
  CabalInstallException
Win32SelfUpgradeNotNeeded -> String
"win32selfupgrade not needed except on win32"
  FreezeException String
errs -> String
errs
  PkgSpecifierException [String]
errorStr -> [String] -> String
unlines [String]
errorStr
  CorruptedIndexCache String
str -> String
str
  UnusableIndexState RemoteRepo
repoRemote Timestamp
maxFound Timestamp
requested ->
    String
"Latest known index-state for '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ RepoName -> String
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' ("
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Timestamp -> String
forall a. Pretty a => a -> String
prettyShow Timestamp
maxFound
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") is older than the requested index-state ("
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Timestamp -> String
forall a. Pretty a => a -> String
prettyShow Timestamp
requested
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
").\nRun 'cabal update' or set the index-state to a value at or before "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Timestamp -> String
forall a. Pretty a => a -> String
prettyShow Timestamp
maxFound
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
  MissingPackageList RemoteRepo
repoRemote ->
    String
"The package list for '"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ RepoName -> String
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repoRemote)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not exist. Run 'cabal update' to download it."
  CabalInstallException
CmdPathAcceptsNoTargets ->
    String
"The 'path' command accepts no target arguments."
  CabalInstallException
CmdPathCommandDoesn'tSupportDryRun ->
    String
"The 'path' command doesn't support the flag '--dry-run'."

instance Exception (VerboseException CabalInstallException) where
  displayException :: VerboseException CabalInstallException -> [Char]
  displayException :: VerboseException CabalInstallException -> String
displayException (VerboseException CallStack
stack POSIXTime
timestamp Verbosity
verb CabalInstallException
cabalInstallException) =
    Verbosity -> ShowS
withOutputMarker
      Verbosity
verb
      ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ String
"Error: [Cabal-"
          , Int -> String
forall a. Show a => a -> String
show (CabalInstallException -> Int
exceptionCodeCabalInstall CabalInstallException
cabalInstallException)
          , String
"]\n"
          ]
      )
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ CallStack -> POSIXTime -> Verbosity -> ShowS
exceptionWithMetadata CallStack
stack POSIXTime
timestamp Verbosity
verb (CabalInstallException -> String
exceptionMessageCabalInstall CabalInstallException
cabalInstallException)