{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE FlexibleInstances           #-}

{-|
Module      : GHCup.Errors
Description : GHCup error types
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Errors where

import           GHCup.Types

import           Codec.Archive
import           Control.Exception.Safe
import           Data.ByteString                ( ByteString )
import           Data.CaseInsensitive           ( CI )
import           Data.Text                      ( Text )
import           Data.Versions
import           Haskus.Utils.Variant
import           System.FilePath
import           Text.PrettyPrint               hiding ( (<>) )
import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import           URI.ByteString

import qualified Data.Map.Strict               as M
import qualified Data.Text                     as T



    ------------------------
    --[ Low-level errors ]--
    ------------------------



-- | A compatible platform could not be found.
data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got
  deriving Int -> NoCompatiblePlatform -> ShowS
[NoCompatiblePlatform] -> ShowS
NoCompatiblePlatform -> String
(Int -> NoCompatiblePlatform -> ShowS)
-> (NoCompatiblePlatform -> String)
-> ([NoCompatiblePlatform] -> ShowS)
-> Show NoCompatiblePlatform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoCompatiblePlatform] -> ShowS
$cshowList :: [NoCompatiblePlatform] -> ShowS
show :: NoCompatiblePlatform -> String
$cshow :: NoCompatiblePlatform -> String
showsPrec :: Int -> NoCompatiblePlatform -> ShowS
$cshowsPrec :: Int -> NoCompatiblePlatform -> ShowS
Show

instance Pretty NoCompatiblePlatform where
  pPrint :: NoCompatiblePlatform -> Doc
pPrint (NoCompatiblePlatform String
str') =
    String -> Doc
text (String
"Could not find a compatible platform. Got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str')

-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload
  deriving Int -> NoDownload -> ShowS
[NoDownload] -> ShowS
NoDownload -> String
(Int -> NoDownload -> ShowS)
-> (NoDownload -> String)
-> ([NoDownload] -> ShowS)
-> Show NoDownload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoDownload] -> ShowS
$cshowList :: [NoDownload] -> ShowS
show :: NoDownload -> String
$cshow :: NoDownload -> String
showsPrec :: Int -> NoDownload -> ShowS
$cshowsPrec :: Int -> NoDownload -> ShowS
Show

instance Pretty NoDownload where
  pPrint :: NoDownload -> Doc
pPrint NoDownload
NoDownload =
    String -> Doc
text String
"Unable to find a download for the requested version/distro."

-- | No update available or necessary.
data NoUpdate = NoUpdate
  deriving Int -> NoUpdate -> ShowS
[NoUpdate] -> ShowS
NoUpdate -> String
(Int -> NoUpdate -> ShowS)
-> (NoUpdate -> String) -> ([NoUpdate] -> ShowS) -> Show NoUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoUpdate] -> ShowS
$cshowList :: [NoUpdate] -> ShowS
show :: NoUpdate -> String
$cshow :: NoUpdate -> String
showsPrec :: Int -> NoUpdate -> ShowS
$cshowsPrec :: Int -> NoUpdate -> ShowS
Show

instance Pretty NoUpdate where
  pPrint :: NoUpdate -> Doc
pPrint NoUpdate
NoUpdate = String -> Doc
text String
"No update available or necessary."

-- | The Architecture is unknown and unsupported.
data NoCompatibleArch = NoCompatibleArch String
  deriving Int -> NoCompatibleArch -> ShowS
[NoCompatibleArch] -> ShowS
NoCompatibleArch -> String
(Int -> NoCompatibleArch -> ShowS)
-> (NoCompatibleArch -> String)
-> ([NoCompatibleArch] -> ShowS)
-> Show NoCompatibleArch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoCompatibleArch] -> ShowS
$cshowList :: [NoCompatibleArch] -> ShowS
show :: NoCompatibleArch -> String
$cshow :: NoCompatibleArch -> String
showsPrec :: Int -> NoCompatibleArch -> ShowS
$cshowsPrec :: Int -> NoCompatibleArch -> ShowS
Show

instance Pretty NoCompatibleArch where
  pPrint :: NoCompatibleArch -> Doc
pPrint (NoCompatibleArch String
arch) =
    String -> Doc
