14
lib/GHCup.hs
14
lib/GHCup.hs
@@ -525,7 +525,7 @@ setGHC ver sghc = do
|
||||
let verBS = verToBS (_tvVersion ver)
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC ver))
|
||||
|
||||
-- symlink destination
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
@@ -605,7 +605,7 @@ setCabal ver = do
|
||||
|
||||
whenM (liftIO $ fmap not $ doesFileExist (binDir </> targetFile))
|
||||
$ throwE
|
||||
$ NotInstalled Cabal (prettyVer ver)
|
||||
$ NotInstalled Cabal (GHCTargetVersion Nothing ver)
|
||||
|
||||
let cabalbin = binDir </> [rel|cabal|]
|
||||
|
||||
@@ -647,7 +647,7 @@ setHLS ver = do
|
||||
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
bins <- lift $ hlsServerBinaries ver
|
||||
when (bins == []) $ throwE $ NotInstalled HLS (prettyVer ver)
|
||||
when (bins == []) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||
|
||||
forM_ bins $ \f -> do
|
||||
let destL = toFilePath f
|
||||
@@ -929,7 +929,7 @@ rmGHCVer :: ( MonadReader AppState m
|
||||
rmGHCVer ver = do
|
||||
isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
|
||||
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC ver))
|
||||
dir <- lift $ ghcupGHCDir ver
|
||||
|
||||
-- this isn't atomic, order matters
|
||||
@@ -970,7 +970,7 @@ rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, M
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmCabalVer ver = do
|
||||
whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (prettyVer ver))
|
||||
whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (GHCTargetVersion Nothing ver))
|
||||
|
||||
cSet <- lift $ cabalSet
|
||||
|
||||
@@ -993,7 +993,7 @@ rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, Mon
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmHLSVer ver = do
|
||||
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (prettyVer ver))
|
||||
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
|
||||
|
||||
isHlsSet <- lift $ hlsSet
|
||||
|
||||
@@ -1240,7 +1240,7 @@ Stage1Only = YES|]
|
||||
$ c
|
||||
tarName <-
|
||||
parseRel
|
||||
[i|ghc-#{prettyTVer tver}-#{prettyPfReq pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
|
||||
[i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
tarPath
|
||||
|
||||
@@ -1,7 +1,13 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Errors
|
||||
@@ -15,13 +21,21 @@ Portability : POSIX
|
||||
module GHCup.Errors where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
#if !defined(TAR)
|
||||
import Codec.Archive
|
||||
#endif
|
||||
import Control.Exception.Safe
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.String.Interpolate
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant
|
||||
import HPath
|
||||
import Haskus.Utils.Variant
|
||||
import Text.PrettyPrint
|
||||
import Text.PrettyPrint.HughesPJClass
|
||||
import URI.ByteString
|
||||
|
||||
|
||||
|
||||
@@ -35,109 +49,211 @@ import HPath
|
||||
data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoCompatiblePlatform where
|
||||
pPrint (NoCompatiblePlatform str') =
|
||||
text ("Could not find a compatible platform. Got: " ++ str')
|
||||
|
||||
-- | Unable to find a download for the requested versio/distro.
|
||||
data NoDownload = NoDownload
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoDownload where
|
||||
pPrint NoDownload =
|
||||
text "Unable to find a download for the requested version/distro."
|
||||
|
||||
-- | No update available or necessary.
|
||||
data NoUpdate = NoUpdate
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoUpdate where
|
||||
pPrint NoUpdate = text "No update available or necessary."
|
||||
|
||||
-- | The Architecture is unknown and unsupported.
|
||||
data NoCompatibleArch = NoCompatibleArch String
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoCompatibleArch where
|
||||
pPrint (NoCompatibleArch arch) =
|
||||
text ("The Architecture is unknown or unsupported. Got: " ++ arch)
|
||||
|
||||
-- | Unable to figure out the distribution of the host.
|
||||
data DistroNotFound = DistroNotFound
|
||||
deriving Show
|
||||
|
||||
instance Pretty DistroNotFound where
|
||||
pPrint DistroNotFound =
|
||||
text "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 ByteString
|
||||
deriving Show
|
||||
|
||||
instance Pretty UnknownArchive where
|
||||
pPrint (UnknownArchive file) =
|
||||
text [i|The archive format is unknown. We don't know how to extract the file "#{decUTF8Safe file}"|]
|
||||
|
||||
-- | The scheme is not supported (such as ftp).
|
||||
data UnsupportedScheme = UnsupportedScheme
|
||||
deriving Show
|
||||
|
||||
instance Pretty UnsupportedScheme where
|
||||
pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
|
||||
|
||||
-- | Unable to copy a file.
|
||||
data CopyError = CopyError String
|
||||
deriving Show
|
||||
|
||||
instance Pretty CopyError where
|
||||
pPrint (CopyError reason) =
|
||||
text ("Unable to copy a file. Reason was: " ++ reason)
|
||||
|
||||
-- | Unable to find a tag of a tool.
|
||||
data TagNotFound = TagNotFound Tag Tool
|
||||
deriving Show
|
||||
|
||||
instance Pretty TagNotFound where
|
||||
pPrint (TagNotFound tag tool) =
|
||||
text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
|
||||
|
||||
-- | Unable to find a version of a tool.
|
||||
data VerNotFound = VerNotFound Version Tool
|
||||
deriving Show
|
||||
|
||||
instance Pretty VerNotFound where
|
||||
pPrint (VerNotFound ver' tool) =
|
||||
text [i|Unable to find version "#{prettyShow ver'}" of tool "#{tool}"|]
|
||||
|
||||
-- | Unable to find the next version of a tool (the one after the currently
|
||||
-- set one).
|
||||
data NextVerNotFound = NextVerNotFound Tool
|
||||
deriving Show
|
||||
|
||||
instance Pretty NextVerNotFound where
|
||||
pPrint (NextVerNotFound tool) =
|
||||
text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|]
|
||||
|
||||
-- | The tool (such as GHC) is already installed with that version.
|
||||
data AlreadyInstalled = AlreadyInstalled Tool Version
|
||||
deriving Show
|
||||
|
||||
instance Pretty AlreadyInstalled where
|
||||
pPrint (AlreadyInstalled tool ver') =
|
||||
text [i|#{tool}-#{prettyShow ver'} is already installed|]
|
||||
|
||||
-- | 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 Text
|
||||
data NotInstalled = NotInstalled Tool GHCTargetVersion
|
||||
deriving Show
|
||||
|
||||
instance Pretty NotInstalled where
|
||||
pPrint (NotInstalled tool ver) =
|
||||
text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
|
||||
|
||||
-- | An executable was expected to be in PATH, but was not found.
|
||||
data NotFoundInPATH = NotFoundInPATH (Path Rel)
|
||||
deriving Show
|
||||
|
||||
instance Pretty NotFoundInPATH where
|
||||
pPrint (NotFoundInPATH exe) =
|
||||
text [i|The exe "#{decUTF8Safe . toFilePath $ exe}" was not found in PATH.|]
|
||||
|
||||
-- | JSON decoding failed.
|
||||
data JSONError = JSONDecodeError String
|
||||
deriving Show
|
||||
|
||||
instance Pretty JSONError where
|
||||
pPrint (JSONDecodeError err) =
|
||||
text [i|JSON decoding failed with: #{err}|]
|
||||
|
||||
-- | A file that is supposed to exist does not exist
|
||||
-- (e.g. when we use file scheme to "download" something).
|
||||
data FileDoesNotExistError = FileDoesNotExistError ByteString
|
||||
deriving Show
|
||||
|
||||
instance Pretty FileDoesNotExistError where
|
||||
pPrint (FileDoesNotExistError file) =
|
||||
text [i|File "#{decUTF8Safe file}" does not exist.|]
|
||||
|
||||
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
|
||||
deriving Show
|
||||
|
||||
instance Pretty TarDirDoesNotExist where
|
||||
pPrint (TarDirDoesNotExist dir) =
|
||||
text "Tar directory does not exist:" <+> pPrint dir
|
||||
|
||||
-- | File digest verification failed.
|
||||
data DigestError = DigestError Text Text
|
||||
deriving Show
|
||||
|
||||
instance Pretty DigestError where
|
||||
pPrint (DigestError currentDigest expectedDigest) =
|
||||
text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
|
||||
|
||||
-- | Unexpected HTTP status.
|
||||
data HTTPStatusError = HTTPStatusError Int
|
||||
deriving Show
|
||||
|
||||
instance Pretty HTTPStatusError where
|
||||
pPrint (HTTPStatusError status) =
|
||||
text [i|Unexpected HTTP status: #{status}|]
|
||||
|
||||
-- | The 'Location' header was expected during a 3xx redirect, but not found.
|
||||
data NoLocationHeader = NoLocationHeader
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoLocationHeader where
|
||||
pPrint NoLocationHeader =
|
||||
text [i|The 'Location' header was expected during a 3xx redirect, but not found.|]
|
||||
|
||||
-- | Too many redirects.
|
||||
data TooManyRedirs = TooManyRedirs
|
||||
deriving Show
|
||||
|
||||
instance Pretty TooManyRedirs where
|
||||
pPrint TooManyRedirs =
|
||||
text [i|Too many redirections.|]
|
||||
|
||||
-- | A patch could not be applied.
|
||||
data PatchFailed = PatchFailed
|
||||
deriving Show
|
||||
|
||||
instance Pretty PatchFailed where
|
||||
pPrint PatchFailed =
|
||||
text [i|A patch could not be applied.|]
|
||||
|
||||
-- | The tool requirements could not be found.
|
||||
data NoToolRequirements = NoToolRequirements
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoToolRequirements where
|
||||
pPrint NoToolRequirements =
|
||||
text [i|The Tool requirements could not be found.|]
|
||||
|
||||
data InvalidBuildConfig = InvalidBuildConfig Text
|
||||
deriving Show
|
||||
|
||||
|
||||
instance Pretty InvalidBuildConfig where
|
||||
pPrint (InvalidBuildConfig reason) =
|
||||
text [i|The build config is invalid. Reason was: #{reason}|]
|
||||
|
||||
data NoToolVersionSet = NoToolVersionSet Tool
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoToolVersionSet where
|
||||
pPrint (NoToolVersionSet tool) =
|
||||
text [i|No version is set for tool "#{tool}".|]
|
||||
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
-------------------------
|
||||
|
||||
-- | A download failed. The underlying error is encapsulated.
|
||||
data DownloadFailed = forall es . Show (V es) => DownloadFailed (V es)
|
||||
data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs))
|
||||
|
||||
instance Pretty DownloadFailed where
|
||||
pPrint (DownloadFailed reason) =
|
||||
text "Download failed:" <+> pPrint reason
|
||||
|
||||
deriving instance Show DownloadFailed
|
||||
|
||||
@@ -145,12 +261,20 @@ deriving instance Show DownloadFailed
|
||||
-- | A build failed.
|
||||
data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es)
|
||||
|
||||
instance Pretty BuildFailed where
|
||||
pPrint (BuildFailed path reason) =
|
||||
text [i|BuildFailed failed in dir "#{decUTF8Safe . toFilePath $ path}": #{reason}|]
|
||||
|
||||
deriving instance Show BuildFailed
|
||||
|
||||
|
||||
-- | Setting the current GHC version failed.
|
||||
data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
|
||||
|
||||
instance Pretty GHCupSetError where
|
||||
pPrint (GHCupSetError reason) =
|
||||
text [i|Setting the current GHC version failed: #{reason}|]
|
||||
|
||||
deriving instance Show GHCupSetError
|
||||
|
||||
|
||||
@@ -163,11 +287,65 @@ deriving instance Show GHCupSetError
|
||||
data ParseError = ParseError String
|
||||
deriving Show
|
||||
|
||||
instance Pretty ParseError where
|
||||
pPrint (ParseError reason) =
|
||||
text [i|Parsing failed: #{reason}|]
|
||||
|
||||
instance Exception ParseError
|
||||
|
||||
|
||||
data UnexpectedListLength = UnexpectedListLength String
|
||||
deriving Show
|
||||
|
||||
instance Pretty UnexpectedListLength where
|
||||
pPrint (UnexpectedListLength reason) =
|
||||
text [i|List length unexpected: #{reason}|]
|
||||
|
||||
instance Exception UnexpectedListLength
|
||||
|
||||
|
||||
|
||||
------------------------
|
||||
--[ orphan instances ]--
|
||||
------------------------
|
||||
|
||||
instance Pretty (V '[]) where
|
||||
{-# INLINABLE pPrint #-}
|
||||
pPrint _ = undefined
|
||||
|
||||
instance
|
||||
( Pretty x
|
||||
, Pretty (V xs)
|
||||
) => Pretty (V (x ': xs))
|
||||
where
|
||||
pPrint v = case popVariantHead v of
|
||||
Right x -> pPrint x
|
||||
Left xs -> pPrint xs
|
||||
|
||||
instance Pretty URIParseError where
|
||||
pPrint (MalformedScheme reason) =
|
||||
text [i|Failed to parse URI. Malformed scheme: #{reason}|]
|
||||
pPrint MalformedUserInfo =
|
||||
text [i|Failed to parse URI. Malformed user info.|]
|
||||
pPrint MalformedQuery =
|
||||
text [i|Failed to parse URI. Malformed query.|]
|
||||
pPrint MalformedFragment =
|
||||
text [i|Failed to parse URI. Malformed fragment.|]
|
||||
pPrint MalformedHost =
|
||||
text [i|Failed to parse URI. Malformed host.|]
|
||||
pPrint MalformedPort =
|
||||
text [i|Failed to parse URI. Malformed port.|]
|
||||
pPrint MalformedPath =
|
||||
text [i|Failed to parse URI. Malformed path.|]
|
||||
pPrint (OtherError err) =
|
||||
text [i|Failed to parse URI: #{err}|]
|
||||
|
||||
#if !defined(TAR)
|
||||
instance Pretty ArchiveResult where
|
||||
pPrint ArchiveFatal = text "Archive result: fatal"
|
||||
pPrint ArchiveFailed = text "Archive result: failed"
|
||||
pPrint ArchiveWarn = text "Archive result: warning"
|
||||
pPrint ArchiveRetry = text "Archive result: retry"
|
||||
pPrint ArchiveOk = text "Archive result: Ok"
|
||||
pPrint ArchiveEOF = text "Archive result: EOF"
|
||||
#endif
|
||||
|
||||
@@ -1,6 +1,8 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types
|
||||
@@ -15,12 +17,16 @@ module GHCup.Types where
|
||||
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.String.Interpolate
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import HPath
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
import qualified GHC.Generics as GHC
|
||||
import qualified Graphics.Vty as Vty
|
||||
|
||||
@@ -106,13 +112,21 @@ data Tag = Latest
|
||||
| UnknownTag String -- ^ used for upwardscompat
|
||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||
|
||||
prettyTag :: Tag -> String
|
||||
prettyTag Recommended = "recommended"
|
||||
prettyTag Latest = "latest"
|
||||
prettyTag Prerelease = "prerelease"
|
||||
prettyTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
prettyTag (UnknownTag t ) = t
|
||||
prettyTag Old = ""
|
||||
tagToString :: Tag -> String
|
||||
tagToString Recommended = "recommended"
|
||||
tagToString Latest = "latest"
|
||||
tagToString Prerelease = "prerelease"
|
||||
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
tagToString (UnknownTag t ) = t
|
||||
tagToString Old = ""
|
||||
|
||||
instance Pretty Tag where
|
||||
pPrint Recommended = text "recommended"
|
||||
pPrint Latest = text "latest"
|
||||
pPrint Prerelease = text "prerelease"
|
||||
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
pPrint (UnknownTag t ) = text t
|
||||
pPrint Old = mempty
|
||||
|
||||
data Architecture = A_64
|
||||
| A_32
|
||||
@@ -124,15 +138,18 @@ data Architecture = A_64
|
||||
| A_ARM64
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
|
||||
prettyArch :: Architecture -> String
|
||||
prettyArch A_64 = "x86_64"
|
||||
prettyArch A_32 = "i386"
|
||||
prettyArch A_PowerPC = "powerpc"
|
||||
prettyArch A_PowerPC64 = "powerpc64"
|
||||
prettyArch A_Sparc = "sparc"
|
||||
prettyArch A_Sparc64 = "sparc64"
|
||||
prettyArch A_ARM = "arm"
|
||||
prettyArch A_ARM64 = "aarch64"
|
||||
archToString :: Architecture -> String
|
||||
archToString A_64 = "x86_64"
|
||||
archToString A_32 = "i386"
|
||||
archToString A_PowerPC = "powerpc"
|
||||
archToString A_PowerPC64 = "powerpc64"
|
||||
archToString A_Sparc = "sparc"
|
||||
archToString A_Sparc64 = "sparc64"
|
||||
archToString A_ARM = "arm"
|
||||
archToString A_ARM64 = "aarch64"
|
||||
|
||||
instance Pretty Architecture where
|
||||
pPrint = text . archToString
|
||||
|
||||
data Platform = Linux LinuxDistro
|
||||
-- ^ must exit
|
||||
@@ -141,10 +158,13 @@ data Platform = Linux LinuxDistro
|
||||
| FreeBSD
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
|
||||
prettyPlatfrom :: Platform -> String
|
||||
prettyPlatfrom (Linux distro) = "linux-" ++ prettyDistro distro
|
||||
prettyPlatfrom Darwin = "darwin"
|
||||
prettyPlatfrom FreeBSD = "freebsd"
|
||||
platformToString :: Platform -> String
|
||||
platformToString (Linux distro) = "linux-" ++ distroToString distro
|
||||
platformToString Darwin = "darwin"
|
||||
platformToString FreeBSD = "freebsd"
|
||||
|
||||
instance Pretty Platform where
|
||||
pPrint = text . platformToString
|
||||
|
||||
data LinuxDistro = Debian
|
||||
| Ubuntu
|
||||
@@ -162,18 +182,21 @@ data LinuxDistro = Debian
|
||||
-- ^ must exit
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
|
||||
prettyDistro :: LinuxDistro -> String
|
||||
prettyDistro Debian = "debian"
|
||||
prettyDistro Ubuntu = "ubuntu"
|
||||
prettyDistro Mint= "mint"
|
||||
prettyDistro Fedora = "fedora"
|
||||
prettyDistro CentOS = "centos"
|
||||
prettyDistro RedHat = "redhat"
|
||||
prettyDistro Alpine = "alpine"
|
||||
prettyDistro AmazonLinux = "amazon"
|
||||
prettyDistro Gentoo = "gentoo"
|
||||
prettyDistro Exherbo = "exherbo"
|
||||
prettyDistro UnknownLinux = "unknown"
|
||||
distroToString :: LinuxDistro -> String
|
||||
distroToString Debian = "debian"
|
||||
distroToString Ubuntu = "ubuntu"
|
||||
distroToString Mint= "mint"
|
||||
distroToString Fedora = "fedora"
|
||||
distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
distroToString Alpine = "alpine"
|
||||
distroToString AmazonLinux = "amazon"
|
||||
distroToString Gentoo = "gentoo"
|
||||
distroToString Exherbo = "exherbo"
|
||||
distroToString UnknownLinux = "unknown"
|
||||
|
||||
instance Pretty LinuxDistro where
|
||||
pPrint = text . distroToString
|
||||
|
||||
|
||||
-- | An encapsulation of a download. This can be used
|
||||
@@ -198,6 +221,10 @@ data TarDir = RealDir (Path Rel)
|
||||
| RegexDir String -- ^ will be compiled to regex, the first match will "win"
|
||||
deriving (Eq, Ord, GHC.Generic, Show)
|
||||
|
||||
instance Pretty TarDir where
|
||||
pPrint (RealDir path) = text [i|#{E.decodeUtf8With E.lenientDecode . toFilePath $ path}|]
|
||||
pPrint (RegexDir regex) = text regex
|
||||
|
||||
|
||||
-- | Where to fetch GHCupDownloads from.
|
||||
data URLSource = GHCupURL
|
||||
@@ -317,12 +344,15 @@ data PlatformResult = PlatformResult
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
prettyPlatform :: PlatformResult -> String
|
||||
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
|
||||
platResToString :: PlatformResult -> String
|
||||
platResToString PlatformResult { _platform = plat, _distroVersion = Just v' }
|
||||
= show plat <> ", " <> T.unpack (prettyV v')
|
||||
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
|
||||
platResToString PlatformResult { _platform = plat, _distroVersion = Nothing }
|
||||
= show plat
|
||||
|
||||
instance Pretty PlatformResult where
|
||||
pPrint = text . platResToString
|
||||
|
||||
data PlatformRequest = PlatformRequest
|
||||
{ _rArch :: Architecture
|
||||
, _rPlatform :: Platform
|
||||
@@ -330,14 +360,17 @@ data PlatformRequest = PlatformRequest
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
prettyPfReq :: PlatformRequest -> String
|
||||
prettyPfReq (PlatformRequest arch plat ver) =
|
||||
prettyArch arch ++ "-" ++ prettyPlatfrom plat ++ pver
|
||||
pfReqToString :: PlatformRequest -> String
|
||||
pfReqToString (PlatformRequest arch plat ver) =
|
||||
archToString arch ++ "-" ++ platformToString plat ++ pver
|
||||
where
|
||||
pver = case ver of
|
||||
Just v' -> "-" ++ (T.unpack $ prettyV v')
|
||||
Nothing -> ""
|
||||
|
||||
instance Pretty PlatformRequest where
|
||||
pPrint = text . pfReqToString
|
||||
|
||||
-- | A GHC identified by the target platform triple
|
||||
-- and the version.
|
||||
data GHCTargetVersion = GHCTargetVersion
|
||||
@@ -350,11 +383,13 @@ data GHCTargetVersion = GHCTargetVersion
|
||||
mkTVer :: Version -> GHCTargetVersion
|
||||
mkTVer = GHCTargetVersion Nothing
|
||||
|
||||
tVerToText :: GHCTargetVersion -> Text
|
||||
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
|
||||
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
|
||||
|
||||
-- | Assembles a path of the form: <target-triple>-<version>
|
||||
prettyTVer :: GHCTargetVersion -> Text
|
||||
prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
|
||||
prettyTVer (GHCTargetVersion Nothing v') = prettyVer v'
|
||||
instance Pretty GHCTargetVersion where
|
||||
pPrint = text . T.unpack . tVerToText
|
||||
|
||||
|
||||
-- | A comparator and a version.
|
||||
@@ -372,3 +407,9 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
|
||||
| OrRange (NonEmpty VersionCmp) VersionRange
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
|
||||
|
||||
instance Pretty Versioning where
|
||||
pPrint = text . T.unpack . prettyV
|
||||
|
||||
instance Pretty Version where
|
||||
pPrint = text . T.unpack . prettyVer
|
||||
|
||||
@@ -650,7 +650,7 @@ ghcToolFiles ver = do
|
||||
|
||||
-- fail if ghc is not installed
|
||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||
(throwE (NotInstalled GHC (prettyTVer ver)))
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO $ getDirsFiles' bindir
|
||||
-- figure out the <ver> suffix, because this might not be `Version` for
|
||||
|
||||
@@ -214,7 +214,7 @@ ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
|
||||
-> m (Path Abs)
|
||||
ghcupGHCDir ver = do
|
||||
ghcbasedir <- ghcupGHCBaseDir
|
||||
verdir <- parseRel $ E.encodeUtf8 (prettyTVer ver)
|
||||
verdir <- parseRel $ E.encodeUtf8 (tVerToText ver)
|
||||
pure (ghcbasedir </> verdir)
|
||||
|
||||
|
||||
|
||||
@@ -43,7 +43,7 @@ import GHC.IO.Exception
|
||||
import HPath
|
||||
import HPath.IO hiding ( hideError )
|
||||
import Optics hiding ((<|), (|>))
|
||||
import System.Console.Pretty
|
||||
import System.Console.Pretty hiding ( Pretty )
|
||||
import System.Console.Regions
|
||||
import System.IO.Error
|
||||
import System.Posix.Directory.ByteString
|
||||
@@ -55,6 +55,7 @@ import "unix" System.Posix.IO.ByteString
|
||||
hiding ( openFd )
|
||||
import System.Posix.Process ( ProcessStatus(..) )
|
||||
import System.Posix.Types
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
import Text.Regex.Posix
|
||||
|
||||
|
||||
@@ -79,6 +80,15 @@ data ProcessError = NonZeroExit Int ByteString [ByteString]
|
||||
| NoSuchPid ByteString [ByteString]
|
||||
deriving Show
|
||||
|
||||
instance Pretty ProcessError where
|
||||
pPrint (NonZeroExit e exe args) =
|
||||
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} failed with exit code #{e}.|]
|
||||
pPrint (PTerminated exe args) =
|
||||
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} terminated.|]
|
||||
pPrint (PStopped exe args) =
|
||||
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} stopped.|]
|
||||
pPrint (NoSuchPid exe args) =
|
||||
text [i|Could not find PID for process running "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args}.|]
|
||||
|
||||
data CapturedProcess = CapturedProcess
|
||||
{ _exitCode :: ExitCode
|
||||
|
||||
Reference in New Issue
Block a user