Compare commits
27 Commits
issue-914
...
sunday-imp
| Author | SHA1 | Date | |
|---|---|---|---|
| e5a7a2da70 | |||
| 6047614a16 | |||
| 6a86e9e77e | |||
| 4132447e04 | |||
| 9d223730de | |||
| ad9199568b | |||
| 0d91c2ac14 | |||
| 8644ca41e1 | |||
|
|
6051c0cfbc | ||
| 67d977ce39 | |||
| 8b6b3d2fbe | |||
| a5d228ba89 | |||
| a7be1e7068 | |||
| 30a10d871a | |||
| 90b0281c1c | |||
|
|
bba92baeb1 | ||
| e06a1c03d4 | |||
| 0171f2e870 | |||
| dde32fa72e | |||
| 675ab17fff | |||
| 9fcacbd96b | |||
| ba4c6e5b99 | |||
| f2b139b58b | |||
| a44bf5884d | |||
| 64c1d63d33 | |||
| 0300d8f2cc | |||
|
|
bb395b652d |
16
CHANGELOG.md
16
CHANGELOG.md
@@ -1,8 +1,20 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.19.5 -- ????-?-??
|
||||
## 0.1.20.0 -- 2023-11-10
|
||||
|
||||
* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
|
||||
### New features
|
||||
|
||||
* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
|
||||
* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
|
||||
* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
|
||||
- you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
|
||||
|
||||
### Improvements and bug fixes
|
||||
|
||||
* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
|
||||
* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
|
||||
* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
|
||||
* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
|
||||
|
||||
## 0.1.19.4 -- 2023-7-02
|
||||
|
||||
|
||||
@@ -5,6 +5,8 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
|
||||
module BrickMain where
|
||||
|
||||
@@ -16,7 +18,6 @@ import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.OptParse.Common (logGHCPostRm)
|
||||
import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
@@ -49,7 +50,6 @@ import Data.Vector ( Vector
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.FilePath
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -61,9 +61,34 @@ import qualified Data.Text.Lazy as L
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
#if !IS_WINDOWS
|
||||
import GHCup.Prelude.File
|
||||
import System.FilePath
|
||||
import qualified System.Posix.Process as SPP
|
||||
#endif
|
||||
|
||||
|
||||
installedSign :: String
|
||||
#if IS_WINDOWS
|
||||
installedSign = "I "
|
||||
#else
|
||||
installedSign = "✓ "
|
||||
#endif
|
||||
|
||||
setSign :: String
|
||||
#if IS_WINDOWS
|
||||
setSign = "IS"
|
||||
#else
|
||||
setSign = "✔✔"
|
||||
#endif
|
||||
|
||||
notInstalledSign :: String
|
||||
#if IS_WINDOWS
|
||||
notInstalledSign = "X "
|
||||
#else
|
||||
notInstalledSign = "✗ "
|
||||
#endif
|
||||
|
||||
hiddenTools :: [Tool]
|
||||
hiddenTools = []
|
||||
|
||||
@@ -165,9 +190,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
|
||||
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
|
||||
let marks = if
|
||||
| lSet -> (withAttr (attrName "set") $ str "✔✔")
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str "✗ ")
|
||||
| lSet -> (withAttr (attrName "set") $ str setSign)
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str installedSign)
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str notInstalledSign)
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
@@ -500,12 +525,15 @@ install' _ (_, ListResult {..}) = do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
#if !IS_WINDOWS
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
|
||||
when ((normalise <$> up) == Just (normalise ce)) $
|
||||
-- TODO: track cli arguments of previous invocation
|
||||
liftIO $ SPP.executeFile ce False ["tui"] Nothing
|
||||
#else
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
#endif
|
||||
_ -> pure ()
|
||||
pure $ Right ()
|
||||
VRight (vi, _, _) -> do
|
||||
@@ -527,7 +555,35 @@ set' bs input@(_, ListResult {..}) = do
|
||||
|
||||
let run =
|
||||
flip runReaderT settings
|
||||
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, ArchiveResult
|
||||
, UnknownArchive
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, DirNotEmpty
|
||||
, NoUpdate
|
||||
, TarDirDoesNotExist
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
run (do
|
||||
case lTool of
|
||||
@@ -535,7 +591,12 @@ set' bs input@(_, ListResult {..}) = do
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
|
||||
Stack -> liftE $ setStack lVer $> ()
|
||||
GHCup -> pure ()
|
||||
GHCup -> do
|
||||
promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
|
||||
case promptAnswer of
|
||||
PromptYes -> do
|
||||
void $ liftE $ upgradeGHCup Nothing False False
|
||||
PromptNo -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
|
||||
@@ -4,35 +4,26 @@ optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/fosskers/versions.git
|
||||
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
if os(linux)
|
||||
package ghcup
|
||||
flags: +tui
|
||||
if arch(x86_64) || arch(i386)
|
||||
package *
|
||||
ghc-options: -split-sections -optl-static
|
||||
elif os(darwin)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static
|
||||
package ghcup
|
||||
flags: +tui
|
||||
elif os(mingw32)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static,
|
||||
text -simdutf
|
||||
package ghcup
|
||||
flags: -tui
|
||||
text -simdutf,
|
||||
vty-windows >=0.1.0.3
|
||||
elif os(freebsd)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
zip +disable-zstd
|
||||
package *
|
||||
ghc-options: -split-sections -pgmc clang++14
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0,
|
||||
|
||||
Submodule data/metadata updated: 2efadd4588...0239166c31
@@ -95,7 +95,7 @@ platform-override:
|
||||
|
||||
This is the complete list of env variables that change GHCup behavior:
|
||||
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
|
||||
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
|
||||
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
||||
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
||||
|
||||
@@ -255,7 +255,7 @@ This list may not be exhaustive and specifies support for bindists only.
|
||||
|
||||
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
||||
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
|
||||
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows 8.1 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
@@ -271,12 +271,11 @@ This list may not be exhaustive and specifies support for bindists only.
|
||||
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||
|
||||
### Windows 7
|
||||
### Windows <8.1
|
||||
|
||||
May or may not work, several issues:
|
||||
|
||||
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
|
||||
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
|
||||
No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7.
|
||||
According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
|
||||
version is now 8.1.
|
||||
|
||||
### WSL1
|
||||
|
||||
|
||||
21
ghcup.cabal
21
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 2.4
|
||||
name: ghcup
|
||||
version: 0.1.19.5
|
||||
version: 0.1.20.0
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -36,7 +36,7 @@ source-repository head
|
||||
|
||||
flag tui
|
||||
description:
|
||||
Build the brick powered tui (ghcup tui). This is disabled on windows.
|
||||
Build the brick powered tui (ghcup tui).
|
||||
|
||||
default: False
|
||||
manual: True
|
||||
@@ -86,7 +86,7 @@ common app-common-depends
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
@@ -190,7 +190,7 @@ library
|
||||
, unliftio-core ^>=0.2.0.1
|
||||
, unordered-containers ^>=0.2.10.0
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, vector ^>=0.12
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml-streamly ^>=0.12.0
|
||||
@@ -236,9 +236,9 @@ library
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
build-depends: vty ^>=5.39
|
||||
build-depends: vty ^>=6.0
|
||||
|
||||
library ghcup-optparse
|
||||
import: app-common-depends
|
||||
@@ -284,7 +284,7 @@ library ghcup-optparse
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
|
||||
if os(windows)
|
||||
@@ -320,14 +320,13 @@ executable ghcup
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
other-modules: BrickMain
|
||||
build-depends:
|
||||
, brick ^>=1.5
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, unix ^>=2.7
|
||||
, vty ^>=5.39
|
||||
, vty ^>=6.0
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
@@ -67,7 +67,6 @@ configP = subparser
|
||||
<> command "show" showP
|
||||
<> command "add-release-channel" addP
|
||||
)
|
||||
<|> argsP -- add show for a single option
|
||||
<|> pure ShowConfig
|
||||
where
|
||||
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
|
||||
@@ -193,10 +192,14 @@ config configCommand settings userConf keybindings runLogger = case configComman
|
||||
throwE $ ParseError "Empty values are not allowed"
|
||||
Nothing -> do
|
||||
usersettings <- decodeSettings k
|
||||
when (usersettings == defaultUserSettings)
|
||||
$ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
|
||||
lift $ doConfig usersettings
|
||||
pure ()
|
||||
Just v -> do
|
||||
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
|
||||
when (usersettings == defaultUserSettings)
|
||||
$ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
|
||||
lift $ doConfig usersettings
|
||||
pure ()
|
||||
case r of
|
||||
@@ -204,7 +207,9 @@ config configCommand settings userConf keybindings runLogger = case configComman
|
||||
VLeft (V (JSONDecodeError e)) -> do
|
||||
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
VLeft e -> do
|
||||
runLogger (logError $ T.pack $ prettyHFError e)
|
||||
pure $ ExitFailure 65
|
||||
|
||||
AddReleaseChannel force new -> do
|
||||
r <- runE @'[DuplicateReleaseChannel] $ do
|
||||
|
||||
@@ -199,19 +199,19 @@ prefetch prefetchCommand runAppState runLogger =
|
||||
(v, _) <- liftE $ fromVersion mt GHC
|
||||
if pfGHCSrc
|
||||
then liftE $ fetchGHCSrc v pfCacheDir
|
||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
||||
else liftE $ fetchToolBindist v GHC pfCacheDir
|
||||
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Cabal
|
||||
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
|
||||
liftE $ fetchToolBindist v Cabal pfCacheDir
|
||||
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt HLS
|
||||
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
|
||||
liftE $ fetchToolBindist v HLS pfCacheDir
|
||||
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Stack
|
||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
||||
liftE $ fetchToolBindist v Stack pfCacheDir
|
||||
PrefetchMetadata -> do
|
||||
pfreq <- lift getPlatformReq
|
||||
_ <- liftE $ getDownloadsF pfreq
|
||||
|
||||
@@ -100,7 +100,7 @@ fetchToolBindist :: ( MonadFail m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
=> GHCTargetVersion
|
||||
-> Tool
|
||||
-> Maybe FilePath
|
||||
-> Excepts
|
||||
@@ -113,7 +113,7 @@ fetchToolBindist :: ( MonadFail m
|
||||
m
|
||||
FilePath
|
||||
fetchToolBindist v t mfp = do
|
||||
dlinfo <- liftE $ getDownloadInfo t v
|
||||
dlinfo <- liftE $ getDownloadInfo' t v
|
||||
liftE $ downloadCached' dlinfo Nothing mfp
|
||||
|
||||
|
||||
|
||||
@@ -149,12 +149,16 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||
-> Excepts
|
||||
'[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
|
||||
m (Either GHCupInfo Stack.SetupInfo)
|
||||
dl' NewGHCupURL = fmap Left $ liftE $ getBase @GHCupInfo ghcupURL
|
||||
dl' NewStackSetupURL = fmap Right $ liftE $ getBase @Stack.SetupInfo stackSetupURL
|
||||
dl' NewGHCupURL = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
|
||||
dl' NewStackSetupURL = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
|
||||
dl' (NewGHCupInfo gi) = pure (Left gi)
|
||||
dl' (NewSetupInfo si) = pure (Right si)
|
||||
dl' (NewURI uri) = catchE @JSONError (\(JSONDecodeError _) -> Right <$> getBase @Stack.SetupInfo uri)
|
||||
$ fmap Left $ getBase @GHCupInfo uri
|
||||
dl' (NewURI uri) = do
|
||||
base <- liftE $ getBase uri
|
||||
catchE @JSONError (\(JSONDecodeError _) -> do
|
||||
logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
|
||||
Right <$> decodeMetadata @Stack.SetupInfo base)
|
||||
$ fmap Left $ decodeMetadata @GHCupInfo base
|
||||
|
||||
fromStackSetupInfo :: MonadThrow m
|
||||
=> Stack.SetupInfo
|
||||
@@ -201,7 +205,7 @@ etagsFile :: FilePath -> FilePath
|
||||
etagsFile = (<.> "etags")
|
||||
|
||||
|
||||
getBase :: forall j m env . ( MonadReader env m
|
||||
getBase :: forall m env . ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadFail m
|
||||
@@ -209,10 +213,9 @@ getBase :: forall j m env . ( MonadReader env m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, FromJSON j
|
||||
)
|
||||
=> URI
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
|
||||
getBase uri = do
|
||||
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||
|
||||
@@ -232,25 +235,8 @@ getBase uri = do
|
||||
$ uri
|
||||
|
||||
-- if we didn't get a filepath from the download, use the cached yaml
|
||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||
|
||||
liftE
|
||||
. onE_ (onError actualYaml)
|
||||
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. liftIO
|
||||
. Y.decodeFileEither
|
||||
$ actualYaml
|
||||
maybe (lift $ yamlFromCache uri) pure mYaml
|
||||
where
|
||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||
-- may re-download and succeed.
|
||||
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
||||
onError fp = do
|
||||
let efp = etagsFile fp
|
||||
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||
(hideError doesNotExistErrorType $ rmFile efp)
|
||||
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||
|
||||
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
|
||||
warnCache s downloader' = do
|
||||
let tryDownloder = case downloader' of
|
||||
@@ -322,6 +308,39 @@ getBase uri = do
|
||||
|
||||
pure f
|
||||
|
||||
decodeMetadata :: forall j m env .
|
||||
( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, FromJSON j
|
||||
)
|
||||
=> FilePath
|
||||
-> Excepts '[JSONError, FileDoesNotExistError] m j
|
||||
decodeMetadata actualYaml = do
|
||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||
|
||||
liftE
|
||||
. onE_ (onError actualYaml)
|
||||
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. liftIO
|
||||
. Y.decodeFileEither
|
||||
$ actualYaml
|
||||
where
|
||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||
-- may re-download and succeed.
|
||||
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
||||
onError fp = do
|
||||
let efp = etagsFile fp
|
||||
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||
(hideError doesNotExistErrorType $ rmFile efp)
|
||||
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||
|
||||
|
||||
getDownloadInfo :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
|
||||
@@ -724,7 +724,7 @@ data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorPr
|
||||
|
||||
instance Pretty InstallSetError where
|
||||
pPrint (InstallSetError reason1 reason2) =
|
||||
text "Both installation and setting the tool failed. Install error was:"
|
||||
text "Both installation and setting the tool failed.\nInstall error was:"
|
||||
<+> pPrint reason1
|
||||
<+> text "\nSet error was:"
|
||||
<+> pPrint reason2
|
||||
|
||||
@@ -234,7 +234,7 @@ setStack ver = do
|
||||
|
||||
liftIO (isShadowed stackbin) >>= \case
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -398,7 +398,7 @@ data UserSettings = UserSettings
|
||||
, uPlatformOverride :: Maybe PlatformRequest
|
||||
, uMirrors :: Maybe DownloadMirrors
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
defaultUserSettings :: UserSettings
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
@@ -459,7 +459,7 @@ data UserKeyBindings = UserKeyBindings
|
||||
, kShowAll :: Maybe KeyCombination
|
||||
, kShowAllTools :: Maybe KeyCombination
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
data KeyBindings = KeyBindings
|
||||
{ bUp :: KeyCombination
|
||||
@@ -475,7 +475,7 @@ data KeyBindings = KeyBindings
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData KeyBindings
|
||||
#if defined(IS_WINDOWS) || !defined(BRICK)
|
||||
#if !defined(BRICK)
|
||||
instance NFData Key
|
||||
|
||||
instance NFData Modifier
|
||||
|
||||
@@ -50,7 +50,7 @@ instance FromJSON SetupInfo where
|
||||
siSevenzExe <- o .:? "sevenzexe-info"
|
||||
siSevenzDll <- o .:? "sevenzdll-info"
|
||||
siMsys2 <- o .:? "msys2" .!= mempty
|
||||
siGHCs <- o .:? "ghc" .!= mempty
|
||||
siGHCs <- o .: "ghc"
|
||||
siStack <- o .:? "stack" .!= mempty
|
||||
pure SetupInfo {..}
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.19.4"
|
||||
ghver="0.1.20.0"
|
||||
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -172,9 +172,8 @@ _done() {
|
||||
green "Start a new haskell project in the current directory via:"
|
||||
green " cabal init --interactive"
|
||||
green
|
||||
green "Install other GHC versions and tools via:"
|
||||
green " ghcup list"
|
||||
green " ghcup install <tool> <version>"
|
||||
green "To install other GHC versions and tools, run:"
|
||||
green " ghcup tui"
|
||||
green
|
||||
green "To install system libraries and update msys2/mingw64,"
|
||||
green "open the \"Mingw haskell shell\""
|
||||
|
||||
Reference in New Issue
Block a user