text (String
"The Architecture is unknown or unsupported. Got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arch)

-- | Unable to figure out the distribution of the host.
data DistroNotFound = DistroNotFound
  deriving Int -> DistroNotFound -> ShowS
[DistroNotFound] -> ShowS
DistroNotFound -> String
(Int -> DistroNotFound -> ShowS)
-> (DistroNotFound -> String)
-> ([DistroNotFound] -> ShowS)
-> Show DistroNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistroNotFound] -> ShowS
$cshowList :: [DistroNotFound] -> ShowS
show :: DistroNotFound -> String
$cshow :: DistroNotFound -> String
showsPrec :: Int -> DistroNotFound -> ShowS
$cshowsPrec :: Int -> DistroNotFound -> ShowS
Show

instance Pretty DistroNotFound where
  pPrint :: DistroNotFound -> Doc
pPrint DistroNotFound
DistroNotFound =
    String -> Doc
text String
"Unable to figure out the distribution of the host."

-- | The archive format is unknown. We don't know how to extract it.
data UnknownArchive = UnknownArchive FilePath
  deriving Int -> UnknownArchive -> ShowS
[UnknownArchive] -> ShowS
UnknownArchive -> String
(Int -> UnknownArchive -> ShowS)
-> (UnknownArchive -> String)
-> ([UnknownArchive] -> ShowS)
-> Show UnknownArchive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownArchive] -> ShowS
$cshowList :: [UnknownArchive] -> ShowS
show :: UnknownArchive -> String
$cshow :: UnknownArchive -> String
showsPrec :: Int -> UnknownArchive -> ShowS
$cshowsPrec :: Int -> UnknownArchive -> ShowS
Show

instance Pretty UnknownArchive where
  pPrint :: UnknownArchive -> Doc
pPrint (UnknownArchive String
file) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"The archive format is unknown. We don't know how to extract the file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
file

-- | The scheme is not supported (such as ftp).
data UnsupportedScheme = UnsupportedScheme
  deriving Int -> UnsupportedScheme -> ShowS
[UnsupportedScheme] -> ShowS
UnsupportedScheme -> String
(Int -> UnsupportedScheme -> ShowS)
-> (UnsupportedScheme -> String)
-> ([UnsupportedScheme] -> ShowS)
-> Show UnsupportedScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsupportedScheme] -> ShowS
$cshowList :: [UnsupportedScheme] -> ShowS
show :: UnsupportedScheme -> String
$cshow :: UnsupportedScheme -> String
showsPrec :: Int -> UnsupportedScheme -> ShowS
$cshowsPrec :: Int -> UnsupportedScheme -> ShowS
Show

instance Pretty UnsupportedScheme where
  pPrint :: UnsupportedScheme -> Doc
pPrint UnsupportedScheme
UnsupportedScheme = String -> Doc
text String
"The scheme is not supported (such as ftp)."

-- | Unable to copy a file.
data CopyError = CopyError String
  deriving Int -> CopyError -> ShowS
[CopyError] -> ShowS
CopyError -> String
(Int -> CopyError -> ShowS)
-> (CopyError -> String)
-> ([CopyError] -> ShowS)
-> Show CopyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyError] -> ShowS
$cshowList :: [CopyError] -> ShowS
show :: CopyError -> String
$cshow :: CopyError -> String
showsPrec :: Int -> CopyError -> ShowS
$cshowsPrec :: Int -> CopyError -> ShowS
Show

instance Pretty CopyError where
  pPrint :: CopyError -> Doc
pPrint (CopyError String
reason) =
    String -> Doc
text (String
"Unable to copy a file. Reason was: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason)

-- | Unable to find a tag of a tool.
data TagNotFound = TagNotFound Tag Tool
  deriving Int -> TagNotFound -> ShowS
[TagNotFound] -> ShowS
TagNotFound -> String
(Int -> TagNotFound -> ShowS)
-> (TagNotFound -> String)
-> ([TagNotFound] -> ShowS)
-> Show TagNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagNotFound] -> ShowS
$cshowList :: [TagNotFound] -> ShowS
show :: TagNotFound -> String
$cshow :: TagNotFound -> String
showsPrec :: Int -> TagNotFound -> ShowS
$cshowsPrec :: Int -> TagNotFound -> ShowS
Show

instance Pretty TagNotFound where
  pPrint :: TagNotFound -> Doc
pPrint (TagNotFound Tag
tag Tool
tool) =
    String -> Doc
text String
"Unable to find tag" Doc -> Doc -> Doc
<+> Tag -> Doc
forall a. Pretty a => a -> Doc
pPrint Tag
tag Doc -> Doc -> Doc
<+> String -> Doc
text String
"of tool" Doc -> Doc -> Doc
<+> Tool -> Doc
forall a. Pretty a => a -> Doc
pPrint Tool
tool

