Compare commits
3 Commits
error-hand
...
issue-440
| Author | SHA1 | Date | |
|---|---|---|---|
|
e116a2392e
|
|||
|
7dd6f1f4a4
|
|||
|
4d82c37539
|
37
.github/scripts/common.sh
vendored
37
.github/scripts/common.sh
vendored
@@ -87,29 +87,39 @@ download_cabal_cache() {
|
|||||||
cd /tmp
|
cd /tmp
|
||||||
case "${RUNNER_OS}" in
|
case "${RUNNER_OS}" in
|
||||||
"Linux")
|
"Linux")
|
||||||
case "${ARCH}" in
|
case "${DISTRO}" in
|
||||||
"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
|
"Alpine")
|
||||||
|
case "${ARCH}" in
|
||||||
|
"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/i386-linux-alpine-cabal-cache-1.0.5.1
|
||||||
|
;;
|
||||||
|
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-linux-alpine-cabal-cache-1.0.5.1
|
||||||
|
;;
|
||||||
|
esac
|
||||||
;;
|
;;
|
||||||
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
|
*)
|
||||||
;;
|
case "${ARCH}" in
|
||||||
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-linux-cabal-cache
|
"64") url=https://github.com/haskell-works/cabal-cache/releases/download/v1.0.5.1/cabal-cache-x86_64-linux.gz
|
||||||
;;
|
;;
|
||||||
"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/armv7-linux-cabal-cache
|
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-linux-cabal-cache-1.0.5.1
|
||||||
|
;;
|
||||||
|
"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/armv7-linux-cabal-cache-1.0.5.1
|
||||||
|
;;
|
||||||
|
esac
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
"FreeBSD")
|
"FreeBSD")
|
||||||
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
|
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-freebsd-cabal-cache-1.0.5.1
|
||||||
;;
|
;;
|
||||||
"Windows")
|
"Windows")
|
||||||
exe=".exe"
|
exe=".exe"
|
||||||
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
|
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-mingw64-cabal-cache-1.0.5.1.exe
|
||||||
;;
|
;;
|
||||||
"macOS")
|
"macOS")
|
||||||
case "${ARCH}" in
|
case "${ARCH}" in
|
||||||
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
|
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-apple-darwin-cabal-cache-1.0.5.1
|
||||||
;;
|
;;
|
||||||
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
|
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-apple-darwin-cabal-cache-1.0.5.1
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
@@ -124,9 +134,8 @@ download_cabal_cache() {
|
|||||||
curl -o cabal-cache${exe} -L "${url}"
|
curl -o cabal-cache${exe} -L "${url}"
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
sha_sum cabal-cache${exe}
|
chmod +x cabal-cache${exe}
|
||||||
mv "cabal-cache${exe}" "${dest}${exe}"
|
cp "cabal-cache${exe}" "${dest}${exe}"
|
||||||
chmod +x "${dest}${exe}"
|
|
||||||
fi
|
fi
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|||||||
8
.github/workflows/release.yaml
vendored
8
.github/workflows/release.yaml
vendored
@@ -102,7 +102,7 @@ jobs:
|
|||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/ubuntu:focal
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
|
||||||
|
|
||||||
- name: git config
|
- name: git config
|
||||||
run: |
|
run: |
|
||||||
@@ -297,7 +297,7 @@ jobs:
|
|||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/ubuntu:focal
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
|
||||||
|
|
||||||
- name: Checkout code
|
- name: Checkout code
|
||||||
uses: actions/checkout@v3
|
uses: actions/checkout@v3
|
||||||
@@ -311,7 +311,7 @@ jobs:
|
|||||||
|
|
||||||
- if: matrix.ARCH == 'ARM'
|
- if: matrix.ARCH == 'ARM'
|
||||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
||||||
name: Run build (armv7 linux)
|
name: Run test (armv7 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
env:
|
env:
|
||||||
@@ -322,7 +322,7 @@ jobs:
|
|||||||
|
|
||||||
- if: matrix.ARCH == 'ARM64'
|
- if: matrix.ARCH == 'ARM64'
|
||||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
||||||
name: Run build (aarch64 linux)
|
name: Run test (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
env:
|
env:
|
||||||
|
|||||||
@@ -67,13 +67,13 @@ import URI.ByteString
|
|||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
{
|
{
|
||||||
-- global options
|
-- global options
|
||||||
optVerbose :: Maybe Bool
|
optVerbose :: Maybe Bool
|
||||||
, optCache :: Maybe Bool
|
, optCache :: Maybe Bool
|
||||||
, optMetaCache :: Maybe Integer
|
, optMetaCache :: Maybe Integer
|
||||||
|
, optMetaMode :: Maybe MetaMode
|
||||||
, optPlatform :: Maybe PlatformRequest
|
, optPlatform :: Maybe PlatformRequest
|
||||||
, optUrlSource :: Maybe URI
|
, optUrlSource :: Maybe URI
|
||||||
, optNoVerify :: Maybe Bool
|
, optNoVerify :: Maybe Bool
|
||||||
@@ -116,7 +116,8 @@ opts =
|
|||||||
Options
|
Options
|
||||||
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
|
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
|
||||||
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
|
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
|
||||||
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
|
<*> optional (option auto (long "metadata-caching" <> metavar "SEC" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable"))
|
||||||
|
<*> optional (option auto (long "metadata-fetching-mode" <> metavar "<Strict|Lax>" <> help "Whether to fail on metadata download failure (Strict) or fall back to cached version (Lax (default))"))
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader platformParser)
|
(eitherReader platformParser)
|
||||||
|
|||||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
configP :: Parser ConfigCommand
|
configP :: Parser ConfigCommand
|
||||||
configP = subparser
|
configP = subparser
|
||||||
( command "init" initP
|
( command "init" initP
|
||||||
@@ -124,6 +124,7 @@ updateSettings :: UserSettings -> Settings -> Settings
|
|||||||
updateSettings UserSettings{..} Settings{..} =
|
updateSettings UserSettings{..} Settings{..} =
|
||||||
let cache' = fromMaybe cache uCache
|
let cache' = fromMaybe cache uCache
|
||||||
metaCache' = fromMaybe metaCache uMetaCache
|
metaCache' = fromMaybe metaCache uMetaCache
|
||||||
|
metaMode' = fromMaybe metaMode uMetaMode
|
||||||
noVerify' = fromMaybe noVerify uNoVerify
|
noVerify' = fromMaybe noVerify uNoVerify
|
||||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||||
downloader' = fromMaybe downloader uDownloader
|
downloader' = fromMaybe downloader uDownloader
|
||||||
@@ -132,7 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
|
|||||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||||
platformOverride' = uPlatformOverride <|> platformOverride
|
platformOverride' = uPlatformOverride <|> platformOverride
|
||||||
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -79,6 +79,7 @@ toSettings options = do
|
|||||||
mergeConf Options{..} UserSettings{..} noColor =
|
mergeConf Options{..} UserSettings{..} noColor =
|
||||||
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
|
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
|
||||||
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
|
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
|
||||||
|
metaMode = fromMaybe (fromMaybe (Types.metaMode defaultSettings) uMetaMode) optMetaMode
|
||||||
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
|
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
|
||||||
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
|
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
|
||||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||||
|
|||||||
@@ -40,6 +40,12 @@ key-bindings:
|
|||||||
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
|
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
|
||||||
meta-cache: 300 # in seconds
|
meta-cache: 300 # in seconds
|
||||||
|
|
||||||
|
# When trying to download ghcup metadata, this option decides what to do
|
||||||
|
# when the download fails:
|
||||||
|
# 1. Lax: use existing ~/.ghcup/cache/ghcup-<ver>.yaml as fallback (default)
|
||||||
|
# 2. Strict: fail hard
|
||||||
|
meta-mode: Lax # Strict | Lax
|
||||||
|
|
||||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
||||||
# check the 'URLSource' type in the code.
|
# check the 'URLSource' type in the code.
|
||||||
url-source:
|
url-source:
|
||||||
|
|||||||
@@ -162,17 +162,21 @@ getBase :: ( MonadReader env m
|
|||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
|
-> Excepts '[DownloadFailed, GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
|
||||||
getBase uri = do
|
getBase uri = do
|
||||||
Settings { noNetwork, downloader } <- lift getSettings
|
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||||
|
|
||||||
-- try to download yaml... usually this writes it into cache dir,
|
-- try to download yaml... usually this writes it into cache dir,
|
||||||
-- but in some cases not (e.g. when using file://), so we honour
|
-- but in some cases not (e.g. when using file://), so we honour
|
||||||
-- the return filepath, if any
|
-- the return filepath, if any
|
||||||
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
||||||
then pure Nothing
|
then pure Nothing
|
||||||
else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
else handleIO (\e -> case metaMode of
|
||||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
Strict -> throwIO e
|
||||||
|
Lax -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
||||||
|
. catchE @_ @_ @'[DownloadFailed] (\e@(DownloadFailed _) -> case metaMode of
|
||||||
|
Strict -> throwE e
|
||||||
|
Lax -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
||||||
. fmap Just
|
. fmap Just
|
||||||
. smartDl
|
. smartDl
|
||||||
$ uri
|
$ uri
|
||||||
|
|||||||
@@ -297,10 +297,16 @@ instance NFData URLSource
|
|||||||
instance NFData (URIRef Absolute) where
|
instance NFData (URIRef Absolute) where
|
||||||
rnf (URI !_ !_ !_ !_ !_) = ()
|
rnf (URI !_ !_ !_ !_ !_) = ()
|
||||||
|
|
||||||
|
data MetaMode = Strict
|
||||||
|
| Lax
|
||||||
|
deriving (Show, Read, Eq, GHC.Generic)
|
||||||
|
|
||||||
|
instance NFData MetaMode
|
||||||
|
|
||||||
data UserSettings = UserSettings
|
data UserSettings = UserSettings
|
||||||
{ uCache :: Maybe Bool
|
{ uCache :: Maybe Bool
|
||||||
, uMetaCache :: Maybe Integer
|
, uMetaCache :: Maybe Integer
|
||||||
|
, uMetaMode :: Maybe MetaMode
|
||||||
, uNoVerify :: Maybe Bool
|
, uNoVerify :: Maybe Bool
|
||||||
, uVerbose :: Maybe Bool
|
, uVerbose :: Maybe Bool
|
||||||
, uKeepDirs :: Maybe KeepDirs
|
, uKeepDirs :: Maybe KeepDirs
|
||||||
@@ -314,13 +320,14 @@ data UserSettings = UserSettings
|
|||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
defaultUserSettings :: UserSettings
|
defaultUserSettings :: UserSettings
|
||||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
||||||
fromSettings Settings{..} Nothing =
|
fromSettings Settings{..} Nothing =
|
||||||
UserSettings {
|
UserSettings {
|
||||||
uCache = Just cache
|
uCache = Just cache
|
||||||
, uMetaCache = Just metaCache
|
, uMetaCache = Just metaCache
|
||||||
|
, uMetaMode = Just metaMode
|
||||||
, uNoVerify = Just noVerify
|
, uNoVerify = Just noVerify
|
||||||
, uVerbose = Just verbose
|
, uVerbose = Just verbose
|
||||||
, uKeepDirs = Just keepDirs
|
, uKeepDirs = Just keepDirs
|
||||||
@@ -346,6 +353,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
|||||||
in UserSettings {
|
in UserSettings {
|
||||||
uCache = Just cache
|
uCache = Just cache
|
||||||
, uMetaCache = Just metaCache
|
, uMetaCache = Just metaCache
|
||||||
|
, uMetaMode = Just metaMode
|
||||||
, uNoVerify = Just noVerify
|
, uNoVerify = Just noVerify
|
||||||
, uVerbose = Just verbose
|
, uVerbose = Just verbose
|
||||||
, uKeepDirs = Just keepDirs
|
, uKeepDirs = Just keepDirs
|
||||||
@@ -426,6 +434,7 @@ instance NFData LeanAppState
|
|||||||
data Settings = Settings
|
data Settings = Settings
|
||||||
{ cache :: Bool
|
{ cache :: Bool
|
||||||
, metaCache :: Integer
|
, metaCache :: Integer
|
||||||
|
, metaMode :: MetaMode
|
||||||
, noVerify :: Bool
|
, noVerify :: Bool
|
||||||
, keepDirs :: KeepDirs
|
, keepDirs :: KeepDirs
|
||||||
, downloader :: Downloader
|
, downloader :: Downloader
|
||||||
@@ -442,7 +451,7 @@ defaultMetaCache :: Integer
|
|||||||
defaultMetaCache = 300 -- 5 minutes
|
defaultMetaCache = 300 -- 5 minutes
|
||||||
|
|
||||||
defaultSettings :: Settings
|
defaultSettings :: Settings
|
||||||
defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
|
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
|
||||||
|
|
||||||
instance NFData Settings
|
instance NFData Settings
|
||||||
|
|
||||||
|
|||||||
@@ -43,6 +43,7 @@ import qualified Text.Megaparsec as MP
|
|||||||
import qualified Text.Megaparsec.Char as MPC
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
|
|
||||||
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
||||||
|
|||||||
@@ -465,22 +465,15 @@ withGHCupTmpDir :: ( MonadReader env m
|
|||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadIO m)
|
, MonadIO m)
|
||||||
=> m GHCupPath
|
=> m GHCupPath
|
||||||
withGHCupTmpDir = do
|
withGHCupTmpDir = snd <$> withRunInIO (\run ->
|
||||||
Settings{keepDirs} <- getSettings
|
run
|
||||||
snd <$> withRunInIO (\run ->
|
$ allocate
|
||||||
run
|
(run mkGhcupTmpDir)
|
||||||
$ allocate
|
(\fp ->
|
||||||
(run mkGhcupTmpDir)
|
handleIO (\e -> run
|
||||||
(\fp -> if -- we don't know whether there was a failure, so can only
|
$ logDebug ("Resource cleanup failed for " <> T.pack (fromGHCupPath fp) <> ", error was: " <> T.pack (displayException e)))
|
||||||
-- decide for 'Always'
|
. removePathForcibly
|
||||||
| keepDirs == Always -> pure ()
|
$ fp))
|
||||||
| otherwise -> handleIO (\e -> run
|
|
||||||
$ logDebug ("Resource cleanup failed for "
|
|
||||||
<> T.pack (fromGHCupPath fp)
|
|
||||||
<> ", error was: "
|
|
||||||
<> T.pack (displayException e)))
|
|
||||||
. removePathForcibly
|
|
||||||
$ fp))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user