-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool
  deriving Int -> NextVerNotFound -> ShowS
[NextVerNotFound] -> ShowS
NextVerNotFound -> String
(Int -> NextVerNotFound -> ShowS)
-> (NextVerNotFound -> String)
-> ([NextVerNotFound] -> ShowS)
-> Show NextVerNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextVerNotFound] -> ShowS
$cshowList :: [NextVerNotFound] -> ShowS
show :: NextVerNotFound -> String
$cshow :: NextVerNotFound -> String
showsPrec :: Int -> NextVerNotFound -> ShowS
$cshowsPrec :: Int -> NextVerNotFound -> ShowS
Show

instance Pretty NextVerNotFound where
  pPrint :: NextVerNotFound -> Doc
pPrint (NextVerNotFound Tool
tool) =
    String -> Doc
text String
"Unable to find next (the one after the currently set one) version of tool" Doc -> Doc -> Doc
<+> Tool -> Doc
forall a. Pretty a => a -> Doc
pPrint Tool
tool

-- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version
  deriving Int -> AlreadyInstalled -> ShowS
[AlreadyInstalled] -> ShowS
AlreadyInstalled -> String
(Int -> AlreadyInstalled -> ShowS)
-> (AlreadyInstalled -> String)
-> ([AlreadyInstalled] -> ShowS)
-> Show AlreadyInstalled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlreadyInstalled] -> ShowS
$cshowList :: [AlreadyInstalled] -> ShowS
show :: AlreadyInstalled -> String
$cshow :: AlreadyInstalled -> String
showsPrec :: Int -> AlreadyInstalled -> ShowS
$cshowsPrec :: Int -> AlreadyInstalled -> ShowS
Show

instance Pretty AlreadyInstalled where
  pPrint :: AlreadyInstalled -> Doc
pPrint (AlreadyInstalled Tool
tool Version
ver') =
    Tool -> Doc
forall a. Pretty a => a -> Doc
pPrint Tool
tool Doc -> Doc -> Doc
<+> String -> Doc
text String
"-" Doc -> Doc -> Doc
<+> Version -> Doc
forall a. Pretty a => a -> Doc
pPrint Version
ver' Doc -> Doc -> Doc
<+> String -> Doc
text String
"is already installed"

-- | The Directory is supposed to be empty, but wasn't.
data DirNotEmpty = DirNotEmpty {DirNotEmpty -> String
path :: FilePath}

instance Pretty DirNotEmpty where
  pPrint :: DirNotEmpty -> Doc
pPrint (DirNotEmpty String
path) = do
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"The directory was expected to be empty, but isn't: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path

-- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool GHCTargetVersion
  deriving Int -> NotInstalled -> ShowS
[NotInstalled] -> ShowS
NotInstalled -> String
(Int -> NotInstalled -> ShowS)
-> (NotInstalled -> String)
-> ([NotInstalled] -> ShowS)
-> Show NotInstalled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotInstalled] -> ShowS
$cshowList :: [NotInstalled] -> ShowS
show :: NotInstalled -> String
$cshow :: NotInstalled -> String
showsPrec :: Int -> NotInstalled -> ShowS
$cshowsPrec :: Int -> NotInstalled -> ShowS
Show

instance Pretty NotInstalled where
  pPrint :: NotInstalled -> Doc
pPrint (NotInstalled Tool
tool GHCTargetVersion
ver) =
    String -> Doc
text String
"The version" Doc -> Doc -> Doc
<+> GHCTargetVersion -> Doc
forall a. Pretty a => a -> Doc
pPrint GHCTargetVersion
ver Doc -> Doc -> Doc
<+> String -> Doc
text String
"of the tool" Doc -> Doc -> Doc
<+> Tool -> Doc
forall a. Pretty a => a -> Doc
pPrint Tool
tool Doc -> Doc -> Doc
<+> String -> Doc
text String
"is not installed."

-- | An executable was expected to be in PATH, but was not found.
data NotFoundInPATH = NotFoundInPATH FilePath
  deriving Int -> NotFoundInPATH -> ShowS
[NotFoundInPATH] -> ShowS
NotFoundInPATH -> String
(Int -> NotFoundInPATH -> ShowS)
-> (NotFoundInPATH -> String)
-> ([NotFoundInPATH] -> ShowS)
-> Show NotFoundInPATH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFoundInPATH] -> ShowS
$cshowList :: [NotFoundInPATH] -> ShowS
show :: NotFoundInPATH -> String
$cshow :: NotFoundInPATH -> String
showsPrec :: Int -> NotFoundInPATH -> ShowS
$cshowsPrec :: Int -> NotFoundInPATH -> ShowS
Show

instance Exception NotFoundInPATH

instance Pretty NotFoundInPATH where
  pPrint :: NotFoundInPATH -> Doc
pPrint (NotFoundInPATH String
exe) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"The exe " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
exe String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was not found in PATH."

-- | JSON decoding failed.
data JSONError = JSONDecodeError String
  deriving Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> String
(Int -> JSONError -> ShowS)
-> (JSONError -> String)
-> ([JSONError] -> ShowS)
-> Show JSONError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> String
$cshow :: JSONError -> String
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show

instance Pretty JSONError where
  pPrint :: JSONError -> Doc
pPrint (JSONDecodeError String
err) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"JSON decoding failed with: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err

-- | A file that is supposed to exist does not exist
-- (e.g. when we use file scheme to "download" something).
data FileDoesNotExistError = FileDoesNotExistError FilePath
  deriving Int -> FileDoesNotExistError -> ShowS
[FileDoesNotExistError] -> ShowS
FileDoesNotExistError -> String
(Int -> FileDoesNotExistError -> ShowS)
-> (FileDoesNotExistError -> String)
-> ([FileDoesNotExistError] -> ShowS)
-> Show FileDoesNotExistError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileDoesNotExistError] -> ShowS
$cshowList :: [FileDoesNotExistError] -> ShowS
show :: FileDoesNotExistError -> String
$cshow :: FileDoesNotExistError -> String
showsPrec :: Int -> FileDoesNotExistError -> ShowS
$cshowsPrec :: Int -> FileDoesNotExistError -> ShowS
Show

instance Pretty FileDoesNotExistError where
  pPrint :: FileDoesNotExistError -> Doc
pPrint (FileDoesNotExistError String
file) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"File " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
file String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist."

-- | The file already exists
-- (e.g. when we use isolated installs with the same path).
-- (e.g. This is done to prevent any overwriting)
data FileAlreadyExistsError = FileAlreadyExistsError FilePath
  deriving Int -> FileAlreadyExistsError -> ShowS
[FileAlreadyExistsError] -> ShowS
FileAlreadyExistsError -> String
(Int -> FileAlreadyExistsError -> ShowS)
-> (FileAlreadyExistsError -> String)
-> ([FileAlreadyExistsError] -> ShowS)
-> Show FileAlreadyExistsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileAlreadyExistsError] -> ShowS
$cshowList :: [FileAlreadyExistsError] -> ShowS
show :: FileAlreadyExistsError -> String
$cshow :: FileAlreadyExistsError -> String
showsPrec :: Int -> FileAlreadyExistsError -> ShowS
$cshowsPrec :: Int -> FileAlreadyExistsError -> ShowS
Show

instance Pretty FileAlreadyExistsError where
  pPrint :: FileAlreadyExistsError -> Doc
pPrint (FileAlreadyExistsError String
file) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"File " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
file String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Already exists."

data TarDirDoesNotExist = TarDirDoesNotExist TarDir
  deriving Int -> TarDirDoesNotExist -> ShowS
[TarDirDoesNotExist] -> ShowS
TarDirDoesNotExist -> String
(Int -> TarDirDoesNotExist -> ShowS)
-> (TarDirDoesNotExist -> String)
-> ([TarDirDoesNotExist] -> ShowS)
-> Show TarDirDoesNotExist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TarDirDoesNotExist] -> ShowS
$cshowList :: [TarDirDoesNotExist] -> ShowS
show :: TarDirDoesNotExist -> String
$cshow :: TarDirDoesNotExist -> String
showsPrec :: Int -> TarDirDoesNotExist -> ShowS
$cshowsPrec :: Int -> TarDirDoesNotExist -> ShowS
Show

instance Pretty TarDirDoesNotExist where
  pPrint :: TarDirDoesNotExist -> Doc
pPrint (TarDirDoesNotExist TarDir
dir) =
    String -> Doc
text String
"Tar directory does not exist:" Doc -> Doc -> Doc
<+> TarDir -> Doc
forall a. Pretty a => a -> Doc
pPrint TarDir
dir

-- | File digest verification failed.
data DigestError = DigestError FilePath Text Text
  deriving Int -> DigestError -> ShowS
[DigestError] -> ShowS
DigestError -> String
(Int -> DigestError -> ShowS)
-> (DigestError -> String)
-> ([DigestError] -> ShowS)
-> Show DigestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DigestError] -> ShowS
$cshowList :: [DigestError] -> ShowS
show :: DigestError -> String
$cshow :: DigestError -> String
showsPrec :: Int -> DigestError -> ShowS
$cshowsPrec :: Int -> DigestError -> ShowS
Show

instance Pretty DigestError where
  pPrint :: DigestError -> Doc
pPrint (DigestError String
fp Text
currentDigest Text
expectedDigest) =
    String -> Doc
text String
"Digest error for" Doc -> Doc -> Doc
<+> String -> Doc
text (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": expected")
      Doc -> Doc -> Doc
<+> String -> Doc
text (Text -> String
T.unpack Text
expectedDigest) Doc -> Doc -> Doc
<+> String -> Doc
text String
"but got" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Pretty a => a -> Doc
pPrint Text
currentDigest Doc -> Doc -> Doc
<+> String -> Doc
text
      String
"\nConsider removing the file in case it's cached and try again."

-- | File digest verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)

deriving instance Show GPGError

instance Pretty GPGError where
  pPrint :: GPGError -> Doc
pPrint (GPGError V xs
reason) = String -> Doc
text String
"GPG verify failed:" Doc -> Doc -> Doc
<+> V xs -> Doc
forall a. Pretty a => a -> Doc
pPrint V xs
reason

-- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
  deriving Int -> HTTPStatusError -> ShowS
[HTTPStatusError] -> ShowS
HTTPStatusError -> String
(Int -> HTTPStatusError -> ShowS)
-> (HTTPStatusError -> String)
-> ([HTTPStatusError] -> ShowS)
-> Show HTTPStatusError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPStatusError] -> ShowS
$cshowList :: [HTTPStatusError] -> ShowS
show :: HTTPStatusError -> String
$cshow :: HTTPStatusError -> String
showsPrec :: Int -> HTTPStatusError -> ShowS
$cshowsPrec :: Int -> HTTPStatusError -> ShowS
Show

instance Pretty HTTPStatusError where
  pPrint :: HTTPStatusError -> Doc
pPrint (HTTPStatusError Int
status Map (CI ByteString) ByteString
_) =
    String -> Doc
text String
"Unexpected HTTP status:" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
pPrint Int
status

-- | Malformed headers.
data MalformedHeaders = MalformedHeaders Text
  deriving Int -> MalformedHeaders -> ShowS
[MalformedHeaders] -> ShowS
MalformedHeaders -> String
(Int -> MalformedHeaders -> ShowS)
-> (MalformedHeaders -> String)
-> ([MalformedHeaders] -> ShowS)
-> Show MalformedHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MalformedHeaders] -> ShowS
$cshowList :: [MalformedHeaders] -> ShowS
show :: MalformedHeaders -> String
$cshow :: MalformedHeaders -> String
showsPrec :: Int -> MalformedHeaders -> ShowS
$cshowsPrec :: Int -> MalformedHeaders -> ShowS
Show

instance Pretty MalformedHeaders where
  pPrint :: MalformedHeaders -> Doc
pPrint (MalformedHeaders Text
h) =
    String -> Doc
text String
"Headers are malformed: " Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Pretty a => a -> Doc
pPrint Text
h

-- | Unexpected HTTP status.
data HTTPNotModified = HTTPNotModified Text
  deriving Int -> HTTPNotModified -> ShowS
[HTTPNotModified] -> ShowS
HTTPNotModified -> String
(Int -> HTTPNotModified -> ShowS)
-> (HTTPNotModified -> String)
-> ([HTTPNotModified] -> ShowS)
-> Show HTTPNotModified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPNotModified] -> ShowS
$cshowList :: [HTTPNotModified] -> ShowS
show :: HTTPNotModified -> String
$cshow :: HTTPNotModified -> String
showsPrec :: Int -> HTTPNotModified -> ShowS
$cshowsPrec :: Int -> HTTPNotModified -> ShowS
Show

instance Pretty HTTPNotModified where
  pPrint :: HTTPNotModified -> Doc
pPrint (HTTPNotModified Text
etag) =
    String -> Doc
text String
"Remote resource not modifed, etag was:" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Pretty a => a -> Doc
pPrint Text
etag

-- | The 'Location' header was expected during a 3xx redirect, but not found.
data NoLocationHeader = NoLocationHeader
  deriving Int -> NoLocationHeader -> ShowS
[NoLocationHeader] -> ShowS
NoLocationHeader -> String
(Int -> NoLocationHeader -> ShowS)
-> (NoLocationHeader -> String)
-> ([NoLocationHeader] -> ShowS)
-> Show NoLocationHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoLocationHeader] -> ShowS
$cshowList :: [NoLocationHeader] -> ShowS
show :: NoLocationHeader -> String
$cshow :: NoLocationHeader -> String
showsPrec :: Int -> NoLocationHeader -> ShowS
$cshowsPrec :: Int -> NoLocationHeader -> ShowS
Show

instance Pretty NoLocationHeader where
  pPrint :: NoLocationHeader -> Doc
pPrint NoLocationHeader
NoLocationHeader =
    String -> Doc
text String
"The 'Location' header was expected during a 3xx redirect, but not found."

-- | Too many redirects.
data TooManyRedirs = TooManyRedirs
  deriving Int -> TooManyRedirs -> ShowS
[TooManyRedirs] -> ShowS
TooManyRedirs -> String
(Int -> TooManyRedirs -> ShowS)
-> (TooManyRedirs -> String)
-> ([TooManyRedirs] -> ShowS)
-> Show TooManyRedirs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TooManyRedirs] -> ShowS
$cshowList :: [TooManyRedirs] -> ShowS
show :: TooManyRedirs -> String
$cshow :: TooManyRedirs -> String
showsPrec :: Int -> TooManyRedirs -> ShowS
$cshowsPrec :: Int -> TooManyRedirs -> ShowS
Show

instance Pretty TooManyRedirs where
  pPrint :: TooManyRedirs -> Doc
pPrint TooManyRedirs
TooManyRedirs =
    String -> Doc
text String
"Too many redirections."

-- | A patch could not be applied.
data PatchFailed = PatchFailed
  deriving Int -> PatchFailed -> ShowS
[PatchFailed] -> ShowS
PatchFailed -> String
(Int -> PatchFailed -> ShowS)
-> (PatchFailed -> String)
-> ([PatchFailed] -> ShowS)
-> Show PatchFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatchFailed] -> ShowS
$cshowList :: [PatchFailed] -> ShowS
show :: PatchFailed -> String
$cshow :: PatchFailed -> String
showsPrec :: Int -> PatchFailed -> ShowS
$cshowsPrec :: Int -> PatchFailed -> ShowS
Show

instance Pretty PatchFailed where
  pPrint :: PatchFailed -> Doc
pPrint PatchFailed
PatchFailed =
    String -> Doc
text String
"A patch could not be applied."

-- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements
  deriving Int -> NoToolRequirements -> ShowS
[NoToolRequirements] -> ShowS
NoToolRequirements -> String
(Int -> NoToolRequirements -> ShowS)
-> (NoToolRequirements -> String)
-> ([NoToolRequirements] -> ShowS)
-> Show NoToolRequirements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoToolRequirements] -> ShowS
$cshowList :: [NoToolRequirements] -> ShowS
show :: NoToolRequirements -> String
$cshow :: NoToolRequirements -> String
showsPrec :: Int -> NoToolRequirements -> ShowS
$cshowsPrec :: Int -> NoToolRequirements -> ShowS
Show

instance Pretty NoToolRequirements where
  pPrint :: NoToolRequirements -> Doc
pPrint NoToolRequirements
NoToolRequirements =
    String -> Doc
text String
"The Tool requirements could not be found."

data InvalidBuildConfig = InvalidBuildConfig Text
  deriving Int -> InvalidBuildConfig -> ShowS
[InvalidBuildConfig] -> ShowS
InvalidBuildConfig -> String
(Int -> InvalidBuildConfig -> ShowS)
-> (InvalidBuildConfig -> String)
-> ([InvalidBuildConfig] -> ShowS)
-> Show InvalidBuildConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidBuildConfig] -> ShowS
$cshowList :: [InvalidBuildConfig] -> ShowS
show :: InvalidBuildConfig -> String
$cshow :: InvalidBuildConfig -> String
showsPrec :: Int -> InvalidBuildConfig -> ShowS
$cshowsPrec :: Int -> InvalidBuildConfig -> ShowS
Show

instance Pretty InvalidBuildConfig where
  pPrint :: InvalidBuildConfig -> Doc
pPrint (InvalidBuildConfig Text
reason) =
    String -> Doc
text String
"The build config is invalid. Reason was:" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Pretty a => a -> Doc
pPrint Text
reason

data NoToolVersionSet = NoToolVersionSet Tool
  deriving Int -> NoToolVersionSet -> ShowS
[NoToolVersionSet] -> ShowS
NoToolVersionSet -> String
(Int -> NoToolVersionSet -> ShowS)
-> (NoToolVersionSet -> String)
-> ([NoToolVersionSet] -> ShowS)
-> Show NoToolVersionSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoToolVersionSet] -> ShowS
$cshowList :: [NoToolVersionSet] -> ShowS
show :: NoToolVersionSet -> String
$cshow :: NoToolVersionSet -> String
showsPrec :: Int -> NoToolVersionSet -> ShowS
$cshowsPrec :: Int -> NoToolVersionSet -> ShowS
Show

instance Pretty NoToolVersionSet where
  pPrint :: NoToolVersionSet -> Doc
pPrint (NoToolVersionSet Tool
tool) =
    String -> Doc
text String
"No version is set for tool" Doc -> Doc -> Doc
<+> Tool -> Doc
forall a. Pretty a => a -> Doc
pPrint Tool
tool Doc -> Doc -> Doc
<+> String -> Doc
text String
"."

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

instance Pretty NoNetwork where
  pPrint :: NoNetwork -> Doc
pPrint NoNetwork
NoNetwork =
    String -> Doc
text String
"A download was required or requested, but '--offline' was specified."

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

instance Pretty HadrianNotFound where
  pPrint :: HadrianNotFound -> Doc
pPrint HadrianNotFound
HadrianNotFound =
    String -> Doc
text String
"Could not find Hadrian build files. Does this GHC version support Hadrian builds?"

data GHCupShadowed = GHCupShadowed
                       FilePath  -- shadow binary
                       FilePath  -- upgraded binary
                       Version   -- upgraded version
  deriving Int -> GHCupShadowed -> ShowS
[GHCupShadowed] -> ShowS
GHCupShadowed -> String
(Int -> GHCupShadowed -> ShowS)
-> (GHCupShadowed -> String)
-> ([GHCupShadowed] -> ShowS)
-> Show GHCupShadowed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCupShadowed] -> ShowS
$cshowList :: [GHCupShadowed] -> ShowS
show :: GHCupShadowed -> String
$cshow :: GHCupShadowed -> String
showsPrec :: Int -> GHCupShadowed -> ShowS
$cshowsPrec :: Int -> GHCupShadowed -> ShowS
Show

instance Pretty GHCupShadowed where
  pPrint :: GHCupShadowed -> Doc
pPrint (GHCupShadowed String
sh String
up Version
_) =
    String -> Doc
text (String
"ghcup is shadowed by "
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sh
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". The upgrade will not be in effect, unless you remove "
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sh
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" or make sure "
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
takeDirectory String
up
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" comes before "
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
takeDirectory String
sh
         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" in PATH."
         )

    -------------------------
    --[ High-level errors ]--
    -------------------------

-- | A download failed. The underlying error is encapsulated.
data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)

instance Pretty DownloadFailed where
  pPrint :: DownloadFailed -> Doc
pPrint (DownloadFailed V xs
reason) =
    case V xs
reason of
      VMaybe (DownloadFailed
_ :: DownloadFailed) -> V xs -> Doc
forall a. Pretty a => a -> Doc
pPrint V xs
reason
      V xs
_ -> String -> Doc
text String
"Download failed:" Doc -> Doc -> Doc
<+> V xs -> Doc
forall a. Pretty a => a -> Doc
pPrint V xs
reason

deriving instance Show DownloadFailed


-- | A build failed.
data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)

instance Pretty BuildFailed where
  pPrint :: BuildFailed -> Doc
pPrint (BuildFailed String
path V es
reason) =
    case V es
reason of
      VMaybe (BuildFailed
_ :: BuildFailed) -> V es -> Doc
forall a. Pretty a => a -> Doc
pPrint V es
reason
      V es
_ -> String -> Doc
text String
"BuildFailed failed in dir" Doc -> Doc -> Doc
<+> String -> Doc
text (String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":") Doc -> Doc -> Doc
<+> V es -> Doc
forall a. Pretty a => a -> Doc
pPrint V es
reason

deriving instance Show BuildFailed


-- | Setting the current GHC version failed.
data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)

instance Pretty GHCupSetError where
  pPrint :: GHCupSetError -> Doc
pPrint (GHCupSetError V es
reason) =
    case V es
reason of
      VMaybe (GHCupSetError
_ :: GHCupSetError) -> V es -> Doc
forall a. Pretty a => a -> Doc
pPrint V es
reason
      V es
_ -> String -> Doc
text String
"Setting the current GHC version failed:" Doc -> Doc -> Doc
<+> V es -> Doc
forall a. Pretty a => a -> Doc
pPrint V es
reason

deriving instance Show GHCupSetError


    ---------------------------------------------
    --[ True Exceptions (e.g. for MonadThrow) ]--
    ---------------------------------------------


-- | Parsing failed.
data ParseError = ParseError String
  deriving Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show

instance Pretty ParseError where
  pPrint :: ParseError -> Doc
pPrint (ParseError String
reason) =
    String -> Doc
text String
"Parsing failed:" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pPrint String
reason

instance Exception ParseError


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

instance Pretty UnexpectedListLength where
  pPrint :: UnexpectedListLength -> Doc
pPrint (UnexpectedListLength String
reason) =
    String -> Doc
text String
"List length unexpected:" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pPrint String
reason

instance Exception UnexpectedListLength

data NoUrlBase = NoUrlBase Text
  deriving Int -> NoUrlBase -> ShowS
[NoUrlBase] -> ShowS
NoUrlBase -> String
(Int -> NoUrlBase -> ShowS)
-> (NoUrlBase -> String)
-> ([NoUrlBase] -> ShowS)
-> Show NoUrlBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoUrlBase] -> ShowS
$cshowList :: [NoUrlBase] -> ShowS
show :: NoUrlBase -> String
$cshow :: NoUrlBase -> String
showsPrec :: Int -> NoUrlBase -> ShowS
$cshowsPrec :: Int -> NoUrlBase -> ShowS
Show

instance Pretty NoUrlBase where
  pPrint :: NoUrlBase -> Doc
pPrint (NoUrlBase Text
url) =
    String -> Doc
text String
"Couldn't get a base filename from url" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Pretty a => a -> Doc
pPrint Text
url

instance Exception NoUrlBase



    ------------------------
    --[ orphan instances ]--
    ------------------------

instance Pretty (V '[]) where
   {-# INLINABLE pPrint #-}
   pPrint :: V '[] -> Doc
pPrint V '[]
_ = Doc
forall a. HasCallStack => a
undefined

instance
   ( Pretty x
   , Pretty (V xs)
   ) => Pretty (V (x ': xs))
   where
      pPrint :: V (x : xs) -> Doc
pPrint V (x : xs)
v = case V (x : xs) -> Either (V xs) x
forall x (xs :: [*]). V (x : xs) -> Either (V xs) x
popVariantHead V (x : xs)
v of
         Right x
x -> x -> Doc
forall a. Pretty a => a -> Doc
pPrint x
x
         Left V xs
xs -> V xs -> Doc
forall a. Pretty a => a -> Doc
pPrint V xs
xs

instance Pretty URIParseError where
  pPrint :: URIParseError -> Doc
pPrint (MalformedScheme SchemaError
reason) =
    String -> Doc
text String
"Failed to parse URI. Malformed scheme:" Doc -> Doc -> Doc
<+> String -> Doc
text (SchemaError -> String
forall a. Show a => a -> String
show SchemaError
reason)
  pPrint URIParseError
MalformedUserInfo =
    String -> Doc
text String
"Failed to parse URI. Malformed user info."
  pPrint URIParseError
MalformedQuery =
    String -> Doc
text String
"Failed to parse URI. Malformed query."
  pPrint URIParseError
MalformedFragment =
    String -> Doc
text String
"Failed to parse URI. Malformed fragment."
  pPrint URIParseError
MalformedHost =
    String -> Doc
text String
"Failed to parse URI. Malformed host."
  pPrint URIParseError
MalformedPort =
    String -> Doc
text String
"Failed to parse URI. Malformed port."
  pPrint URIParseError
MalformedPath =
    String -> Doc
text String
"Failed to parse URI. Malformed path."
  pPrint (OtherError String
err) =
    String -> Doc
text String
"Failed to parse URI:" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pPrint String
err

instance Pretty ArchiveResult where
  pPrint :: ArchiveResult -> Doc
pPrint ArchiveResult
ArchiveFatal = String -> Doc
text String
"Archive result: fatal"
  pPrint ArchiveResult
ArchiveFailed = String -> Doc
text String
"Archive result: failed"
  pPrint ArchiveResult
ArchiveWarn = String -> Doc
text String
"Archive result: warning"
  pPrint ArchiveResult
ArchiveRetry = String -> Doc
text String
"Archive result: retry"
  pPrint ArchiveResult
ArchiveOk = String -> Doc
text String
"Archive result: Ok"
  pPrint ArchiveResult
ArchiveEOF = String -> Doc
text String
"Archive result: EOF"

instance Pretty T.Text where
  pPrint :: Text -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack