Compare commits
45 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
283f2a6e46
|
|||
|
94637dfbab
|
|||
|
3e26d7057c
|
|||
|
3f710112f3
|
|||
|
34df41b44a
|
|||
|
3897434ef0
|
|||
|
375dba9dd1
|
|||
|
2edd1fb583
|
|||
|
11326060fb
|
|||
|
d343c01737
|
|||
|
3925f78721
|
|||
|
d98e54a743
|
|||
|
13143b8e4d
|
|||
|
3a7895e5ea
|
|||
|
2893b2e2d2
|
|||
|
987436fed2
|
|||
|
96ac66e909
|
|||
|
e5947f3490
|
|||
|
b35fe15703
|
|||
|
a269b60282
|
|||
|
fc6f7ffd73
|
|||
|
430dc2d20b
|
|||
|
77c464870f
|
|||
|
dda38ec52b
|
|||
|
|
f6b6b36eb7 | ||
|
|
3986677b06 | ||
|
1fb048777c
|
|||
|
e9c335eecc
|
|||
|
a7c7186aa4
|
|||
|
e38bd61066
|
|||
|
b086261c3c
|
|||
|
8c098d4e17
|
|||
|
e3a9c095c6
|
|||
|
678bdd7915
|
|||
|
14fc6b7281
|
|||
|
a2555cecc5
|
|||
|
9d6e469f79
|
|||
|
982c0a0fcf
|
|||
|
f8cfcd4038
|
|||
|
4d465efef1
|
|||
|
d667160027
|
|||
|
|
df55d972cf | ||
|
|
df758d828b | ||
|
7bc00c4e68
|
|||
|
|
8c486e8d46 |
@@ -14,7 +14,7 @@ variables:
|
|||||||
############################################################
|
############################################################
|
||||||
|
|
||||||
.debian:
|
.debian:
|
||||||
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
|
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
|
||||||
tags:
|
tags:
|
||||||
- x86_64-linux
|
- x86_64-linux
|
||||||
variables:
|
variables:
|
||||||
@@ -99,7 +99,7 @@ variables:
|
|||||||
script:
|
script:
|
||||||
- bash ./.gitlab/script/ghcup_version.sh
|
- bash ./.gitlab/script/ghcup_version.sh
|
||||||
variables:
|
variables:
|
||||||
JSON_VERSION: "0.0.6"
|
JSON_VERSION: "0.0.7"
|
||||||
artifacts:
|
artifacts:
|
||||||
expire_in: 2 week
|
expire_in: 2 week
|
||||||
paths:
|
paths:
|
||||||
@@ -207,7 +207,7 @@ variables:
|
|||||||
only:
|
only:
|
||||||
- tags
|
- tags
|
||||||
variables:
|
variables:
|
||||||
JSON_VERSION: "0.0.6"
|
JSON_VERSION: "0.0.7"
|
||||||
|
|
||||||
######## stack test ########
|
######## stack test ########
|
||||||
|
|
||||||
@@ -527,15 +527,9 @@ release:windows:
|
|||||||
hlint:
|
hlint:
|
||||||
stage: hlint
|
stage: hlint
|
||||||
extends:
|
extends:
|
||||||
- .alpine:64bit
|
- .debian
|
||||||
before_script:
|
|
||||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
|
||||||
script:
|
script:
|
||||||
- ./.gitlab/script/hlint.sh
|
- curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
|
||||||
variables:
|
|
||||||
GHC_VERSION: "8.10.6"
|
|
||||||
CABAL_VERSION: "3.4.0.0"
|
|
||||||
JSON_VERSION: "0.0.4"
|
|
||||||
allow_failure: true
|
allow_failure: true
|
||||||
artifacts:
|
artifacts:
|
||||||
expire_in: 2 week
|
expire_in: 2 week
|
||||||
|
|||||||
@@ -52,3 +52,7 @@ apk add --no-cache \
|
|||||||
xz-dev \
|
xz-dev \
|
||||||
ncurses-static
|
ncurses-static
|
||||||
|
|
||||||
|
if [ "${ARCH}" = "32" ] ; then
|
||||||
|
apk add --no-cache \
|
||||||
|
bsd-compat-headers
|
||||||
|
fi
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -18,7 +18,7 @@ ecabal update
|
|||||||
|
|
||||||
if [ "${OS}" = "LINUX" ] ; then
|
if [ "${OS}" = "LINUX" ] ; then
|
||||||
if [ "${ARCH}" = "32" ] ; then
|
if [ "${ARCH}" = "32" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
|
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||||
elif [ "${ARCH}" = "64" ] ; then
|
elif [ "${ARCH}" = "64" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||||
else
|
else
|
||||||
|
|||||||
@@ -42,22 +42,25 @@ if [ "${OS}" = "DARWIN" ] ; then
|
|||||||
ecabal haddock -w ghc-${GHC_VERSION} -ftui
|
ecabal haddock -w ghc-${GHC_VERSION} -ftui
|
||||||
elif [ "${OS}" = "LINUX" ] ; then
|
elif [ "${OS}" = "LINUX" ] ; then
|
||||||
if [ "${ARCH}" = "32" ] ; then
|
if [ "${ARCH}" = "32" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
|
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test
|
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
||||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
|
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||||
else
|
else
|
||||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
||||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||||
|
|
||||||
# doctest
|
if [ "${ARCH}" = "64" ] ; then
|
||||||
curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz > cabal-docspec.xz
|
# doctest
|
||||||
echo '0829bd034fba901cbcfe491d98ed8b28fd54f9cb5c91fa8e1ac62dc4413c9562 cabal-docspec.xz' | sha256sum -c -
|
curl -sL https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-docspec/cabal-docspec-0.0.0.20210228_p1.tar.bz2 > cabal-docspec.tar.bz2
|
||||||
xz -d < cabal-docspec.xz > "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
echo '3a10f6fec16dbd18efdd331b1cef5d2d342082da42f5b520726d1fa6a3990d12 cabal-docspec.tar.bz2' | sha256sum -c -
|
||||||
rm -f cabal-docspec.xz
|
tar -xjf cabal-docspec.tar.bz2 cabal-docspec
|
||||||
chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
mv cabal-docspec "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
||||||
|
rm -f cabal-docspec.tar.bz2
|
||||||
|
chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
||||||
|
|
||||||
cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
|
cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
|
||||||
|
fi
|
||||||
fi
|
fi
|
||||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
|
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
|
||||||
|
|||||||
121
README.md
121
README.md
@@ -24,6 +24,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
|||||||
* [Env variables](#env-variables)
|
* [Env variables](#env-variables)
|
||||||
* [Installing custom bindists](#installing-custom-bindists)
|
* [Installing custom bindists](#installing-custom-bindists)
|
||||||
* [Isolated Installs](#isolated-installs)
|
* [Isolated Installs](#isolated-installs)
|
||||||
|
* [CI](#ci)
|
||||||
* [Tips and tricks](#tips-and-tricks)
|
* [Tips and tricks](#tips-and-tricks)
|
||||||
* [Design goals](#design-goals)
|
* [Design goals](#design-goals)
|
||||||
* [How](#how)
|
* [How](#how)
|
||||||
@@ -190,6 +191,126 @@ Examples:-
|
|||||||
5. you can even compile ghc to an isolated location.
|
5. you can even compile ghc to an isolated location.
|
||||||
- `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
|
- `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
|
||||||
---
|
---
|
||||||
|
|
||||||
|
### CI
|
||||||
|
|
||||||
|
On windows, ghcup can be installed automatically on a CI runner like so:
|
||||||
|
|
||||||
|
```ps
|
||||||
|
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
|
||||||
|
```
|
||||||
|
|
||||||
|
On linux/darwin/freebsd, run the following on your runner:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||||
|
```
|
||||||
|
|
||||||
|
This will just install `ghcup` and on windows additionally `msys2`.
|
||||||
|
|
||||||
|
#### Example github workflow
|
||||||
|
|
||||||
|
On github workflows you can use https://github.com/haskell/actions/
|
||||||
|
|
||||||
|
If you want to install ghcup manually though, here's an example config:
|
||||||
|
|
||||||
|
```yml
|
||||||
|
name: Haskell CI
|
||||||
|
|
||||||
|
on:
|
||||||
|
push:
|
||||||
|
branches: [ master ]
|
||||||
|
pull_request:
|
||||||
|
branches: [ master ]
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
build-cabal:
|
||||||
|
|
||||||
|
runs-on: ${{ matrix.os }}
|
||||||
|
strategy:
|
||||||
|
fail-fast: false
|
||||||
|
matrix:
|
||||||
|
os: [ubuntu-latest, macOS-latest, windows-latest]
|
||||||
|
ghc: ['8.10.7', '9.0.1']
|
||||||
|
cabal: ['3.4.0.0']
|
||||||
|
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v2
|
||||||
|
|
||||||
|
- if: matrix.os == 'windows-latest'
|
||||||
|
name: Install ghcup on windows
|
||||||
|
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
|
||||||
|
|
||||||
|
- if: matrix.os != 'windows-latest'
|
||||||
|
name: Install ghcup on non-windows
|
||||||
|
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||||
|
|
||||||
|
- if: matrix.os == 'windows-latest'
|
||||||
|
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Install ghc/cabal
|
||||||
|
run: |
|
||||||
|
ghcup install ghc ${{ matrix.ghc }}
|
||||||
|
ghcup install cabal ${{ matrix.cabal }}
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Update cabal index
|
||||||
|
run: cabal update
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Build
|
||||||
|
run: cabal build --enable-tests --enable-benchmarks
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Run tests
|
||||||
|
run: cabal test
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Run benches
|
||||||
|
run: cabal bench
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
build-stack:
|
||||||
|
name: Stack ${{ matrix.stack }} ${{ matrix.os }}
|
||||||
|
runs-on: ${{ matrix.os }}
|
||||||
|
strategy:
|
||||||
|
fail-fast: false
|
||||||
|
matrix:
|
||||||
|
os: [ubuntu-latest, macOS-latest, windows-latest]
|
||||||
|
stack: ['latest']
|
||||||
|
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v2
|
||||||
|
|
||||||
|
- if: matrix.os == 'windows-latest'
|
||||||
|
name: Install ghcup on windows
|
||||||
|
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
|
||||||
|
|
||||||
|
- if: matrix.os != 'windows-latest'
|
||||||
|
name: Install ghcup on non-windows
|
||||||
|
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||||
|
|
||||||
|
- if: matrix.os == 'windows-latest'
|
||||||
|
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Install stack
|
||||||
|
run: ghcup install stack ${{ matrix.stack }}
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Build
|
||||||
|
run: stack build
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Run tests
|
||||||
|
run: stack test
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Run benches
|
||||||
|
run: stack bench
|
||||||
|
shell: bash
|
||||||
|
```
|
||||||
|
|
||||||
### Tips and tricks
|
### Tips and tricks
|
||||||
|
|
||||||
|
|||||||
@@ -11,22 +11,31 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.Optics
|
||||||
|
import GHCup.Errors
|
||||||
|
import GHCup.Platform
|
||||||
|
import GHCup.Utils.Dirs
|
||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Utils.Logger
|
|
||||||
|
|
||||||
|
import Control.Monad.Trans.Reader ( runReaderT )
|
||||||
|
import Control.Monad.IO.Class
|
||||||
import Data.Char ( toLower )
|
import Data.Char ( toLower )
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Data.Semigroup ( (<>) )
|
import Data.Semigroup ( (<>) )
|
||||||
#endif
|
#endif
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
|
import Haskus.Utils.Variant.Excepts
|
||||||
import System.Console.Pretty
|
import System.Console.Pretty
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO ( stdout )
|
import System.IO ( stderr )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import Validate
|
import Validate
|
||||||
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
|
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.YAML.Aeson as Y
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
@@ -105,10 +114,27 @@ com = subparser
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||||
|
, colorOutter = T.hPutStr stderr
|
||||||
|
, rawOutter = \_ -> pure ()
|
||||||
|
}
|
||||||
|
dirs <- liftIO getAllDirs
|
||||||
|
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig
|
||||||
|
|
||||||
|
pfreq <- (
|
||||||
|
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
|
||||||
|
) >>= \case
|
||||||
|
VRight r -> pure r
|
||||||
|
VLeft e -> do
|
||||||
|
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
|
||||||
|
liftIO $ exitWith (ExitFailure 2)
|
||||||
|
|
||||||
|
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
||||||
|
|
||||||
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
||||||
>>= \Options {..} -> case optCommand of
|
>>= \Options {..} -> case optCommand of
|
||||||
ValidateYAML vopts -> withValidateYamlOpts vopts validate
|
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
|
||||||
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter)
|
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
where
|
where
|
||||||
@@ -120,8 +146,8 @@ main = do
|
|||||||
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
||||||
B.readFile file >>= valAndExit f
|
B.readFile file >>= valAndExit f
|
||||||
valAndExit f contents = do
|
valAndExit f contents = do
|
||||||
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
|
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
|
||||||
Right r -> pure r
|
Right r -> pure r
|
||||||
Left e -> die (color Red $ show e)
|
Left (_, e) -> die (color Red $ show e)
|
||||||
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av gt)
|
f av gt
|
||||||
>>= exitWith
|
>>= exitWith
|
||||||
|
|||||||
@@ -5,29 +5,23 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Validate where
|
module Validate where
|
||||||
|
|
||||||
import GHCup
|
import GHCup
|
||||||
import GHCup.Download
|
import GHCup.Download
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Platform
|
import GHCup.Types
|
||||||
import GHCup.Types hiding ( LeanAppState (..) )
|
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import GHCup.Utils.Logger
|
|
||||||
import GHCup.Utils.Version.QQ
|
import GHCup.Utils.Version.QQ
|
||||||
|
|
||||||
#if defined(TAR)
|
|
||||||
import qualified Codec.Archive.Tar as Tar
|
|
||||||
#else
|
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#endif
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader.Class
|
import Control.Monad.Reader.Class
|
||||||
import Control.Monad.Trans.Class ( lift )
|
import Control.Monad.Trans.Class ( lift )
|
||||||
import Control.Monad.Trans.Reader ( runReaderT )
|
import Control.Monad.Trans.Reader ( runReaderT )
|
||||||
@@ -37,18 +31,15 @@ import Control.Monad.Trans.Resource ( runResourceT
|
|||||||
import Data.Containers.ListUtils ( nubOrd )
|
import Data.Containers.ListUtils ( nubOrd )
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
|
||||||
import Text.ParserCombinators.ReadP
|
import Text.ParserCombinators.ReadP
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Version as V
|
import qualified Data.Version as V
|
||||||
@@ -66,7 +57,7 @@ addError = do
|
|||||||
liftIO $ modifyIORef ref (+ 1)
|
liftIO $ modifyIORef ref (+ 1)
|
||||||
|
|
||||||
|
|
||||||
validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m)
|
validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
|
||||||
=> GHCupDownloads
|
=> GHCupDownloads
|
||||||
-> M.Map GlobalTool DownloadInfo
|
-> M.Map GlobalTool DownloadInfo
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
@@ -93,24 +84,23 @@ validate dls _ = do
|
|||||||
if e > 0
|
if e > 0
|
||||||
then pure $ ExitFailure e
|
then pure $ ExitFailure e
|
||||||
else do
|
else do
|
||||||
lift $ $(logInfo) [i|All good|]
|
lift $ logInfo "All good"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
where
|
where
|
||||||
checkHasRequiredPlatforms t v tags arch pspecs = do
|
checkHasRequiredPlatforms t v tags arch pspecs = do
|
||||||
let v' = prettyVer v
|
let v' = prettyVer v
|
||||||
arch' = prettyShow arch
|
arch' = prettyShow arch
|
||||||
when (notElem (Linux UnknownLinux) pspecs) $ do
|
when (notElem (Linux UnknownLinux) pspecs) $ do
|
||||||
lift $ $(logError)
|
lift $ logError $
|
||||||
[i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
|
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||||
addError
|
addError
|
||||||
when ((notElem Darwin pspecs) && arch == A_64) $ do
|
when ((notElem Darwin pspecs) && arch == A_64) $ do
|
||||||
lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|]
|
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||||
addError
|
addError
|
||||||
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn)
|
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
|
||||||
[i|FreeBSD missing for #{t} #{v'} #{arch'}|]
|
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||||
when (notElem Windows pspecs && arch == A_64) $ do
|
when (notElem Windows pspecs && arch == A_64) $ do
|
||||||
lift $ $(logError)
|
lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||||
[i|Windows missing for for #{t} #{v'} #{arch'}|]
|
|
||||||
addError
|
addError
|
||||||
|
|
||||||
-- alpine needs to be set explicitly, because
|
-- alpine needs to be set explicitly, because
|
||||||
@@ -118,12 +108,12 @@ validate dls _ = do
|
|||||||
-- (although it could be static)
|
-- (although it could be static)
|
||||||
when (notElem (Linux Alpine) pspecs) $
|
when (notElem (Linux Alpine) pspecs) $
|
||||||
case t of
|
case t of
|
||||||
GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
|
GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
|
||||||
Cabal | v > [vver|2.4.1.0|]
|
Cabal | v > [vver|2.4.1.0|]
|
||||||
, arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError
|
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
|
||||||
GHC | Latest `elem` tags || Recommended `elem` tags
|
GHC | Latest `elem` tags || Recommended `elem` tags
|
||||||
, arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|])
|
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
|
||||||
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
|
_ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
|
||||||
|
|
||||||
checkUniqueTags tool = do
|
checkUniqueTags tool = do
|
||||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||||
@@ -143,7 +133,7 @@ validate dls _ = do
|
|||||||
case join nonUnique of
|
case join nonUnique of
|
||||||
[] -> pure ()
|
[] -> pure ()
|
||||||
xs -> do
|
xs -> do
|
||||||
lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|]
|
lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
|
||||||
addError
|
addError
|
||||||
where
|
where
|
||||||
isUniqueTag Latest = True
|
isUniqueTag Latest = True
|
||||||
@@ -159,7 +149,7 @@ validate dls _ = do
|
|||||||
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
|
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
|
||||||
[_] -> pure ()
|
[_] -> pure ()
|
||||||
_ -> do
|
_ -> do
|
||||||
lift $ $(logError) [i|GHC version #{v} is not valid |]
|
lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
|
||||||
addError
|
addError
|
||||||
|
|
||||||
-- a tool must have at least one of each mandatory tags
|
-- a tool must have at least one of each mandatory tags
|
||||||
@@ -167,7 +157,7 @@ validate dls _ = do
|
|||||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||||
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
|
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
|
||||||
False -> do
|
False -> do
|
||||||
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
|
lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
|
||||||
addError
|
addError
|
||||||
True -> pure ()
|
True -> pure ()
|
||||||
|
|
||||||
@@ -176,7 +166,7 @@ validate dls _ = do
|
|||||||
let allTags = M.toList $ availableToolVersions dls GHC
|
let allTags = M.toList $ availableToolVersions dls GHC
|
||||||
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
|
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
|
||||||
False -> do
|
False -> do
|
||||||
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
|
lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
|
||||||
addError
|
addError
|
||||||
True -> pure ()
|
True -> pure ()
|
||||||
|
|
||||||
@@ -189,7 +179,10 @@ data TarballFilter = TarballFilter
|
|||||||
}
|
}
|
||||||
|
|
||||||
validateTarballs :: ( Monad m
|
validateTarballs :: ( Monad m
|
||||||
, MonadLogger m
|
, MonadReader env m
|
||||||
|
, HasLog env
|
||||||
|
, HasDirs env
|
||||||
|
, HasSettings env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -204,53 +197,41 @@ validateTarballs :: ( Monad m
|
|||||||
validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||||
ref <- liftIO $ newIORef 0
|
ref <- liftIO $ newIORef 0
|
||||||
|
|
||||||
flip runReaderT ref $ do
|
-- download/verify all tarballs
|
||||||
-- download/verify all tarballs
|
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
|
||||||
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
|
let gdlis = nubOrd $ gt ^.. each
|
||||||
let gdlis = nubOrd $ gt ^.. each
|
let allDls = either (const gdlis) (const dlis) etool
|
||||||
let allDls = either (const gdlis) (const dlis) etool
|
when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
|
||||||
when (null allDls) $ $(logError) [i|no tarballs selected by filter|] *> addError
|
forM_ allDls (downloadAll ref)
|
||||||
forM_ allDls downloadAll
|
|
||||||
|
|
||||||
-- exit
|
-- exit
|
||||||
e <- liftIO $ readIORef ref
|
e <- liftIO $ readIORef ref
|
||||||
if e > 0
|
if e > 0
|
||||||
then pure $ ExitFailure e
|
then pure $ ExitFailure e
|
||||||
else do
|
else do
|
||||||
lift $ $(logInfo) [i|All good|]
|
logInfo "All good"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
|
||||||
where
|
where
|
||||||
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
downloadAll :: ( MonadUnliftIO m
|
||||||
, colorOutter = B.hPut stderr
|
, MonadIO m
|
||||||
, rawOutter = \_ -> pure ()
|
, MonadReader env m
|
||||||
}
|
, HasLog env
|
||||||
downloadAll dli = do
|
, HasDirs env
|
||||||
dirs <- liftIO getAllDirs
|
, HasSettings env
|
||||||
|
, MonadCatch m
|
||||||
pfreq <- (
|
, MonadMask m
|
||||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
, MonadThrow m
|
||||||
) >>= \case
|
)
|
||||||
VRight r -> pure r
|
=> IORef Int
|
||||||
VLeft e -> do
|
-> DownloadInfo
|
||||||
lift $ runLogger
|
-> m ()
|
||||||
($(logError) $ T.pack $ prettyShow e)
|
downloadAll ref dli = do
|
||||||
liftIO $ exitWith (ExitFailure 2)
|
r <- runResourceT
|
||||||
|
|
||||||
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
|
|
||||||
|
|
||||||
r <-
|
|
||||||
runLogger
|
|
||||||
. flip runReaderT appstate
|
|
||||||
. runResourceT
|
|
||||||
. runE @'[DigestError
|
. runE @'[DigestError
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
#if defined(TAR)
|
|
||||||
, Tar.FormatError
|
|
||||||
#else
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
$ do
|
$ do
|
||||||
case etool of
|
case etool of
|
||||||
@@ -272,26 +253,26 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
|||||||
VRight (Just basePath) -> do
|
VRight (Just basePath) -> do
|
||||||
case _dlSubdir dli of
|
case _dlSubdir dli of
|
||||||
Just (RealDir prel) -> do
|
Just (RealDir prel) -> do
|
||||||
lift $ $(logInfo)
|
logInfo
|
||||||
[i|verifying subdir: #{prel}|]
|
$ " verifying subdir: " <> T.pack prel
|
||||||
when (basePath /= prel) $ do
|
when (basePath /= prel) $ do
|
||||||
lift $ $(logError)
|
logError $
|
||||||
[i|Subdir doesn't match: expected "#{prel}", got "#{basePath}"|]
|
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
|
||||||
addError
|
(flip runReaderT ref addError)
|
||||||
Just (RegexDir regexString) -> do
|
Just (RegexDir regexString) -> do
|
||||||
lift $ $(logInfo)
|
logInfo $
|
||||||
[i|verifying subdir (regex): #{regexString}|]
|
"verifying subdir (regex): " <> T.pack regexString
|
||||||
let regex = makeRegexOpts
|
let regex = makeRegexOpts
|
||||||
compIgnoreCase
|
compIgnoreCase
|
||||||
execBlank
|
execBlank
|
||||||
regexString
|
regexString
|
||||||
when (not (match regex basePath)) $ do
|
when (not (match regex basePath)) $ do
|
||||||
lift $ $(logError)
|
logError $
|
||||||
[i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|]
|
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
|
||||||
addError
|
(flip runReaderT ref addError)
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
VRight Nothing -> pure ()
|
VRight Nothing -> pure ()
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
lift $ $(logError)
|
logError $
|
||||||
[i|Could not download (or verify hash) of #{dli}, Error was: #{prettyShow e}|]
|
"Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
|
||||||
addError
|
(flip runReaderT ref addError)
|
||||||
|
|||||||
@@ -13,11 +13,11 @@ module BrickMain where
|
|||||||
import GHCup
|
import GHCup
|
||||||
import GHCup.Download
|
import GHCup.Download
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
|
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||||
import GHCup.Types hiding ( LeanAppState(..) )
|
import GHCup.Types hiding ( LeanAppState(..) )
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||||
import GHCup.Utils.File
|
import GHCup.Utils.File
|
||||||
import GHCup.Utils.Logger
|
|
||||||
|
|
||||||
import Brick
|
import Brick
|
||||||
import Brick.Widgets.Border
|
import Brick.Widgets.Border
|
||||||
@@ -27,11 +27,8 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
|||||||
, listSelectedAttr
|
, listSelectedAttr
|
||||||
, listAttr
|
, listAttr
|
||||||
)
|
)
|
||||||
#if !defined(TAR)
|
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#endif
|
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
@@ -40,7 +37,6 @@ import Data.Functor
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Vector ( Vector
|
import Data.Vector ( Vector
|
||||||
, (!?)
|
, (!?)
|
||||||
)
|
)
|
||||||
@@ -420,17 +416,11 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, Monad
|
|||||||
install' _ (_, ListResult {..}) = do
|
install' _ (_, ListResult {..}) = do
|
||||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
|
|
||||||
l <- liftIO $ readIORef logger'
|
|
||||||
let runLogger = myLoggerT l
|
|
||||||
|
|
||||||
let run =
|
let run =
|
||||||
runLogger
|
runResourceT
|
||||||
. runResourceT
|
|
||||||
. runE
|
. runE
|
||||||
@'[ AlreadyInstalled
|
@'[ AlreadyInstalled
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, FileDoesNotExistError
|
, FileDoesNotExistError
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -467,23 +457,20 @@ install' _ (_, ListResult {..}) = do
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
myLoggerT l $ $(logInfo) msg
|
logInfo msg
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||||
VLeft (V NoUpdate) -> pure $ Right ()
|
VLeft (V NoUpdate) -> pure $ Right ()
|
||||||
VLeft e -> pure $ Left [i|#{prettyShow e}
|
VLeft e -> pure $ Left $ prettyShow e <> "\n"
|
||||||
Also check the logs in ~/.ghcup/logs|]
|
<> "Also check the logs in ~/.ghcup/logs"
|
||||||
|
|
||||||
|
|
||||||
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
||||||
set' _ (_, ListResult {..}) = do
|
set' _ (_, ListResult {..}) = do
|
||||||
settings <- readIORef settings'
|
settings <- readIORef settings'
|
||||||
l <- readIORef logger'
|
|
||||||
let runLogger = myLoggerT l
|
|
||||||
|
|
||||||
let run =
|
let run =
|
||||||
runLogger
|
flip runReaderT settings
|
||||||
. flip runReaderT settings
|
|
||||||
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||||
|
|
||||||
run (do
|
run (do
|
||||||
@@ -506,9 +493,7 @@ del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnlif
|
|||||||
del' _ (_, ListResult {..}) = do
|
del' _ (_, ListResult {..}) = do
|
||||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
|
|
||||||
l <- liftIO $ readIORef logger'
|
let run = runE @'[NotInstalled]
|
||||||
let runLogger = myLoggerT l
|
|
||||||
let run = myLoggerT l . runE @'[NotInstalled]
|
|
||||||
|
|
||||||
run (do
|
run (do
|
||||||
let vi = getVersionInfo lVer lTool dls
|
let vi = getVersionInfo lVer lTool dls
|
||||||
@@ -522,7 +507,7 @@ del' _ (_, ListResult {..}) = do
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
|
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
logInfo msg
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
VLeft e -> pure $ Left (prettyShow e)
|
VLeft e -> pure $ Left (prettyShow e)
|
||||||
|
|
||||||
@@ -534,8 +519,8 @@ changelog' :: (MonadReader AppState m, MonadIO m)
|
|||||||
changelog' _ (_, ListResult {..}) = do
|
changelog' _ (_, ListResult {..}) = do
|
||||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
case getChangeLog dls lTool (Left lVer) of
|
case getChangeLog dls lTool (Left lVer) of
|
||||||
Nothing -> pure $ Left
|
Nothing -> pure $ Left $
|
||||||
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
|
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
let cmd = case _rPlatform pfreq of
|
let cmd = case _rPlatform pfreq of
|
||||||
Darwin -> "open"
|
Darwin -> "open"
|
||||||
@@ -551,6 +536,10 @@ settings' :: IORef AppState
|
|||||||
{-# NOINLINE settings' #-}
|
{-# NOINLINE settings' #-}
|
||||||
settings' = unsafePerformIO $ do
|
settings' = unsafePerformIO $ do
|
||||||
dirs <- getAllDirs
|
dirs <- getAllDirs
|
||||||
|
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||||
|
, colorOutter = \_ -> pure ()
|
||||||
|
, rawOutter = \_ -> pure ()
|
||||||
|
}
|
||||||
newIORef $ AppState (Settings { cache = True
|
newIORef $ AppState (Settings { cache = True
|
||||||
, noVerify = False
|
, noVerify = False
|
||||||
, keepDirs = Never
|
, keepDirs = Never
|
||||||
@@ -564,27 +553,14 @@ settings' = unsafePerformIO $ do
|
|||||||
defaultKeyBindings
|
defaultKeyBindings
|
||||||
(GHCupInfo mempty mempty mempty)
|
(GHCupInfo mempty mempty mempty)
|
||||||
(PlatformRequest A_64 Darwin Nothing)
|
(PlatformRequest A_64 Darwin Nothing)
|
||||||
|
loggerConfig
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
logger' :: IORef LoggerConfig
|
|
||||||
{-# NOINLINE logger' #-}
|
|
||||||
logger' = unsafePerformIO
|
|
||||||
(newIORef $ LoggerConfig { lcPrintDebug = False
|
|
||||||
, colorOutter = \_ -> pure ()
|
|
||||||
, rawOutter = \_ -> pure ()
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
brickMain :: AppState
|
brickMain :: AppState
|
||||||
-> LoggerConfig
|
|
||||||
-> IO ()
|
-> IO ()
|
||||||
brickMain s l = do
|
brickMain s = do
|
||||||
writeIORef settings' s
|
writeIORef settings' s
|
||||||
-- logger interpreter
|
|
||||||
writeIORef logger' l
|
|
||||||
let runLogger = myLoggerT l
|
|
||||||
|
|
||||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||||
|
|
||||||
@@ -601,7 +577,7 @@ brickMain s l = do
|
|||||||
)
|
)
|
||||||
$> ()
|
$> ()
|
||||||
Left e -> do
|
Left e -> do
|
||||||
runLogger ($(logError) [i|Error building app state: #{show e}|])
|
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
|
||||||
exitWith $ ExitFailure 2
|
exitWith $ ExitFailure 2
|
||||||
|
|
||||||
|
|
||||||
@@ -612,12 +588,9 @@ defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = Fal
|
|||||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||||
getGHCupInfo = do
|
getGHCupInfo = do
|
||||||
settings <- readIORef settings'
|
settings <- readIORef settings'
|
||||||
l <- readIORef logger'
|
|
||||||
let runLogger = myLoggerT l
|
|
||||||
|
|
||||||
r <-
|
r <-
|
||||||
runLogger
|
flip runReaderT settings
|
||||||
. flip runReaderT settings
|
|
||||||
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||||
$ liftE
|
$ liftE
|
||||||
$ getDownloadsF
|
$ getDownloadsF
|
||||||
@@ -630,14 +603,11 @@ getGHCupInfo = do
|
|||||||
getAppData :: Maybe GHCupInfo
|
getAppData :: Maybe GHCupInfo
|
||||||
-> IO (Either String BrickData)
|
-> IO (Either String BrickData)
|
||||||
getAppData mgi = runExceptT $ do
|
getAppData mgi = runExceptT $ do
|
||||||
l <- liftIO $ readIORef logger'
|
|
||||||
let runLogger = myLoggerT l
|
|
||||||
|
|
||||||
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
|
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
|
||||||
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
|
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
|
||||||
settings <- liftIO $ readIORef settings'
|
settings <- liftIO $ readIORef settings'
|
||||||
|
|
||||||
runLogger . flip runReaderT settings $ do
|
flip runReaderT settings $ do
|
||||||
lV <- listVersions Nothing Nothing
|
lV <- listVersions Nothing Nothing
|
||||||
pure $ BrickData (reverse lV)
|
pure $ BrickData (reverse lV)
|
||||||
|
|
||||||
|
|||||||
@@ -30,9 +30,8 @@ import GHCup.Utils.Prelude
|
|||||||
import GHCup.Utils.String.QQ
|
import GHCup.Utils.String.QQ
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
|
|
||||||
#if !defined(TAR)
|
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#endif
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.DeepSeq ( force )
|
import Control.DeepSeq ( force )
|
||||||
@@ -41,9 +40,10 @@ import Control.Exception.Safe
|
|||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
|
import Data.Aeson ( decodeStrict', Value )
|
||||||
|
import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Either
|
import Data.Either
|
||||||
@@ -51,7 +51,6 @@ import Data.Functor
|
|||||||
import Data.List ( intercalate, nub, sort, sortBy )
|
import Data.List ( intercalate, nub, sort, sortBy )
|
||||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions hiding ( str )
|
||||||
import Data.Void
|
import Data.Void
|
||||||
@@ -78,8 +77,7 @@ import qualified Data.Map.Strict as M
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.YAML.Aeson as Y
|
||||||
import qualified Data.Yaml.Pretty as YP
|
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import qualified Text.Megaparsec.Char as MPC
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
@@ -207,6 +205,11 @@ data ChangeLogOptions = ChangeLogOptions
|
|||||||
|
|
||||||
|
|
||||||
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||||
|
| WhereisBaseDir
|
||||||
|
| WhereisBinDir
|
||||||
|
| WhereisCacheDir
|
||||||
|
| WhereisLogsDir
|
||||||
|
| WhereisConfDir
|
||||||
|
|
||||||
data WhereisOptions = WhereisOptions {
|
data WhereisOptions = WhereisOptions {
|
||||||
directory :: Bool
|
directory :: Bool
|
||||||
@@ -835,7 +838,8 @@ configP = subparser
|
|||||||
|
|
||||||
whereisP :: Parser WhereisCommand
|
whereisP :: Parser WhereisCommand
|
||||||
whereisP = subparser
|
whereisP = subparser
|
||||||
( command
|
(commandGroup "Tools locations:" <>
|
||||||
|
command
|
||||||
"ghc"
|
"ghc"
|
||||||
(WhereisTool GHC <$> info
|
(WhereisTool GHC <$> info
|
||||||
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
||||||
@@ -870,6 +874,37 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"ghcup"
|
"ghcup"
|
||||||
(WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" ))
|
(WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" ))
|
||||||
|
) <|> subparser ( commandGroup "Directory locations:"
|
||||||
|
<>
|
||||||
|
command
|
||||||
|
"basedir"
|
||||||
|
(info (pure WhereisBaseDir <**> helper)
|
||||||
|
( progDesc "Get ghcup base directory location" )
|
||||||
|
)
|
||||||
|
<>
|
||||||
|
command
|
||||||
|
"bindir"
|
||||||
|
(info (pure WhereisBinDir <**> helper)
|
||||||
|
( progDesc "Get ghcup binary directory location" )
|
||||||
|
)
|
||||||
|
<>
|
||||||
|
command
|
||||||
|
"cachedir"
|
||||||
|
(info (pure WhereisCacheDir <**> helper)
|
||||||
|
( progDesc "Get ghcup cache directory location" )
|
||||||
|
)
|
||||||
|
<>
|
||||||
|
command
|
||||||
|
"logsdir"
|
||||||
|
(info (pure WhereisLogsDir <**> helper)
|
||||||
|
( progDesc "Get ghcup logs directory location" )
|
||||||
|
)
|
||||||
|
<>
|
||||||
|
command
|
||||||
|
"confdir"
|
||||||
|
(info (pure WhereisConfDir <**> helper)
|
||||||
|
( progDesc "Get ghcup config directory location" )
|
||||||
|
)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
whereisGHCFooter = [s|Discussion:
|
whereisGHCFooter = [s|Discussion:
|
||||||
@@ -1089,7 +1124,7 @@ setVersionArgument criteria tool =
|
|||||||
<|> second SetToolVersion (tVersionEither s')
|
<|> second SetToolVersion (tVersionEither s')
|
||||||
parseSet s' = case fmap toLower s' of
|
parseSet s' = case fmap toLower s' of
|
||||||
"next" -> Right SetNext
|
"next" -> Right SetNext
|
||||||
other -> Left [i|Unknown tag/version #{other}|]
|
other -> Left $ "Unknown tag/version " <> other
|
||||||
|
|
||||||
|
|
||||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||||
@@ -1099,19 +1134,18 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
|
|||||||
tagCompleter :: Tool -> [String] -> Completer
|
tagCompleter :: Tool -> [String] -> Completer
|
||||||
tagCompleter tool add = listIOCompleter $ do
|
tagCompleter tool add = listIOCompleter $ do
|
||||||
dirs' <- liftIO getAllDirs
|
dirs' <- liftIO getAllDirs
|
||||||
let appState = LeanAppState
|
|
||||||
(Settings True False Never Curl False GHCupURL True)
|
|
||||||
dirs'
|
|
||||||
defaultKeyBindings
|
|
||||||
|
|
||||||
let loggerConfig = LoggerConfig
|
let loggerConfig = LoggerConfig
|
||||||
{ lcPrintDebug = False
|
{ lcPrintDebug = False
|
||||||
, colorOutter = mempty
|
, colorOutter = mempty
|
||||||
, rawOutter = mempty
|
, rawOutter = mempty
|
||||||
}
|
}
|
||||||
let runLogger = myLoggerT loggerConfig
|
let appState = LeanAppState
|
||||||
|
(Settings True False Never Curl False GHCupURL True)
|
||||||
|
dirs'
|
||||||
|
defaultKeyBindings
|
||||||
|
loggerConfig
|
||||||
|
|
||||||
mGhcUpInfo <- runLogger . flip runReaderT appState . runE $ getDownloadsF
|
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
|
||||||
case mGhcUpInfo of
|
case mGhcUpInfo of
|
||||||
VRight ghcupInfo -> do
|
VRight ghcupInfo -> do
|
||||||
let allTags = filter (\t -> t /= Old)
|
let allTags = filter (\t -> t /= Old)
|
||||||
@@ -1131,14 +1165,14 @@ versionCompleter criteria tool = listIOCompleter $ do
|
|||||||
, colorOutter = mempty
|
, colorOutter = mempty
|
||||||
, rawOutter = mempty
|
, rawOutter = mempty
|
||||||
}
|
}
|
||||||
let runLogger = myLoggerT loggerConfig
|
let settings = Settings True False Never Curl False GHCupURL True
|
||||||
settings = Settings True False Never Curl False GHCupURL True
|
|
||||||
let leanAppState = LeanAppState
|
let leanAppState = LeanAppState
|
||||||
settings
|
settings
|
||||||
dirs'
|
dirs'
|
||||||
defaultKeyBindings
|
defaultKeyBindings
|
||||||
mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest
|
loggerConfig
|
||||||
mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF
|
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||||
|
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||||
forFold mpFreq $ \pfreq -> do
|
forFold mpFreq $ \pfreq -> do
|
||||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||||
let appState = AppState
|
let appState = AppState
|
||||||
@@ -1147,8 +1181,9 @@ versionCompleter criteria tool = listIOCompleter $ do
|
|||||||
defaultKeyBindings
|
defaultKeyBindings
|
||||||
ghcupInfo
|
ghcupInfo
|
||||||
pfreq
|
pfreq
|
||||||
|
loggerConfig
|
||||||
|
|
||||||
runEnv = runLogger . flip runReaderT appState
|
runEnv = flip runReaderT appState
|
||||||
|
|
||||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||||
@@ -1172,8 +1207,8 @@ tagEither s' = case fmap toLower s' of
|
|||||||
"latest" -> Right Latest
|
"latest" -> Right Latest
|
||||||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||||
Right x -> Right (Base x)
|
Right x -> Right (Base x)
|
||||||
Left _ -> Left [i|Invalid PVP version for base #{ver'}|]
|
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
||||||
other -> Left [i|Unknown tag #{other}|]
|
other -> Left $ "Unknown tag " <> other
|
||||||
|
|
||||||
|
|
||||||
tVersionEither :: String -> Either String GHCTargetVersion
|
tVersionEither :: String -> Either String GHCTargetVersion
|
||||||
@@ -1319,7 +1354,7 @@ toSettings options = do
|
|||||||
|
|
||||||
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
||||||
updateSettings config settings = do
|
updateSettings config settings = do
|
||||||
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
|
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config
|
||||||
pure $ mergeConf settings' settings
|
pure $ mergeConf settings' settings
|
||||||
where
|
where
|
||||||
mergeConf :: UserSettings -> Settings -> Settings
|
mergeConf :: UserSettings -> Settings -> Settings
|
||||||
@@ -1366,11 +1401,19 @@ describe_result = $( LitE . StringL <$>
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
plan_json :: String
|
||||||
|
plan_json = $( LitE . StringL <$>
|
||||||
|
runIO (handleIO (\_ -> pure "") $ do
|
||||||
|
fp <- findPlanJson (ProjectRelativeToDir ".")
|
||||||
|
c <- B.readFile fp
|
||||||
|
(Just res) <- pure $ decodeStrict' @Value c
|
||||||
|
pure $ T.unpack $ decUTF8Safe' $ encodePretty res
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
formatConfig :: UserSettings -> String
|
formatConfig :: UserSettings -> String
|
||||||
formatConfig settings
|
formatConfig settings
|
||||||
= UTF8.toString . YP.encodePretty yamlConfig $ settings
|
= UTF8.toString . Y.encode1Strict $ settings
|
||||||
where
|
|
||||||
yamlConfig = YP.setConfCompare compare YP.defConfig
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
@@ -1384,6 +1427,9 @@ main = do
|
|||||||
(head . lines $ describe_result)
|
(head . lines $ describe_result)
|
||||||
)
|
)
|
||||||
(long "version" <> help "Show version" <> hidden)
|
(long "version" <> help "Show version" <> hidden)
|
||||||
|
let planJson = infoOption
|
||||||
|
plan_json
|
||||||
|
(long "plan-json" <> help "Show the build-time configuration" <> internal)
|
||||||
let numericVersionHelp = infoOption
|
let numericVersionHelp = infoOption
|
||||||
numericVer
|
numericVer
|
||||||
( long "numeric-version"
|
( long "numeric-version"
|
||||||
@@ -1411,7 +1457,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
customExecParser
|
customExecParser
|
||||||
(prefs showHelpOnError)
|
(prefs showHelpOnError)
|
||||||
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands)
|
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> planJson <**> listCommands)
|
||||||
(footerDoc (Just $ text main_footer))
|
(footerDoc (Just $ text main_footer))
|
||||||
)
|
)
|
||||||
>>= \opt@Options {..} -> do
|
>>= \opt@Options {..} -> do
|
||||||
@@ -1422,18 +1468,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
(settings, keybindings) <- toSettings opt
|
(settings, keybindings) <- toSettings opt
|
||||||
|
|
||||||
|
|
||||||
-- logger interpreter
|
-- logger interpreter
|
||||||
logfile <- flip runReaderT dirs $ initGHCupFileLogging
|
logfile <- flip runReaderT dirs initGHCupFileLogging
|
||||||
let loggerConfig = LoggerConfig
|
let loggerConfig = LoggerConfig
|
||||||
{ lcPrintDebug = verbose settings
|
{ lcPrintDebug = verbose settings
|
||||||
, colorOutter = B.hPut stderr
|
, colorOutter = T.hPutStr stderr
|
||||||
, rawOutter =
|
, rawOutter =
|
||||||
case optCommand of
|
case optCommand of
|
||||||
Nuke -> \_ -> pure ()
|
Nuke -> \_ -> pure ()
|
||||||
_ -> B.appendFile logfile
|
_ -> T.appendFile logfile
|
||||||
}
|
}
|
||||||
let runLogger = myLoggerT loggerConfig
|
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
|
||||||
let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
|
let runLogger = flip runReaderT leanAppstate
|
||||||
|
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
@@ -1441,7 +1489,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
-------------------------
|
-------------------------
|
||||||
|
|
||||||
|
|
||||||
let leanAppstate = LeanAppState settings dirs keybindings
|
|
||||||
appState = do
|
appState = do
|
||||||
pfreq <- (
|
pfreq <- (
|
||||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||||
@@ -1449,12 +1496,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
VRight r -> pure r
|
VRight r -> pure r
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger
|
runLogger
|
||||||
($(logError) $ T.pack $ prettyShow e)
|
(logError $ T.pack $ prettyShow e)
|
||||||
exitWith (ExitFailure 2)
|
exitWith (ExitFailure 2)
|
||||||
|
|
||||||
ghcupInfo <-
|
ghcupInfo <-
|
||||||
( runLogger
|
( flip runReaderT leanAppstate
|
||||||
. flip runReaderT leanAppstate
|
|
||||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||||
$ liftE
|
$ liftE
|
||||||
$ getDownloadsF
|
$ getDownloadsF
|
||||||
@@ -1463,12 +1509,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
VRight r -> pure r
|
VRight r -> pure r
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger
|
runLogger
|
||||||
($(logError) $ T.pack $ prettyShow e)
|
(logError $ T.pack $ prettyShow e)
|
||||||
exitWith (ExitFailure 2)
|
exitWith (ExitFailure 2)
|
||||||
let s' = AppState settings dirs keybindings ghcupInfo pfreq
|
let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
|
||||||
|
|
||||||
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
|
race_ (liftIO $ flip runReaderT s' cleanupTrash)
|
||||||
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
|
(threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
|
||||||
|
|
||||||
case optCommand of
|
case optCommand of
|
||||||
Nuke -> pure ()
|
Nuke -> pure ()
|
||||||
@@ -1480,7 +1526,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
Interactive -> pure ()
|
Interactive -> pure ()
|
||||||
#endif
|
#endif
|
||||||
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
Nothing -> flip runReaderT s' checkForUpdates
|
||||||
Just _ -> pure ()
|
Just _ -> pure ()
|
||||||
|
|
||||||
-- TODO: always run for windows
|
-- TODO: always run for windows
|
||||||
@@ -1488,7 +1534,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
VRight _ -> pure ()
|
VRight _ -> pure ()
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger
|
runLogger
|
||||||
($(logError) $ T.pack $ prettyShow e)
|
(logError $ T.pack $ prettyShow e)
|
||||||
exitWith (ExitFailure 30)
|
exitWith (ExitFailure 30)
|
||||||
pure s'
|
pure s'
|
||||||
|
|
||||||
@@ -1513,15 +1559,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
|
|
||||||
let runInstTool' appstate' mInstPlatform =
|
let runInstTool' appstate' mInstPlatform =
|
||||||
runLogger
|
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
||||||
. flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
|
||||||
. runResourceT
|
. runResourceT
|
||||||
. runE
|
. runE
|
||||||
@'[ AlreadyInstalled
|
@'[ AlreadyInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
, FileDoesNotExistError
|
, FileDoesNotExistError
|
||||||
, CopyError
|
, CopyError
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
@@ -1544,8 +1587,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
let
|
let
|
||||||
runLeanSetGHC =
|
runLeanSetGHC =
|
||||||
runLogger
|
runLeanAppState
|
||||||
. runLeanAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ FileDoesNotExistError
|
@'[ FileDoesNotExistError
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
@@ -1555,8 +1597,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
runSetGHC =
|
runSetGHC =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ FileDoesNotExistError
|
@'[ FileDoesNotExistError
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
@@ -1567,8 +1608,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
let
|
let
|
||||||
runLeanSetCabal =
|
runLeanSetCabal =
|
||||||
runLogger
|
runLeanAppState
|
||||||
. runLeanAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
@@ -1577,8 +1617,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
runSetCabal =
|
runSetCabal =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
@@ -1588,8 +1627,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
|
|
||||||
let
|
let
|
||||||
runSetHLS =
|
runSetHLS =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
@@ -1598,8 +1636,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
runLeanSetHLS =
|
runLeanSetHLS =
|
||||||
runLogger
|
runLeanAppState
|
||||||
. runLeanAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
@@ -1607,23 +1644,21 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
]
|
]
|
||||||
|
|
||||||
let runListGHC = runLogger . runAppState
|
let runListGHC = runAppState
|
||||||
|
|
||||||
let runRm =
|
let runRm =
|
||||||
runLogger . runAppState . runE @'[NotInstalled]
|
runAppState . runE @'[NotInstalled]
|
||||||
|
|
||||||
let runNuke s' =
|
let runNuke s' =
|
||||||
runLogger . flip runReaderT s' . runE @'[NotInstalled]
|
flip runReaderT s' . runE @'[NotInstalled]
|
||||||
|
|
||||||
let runDebugInfo =
|
let runDebugInfo =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
||||||
|
|
||||||
let runCompileGHC =
|
let runCompileGHC =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runResourceT
|
. runResourceT
|
||||||
. runE
|
. runE
|
||||||
@'[ AlreadyInstalled
|
@'[ AlreadyInstalled
|
||||||
@@ -1638,17 +1673,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
, DirNotEmpty
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
|
|
||||||
let
|
let
|
||||||
runLeanWhereIs =
|
runLeanWhereIs =
|
||||||
runLogger
|
|
||||||
-- Don't use runLeanAppState here, which is disabled on windows.
|
-- Don't use runLeanAppState here, which is disabled on windows.
|
||||||
-- This is the only command on all platforms that doesn't need full appstate.
|
-- This is the only command on all platforms that doesn't need full appstate.
|
||||||
. flip runReaderT leanAppstate
|
flip runReaderT leanAppstate
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
@@ -1657,8 +1689,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
runWhereIs =
|
runWhereIs =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runE
|
. runE
|
||||||
@'[ NotInstalled
|
@'[ NotInstalled
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
@@ -1667,8 +1698,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
let runUpgrade =
|
let runUpgrade =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runResourceT
|
. runResourceT
|
||||||
. runE
|
. runE
|
||||||
@'[ DigestError
|
@'[ DigestError
|
||||||
@@ -1680,8 +1710,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
]
|
]
|
||||||
|
|
||||||
let runPrefetch =
|
let runPrefetch =
|
||||||
runLogger
|
runAppState
|
||||||
. runAppState
|
|
||||||
. runResourceT
|
. runResourceT
|
||||||
. runE
|
. runE
|
||||||
@'[ TagNotFound
|
@'[ TagNotFound
|
||||||
@@ -1719,25 +1748,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "GHC installation successful"
|
runLogger $ logInfo "GHC installation successful"
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||||
runLogger $ $(logWarn)
|
runLogger $ logWarn $
|
||||||
[i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
|
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||||
case keepDirs settings of
|
case keepDirs settings of
|
||||||
Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
|
Never -> runLogger $ (logError $ T.pack $ prettyShow err)
|
||||||
_ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
|
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||||
Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
|
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||||
Make sure to clean up #{tmpdir} afterwards.|])
|
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||||
pure $ ExitFailure 3
|
pure $ ExitFailure 3
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) $ T.pack $ prettyShow e
|
logError $ T.pack $ prettyShow e
|
||||||
$(logError) [i|Also check the logs in #{logsDir}|]
|
logError $ "Also check the logs in " <> T.pack logsDir
|
||||||
pure $ ExitFailure 3
|
pure $ ExitFailure 3
|
||||||
|
|
||||||
|
|
||||||
@@ -1759,18 +1788,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "Cabal installation successful"
|
runLogger $ logInfo "Cabal installation successful"
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||||
runLogger $ $(logWarn)
|
runLogger $ logWarn $
|
||||||
[i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|]
|
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) $ T.pack $ prettyShow e
|
logError $ T.pack $ prettyShow e
|
||||||
$(logError) [i|Also check the logs in #{logsDir}|]
|
logError $ "Also check the logs in " <> T.pack logsDir
|
||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installHLS InstallOptions{..} =
|
let installHLS InstallOptions{..} =
|
||||||
@@ -1791,18 +1820,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "HLS installation successful"
|
runLogger $ logInfo "HLS installation successful"
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||||
runLogger $ $(logWarn)
|
runLogger $ logWarn $
|
||||||
[i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
|
"HLS ver "
|
||||||
|
<> prettyVer v
|
||||||
|
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
|
||||||
|
<> prettyVer v
|
||||||
|
<> "' first"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) $ T.pack $ prettyShow e
|
logError $ T.pack $ prettyShow e
|
||||||
$(logError) [i|Also check the logs in #{logsDir}|]
|
logError $ "Also check the logs in " <> T.pack logsDir
|
||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installStack InstallOptions{..} =
|
let installStack InstallOptions{..} =
|
||||||
@@ -1823,18 +1856,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "Stack installation successful"
|
runLogger $ logInfo "Stack installation successful"
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||||
runLogger $ $(logWarn)
|
runLogger $ logWarn $
|
||||||
[i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|]
|
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) $ T.pack $ prettyShow e
|
logError $ T.pack $ prettyShow e
|
||||||
$(logError) [i|Also check the logs in #{logsDir}|]
|
logError $ "Also check the logs in " <> T.pack logsDir
|
||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
|
|
||||||
@@ -1848,11 +1881,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight GHCTargetVersion{..} -> do
|
VRight GHCTargetVersion{..} -> do
|
||||||
runLogger
|
runLogger
|
||||||
$ $(logInfo)
|
$ logInfo $
|
||||||
[i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
|
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 5
|
pure $ ExitFailure 5
|
||||||
|
|
||||||
let setCabal' SetOptions{ sToolVer } =
|
let setCabal' SetOptions{ sToolVer } =
|
||||||
@@ -1866,11 +1899,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight GHCTargetVersion{..} -> do
|
VRight GHCTargetVersion{..} -> do
|
||||||
runLogger
|
runLogger
|
||||||
$ $(logInfo)
|
$ logInfo $
|
||||||
[i|Cabal #{prettyVer _tvVersion} successfully set as default version|]
|
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 14
|
pure $ ExitFailure 14
|
||||||
|
|
||||||
let setHLS' SetOptions{ sToolVer } =
|
let setHLS' SetOptions{ sToolVer } =
|
||||||
@@ -1884,11 +1917,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight GHCTargetVersion{..} -> do
|
VRight GHCTargetVersion{..} -> do
|
||||||
runLogger
|
runLogger
|
||||||
$ $(logInfo)
|
$ logInfo $
|
||||||
[i|HLS #{prettyVer _tvVersion} successfully set as default version|]
|
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 14
|
pure $ ExitFailure 14
|
||||||
|
|
||||||
let setStack' SetOptions{ sToolVer } =
|
let setStack' SetOptions{ sToolVer } =
|
||||||
@@ -1902,11 +1935,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight GHCTargetVersion{..} -> do
|
VRight GHCTargetVersion{..} -> do
|
||||||
runLogger
|
runLogger
|
||||||
$ $(logInfo)
|
$ logInfo $
|
||||||
[i|Stack #{prettyVer _tvVersion} successfully set as default version|]
|
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 14
|
pure $ ExitFailure 14
|
||||||
|
|
||||||
let rmGHC' RmOptions{..} =
|
let rmGHC' RmOptions{..} =
|
||||||
@@ -1919,10 +1952,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 7
|
pure $ ExitFailure 7
|
||||||
|
|
||||||
let rmCabal' tv =
|
let rmCabal' tv =
|
||||||
@@ -1935,10 +1968,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
let rmHLS' tv =
|
let rmHLS' tv =
|
||||||
@@ -1951,10 +1984,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
let rmStack' tv =
|
let rmStack' tv =
|
||||||
@@ -1967,31 +2000,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
res <- case optCommand of
|
res <- case optCommand of
|
||||||
#if defined(BRICK)
|
#if defined(BRICK)
|
||||||
Interactive -> do
|
Interactive -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
|
liftIO $ brickMain s' >> pure ExitSuccess
|
||||||
#endif
|
#endif
|
||||||
Install (Right iopts) -> do
|
Install (Right iopts) -> do
|
||||||
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
|
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
||||||
installGHC iopts
|
installGHC iopts
|
||||||
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
||||||
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
||||||
Install (Left (InstallHLS iopts)) -> installHLS iopts
|
Install (Left (InstallHLS iopts)) -> installHLS iopts
|
||||||
Install (Left (InstallStack iopts)) -> installStack iopts
|
Install (Left (InstallStack iopts)) -> installStack iopts
|
||||||
InstallCabalLegacy iopts -> do
|
InstallCabalLegacy iopts -> do
|
||||||
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
|
runLogger (logWarn "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.")
|
||||||
installCabal iopts
|
installCabal iopts
|
||||||
|
|
||||||
Set (Right sopts) -> do
|
Set (Right sopts) -> do
|
||||||
runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|])
|
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||||
setGHC' sopts
|
setGHC' sopts
|
||||||
Set (Left (SetGHC sopts)) -> setGHC' sopts
|
Set (Left (SetGHC sopts)) -> setGHC' sopts
|
||||||
Set (Left (SetCabal sopts)) -> setCabal' sopts
|
Set (Left (SetCabal sopts)) -> setCabal' sopts
|
||||||
@@ -2006,7 +2039,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
|
|
||||||
Rm (Right rmopts) -> do
|
Rm (Right rmopts) -> do
|
||||||
runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
|
runLogger (logWarn "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
|
||||||
rmGHC' rmopts
|
rmGHC' rmopts
|
||||||
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
|
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
|
||||||
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
|
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
|
||||||
@@ -2020,11 +2053,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
putStrLn $ prettyDebugInfo dinfo
|
putStrLn $ prettyDebugInfo dinfo
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 8
|
pure $ ExitFailure 8
|
||||||
|
|
||||||
Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
||||||
runLogger $ $(logError) "Hadrian cross compile support is not yet implemented!"
|
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
Compile (CompileGHC GHCCompileOptions {..}) ->
|
Compile (CompileGHC GHCCompileOptions {..}) ->
|
||||||
runCompileGHC (do
|
runCompileGHC (do
|
||||||
@@ -2033,8 +2066,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer GHC dls
|
let vi = getVersionInfo targetVer GHC dls
|
||||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
lift $ $(logInfo) msg
|
lift $ logInfo msg
|
||||||
lift $ $(logInfo)
|
lift $ logInfo
|
||||||
"...waiting for 5 seconds, you can still abort..."
|
"...waiting for 5 seconds, you can still abort..."
|
||||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||||
Right _ -> pure ()
|
Right _ -> pure ()
|
||||||
@@ -2057,31 +2090,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight (vi, tv) -> do
|
VRight (vi, tv) -> do
|
||||||
runLogger $ $(logInfo)
|
runLogger $ logInfo
|
||||||
"GHC successfully compiled and installed"
|
"GHC successfully compiled and installed"
|
||||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
putStr (T.unpack $ tVerToText tv)
|
putStr (T.unpack $ tVerToText tv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||||
runLogger $ $(logWarn)
|
runLogger $ logWarn $
|
||||||
[i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
|
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||||
case keepDirs settings of
|
case keepDirs settings of
|
||||||
Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
|
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||||
_ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
|
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||||
Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
|
"Check the logs at " <> T.pack logsDir <> " and the build directory "
|
||||||
Make sure to clean up #{tmpdir} afterwards.|])
|
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||||
|
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
|
|
||||||
Config InitConfig -> do
|
Config InitConfig -> do
|
||||||
path <- getConfigFilePath
|
path <- getConfigFilePath
|
||||||
writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||||
runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
|
runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
|
||||||
Config ShowConfig -> do
|
Config ShowConfig -> do
|
||||||
@@ -2091,21 +2125,20 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
Config (SetConfig k v) -> do
|
Config (SetConfig k v) -> do
|
||||||
case v of
|
case v of
|
||||||
"" -> do
|
"" -> do
|
||||||
runLogger $ $(logError) "Empty values are not allowed"
|
runLogger $ logError "Empty values are not allowed"
|
||||||
pure $ ExitFailure 55
|
pure $ ExitFailure 55
|
||||||
_ -> do
|
_ -> do
|
||||||
r <- runE @'[JSONError] $ do
|
r <- runE @'[JSONError] $ do
|
||||||
settings' <- updateSettings [i|#{k}: #{v}\n|] settings
|
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
|
||||||
path <- liftIO getConfigFilePath
|
path <- liftIO getConfigFilePath
|
||||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||||
runLogger $ $(logDebug) $ T.pack $ show settings'
|
runLogger $ logDebug $ T.pack $ show settings'
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
case r of
|
case r of
|
||||||
VRight _ -> pure ExitSuccess
|
VRight _ -> pure ExitSuccess
|
||||||
VLeft (V (JSONDecodeError e)) -> do
|
VLeft (V (JSONDecodeError e)) -> do
|
||||||
runLogger $ $(logError)
|
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
||||||
[i|Error decoding config: #{e}|]
|
|
||||||
pure $ ExitFailure 65
|
pure $ ExitFailure 65
|
||||||
VLeft _ -> pure $ ExitFailure 65
|
VLeft _ -> pure $ ExitFailure 65
|
||||||
|
|
||||||
@@ -2121,7 +2154,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
putStr r
|
putStr r
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 30
|
pure $ ExitFailure 30
|
||||||
|
|
||||||
Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
|
Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
|
||||||
@@ -2137,9 +2170,29 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
putStr r
|
putStr r
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 30
|
pure $ ExitFailure 30
|
||||||
|
|
||||||
|
Whereis _ WhereisBaseDir -> do
|
||||||
|
putStr baseDir
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Whereis _ WhereisBinDir -> do
|
||||||
|
putStr binDir
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Whereis _ WhereisCacheDir -> do
|
||||||
|
putStr cacheDir
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Whereis _ WhereisLogsDir -> do
|
||||||
|
putStr logsDir
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Whereis _ WhereisConfDir -> do
|
||||||
|
putStr confDir
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
Upgrade uOpts force' -> do
|
Upgrade uOpts force' -> do
|
||||||
target <- case uOpts of
|
target <- case uOpts of
|
||||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||||
@@ -2154,23 +2207,22 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
VRight (v', dls) -> do
|
VRight (v', dls) -> do
|
||||||
let pretty_v = prettyVer v'
|
let pretty_v = prettyVer v'
|
||||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||||
runLogger $ $(logInfo)
|
runLogger $ logInfo $
|
||||||
[i|Successfully upgraded GHCup to version #{pretty_v}|]
|
"Successfully upgraded GHCup to version " <> pretty_v
|
||||||
forM_ (_viPostInstall vi) $ \msg ->
|
forM_ (_viPostInstall vi) $ \msg ->
|
||||||
runLogger $ $(logInfo) msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V NoUpdate) -> do
|
VLeft (V NoUpdate) -> do
|
||||||
runLogger $ $(logWarn) [i|No GHCup update available|]
|
runLogger $ logWarn "No GHCup update available"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 11
|
pure $ ExitFailure 11
|
||||||
|
|
||||||
ToolRequirements -> do
|
ToolRequirements -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
flip runReaderT s'
|
flip runReaderT s'
|
||||||
$ runLogger
|
$ (runE
|
||||||
(runE
|
|
||||||
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
||||||
$ do
|
$ do
|
||||||
GHCupInfo { .. } <- lift getGHCupInfo
|
GHCupInfo { .. } <- lift getGHCupInfo
|
||||||
@@ -2181,7 +2233,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight _ -> pure ExitSuccess
|
VRight _ -> pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 12
|
pure $ ExitFailure 12
|
||||||
|
|
||||||
ChangeLog ChangeLogOptions{..} -> do
|
ChangeLog ChangeLogOptions{..} -> do
|
||||||
@@ -2198,8 +2250,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
case muri of
|
case muri of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
runLogger
|
runLogger
|
||||||
($(logWarn)
|
(logWarn $
|
||||||
[i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|]
|
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
||||||
)
|
)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
@@ -2221,7 +2273,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
Nothing
|
Nothing
|
||||||
>>= \case
|
>>= \case
|
||||||
Right _ -> pure ExitSuccess
|
Right _ -> pure ExitSuccess
|
||||||
Left e -> runLogger ($(logError) [i|#{e}|])
|
Left e -> logError (T.pack $ prettyShow e)
|
||||||
>> pure (ExitFailure 13)
|
>> pure (ExitFailure 13)
|
||||||
else putStrLn uri' >> pure ExitSuccess
|
else putStrLn uri' >> pure ExitSuccess
|
||||||
|
|
||||||
@@ -2229,12 +2281,12 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
s' <- liftIO appState
|
s' <- liftIO appState
|
||||||
void $ liftIO $ evaluate $ force s'
|
void $ liftIO $ evaluate $ force s'
|
||||||
runNuke s' (do
|
runNuke s' (do
|
||||||
lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
|
lift $ logWarn "WARNING: This will remove GHCup and all installed components from your system."
|
||||||
lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
|
lift $ logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
|
||||||
liftIO $ threadDelay 10000000 -- wait 10s
|
liftIO $ threadDelay 10000000 -- wait 10s
|
||||||
|
|
||||||
lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||||
lift $ $logInfo "Nuking in 3...2...1"
|
lift $ logInfo "Nuking in 3...2...1"
|
||||||
|
|
||||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
||||||
|
|
||||||
@@ -2245,15 +2297,15 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
) >>= \case
|
) >>= \case
|
||||||
VRight leftOverFiles
|
VRight leftOverFiles
|
||||||
| null leftOverFiles -> do
|
| null leftOverFiles -> do
|
||||||
runLogger $ $logInfo "Nuclear Annihilation complete!"
|
runLogger $ logInfo "Nuclear Annihilation complete!"
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually."
|
runLogger $ logError "These Files have survived Nuclear Annihilation, you may remove them manually."
|
||||||
forM_ leftOverFiles putStrLn
|
forM_ leftOverFiles putStrLn
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
Prefetch pfCom ->
|
Prefetch pfCom ->
|
||||||
runPrefetch (do
|
runPrefetch (do
|
||||||
@@ -2284,7 +2336,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
VRight _ -> do
|
VRight _ -> do
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
|
|
||||||
@@ -2295,7 +2347,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
fromVersion :: ( MonadLogger m
|
fromVersion :: ( HasLog env
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
@@ -2313,7 +2365,7 @@ fromVersion :: ( MonadLogger m
|
|||||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||||
fromVersion tv = fromVersion' (toSetToolVer tv)
|
fromVersion tv = fromVersion' (toSetToolVer tv)
|
||||||
|
|
||||||
fromVersion' :: ( MonadLogger m
|
fromVersion' :: ( HasLog env
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
@@ -2559,11 +2611,10 @@ checkForUpdates :: ( MonadReader env m
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadLogger m
|
|
||||||
)
|
)
|
||||||
=> m ()
|
=> m ()
|
||||||
checkForUpdates = do
|
checkForUpdates = do
|
||||||
@@ -2574,46 +2625,46 @@ checkForUpdates = do
|
|||||||
forM_ (getLatest dls GHCup) $ \(l, _) -> do
|
forM_ (getLatest dls GHCup) $ \(l, _) -> do
|
||||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||||
when (l > ghc_ver)
|
when (l > ghc_ver)
|
||||||
$ $(logWarn)
|
$ logWarn $
|
||||||
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
|
||||||
|
|
||||||
forM_ (getLatest dls GHC) $ \(l, _) -> do
|
forM_ (getLatest dls GHC) $ \(l, _) -> do
|
||||||
let mghc_ver = latestInstalled GHC
|
let mghc_ver = latestInstalled GHC
|
||||||
forM mghc_ver $ \ghc_ver ->
|
forM mghc_ver $ \ghc_ver ->
|
||||||
when (l > ghc_ver)
|
when (l > ghc_ver)
|
||||||
$ $(logWarn)
|
$ logWarn $
|
||||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
|
||||||
|
|
||||||
forM_ (getLatest dls Cabal) $ \(l, _) -> do
|
forM_ (getLatest dls Cabal) $ \(l, _) -> do
|
||||||
let mcabal_ver = latestInstalled Cabal
|
let mcabal_ver = latestInstalled Cabal
|
||||||
forM mcabal_ver $ \cabal_ver ->
|
forM mcabal_ver $ \cabal_ver ->
|
||||||
when (l > cabal_ver)
|
when (l > cabal_ver)
|
||||||
$ $(logWarn)
|
$ logWarn $
|
||||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
|
||||||
|
|
||||||
forM_ (getLatest dls HLS) $ \(l, _) -> do
|
forM_ (getLatest dls HLS) $ \(l, _) -> do
|
||||||
let mhls_ver = latestInstalled HLS
|
let mhls_ver = latestInstalled HLS
|
||||||
forM mhls_ver $ \hls_ver ->
|
forM mhls_ver $ \hls_ver ->
|
||||||
when (l > hls_ver)
|
when (l > hls_ver)
|
||||||
$ $(logWarn)
|
$ logWarn $
|
||||||
[i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
|
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
|
||||||
|
|
||||||
forM_ (getLatest dls Stack) $ \(l, _) -> do
|
forM_ (getLatest dls Stack) $ \(l, _) -> do
|
||||||
let mstack_ver = latestInstalled Stack
|
let mstack_ver = latestInstalled Stack
|
||||||
forM mstack_ver $ \stack_ver ->
|
forM mstack_ver $ \stack_ver ->
|
||||||
when (l > stack_ver)
|
when (l > stack_ver)
|
||||||
$ $(logWarn)
|
$ logWarn $
|
||||||
[i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|]
|
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
|
||||||
|
|
||||||
|
|
||||||
prettyDebugInfo :: DebugInfo -> String
|
prettyDebugInfo :: DebugInfo -> String
|
||||||
prettyDebugInfo DebugInfo {..} = [i|Debug Info
|
prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
|
||||||
==========
|
"==========" <> "\n" <>
|
||||||
GHCup base dir: #{diBaseDir}
|
"GHCup base dir: " <> diBaseDir <> "\n" <>
|
||||||
GHCup bin dir: #{diBinDir}
|
"GHCup bin dir: " <> diBinDir <> "\n" <>
|
||||||
GHCup GHC directory: #{diGHCDir}
|
"GHCup GHC directory: " <> diGHCDir <> "\n" <>
|
||||||
GHCup cache directory: #{diCacheDir}
|
"GHCup cache directory: " <> diCacheDir <> "\n" <>
|
||||||
Architecture: #{prettyShow diArch}
|
"Architecture: " <> prettyShow diArch <> "\n" <>
|
||||||
Platform: #{prettyShow diPlatform}
|
"Platform: " <> prettyShow diPlatform <> "\n" <>
|
||||||
Version: #{describe_result}|]
|
"Version: " <> describe_result
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@
|
|||||||
# Main settings:
|
# Main settings:
|
||||||
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
||||||
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
|
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
|
||||||
|
# * BOOTSTRAP_HASKELL_MINIMAL - any nonzero value to only install ghcup
|
||||||
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
|
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
|
||||||
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
|
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
|
||||||
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
|
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
|
||||||
@@ -371,6 +372,13 @@ adjust_bashrc() {
|
|||||||
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||||
fi
|
fi
|
||||||
;;
|
;;
|
||||||
|
MSYS*|MINGW*)
|
||||||
|
if [ ! -e "${HOME}/.bash_profile" ] ; then
|
||||||
|
echo '# generated by ghcup' > "${HOME}/.bash_profile"
|
||||||
|
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
|
||||||
|
echo 'test -f ~/.bashrc && . ~/.bashrc' >> "${HOME}/.bash_profile"
|
||||||
|
fi
|
||||||
|
;;
|
||||||
esac
|
esac
|
||||||
break ;;
|
break ;;
|
||||||
|
|
||||||
@@ -591,10 +599,12 @@ ask_bashrc
|
|||||||
ask_bashrc_answer=$?
|
ask_bashrc_answer=$?
|
||||||
ask_cabal_config_init
|
ask_cabal_config_init
|
||||||
ask_cabal_config_init_answer=$?
|
ask_cabal_config_init_answer=$?
|
||||||
ask_hls
|
if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||||
ask_hls_answer=$?
|
ask_hls
|
||||||
ask_stack
|
ask_hls_answer=$?
|
||||||
ask_stack_answer=$?
|
ask_stack
|
||||||
|
ask_stack_answer=$?
|
||||||
|
fi
|
||||||
|
|
||||||
edo mkdir -p "${GHCUP_BIN}"
|
edo mkdir -p "${GHCUP_BIN}"
|
||||||
|
|
||||||
@@ -620,14 +630,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
|
|||||||
read -r answer </dev/tty
|
read -r answer </dev/tty
|
||||||
fi
|
fi
|
||||||
|
|
||||||
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||||
|
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
||||||
|
|
||||||
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
||||||
eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
||||||
|
|
||||||
do_cabal_config_init $ask_cabal_config_init_answer
|
do_cabal_config_init $ask_cabal_config_init_answer
|
||||||
|
|
||||||
edo cabal new-update
|
edo cabal new-update
|
||||||
|
else # don't install ghc and cabal
|
||||||
|
case "${plat}" in
|
||||||
|
MSYS*|MINGW*)
|
||||||
|
# need to bootstrap cabal to initialize config on windows
|
||||||
|
# we'll remove it afterwards
|
||||||
|
tmp_dir="$(mktemp -d)"
|
||||||
|
eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
||||||
|
PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
|
||||||
|
rm "${tmp_dir}/cabal"
|
||||||
|
unset tmp_dir
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
fi
|
||||||
|
|
||||||
case $ask_hls_answer in
|
case $ask_hls_answer in
|
||||||
1)
|
1)
|
||||||
|
|||||||
@@ -15,24 +15,26 @@
|
|||||||
param (
|
param (
|
||||||
# Run an interactive installation
|
# Run an interactive installation
|
||||||
[switch]$Interactive,
|
[switch]$Interactive,
|
||||||
# Specify the install root (default: 'C:\')
|
# Do minimal installation of ghcup and msys2 only
|
||||||
[string]$InstallDir,
|
[switch]$Minimal,
|
||||||
# Instead of installing a new MSys2, use an existing installation
|
|
||||||
[string]$ExistingMsys2Dir,
|
|
||||||
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
|
||||||
[string]$CabalDir,
|
|
||||||
# Overwrite (or rather backup) a previous install
|
|
||||||
[switch]$Overwrite,
|
|
||||||
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
|
|
||||||
[string]$BootstrapUrl,
|
|
||||||
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
|
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
|
||||||
[switch]$InBash,
|
[switch]$InBash,
|
||||||
|
# Overwrite (or rather backup) a previous install
|
||||||
|
[switch]$Overwrite,
|
||||||
|
# Skip adjusting cabal.config with mingw paths
|
||||||
|
[switch]$NoAdjustCabalConfig,
|
||||||
# Whether to install stack as well
|
# Whether to install stack as well
|
||||||
[switch]$InstallStack,
|
[switch]$InstallStack,
|
||||||
# Whether to install hls as well
|
# Whether to install hls as well
|
||||||
[switch]$InstallHLS,
|
[switch]$InstallHLS,
|
||||||
# Skip adjusting cabal.config with mingw paths
|
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
|
||||||
[switch]$NoAdjustCabalConfig
|
[string]$InstallDir,
|
||||||
|
# Instead of installing a new MSys2, use an existing installation
|
||||||
|
[string]$BootstrapUrl,
|
||||||
|
# Specify the install root (default: 'C:\')
|
||||||
|
[string]$ExistingMsys2Dir,
|
||||||
|
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
||||||
|
[string]$CabalDir
|
||||||
)
|
)
|
||||||
|
|
||||||
$Silent = !$Interactive
|
$Silent = !$Interactive
|
||||||
@@ -180,7 +182,7 @@ elevated command prompt:
|
|||||||
|
|
||||||
if ($GhcupBasePrefixEnv) {
|
if ($GhcupBasePrefixEnv) {
|
||||||
$defaultGhcupBasePrefix = $GhcupBasePrefixEnv
|
$defaultGhcupBasePrefix = $GhcupBasePrefixEnv
|
||||||
} else {
|
} elseif (!($InstallDir)) {
|
||||||
$partitions = Get-CimInstance win32_logicaldisk
|
$partitions = Get-CimInstance win32_logicaldisk
|
||||||
$defaultGhcupBasePrefix = $null
|
$defaultGhcupBasePrefix = $null
|
||||||
foreach ($p in $partitions){
|
foreach ($p in $partitions){
|
||||||
@@ -209,10 +211,10 @@ if ($Silent -and !($InstallDir)) {
|
|||||||
$GhcupBasePrefix = $defaultGhcupBasePrefix
|
$GhcupBasePrefix = $defaultGhcupBasePrefix
|
||||||
} elseif ($InstallDir) {
|
} elseif ($InstallDir) {
|
||||||
if (!(Test-Path -LiteralPath ('{0}' -f $InstallDir) -IsValid)) {
|
if (!(Test-Path -LiteralPath ('{0}' -f $InstallDir) -IsValid)) {
|
||||||
Print-Msg -color Red -msg "Not a valid directory!"
|
Print-Msg -color Red -msg "Not a valid directory! (InstallDir)"
|
||||||
Exit 1
|
Exit 1
|
||||||
} elseif (!(Split-Path -IsAbsolute -Path "$InstallDir")) {
|
} elseif (!(Split-Path -IsAbsolute -Path "$InstallDir")) {
|
||||||
Print-Msg -color Red -msg "Non-absolute Path specified!"
|
Print-Msg -color Red -msg "Non-absolute Path specified! (InstallDir)"
|
||||||
Exit 1
|
Exit 1
|
||||||
} else {
|
} else {
|
||||||
$GhcupBasePrefix = $InstallDir
|
$GhcupBasePrefix = $InstallDir
|
||||||
@@ -243,7 +245,20 @@ $null = [Environment]::SetEnvironmentVariable("GHCUP_INSTALL_BASE_PREFIX", $Ghcu
|
|||||||
|
|
||||||
|
|
||||||
$GhcupDir = ('{0}\ghcup' -f $GhcupBasePrefix)
|
$GhcupDir = ('{0}\ghcup' -f $GhcupBasePrefix)
|
||||||
$MsysDir = ('{0}\msys64' -f $GhcupDir)
|
if ($ExistingMsys2Dir) {
|
||||||
|
if (!(Test-Path -LiteralPath ('{0}' -f $ExistingMsys2Dir) -IsValid)) {
|
||||||
|
Print-Msg -color Red -msg "Not a valid directory! (ExistingMsys2Dir)"
|
||||||
|
Exit 1
|
||||||
|
} elseif (!(Split-Path -IsAbsolute -Path "$ExistingMsys2Dir")) {
|
||||||
|
Print-Msg -color Red -msg "Non-absolute Path specified! (ExistingMsys2Dir)"
|
||||||
|
Exit 1
|
||||||
|
} else {
|
||||||
|
$MsysDir = $ExistingMsys2Dir
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$MsysDir = ('{0}\msys64' -f $GhcupDir)
|
||||||
|
}
|
||||||
|
|
||||||
$Bash = ('{0}\usr\bin\bash' -f $MsysDir)
|
$Bash = ('{0}\usr\bin\bash' -f $MsysDir)
|
||||||
if (!($BootstrapUrl)) {
|
if (!($BootstrapUrl)) {
|
||||||
$BootstrapUrl = 'https://www.haskell.org/ghcup/sh/bootstrap-haskell'
|
$BootstrapUrl = 'https://www.haskell.org/ghcup/sh/bootstrap-haskell'
|
||||||
@@ -398,6 +413,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
|
|
||||||
Print-Msg -msg 'Setting default home directory...'
|
Print-Msg -msg 'Setting default home directory...'
|
||||||
Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
|
Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
|
||||||
|
|
||||||
} elseif ($msys2Decision -eq 1) {
|
} elseif ($msys2Decision -eq 1) {
|
||||||
Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
|
Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
|
||||||
while ($true) {
|
while ($true) {
|
||||||
@@ -529,10 +545,14 @@ if (!($NoAdjustCabalConfig)) {
|
|||||||
$AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
|
$AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if ($Minimal) {
|
||||||
|
$MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
|
||||||
|
}
|
||||||
|
|
||||||
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
|
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
|
||||||
Exec "$Bash" '-lc' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
|
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
|
||||||
} else {
|
} else {
|
||||||
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
|
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -8,26 +8,27 @@ package ghcup
|
|||||||
tests: True
|
tests: True
|
||||||
flags: +tui
|
flags: +tui
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/jtdaugherty/brick.git
|
|
||||||
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
|
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/Bodigrim/tar
|
|
||||||
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
|
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/bgamari/terminal-size
|
location: https://github.com/bgamari/terminal-size
|
||||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||||
|
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/hasufell/libarchive
|
||||||
|
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||||
|
|
||||||
constraints: http-io-streams -brotli
|
constraints: http-io-streams -brotli
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: -system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
|
package aeson-pretty
|
||||||
|
flags: +lib-only
|
||||||
|
|
||||||
|
package cabal-plan
|
||||||
|
flags: -exe
|
||||||
|
|
||||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||||
|
|
||||||
with-compiler: ghc-8.10.5
|
with-compiler: ghc-8.10.7
|
||||||
@@ -1,15 +1,18 @@
|
|||||||
active-repositories: hackage.haskell.org:merge
|
active-repositories: hackage.haskell.org:merge
|
||||||
constraints: any.Cabal ==3.2.1.0,
|
constraints: any.Cabal ==3.2.1.0,
|
||||||
any.HUnit ==1.6.2.0,
|
any.HUnit ==1.6.2.0,
|
||||||
any.HsOpenSSL ==0.11.7,
|
any.HsOpenSSL ==0.11.7.1,
|
||||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||||
|
any.HsYAML ==0.2.1.0,
|
||||||
|
HsYAML -exe,
|
||||||
|
any.HsYAML-aeson ==0.2.0.0,
|
||||||
any.QuickCheck ==2.14.2,
|
any.QuickCheck ==2.14.2,
|
||||||
QuickCheck -old-random +templatehaskell,
|
QuickCheck -old-random +templatehaskell,
|
||||||
any.StateVar ==1.2.2,
|
any.StateVar ==1.2.2,
|
||||||
any.aeson ==1.5.6.0,
|
any.aeson ==1.5.6.0,
|
||||||
aeson -bytestring-builder -cffi -developer -fast,
|
aeson -bytestring-builder -cffi -developer -fast,
|
||||||
any.aeson-pretty ==0.8.8,
|
any.aeson-pretty ==0.8.8,
|
||||||
aeson-pretty -lib-only,
|
aeson-pretty +lib-only,
|
||||||
any.alex ==3.2.6,
|
any.alex ==3.2.6,
|
||||||
alex +small_base,
|
alex +small_base,
|
||||||
any.ansi-terminal ==0.11,
|
any.ansi-terminal ==0.11,
|
||||||
@@ -22,8 +25,7 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
async -bench,
|
async -bench,
|
||||||
any.attoparsec ==0.13.2.5,
|
any.attoparsec ==0.13.2.5,
|
||||||
attoparsec -developer,
|
attoparsec -developer,
|
||||||
any.auto-update ==0.1.6,
|
any.base ==4.14.3.0,
|
||||||
any.base ==4.14.2.0,
|
|
||||||
any.base-compat ==0.11.2,
|
any.base-compat ==0.11.2,
|
||||||
any.base-compat-batteries ==0.11.2,
|
any.base-compat-batteries ==0.11.2,
|
||||||
any.base-orphans ==0.8.4,
|
any.base-orphans ==0.8.4,
|
||||||
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.bifunctors ==5.5.11,
|
any.bifunctors ==5.5.11,
|
||||||
bifunctors +semigroups +tagged,
|
bifunctors +semigroups +tagged,
|
||||||
any.binary ==0.8.8.0,
|
any.binary ==0.8.8.0,
|
||||||
any.bindings-DSL ==1.0.25,
|
|
||||||
any.blaze-builder ==0.4.2.1,
|
any.blaze-builder ==0.4.2.1,
|
||||||
any.brick ==0.63,
|
any.brick ==0.64,
|
||||||
brick -demos,
|
brick -demos,
|
||||||
any.bytestring ==0.10.12.0,
|
any.bytestring ==0.10.12.0,
|
||||||
any.bz2 ==1.0.1.0,
|
any.bz2 ==1.0.1.0,
|
||||||
bz2 -cross +with-bzlib,
|
bz2 -cross +with-bzlib,
|
||||||
any.bzlib-conduit ==0.3.0.2,
|
|
||||||
any.c2hs ==0.28.8,
|
any.c2hs ==0.28.8,
|
||||||
c2hs +base3 -regression,
|
c2hs +base3 -regression,
|
||||||
|
any.cabal-plan ==0.7.2.0,
|
||||||
|
cabal-plan -_ -exe -license-report,
|
||||||
any.call-stack ==0.4.0,
|
any.call-stack ==0.4.0,
|
||||||
any.case-insensitive ==1.2.1.0,
|
any.case-insensitive ==1.2.1.0,
|
||||||
any.casing ==0.1.4.1,
|
any.casing ==0.1.4.1,
|
||||||
any.cereal ==0.5.8.1,
|
|
||||||
cereal -bytestring-builder,
|
|
||||||
any.chs-cabal ==0.1.1.0,
|
any.chs-cabal ==0.1.1.0,
|
||||||
any.chs-deps ==0.1.0.0,
|
any.chs-deps ==0.1.0.0,
|
||||||
chs-deps -cross,
|
chs-deps -cross,
|
||||||
any.clock ==0.8.2,
|
any.clock ==0.8.2,
|
||||||
clock -llvm,
|
clock -llvm,
|
||||||
any.cmdargs ==0.10.21,
|
|
||||||
cmdargs +quotation -testprog,
|
|
||||||
any.colour ==2.3.6,
|
any.colour ==2.3.6,
|
||||||
any.comonad ==5.0.8,
|
any.comonad ==5.0.8,
|
||||||
comonad +containers +distributive +indexed-traversable,
|
comonad +containers +distributive +indexed-traversable,
|
||||||
any.composition-prelude ==3.0.0.2,
|
any.composition-prelude ==3.0.0.2,
|
||||||
composition-prelude -development,
|
composition-prelude -development,
|
||||||
any.concurrent-output ==1.10.12,
|
any.concurrent-output ==1.10.12,
|
||||||
any.conduit ==1.3.4.1,
|
|
||||||
any.conduit-extra ==1.3.5,
|
|
||||||
any.conduit-zstd ==0.0.2.0,
|
|
||||||
any.config-ini ==0.2.4.0,
|
any.config-ini ==0.2.4.0,
|
||||||
config-ini -enable-doctests,
|
config-ini -enable-doctests,
|
||||||
any.containers ==0.6.4.1,
|
any.containers ==0.6.5.1,
|
||||||
any.contravariant ==1.5.4,
|
any.contravariant ==1.5.5,
|
||||||
contravariant +semigroups +statevar +tagged,
|
contravariant +semigroups +statevar +tagged,
|
||||||
any.cpphs ==1.20.9.1,
|
any.cpphs ==1.20.9.1,
|
||||||
cpphs -old-locale,
|
cpphs -old-locale,
|
||||||
@@ -74,44 +69,32 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.cryptohash-sha256 ==0.11.102.0,
|
any.cryptohash-sha256 ==0.11.102.0,
|
||||||
cryptohash-sha256 -exe +use-cbits,
|
cryptohash-sha256 -exe +use-cbits,
|
||||||
any.data-clist ==0.1.2.3,
|
any.data-clist ==0.1.2.3,
|
||||||
any.data-default-class ==0.1.2.0,
|
any.data-fix ==0.3.2,
|
||||||
any.data-fix ==0.3.1,
|
|
||||||
any.deepseq ==1.4.4.0,
|
any.deepseq ==1.4.4.0,
|
||||||
any.digest ==0.0.1.3,
|
|
||||||
digest -bytestring-in-base,
|
|
||||||
any.directory ==1.3.6.0,
|
any.directory ==1.3.6.0,
|
||||||
any.disk-free-space ==0.1.0.1,
|
any.disk-free-space ==0.1.0.1,
|
||||||
any.distributive ==0.6.2.1,
|
any.distributive ==0.6.2.1,
|
||||||
distributive +semigroups +tagged,
|
distributive +semigroups +tagged,
|
||||||
any.dlist ==1.0,
|
any.dlist ==1.0,
|
||||||
dlist -werror,
|
dlist -werror,
|
||||||
any.easy-file ==0.2.2,
|
|
||||||
any.errors ==2.3.0,
|
|
||||||
any.exceptions ==0.10.4,
|
any.exceptions ==0.10.4,
|
||||||
any.extra ==1.7.9,
|
|
||||||
any.fast-logger ==3.0.5,
|
|
||||||
any.filepath ==1.4.2.1,
|
any.filepath ==1.4.2.1,
|
||||||
any.free ==5.1.7,
|
any.free ==5.1.7,
|
||||||
any.generic-arbitrary ==0.1.0,
|
any.generic-arbitrary ==0.1.0,
|
||||||
any.generics-sop ==0.5.1.1,
|
any.ghc-boot-th ==8.10.7,
|
||||||
any.ghc-boot-th ==8.10.5,
|
|
||||||
any.ghc-byteorder ==4.11.0.0.10,
|
any.ghc-byteorder ==4.11.0.0.10,
|
||||||
any.ghc-prim ==0.6.1,
|
any.ghc-prim ==0.6.1,
|
||||||
any.happy ==1.20.0,
|
any.happy ==1.20.0,
|
||||||
any.hashable ==1.3.2.0,
|
any.hashable ==1.3.3.0,
|
||||||
hashable +integer-gmp -random-initial-seed,
|
hashable +integer-gmp -random-initial-seed,
|
||||||
any.haskell-src-exts ==1.23.1,
|
|
||||||
any.haskell-src-meta ==0.8.7,
|
|
||||||
any.haskus-utils-data ==1.4,
|
any.haskus-utils-data ==1.4,
|
||||||
any.haskus-utils-types ==1.5.1,
|
any.haskus-utils-types ==1.5.1,
|
||||||
any.haskus-utils-variant ==3.1,
|
any.haskus-utils-variant ==3.1,
|
||||||
any.hpath-filepath ==0.10.4,
|
|
||||||
any.hpath-posix ==0.13.3,
|
|
||||||
any.hsc2hs ==0.68.7,
|
any.hsc2hs ==0.68.7,
|
||||||
hsc2hs -in-ghc-tree,
|
hsc2hs -in-ghc-tree,
|
||||||
any.hspec ==2.7.10,
|
any.hspec ==2.7.10,
|
||||||
any.hspec-core ==2.7.10,
|
any.hspec-core ==2.7.10,
|
||||||
any.hspec-discover ==2.7.10 || ==2.8.2,
|
any.hspec-discover ==2.7.10 || ==2.8.3,
|
||||||
any.hspec-expectations ==0.8.2,
|
any.hspec-expectations ==0.8.2,
|
||||||
any.hspec-golden-aeson ==0.9.0.0,
|
any.hspec-golden-aeson ==0.9.0.0,
|
||||||
any.http-io-streams ==0.1.6.0,
|
any.http-io-streams ==0.1.6.0,
|
||||||
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||||
any.libarchive ==3.0.2.2,
|
any.libarchive ==3.0.2.2,
|
||||||
libarchive -cross -low-memory -system-libarchive,
|
libarchive -cross -low-memory -system-libarchive,
|
||||||
any.libyaml ==0.1.2,
|
|
||||||
libyaml -no-unicode -system-libyaml,
|
|
||||||
any.lifted-base ==0.2.3.12,
|
|
||||||
any.lzma-static ==5.2.5.4,
|
any.lzma-static ==5.2.5.4,
|
||||||
any.megaparsec ==9.0.1,
|
any.megaparsec ==9.0.1,
|
||||||
megaparsec -dev,
|
megaparsec -dev,
|
||||||
any.microlens ==0.4.12.0,
|
any.microlens ==0.4.12.0,
|
||||||
any.microlens-mtl ==0.2.0.1,
|
any.microlens-mtl ==0.2.0.1,
|
||||||
any.microlens-th ==0.4.3.10,
|
any.microlens-th ==0.4.3.10,
|
||||||
any.monad-control ==1.0.3,
|
|
||||||
any.monad-logger ==0.3.36,
|
|
||||||
monad-logger +template_haskell,
|
|
||||||
any.monad-loops ==0.4.3,
|
|
||||||
monad-loops +base4,
|
|
||||||
any.mono-traversable ==1.0.15.1,
|
|
||||||
any.mtl ==2.2.2,
|
any.mtl ==2.2.2,
|
||||||
any.network ==3.1.2.2,
|
any.network ==3.1.2.2,
|
||||||
network -devel,
|
network -devel,
|
||||||
any.network-uri ==2.6.4.1,
|
any.network-uri ==2.6.4.1,
|
||||||
any.old-locale ==1.0.0.7,
|
|
||||||
any.old-time ==1.1.0.3,
|
|
||||||
any.openssl-streams ==1.2.3.0,
|
any.openssl-streams ==1.2.3.0,
|
||||||
any.optics ==0.4,
|
any.optics ==0.4,
|
||||||
any.optics-core ==0.4,
|
any.optics-core ==0.4,
|
||||||
optics-core -explicit-generic-labels,
|
optics-core -explicit-generic-labels,
|
||||||
any.optics-extra ==0.4,
|
any.optics-extra ==0.4,
|
||||||
any.optics-th ==0.4,
|
any.optics-th ==0.4,
|
||||||
any.optics-vl ==0.2.1,
|
|
||||||
any.optparse-applicative ==0.16.1.0,
|
any.optparse-applicative ==0.16.1.0,
|
||||||
optparse-applicative +process,
|
optparse-applicative +process,
|
||||||
any.os-release ==1.0.2,
|
any.os-release ==1.0.2,
|
||||||
@@ -167,8 +138,8 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.polyparse ==1.13,
|
any.polyparse ==1.13,
|
||||||
any.pretty ==1.1.3.6,
|
any.pretty ==1.1.3.6,
|
||||||
any.pretty-terminal ==0.1.0.0,
|
any.pretty-terminal ==0.1.0.0,
|
||||||
any.primitive ==0.7.1.0,
|
any.primitive ==0.7.2.0,
|
||||||
any.process ==1.6.9.0,
|
any.process ==1.6.13.2,
|
||||||
any.profunctors ==5.6.2,
|
any.profunctors ==5.6.2,
|
||||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||||
any.quickcheck-io ==0.2.0,
|
any.quickcheck-io ==0.2.0,
|
||||||
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.regex-base ==0.94.0.1,
|
any.regex-base ==0.94.0.1,
|
||||||
any.regex-posix ==0.96.0.1,
|
any.regex-posix ==0.96.0.1,
|
||||||
regex-posix -_regex-posix-clib,
|
regex-posix -_regex-posix-clib,
|
||||||
any.resourcet ==1.2.4.2,
|
any.resourcet ==1.2.4.3,
|
||||||
any.rts ==1.0.1,
|
any.rts ==1.0.1,
|
||||||
any.safe ==0.3.19,
|
any.safe ==0.3.19,
|
||||||
any.safe-exceptions ==0.1.7.2,
|
any.safe-exceptions ==0.1.7.2,
|
||||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.semigroupoids ==5.3.5,
|
any.semigroupoids ==5.3.5,
|
||||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||||
any.setenv ==0.1.1.3,
|
any.setenv ==0.1.1.3,
|
||||||
any.sop-core ==0.5.0.1,
|
|
||||||
any.split ==0.2.3.4,
|
any.split ==0.2.3.4,
|
||||||
any.splitmix ==0.1.0.3,
|
any.splitmix ==0.1.0.3,
|
||||||
splitmix -optimised-mixer,
|
splitmix -optimised-mixer,
|
||||||
any.stm ==2.5.0.1,
|
any.stm ==2.5.0.1,
|
||||||
any.stm-chans ==3.0.0.4,
|
|
||||||
any.streaming-commons ==0.2.2.1,
|
|
||||||
streaming-commons -use-bytestring-builder,
|
|
||||||
any.strict ==0.4.0.1,
|
any.strict ==0.4.0.1,
|
||||||
strict +assoc,
|
strict +assoc,
|
||||||
any.strict-base ==0.4.0.0,
|
any.strict-base ==0.4.0.0,
|
||||||
any.string-interpolate ==0.3.1.1,
|
|
||||||
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
|
|
||||||
any.syb ==0.7.2.1,
|
|
||||||
any.tagged ==0.8.6.1,
|
any.tagged ==0.8.6.1,
|
||||||
tagged +deepseq +transformers,
|
tagged +deepseq +transformers,
|
||||||
any.tar ==0.6.0.0,
|
|
||||||
any.template-haskell ==2.16.0.0,
|
any.template-haskell ==2.16.0.0,
|
||||||
any.temporary ==1.3,
|
any.temporary ==1.3,
|
||||||
any.terminal-progress-bar ==0.4.1,
|
any.terminal-progress-bar ==0.4.1,
|
||||||
any.terminal-size ==0.3.2.1,
|
any.terminal-size ==0.3.2.1,
|
||||||
any.terminfo ==0.4.1.4,
|
any.terminfo ==0.4.1.4,
|
||||||
any.text ==1.2.4.1,
|
any.text ==1.2.4.1,
|
||||||
any.text-conversions ==0.3.1,
|
|
||||||
any.text-zipper ==0.11,
|
any.text-zipper ==0.11,
|
||||||
any.tf-random ==0.5,
|
any.tf-random ==0.5,
|
||||||
any.th-abstraction ==0.4.2.0,
|
any.th-abstraction ==0.4.2.0,
|
||||||
any.th-compat ==0.1.2,
|
any.th-compat ==0.1.2,
|
||||||
any.th-expand-syns ==0.4.8.0,
|
|
||||||
any.th-lift ==0.8.2,
|
any.th-lift ==0.8.2,
|
||||||
any.th-lift-instances ==0.1.18,
|
any.th-lift-instances ==0.1.18,
|
||||||
any.th-orphans ==0.13.11,
|
|
||||||
any.th-reify-many ==0.1.9,
|
|
||||||
any.these ==1.1.1.1,
|
any.these ==1.1.1.1,
|
||||||
these +assoc,
|
these +assoc,
|
||||||
any.time ==1.9.3,
|
any.time ==1.9.3,
|
||||||
any.time-compat ==1.9.6,
|
any.time-compat ==1.9.6,
|
||||||
time-compat -old-locale,
|
time-compat -old-locale,
|
||||||
any.transformers ==0.5.6.2,
|
any.transformers ==0.5.6.2,
|
||||||
any.transformers-base ==0.4.5.2,
|
any.transformers-base ==0.4.6,
|
||||||
transformers-base +orphaninstances,
|
transformers-base +orphaninstances,
|
||||||
any.transformers-compat ==0.7,
|
any.transformers-compat ==0.7,
|
||||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||||
any.typed-process ==0.2.6.0,
|
|
||||||
any.unix ==2.7.2.2,
|
any.unix ==2.7.2.2,
|
||||||
any.unix-bytestring ==0.3.7.3,
|
any.unix-bytestring ==0.3.7.3,
|
||||||
any.unix-compat ==0.5.3,
|
any.unix-compat ==0.5.3,
|
||||||
unix-compat -old-time,
|
unix-compat -old-time,
|
||||||
any.unix-time ==0.4.7,
|
|
||||||
any.unliftio-core ==0.2.0.1,
|
any.unliftio-core ==0.2.0.1,
|
||||||
any.unordered-containers ==0.2.14.0,
|
any.unordered-containers ==0.2.14.0,
|
||||||
unordered-containers -debug,
|
unordered-containers -debug,
|
||||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.2.1.0,
|
|||||||
any.uuid-types ==1.0.5,
|
any.uuid-types ==1.0.5,
|
||||||
any.vector ==0.12.3.0,
|
any.vector ==0.12.3.0,
|
||||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||||
any.vector-algorithms ==0.8.0.4,
|
|
||||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
|
||||||
any.versions ==5.0.0,
|
any.versions ==5.0.0,
|
||||||
any.vty ==5.33,
|
any.vty ==5.33,
|
||||||
any.word-wrap ==0.4.1,
|
any.word-wrap ==0.4.1,
|
||||||
any.word8 ==0.1.3,
|
any.word8 ==0.1.3,
|
||||||
any.xor ==0.0.1.0,
|
any.xor ==0.0.1.0,
|
||||||
any.yaml ==0.11.5.0,
|
|
||||||
yaml +no-examples +no-exe,
|
|
||||||
any.zip ==1.7.1,
|
|
||||||
zip -dev -disable-bzip2 -disable-zstd,
|
|
||||||
any.zlib ==0.6.2.3,
|
any.zlib ==0.6.2.3,
|
||||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||||
any.zlib-bindings ==0.1.1.5,
|
any.zlib-bindings ==0.1.1.5
|
||||||
any.zstd ==0.1.2.0,
|
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||||
zstd +standalone
|
|
||||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
|
||||||
@@ -8,26 +8,27 @@ package ghcup
|
|||||||
tests: True
|
tests: True
|
||||||
flags: +tui
|
flags: +tui
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/jtdaugherty/brick.git
|
|
||||||
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
|
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/Bodigrim/tar
|
|
||||||
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
|
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/bgamari/terminal-size
|
location: https://github.com/bgamari/terminal-size
|
||||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||||
|
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/hasufell/libarchive
|
||||||
|
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||||
|
|
||||||
constraints: http-io-streams -brotli
|
constraints: http-io-streams -brotli
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: -system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
|
package aeson-pretty
|
||||||
|
flags: +lib-only
|
||||||
|
|
||||||
|
package cabal-plan
|
||||||
|
flags: -exe
|
||||||
|
|
||||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||||
|
|
||||||
with-compiler: ghc-9.0.1
|
with-compiler: ghc-9.0.1
|
||||||
|
|||||||
@@ -1,15 +1,18 @@
|
|||||||
active-repositories: hackage.haskell.org:merge
|
active-repositories: hackage.haskell.org:merge
|
||||||
constraints: any.Cabal ==3.4.0.0,
|
constraints: any.Cabal ==3.4.0.0,
|
||||||
any.HUnit ==1.6.2.0,
|
any.HUnit ==1.6.2.0,
|
||||||
any.HsOpenSSL ==0.11.7,
|
any.HsOpenSSL ==0.11.7.1,
|
||||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||||
|
any.HsYAML ==0.2.1.0,
|
||||||
|
HsYAML -exe,
|
||||||
|
any.HsYAML-aeson ==0.2.0.0,
|
||||||
any.QuickCheck ==2.14.2,
|
any.QuickCheck ==2.14.2,
|
||||||
QuickCheck -old-random +templatehaskell,
|
QuickCheck -old-random +templatehaskell,
|
||||||
any.StateVar ==1.2.2,
|
any.StateVar ==1.2.2,
|
||||||
any.aeson ==1.5.6.0,
|
any.aeson ==1.5.6.0,
|
||||||
aeson -bytestring-builder -cffi -developer -fast,
|
aeson -bytestring-builder -cffi -developer -fast,
|
||||||
any.aeson-pretty ==0.8.8,
|
any.aeson-pretty ==0.8.8,
|
||||||
aeson-pretty -lib-only,
|
aeson-pretty +lib-only,
|
||||||
any.alex ==3.2.6,
|
any.alex ==3.2.6,
|
||||||
alex +small_base,
|
alex +small_base,
|
||||||
any.ansi-terminal ==0.11,
|
any.ansi-terminal ==0.11,
|
||||||
@@ -22,7 +25,6 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
async -bench,
|
async -bench,
|
||||||
any.attoparsec ==0.13.2.5,
|
any.attoparsec ==0.13.2.5,
|
||||||
attoparsec -developer,
|
attoparsec -developer,
|
||||||
any.auto-update ==0.1.6,
|
|
||||||
any.base ==4.15.0.0,
|
any.base ==4.15.0.0,
|
||||||
any.base-compat ==0.11.2,
|
any.base-compat ==0.11.2,
|
||||||
any.base-compat-batteries ==0.11.2,
|
any.base-compat-batteries ==0.11.2,
|
||||||
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.bifunctors ==5.5.11,
|
any.bifunctors ==5.5.11,
|
||||||
bifunctors +semigroups +tagged,
|
bifunctors +semigroups +tagged,
|
||||||
any.binary ==0.8.8.0,
|
any.binary ==0.8.8.0,
|
||||||
any.bindings-DSL ==1.0.25,
|
|
||||||
any.blaze-builder ==0.4.2.1,
|
any.blaze-builder ==0.4.2.1,
|
||||||
any.brick ==0.63,
|
any.brick ==0.64,
|
||||||
brick -demos,
|
brick -demos,
|
||||||
any.bytestring ==0.10.12.1,
|
any.bytestring ==0.10.12.1,
|
||||||
any.bz2 ==1.0.1.0,
|
any.bz2 ==1.0.1.0,
|
||||||
bz2 -cross +with-bzlib,
|
bz2 -cross +with-bzlib,
|
||||||
any.bzlib-conduit ==0.3.0.2,
|
|
||||||
any.c2hs ==0.28.8,
|
any.c2hs ==0.28.8,
|
||||||
c2hs +base3 -regression,
|
c2hs +base3 -regression,
|
||||||
|
any.cabal-plan ==0.7.2.0,
|
||||||
|
cabal-plan -_ -exe -license-report,
|
||||||
any.call-stack ==0.4.0,
|
any.call-stack ==0.4.0,
|
||||||
any.case-insensitive ==1.2.1.0,
|
any.case-insensitive ==1.2.1.0,
|
||||||
any.casing ==0.1.4.1,
|
any.casing ==0.1.4.1,
|
||||||
any.cereal ==0.5.8.1,
|
|
||||||
cereal -bytestring-builder,
|
|
||||||
any.chs-cabal ==0.1.1.0,
|
any.chs-cabal ==0.1.1.0,
|
||||||
any.chs-deps ==0.1.0.0,
|
any.chs-deps ==0.1.0.0,
|
||||||
chs-deps -cross,
|
chs-deps -cross,
|
||||||
any.clock ==0.8.2,
|
any.clock ==0.8.2,
|
||||||
clock -llvm,
|
clock -llvm,
|
||||||
any.cmdargs ==0.10.21,
|
|
||||||
cmdargs +quotation -testprog,
|
|
||||||
any.colour ==2.3.6,
|
any.colour ==2.3.6,
|
||||||
any.comonad ==5.0.8,
|
any.comonad ==5.0.8,
|
||||||
comonad +containers +distributive +indexed-traversable,
|
comonad +containers +distributive +indexed-traversable,
|
||||||
any.composition-prelude ==3.0.0.2,
|
any.composition-prelude ==3.0.0.2,
|
||||||
composition-prelude -development,
|
composition-prelude -development,
|
||||||
any.concurrent-output ==1.10.12,
|
any.concurrent-output ==1.10.12,
|
||||||
any.conduit ==1.3.4.1,
|
|
||||||
any.conduit-extra ==1.3.5,
|
|
||||||
any.conduit-zstd ==0.0.2.0,
|
|
||||||
any.config-ini ==0.2.4.0,
|
any.config-ini ==0.2.4.0,
|
||||||
config-ini -enable-doctests,
|
config-ini -enable-doctests,
|
||||||
any.containers ==0.6.4.1,
|
any.containers ==0.6.4.1,
|
||||||
any.contravariant ==1.5.4,
|
any.contravariant ==1.5.5,
|
||||||
contravariant +semigroups +statevar +tagged,
|
contravariant +semigroups +statevar +tagged,
|
||||||
any.cpphs ==1.20.9.1,
|
any.cpphs ==1.20.9.1,
|
||||||
cpphs -old-locale,
|
cpphs -old-locale,
|
||||||
@@ -74,45 +69,33 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.cryptohash-sha256 ==0.11.102.0,
|
any.cryptohash-sha256 ==0.11.102.0,
|
||||||
cryptohash-sha256 -exe +use-cbits,
|
cryptohash-sha256 -exe +use-cbits,
|
||||||
any.data-clist ==0.1.2.3,
|
any.data-clist ==0.1.2.3,
|
||||||
any.data-default-class ==0.1.2.0,
|
any.data-fix ==0.3.2,
|
||||||
any.data-fix ==0.3.1,
|
|
||||||
any.deepseq ==1.4.5.0,
|
any.deepseq ==1.4.5.0,
|
||||||
any.digest ==0.0.1.3,
|
|
||||||
digest -bytestring-in-base,
|
|
||||||
any.directory ==1.3.6.1,
|
any.directory ==1.3.6.1,
|
||||||
any.disk-free-space ==0.1.0.1,
|
any.disk-free-space ==0.1.0.1,
|
||||||
any.distributive ==0.6.2.1,
|
any.distributive ==0.6.2.1,
|
||||||
distributive +semigroups +tagged,
|
distributive +semigroups +tagged,
|
||||||
any.dlist ==1.0,
|
any.dlist ==1.0,
|
||||||
dlist -werror,
|
dlist -werror,
|
||||||
any.easy-file ==0.2.2,
|
|
||||||
any.errors ==2.3.0,
|
|
||||||
any.exceptions ==0.10.4,
|
any.exceptions ==0.10.4,
|
||||||
any.extra ==1.7.9,
|
|
||||||
any.fast-logger ==3.0.5,
|
|
||||||
any.filepath ==1.4.2.1,
|
any.filepath ==1.4.2.1,
|
||||||
any.free ==5.1.7,
|
any.free ==5.1.7,
|
||||||
any.generic-arbitrary ==0.1.0,
|
any.generic-arbitrary ==0.1.0,
|
||||||
any.generics-sop ==0.5.1.1,
|
|
||||||
any.ghc-bignum ==1.0,
|
any.ghc-bignum ==1.0,
|
||||||
any.ghc-boot-th ==9.0.1,
|
any.ghc-boot-th ==9.0.1,
|
||||||
any.ghc-byteorder ==4.11.0.0.10,
|
any.ghc-byteorder ==4.11.0.0.10,
|
||||||
any.ghc-prim ==0.7.0,
|
any.ghc-prim ==0.7.0,
|
||||||
any.happy ==1.20.0,
|
any.happy ==1.20.0,
|
||||||
any.hashable ==1.3.2.0,
|
any.hashable ==1.3.3.0,
|
||||||
hashable +integer-gmp -random-initial-seed,
|
hashable +integer-gmp -random-initial-seed,
|
||||||
any.haskell-src-exts ==1.23.1,
|
|
||||||
any.haskell-src-meta ==0.8.7,
|
|
||||||
any.haskus-utils-data ==1.4,
|
any.haskus-utils-data ==1.4,
|
||||||
any.haskus-utils-types ==1.5.1,
|
any.haskus-utils-types ==1.5.1,
|
||||||
any.haskus-utils-variant ==3.1,
|
any.haskus-utils-variant ==3.1,
|
||||||
any.hpath-filepath ==0.10.4,
|
|
||||||
any.hpath-posix ==0.13.3,
|
|
||||||
any.hsc2hs ==0.68.7,
|
any.hsc2hs ==0.68.7,
|
||||||
hsc2hs -in-ghc-tree,
|
hsc2hs -in-ghc-tree,
|
||||||
any.hspec ==2.7.10,
|
any.hspec ==2.7.10,
|
||||||
any.hspec-core ==2.7.10,
|
any.hspec-core ==2.7.10,
|
||||||
any.hspec-discover ==2.7.10 || ==2.8.2,
|
any.hspec-discover ==2.7.10 || ==2.8.3,
|
||||||
any.hspec-expectations ==0.8.2,
|
any.hspec-expectations ==0.8.2,
|
||||||
any.hspec-golden-aeson ==0.9.0.0,
|
any.hspec-golden-aeson ==0.9.0.0,
|
||||||
any.http-io-streams ==0.1.6.0,
|
any.http-io-streams ==0.1.6.0,
|
||||||
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||||
any.libarchive ==3.0.2.2,
|
any.libarchive ==3.0.2.2,
|
||||||
libarchive -cross -low-memory -system-libarchive,
|
libarchive -cross -low-memory -system-libarchive,
|
||||||
any.libyaml ==0.1.2,
|
|
||||||
libyaml -no-unicode -system-libyaml,
|
|
||||||
any.lifted-base ==0.2.3.12,
|
|
||||||
any.lzma-static ==5.2.5.4,
|
any.lzma-static ==5.2.5.4,
|
||||||
any.megaparsec ==9.0.1,
|
any.megaparsec ==9.0.1,
|
||||||
megaparsec -dev,
|
megaparsec -dev,
|
||||||
any.microlens ==0.4.12.0,
|
any.microlens ==0.4.12.0,
|
||||||
any.microlens-mtl ==0.2.0.1,
|
any.microlens-mtl ==0.2.0.1,
|
||||||
any.microlens-th ==0.4.3.10,
|
any.microlens-th ==0.4.3.10,
|
||||||
any.monad-control ==1.0.3,
|
|
||||||
any.monad-logger ==0.3.36,
|
|
||||||
monad-logger +template_haskell,
|
|
||||||
any.monad-loops ==0.4.3,
|
|
||||||
monad-loops +base4,
|
|
||||||
any.mono-traversable ==1.0.15.1,
|
|
||||||
any.mtl ==2.2.2,
|
any.mtl ==2.2.2,
|
||||||
any.network ==3.1.2.2,
|
any.network ==3.1.2.2,
|
||||||
network -devel,
|
network -devel,
|
||||||
any.network-uri ==2.6.4.1,
|
any.network-uri ==2.6.4.1,
|
||||||
any.old-locale ==1.0.0.7,
|
|
||||||
any.old-time ==1.1.0.3,
|
|
||||||
any.openssl-streams ==1.2.3.0,
|
any.openssl-streams ==1.2.3.0,
|
||||||
any.optics ==0.4,
|
any.optics ==0.4,
|
||||||
any.optics-core ==0.4,
|
any.optics-core ==0.4,
|
||||||
optics-core -explicit-generic-labels,
|
optics-core -explicit-generic-labels,
|
||||||
any.optics-extra ==0.4,
|
any.optics-extra ==0.4,
|
||||||
any.optics-th ==0.4,
|
any.optics-th ==0.4,
|
||||||
any.optics-vl ==0.2.1,
|
|
||||||
any.optparse-applicative ==0.16.1.0,
|
any.optparse-applicative ==0.16.1.0,
|
||||||
optparse-applicative +process,
|
optparse-applicative +process,
|
||||||
any.os-release ==1.0.2,
|
any.os-release ==1.0.2,
|
||||||
@@ -167,7 +138,7 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.polyparse ==1.13,
|
any.polyparse ==1.13,
|
||||||
any.pretty ==1.1.3.6,
|
any.pretty ==1.1.3.6,
|
||||||
any.pretty-terminal ==0.1.0.0,
|
any.pretty-terminal ==0.1.0.0,
|
||||||
any.primitive ==0.7.1.0,
|
any.primitive ==0.7.2.0,
|
||||||
any.process ==1.6.11.0,
|
any.process ==1.6.11.0,
|
||||||
any.profunctors ==5.6.2,
|
any.profunctors ==5.6.2,
|
||||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||||
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.regex-base ==0.94.0.1,
|
any.regex-base ==0.94.0.1,
|
||||||
any.regex-posix ==0.96.0.1,
|
any.regex-posix ==0.96.0.1,
|
||||||
regex-posix -_regex-posix-clib,
|
regex-posix -_regex-posix-clib,
|
||||||
any.resourcet ==1.2.4.2,
|
any.resourcet ==1.2.4.3,
|
||||||
any.rts ==1.0,
|
any.rts ==1.0,
|
||||||
any.safe ==0.3.19,
|
any.safe ==0.3.19,
|
||||||
any.safe-exceptions ==0.1.7.2,
|
any.safe-exceptions ==0.1.7.2,
|
||||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.semigroupoids ==5.3.5,
|
any.semigroupoids ==5.3.5,
|
||||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||||
any.setenv ==0.1.1.3,
|
any.setenv ==0.1.1.3,
|
||||||
any.sop-core ==0.5.0.1,
|
|
||||||
any.split ==0.2.3.4,
|
any.split ==0.2.3.4,
|
||||||
any.splitmix ==0.1.0.3,
|
any.splitmix ==0.1.0.3,
|
||||||
splitmix -optimised-mixer,
|
splitmix -optimised-mixer,
|
||||||
any.stm ==2.5.0.0,
|
any.stm ==2.5.0.0,
|
||||||
any.stm-chans ==3.0.0.4,
|
|
||||||
any.streaming-commons ==0.2.2.1,
|
|
||||||
streaming-commons -use-bytestring-builder,
|
|
||||||
any.strict ==0.4.0.1,
|
any.strict ==0.4.0.1,
|
||||||
strict +assoc,
|
strict +assoc,
|
||||||
any.strict-base ==0.4.0.0,
|
any.strict-base ==0.4.0.0,
|
||||||
any.string-interpolate ==0.3.1.1,
|
|
||||||
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
|
|
||||||
any.syb ==0.7.2.1,
|
|
||||||
any.tagged ==0.8.6.1,
|
any.tagged ==0.8.6.1,
|
||||||
tagged +deepseq +transformers,
|
tagged +deepseq +transformers,
|
||||||
any.tar ==0.6.0.0,
|
|
||||||
any.template-haskell ==2.17.0.0,
|
any.template-haskell ==2.17.0.0,
|
||||||
any.temporary ==1.3,
|
any.temporary ==1.3,
|
||||||
any.terminal-progress-bar ==0.4.1,
|
any.terminal-progress-bar ==0.4.1,
|
||||||
any.terminal-size ==0.3.2.1,
|
any.terminal-size ==0.3.2.1,
|
||||||
any.terminfo ==0.4.1.4,
|
any.terminfo ==0.4.1.4,
|
||||||
any.text ==1.2.4.1,
|
any.text ==1.2.4.1,
|
||||||
any.text-conversions ==0.3.1,
|
|
||||||
any.text-zipper ==0.11,
|
any.text-zipper ==0.11,
|
||||||
any.tf-random ==0.5,
|
any.tf-random ==0.5,
|
||||||
any.th-abstraction ==0.4.2.0,
|
any.th-abstraction ==0.4.2.0,
|
||||||
any.th-compat ==0.1.2,
|
any.th-compat ==0.1.2,
|
||||||
any.th-expand-syns ==0.4.8.0,
|
|
||||||
any.th-lift ==0.8.2,
|
any.th-lift ==0.8.2,
|
||||||
any.th-lift-instances ==0.1.18,
|
any.th-lift-instances ==0.1.18,
|
||||||
any.th-orphans ==0.13.11,
|
|
||||||
any.th-reify-many ==0.1.9,
|
|
||||||
any.these ==1.1.1.1,
|
any.these ==1.1.1.1,
|
||||||
these +assoc,
|
these +assoc,
|
||||||
any.time ==1.9.3,
|
any.time ==1.9.3,
|
||||||
any.time-compat ==1.9.6,
|
any.time-compat ==1.9.6,
|
||||||
time-compat -old-locale,
|
time-compat -old-locale,
|
||||||
any.transformers ==0.5.6.2,
|
any.transformers ==0.5.6.2,
|
||||||
any.transformers-base ==0.4.5.2,
|
any.transformers-base ==0.4.6,
|
||||||
transformers-base +orphaninstances,
|
transformers-base +orphaninstances,
|
||||||
any.transformers-compat ==0.7,
|
any.transformers-compat ==0.7,
|
||||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||||
any.typed-process ==0.2.6.0,
|
|
||||||
any.unix ==2.7.2.2,
|
any.unix ==2.7.2.2,
|
||||||
any.unix-bytestring ==0.3.7.3,
|
any.unix-bytestring ==0.3.7.3,
|
||||||
any.unix-compat ==0.5.3,
|
any.unix-compat ==0.5.3,
|
||||||
unix-compat -old-time,
|
unix-compat -old-time,
|
||||||
any.unix-time ==0.4.7,
|
|
||||||
any.unliftio-core ==0.2.0.1,
|
any.unliftio-core ==0.2.0.1,
|
||||||
any.unordered-containers ==0.2.14.0,
|
any.unordered-containers ==0.2.14.0,
|
||||||
unordered-containers -debug,
|
unordered-containers -debug,
|
||||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.4.0.0,
|
|||||||
any.uuid-types ==1.0.5,
|
any.uuid-types ==1.0.5,
|
||||||
any.vector ==0.12.3.0,
|
any.vector ==0.12.3.0,
|
||||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||||
any.vector-algorithms ==0.8.0.4,
|
|
||||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
|
||||||
any.versions ==5.0.0,
|
any.versions ==5.0.0,
|
||||||
any.vty ==5.33,
|
any.vty ==5.33,
|
||||||
any.word-wrap ==0.4.1,
|
any.word-wrap ==0.4.1,
|
||||||
any.word8 ==0.1.3,
|
any.word8 ==0.1.3,
|
||||||
any.xor ==0.0.1.0,
|
any.xor ==0.0.1.0,
|
||||||
any.yaml ==0.11.5.0,
|
|
||||||
yaml +no-examples +no-exe,
|
|
||||||
any.zip ==1.7.1,
|
|
||||||
zip -dev -disable-bzip2 -disable-zstd,
|
|
||||||
any.zlib ==0.6.2.3,
|
any.zlib ==0.6.2.3,
|
||||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||||
any.zlib-bindings ==0.1.1.5,
|
any.zlib-bindings ==0.1.1.5
|
||||||
any.zstd ==0.1.2.0,
|
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||||
zstd +standalone
|
|
||||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
|
||||||
|
|||||||
@@ -8,24 +8,25 @@ package ghcup
|
|||||||
tests: True
|
tests: True
|
||||||
flags: +tui
|
flags: +tui
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/jtdaugherty/brick.git
|
|
||||||
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
|
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/Bodigrim/tar
|
|
||||||
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
|
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/bgamari/terminal-size
|
location: https://github.com/bgamari/terminal-size
|
||||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||||
|
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/hasufell/libarchive
|
||||||
|
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||||
|
|
||||||
constraints: http-io-streams -brotli
|
constraints: http-io-streams -brotli
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: -system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
|
package aeson-pretty
|
||||||
|
flags: +lib-only
|
||||||
|
|
||||||
|
package cabal-plan
|
||||||
|
flags: -exe
|
||||||
|
|
||||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||||
|
|||||||
102
ghcup-0.0.6.yaml
102
ghcup-0.0.6.yaml
@@ -1690,7 +1690,6 @@ ghcupDownloads:
|
|||||||
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
|
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
|
||||||
8.10.6:
|
8.10.6:
|
||||||
viTags:
|
viTags:
|
||||||
- Recommended
|
|
||||||
- base-4.14.3.0
|
- base-4.14.3.0
|
||||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
||||||
viSourceDL:
|
viSourceDL:
|
||||||
@@ -1789,6 +1788,107 @@ ghcupDownloads:
|
|||||||
dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
|
dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
|
||||||
dlSubdir: ghc-8.10.6
|
dlSubdir: ghc-8.10.6
|
||||||
dlHash: d54de8306aa8b33afabf2ac94408e1f82c8e982a2a3346168c071b92bdb464c0
|
dlHash: d54de8306aa8b33afabf2ac94408e1f82c8e982a2a3346168c071b92bdb464c0
|
||||||
|
8.10.7:
|
||||||
|
viTags:
|
||||||
|
- Recommended
|
||||||
|
- base-4.14.3.0
|
||||||
|
viChangeLog: https://downloads.haskell.org/~ghc/8.10.7/docs/html/users_guide/8.10.7-notes.html
|
||||||
|
viSourceDL:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-src.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: e3eef6229ce9908dfe1ea41436befb0455fefb1932559e860ad4c606b0d03c9d
|
||||||
|
viPostRemove: *ghc-post-remove
|
||||||
|
viPreCompile: *ghc-pre-compile
|
||||||
|
viArch:
|
||||||
|
A_64:
|
||||||
|
Linux_Debian:
|
||||||
|
'( >= 9 && < 10 )': &ghc-8107-64-deb9
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb9-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: ced9870ea351af64fb48274b81a664cdb6a9266775f1598a79cbb6fdd5770a23
|
||||||
|
'( >= 10 && < 11 )': &ghc-8107-64-deb10
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb10-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: a13719bca87a0d3ac0c7d4157a4e60887009a7f1a8dbe95c4759ec413e086d30
|
||||||
|
unknown_versioning: *ghc-8107-64-deb9
|
||||||
|
Linux_Ubuntu:
|
||||||
|
unknown_versioning: &ghc-8107-64-fedora
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-fedora27-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: b6ed67049a23054a8042e65c9976d5e196e5ee4e83b29b2ee35c8a22ab1e5b73
|
||||||
|
'( >= 16 && < 19 )': *ghc-8107-64-deb9
|
||||||
|
Linux_Mint:
|
||||||
|
unknown_versioning: *ghc-8107-64-deb10
|
||||||
|
Linux_Fedora:
|
||||||
|
'( >= 27 && < 28 )': *ghc-8107-64-fedora
|
||||||
|
unknown_versioning: *ghc-8107-64-fedora
|
||||||
|
Linux_CentOS:
|
||||||
|
'( >= 7 && < 8 )': &ghc-8107-64-centos
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-centos7-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: 262a50bfb5b7c8770e0d99f54d42e5876968da7bf93e2e4d6cfe397891a36d05
|
||||||
|
unknown_versioning: *ghc-8107-64-centos
|
||||||
|
Linux_RedHat:
|
||||||
|
unknown_versioning: *ghc-8107-64-centos
|
||||||
|
Linux_Alpine:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-alpine3.10-linux-integer-simple.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7-x86_64-unknown-linux
|
||||||
|
dlHash: 16903df850ef73d5246f2ff169cbf57ecab76c2ac5acfa9928934282cfad575c
|
||||||
|
Linux_AmazonLinux:
|
||||||
|
unknown_versioning: *ghc-8107-64-centos
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning: *ghc-8107-64-fedora
|
||||||
|
Darwin:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-apple-darwin.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: 287db0f9c338c9f53123bfa8731b0996803ee50f6ee847fe388092e5e5132047
|
||||||
|
FreeBSD:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-freebsd.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: 45e35d24bc700e1093efa39189e9fa01498069881aed2fa8779c011941a80da1
|
||||||
|
Windows:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-mingw32.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: b6515b0ea3f7a6e34d92e7fcd0c1fef50d6030fe8f46883000185289a4b8ea9a
|
||||||
|
A_32:
|
||||||
|
Linux_Debian:
|
||||||
|
'( >= 9 && < 10 )': &ghc-8107-32-deb9
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-i386-deb9-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: fbfc1ef194f4e7a4c0da8c11cc69b17458a4b928b609b3622c97acc4acd5c5ab
|
||||||
|
unknown_versioning: *ghc-8107-32-deb9
|
||||||
|
Linux_Ubuntu:
|
||||||
|
unknown_versioning: *ghc-8107-32-deb9
|
||||||
|
Linux_Mint:
|
||||||
|
unknown_versioning: *ghc-8107-32-deb9
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning: *ghc-8107-32-deb9
|
||||||
|
Linux_Alpine:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/8.10.7/ghc-8.10.7-i386-alpine-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: 3110e6ee029d9d8062158b54b06f71a21b0fac87bf0e085f9be5bbcf73f99e6d
|
||||||
|
A_ARM64:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-deb10-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: fad2417f9b295233bf8ade79c0e6140896359e87be46cb61cd1d35863d9d0e55
|
||||||
|
Darwin:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-apple-darwin.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: dc469fc3c35fd2a33a5a575ffce87f13de7b98c2d349a41002e200a56d9bba1c
|
||||||
|
A_ARM:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-armv7-deb10-linux.tar.xz
|
||||||
|
dlSubdir: ghc-8.10.7
|
||||||
|
dlHash: 3949c31bdf7d3b4afb765ea8246bca4ca9707c5d988d9961a244f0da100956a2
|
||||||
9.0.1:
|
9.0.1:
|
||||||
viTags:
|
viTags:
|
||||||
- Latest
|
- Latest
|
||||||
|
|||||||
2494
ghcup-0.0.7.yaml
Normal file
2494
ghcup-0.0.7.yaml
Normal file
File diff suppressed because it is too large
Load Diff
55
ghcup.cabal
55
ghcup.cabal
@@ -21,6 +21,7 @@ extra-doc-files:
|
|||||||
ghcup-0.0.4.yaml
|
ghcup-0.0.4.yaml
|
||||||
ghcup-0.0.5.yaml
|
ghcup-0.0.5.yaml
|
||||||
ghcup-0.0.6.yaml
|
ghcup-0.0.6.yaml
|
||||||
|
ghcup-0.0.7.yaml
|
||||||
HACKING.md
|
HACKING.md
|
||||||
README.md
|
README.md
|
||||||
RELEASING.md
|
RELEASING.md
|
||||||
@@ -43,11 +44,6 @@ flag internal-downloader
|
|||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
flag tar
|
|
||||||
description: Use tar-bytestring instead of libarchive.
|
|
||||||
default: False
|
|
||||||
manual: True
|
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
GHCup
|
GHCup
|
||||||
@@ -108,19 +104,15 @@ library
|
|||||||
, deepseq ^>=1.4.4.0
|
, deepseq ^>=1.4.4.0
|
||||||
, directory ^>=1.3.6.0
|
, directory ^>=1.3.6.0
|
||||||
, disk-free-space ^>=0.1.0.1
|
, disk-free-space ^>=0.1.0.1
|
||||||
, extra ^>=1.7.9
|
|
||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, generics-sop ^>=0.5
|
|
||||||
, haskus-utils-types ^>=1.5
|
, haskus-utils-types ^>=1.5
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
|
, libarchive ^>=3.0.0.0
|
||||||
, lzma-static ^>=5.2.5.3
|
, lzma-static ^>=5.2.5.3
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
, monad-logger ^>=0.3.31
|
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
, optics ^>=0.4
|
, optics ^>=0.4
|
||||||
, optics-vl ^>=0.2
|
|
||||||
, os-release ^>=1.0.0
|
, os-release ^>=1.0.0
|
||||||
, parsec ^>=3.1
|
|
||||||
, pretty ^>=1.1.3.1
|
, pretty ^>=1.1.3.1
|
||||||
, pretty-terminal ^>=0.1.0.0
|
, pretty-terminal ^>=0.1.0.0
|
||||||
, regex-posix ^>=0.96
|
, regex-posix ^>=0.96
|
||||||
@@ -129,7 +121,6 @@ library
|
|||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, split ^>=0.2.3.4
|
, split ^>=0.2.3.4
|
||||||
, strict-base ^>=0.4
|
, strict-base ^>=0.4
|
||||||
, string-interpolate >=0.2.0.0 && <0.4
|
|
||||||
, template-haskell >=2.7 && <2.18
|
, template-haskell >=2.7 && <2.18
|
||||||
, temporary ^>=1.3
|
, temporary ^>=1.3
|
||||||
, text ^>=1.2.4.0
|
, text ^>=1.2.4.0
|
||||||
@@ -138,12 +129,10 @@ library
|
|||||||
, unliftio-core ^>=0.2.0.1
|
, unliftio-core ^>=0.2.0.1
|
||||||
, unordered-containers ^>=0.2.10.0
|
, unordered-containers ^>=0.2.10.0
|
||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, utf8-string ^>=1.0
|
|
||||||
, vector ^>=0.12
|
, vector ^>=0.12
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
, word8 ^>=0.1.3
|
, word8 ^>=0.1.3
|
||||||
, yaml ^>=0.11.4.0
|
, HsYAML-aeson ^>=0.2.0.0
|
||||||
, zip ^>=1.7.1
|
|
||||||
, zlib ^>=0.6.2.2
|
, zlib ^>=0.6.2.2
|
||||||
|
|
||||||
if (flag(internal-downloader) && !os(windows))
|
if (flag(internal-downloader) && !os(windows))
|
||||||
@@ -155,13 +144,6 @@ library
|
|||||||
, io-streams >=1.5.2.1
|
, io-streams >=1.5.2.1
|
||||||
, terminal-progress-bar >=0.4.1
|
, terminal-progress-bar >=0.4.1
|
||||||
|
|
||||||
if flag(tar)
|
|
||||||
cpp-options: -DTAR
|
|
||||||
build-depends: tar
|
|
||||||
|
|
||||||
else
|
|
||||||
build-depends: libarchive ^>=3.0.0.0
|
|
||||||
|
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
other-modules: GHCup.Utils.File.Windows
|
other-modules: GHCup.Utils.File.Windows
|
||||||
@@ -175,8 +157,6 @@ library
|
|||||||
other-modules: GHCup.Utils.File.Posix
|
other-modules: GHCup.Utils.File.Posix
|
||||||
build-depends:
|
build-depends:
|
||||||
, bz2 >=0.5.0.5 && <1.1
|
, bz2 >=0.5.0.5 && <1.1
|
||||||
, hpath-posix ^>=0.13.3
|
|
||||||
, process ^>=1.6.9
|
|
||||||
, unix ^>=2.7
|
, unix ^>=2.7
|
||||||
, unix-bytestring ^>=0.3.7.3
|
, unix-bytestring ^>=0.3.7.3
|
||||||
|
|
||||||
@@ -203,16 +183,19 @@ executable ghcup
|
|||||||
-fwarn-incomplete-record-updates -threaded
|
-fwarn-incomplete-record-updates -threaded
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
|
, aeson >=1.4 && <1.6
|
||||||
|
, aeson-pretty ^>=0.8.8
|
||||||
, async ^>=2.2.3
|
, async ^>=2.2.3
|
||||||
, base >=4.13 && <5
|
, base >=4.13 && <5
|
||||||
, bytestring ^>=0.10
|
, bytestring ^>=0.10
|
||||||
|
, cabal-plan ^>=0.7.2
|
||||||
, containers ^>=0.6
|
, containers ^>=0.6
|
||||||
, deepseq ^>=1.4
|
, deepseq ^>=1.4
|
||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
|
, libarchive ^>=3.0.0.0
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
, monad-logger ^>=0.3.31
|
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
, optparse-applicative >=0.15.1.0 && <0.17
|
, optparse-applicative >=0.15.1.0 && <0.17
|
||||||
, pretty ^>=1.1.3.1
|
, pretty ^>=1.1.3.1
|
||||||
@@ -220,13 +203,12 @@ executable ghcup
|
|||||||
, resourcet ^>=1.2.2
|
, resourcet ^>=1.2.2
|
||||||
, safe ^>=0.3.18
|
, safe ^>=0.3.18
|
||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, string-interpolate >=0.2.0.0 && <0.4
|
|
||||||
, template-haskell >=2.7 && <2.18
|
, template-haskell >=2.7 && <2.18
|
||||||
, text ^>=1.2.4.0
|
, text ^>=1.2.4.0
|
||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, utf8-string ^>=1.0
|
, utf8-string ^>=1.0
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
, yaml ^>=0.11.4.0
|
, HsYAML-aeson ^>=0.2.0.0
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if flag(internal-downloader)
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
@@ -235,7 +217,7 @@ executable ghcup
|
|||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
other-modules: BrickMain
|
other-modules: BrickMain
|
||||||
build-depends:
|
build-depends:
|
||||||
, brick >=0.5 && <0.64
|
, brick ^>=0.64
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, vector ^>=0.12
|
, vector ^>=0.12
|
||||||
, vty >=5.28.2 && <5.34
|
, vty >=5.28.2 && <5.34
|
||||||
@@ -243,12 +225,6 @@ executable ghcup
|
|||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
|
|
||||||
if flag(tar)
|
|
||||||
cpp-options: -DTAR
|
|
||||||
|
|
||||||
else
|
|
||||||
build-depends: libarchive ^>=3.0.0.0
|
|
||||||
|
|
||||||
executable ghcup-gen
|
executable ghcup-gen
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
hs-source-dirs: app/ghcup-gen
|
hs-source-dirs: app/ghcup-gen
|
||||||
@@ -280,7 +256,7 @@ executable ghcup-gen
|
|||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant >=3.0 && <3.2
|
||||||
, monad-logger ^>=0.3.31
|
, libarchive ^>=3.0.0.0
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
, optics ^>=0.4
|
, optics ^>=0.4
|
||||||
, optparse-applicative >=0.15.1.0 && <0.17
|
, optparse-applicative >=0.15.1.0 && <0.17
|
||||||
@@ -289,19 +265,10 @@ executable ghcup-gen
|
|||||||
, regex-posix ^>=0.96
|
, regex-posix ^>=0.96
|
||||||
, resourcet ^>=1.2.2
|
, resourcet ^>=1.2.2
|
||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, string-interpolate >=0.2.0.0 && <0.4
|
|
||||||
, text ^>=1.2.4.0
|
, text ^>=1.2.4.0
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, uri-bytestring ^>=0.3.2.2
|
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
, yaml ^>=0.11.4.0
|
, HsYAML-aeson ^>=0.2.0.0
|
||||||
|
|
||||||
if flag(tar)
|
|
||||||
cpp-options: -DTAR
|
|
||||||
build-depends: tar
|
|
||||||
|
|
||||||
else
|
|
||||||
build-depends: libarchive ^>=3.0.0.0
|
|
||||||
|
|
||||||
test-suite ghcup-test
|
test-suite ghcup-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|||||||
327
lib/GHCup.hs
327
lib/GHCup.hs
@@ -39,9 +39,7 @@ import GHCup.Utils.String.QQ
|
|||||||
import GHCup.Utils.Version.QQ
|
import GHCup.Utils.Version.QQ
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
|
|
||||||
#if !defined(TAR)
|
|
||||||
import Codec.Archive ( ArchiveResult )
|
import Codec.Archive ( ArchiveResult )
|
||||||
#endif
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.DeepSeq ( force )
|
import Control.DeepSeq ( force )
|
||||||
import Control.Exception ( evaluate )
|
import Control.Exception ( evaluate )
|
||||||
@@ -50,7 +48,6 @@ import Control.Monad
|
|||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
@@ -60,10 +57,8 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
|||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.List.Extra
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String ( fromString )
|
import Data.String ( fromString )
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Format.ISO8601
|
import Data.Time.Format.ISO8601
|
||||||
@@ -83,7 +78,7 @@ import System.IO.Error
|
|||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
import System.IO.Temp
|
import System.IO.Temp
|
||||||
#endif
|
#endif
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
|
|
||||||
import qualified Crypto.Hash.SHA256 as SHA256
|
import qualified Crypto.Hash.SHA256 as SHA256
|
||||||
@@ -92,6 +87,7 @@ import qualified Data.ByteString as B
|
|||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
import qualified System.Win32.File as Win32
|
import qualified System.Win32.File as Win32
|
||||||
@@ -114,7 +110,7 @@ fetchToolBindist :: ( MonadFail m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -142,7 +138,7 @@ fetchGHCSrc :: ( MonadFail m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -179,7 +175,7 @@ installGHCBindist :: ( MonadFail m
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -197,16 +193,14 @@ installGHCBindist :: ( MonadFail m
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, DirNotEmpty
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBindist dlinfo ver isoFilepath = do
|
installGHCBindist dlinfo ver isoFilepath = do
|
||||||
let tver = mkTVer ver
|
let tver = mkTVer ver
|
||||||
|
|
||||||
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
-- we only care for already installed errors in regular (non-isolated) installs
|
-- we only care for already installed errors in regular (non-isolated) installs
|
||||||
@@ -223,7 +217,7 @@ installGHCBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
Just isoDir -> do -- isolated install
|
Just isoDir -> do -- isolated install
|
||||||
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
|
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
|
||||||
Nothing -> do -- regular install
|
Nothing -> do -- regular install
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
||||||
@@ -237,9 +231,9 @@ installGHCBindist dlinfo ver isoFilepath = do
|
|||||||
case catMaybes r of
|
case catMaybes r of
|
||||||
[] -> pure ()
|
[] -> pure ()
|
||||||
_ -> do
|
_ -> do
|
||||||
lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker"
|
lift $ logWarn $ "CC/LD environment variable is set. This will change the compiler/linker"
|
||||||
lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
|
<> "\n" <> "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
|
||||||
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
|
<> "\n" <> "environments). If you encounter problems, unset CC and LD and reinstall."
|
||||||
|
|
||||||
|
|
||||||
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
|
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
|
||||||
@@ -251,7 +245,7 @@ installPackedGHC :: ( MonadMask m
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
@@ -264,9 +258,7 @@ installPackedGHC :: ( MonadMask m
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, DirNotEmpty
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
] m ()
|
] m ()
|
||||||
installPackedGHC dl msubdir inst ver = do
|
installPackedGHC dl msubdir inst ver = do
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
@@ -311,7 +303,7 @@ installUnpackedGHC :: ( MonadReader env m
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
@@ -322,7 +314,7 @@ installUnpackedGHC :: ( MonadReader env m
|
|||||||
-> Excepts '[ProcessError] m ()
|
-> Excepts '[ProcessError] m ()
|
||||||
installUnpackedGHC path inst ver = do
|
installUnpackedGHC path inst ver = do
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
lift $ $(logInfo) "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
-- Windows bindists are relocatable and don't need
|
-- Windows bindists are relocatable and don't need
|
||||||
-- to run configure.
|
-- to run configure.
|
||||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||||
@@ -339,7 +331,7 @@ installUnpackedGHC path inst ver = do
|
|||||||
| otherwise
|
| otherwise
|
||||||
= []
|
= []
|
||||||
|
|
||||||
lift $ $(logInfo) "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
lEM $ execLogged "sh"
|
lEM $ execLogged "sh"
|
||||||
("./configure" : ("--prefix=" <> inst)
|
("./configure" : ("--prefix=" <> inst)
|
||||||
: alpineArgs
|
: alpineArgs
|
||||||
@@ -365,7 +357,7 @@ installGHCBin :: ( MonadFail m
|
|||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -382,9 +374,7 @@ installGHCBin :: ( MonadFail m
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, DirNotEmpty
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
@@ -401,7 +391,7 @@ installCabalBindist :: ( MonadMask m
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -419,15 +409,13 @@ installCabalBindist :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
, FileAlreadyExistsError
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installCabalBindist dlinfo ver isoFilepath = do
|
installCabalBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
@@ -458,7 +446,7 @@ installCabalBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
Just isoDir -> do -- isolated install
|
Just isoDir -> do -- isolated install
|
||||||
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
|
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
|
||||||
liftE $ installCabalUnpacked workdir isoDir Nothing
|
liftE $ installCabalUnpacked workdir isoDir Nothing
|
||||||
|
|
||||||
Nothing -> do -- regular install
|
Nothing -> do -- regular install
|
||||||
@@ -470,19 +458,22 @@ installCabalBindist dlinfo ver isoFilepath = do
|
|||||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||||
|
|
||||||
-- | Install an unpacked cabal distribution.
|
-- | Install an unpacked cabal distribution.
|
||||||
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
|
||||||
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
||||||
-> FilePath -- ^ Path to install to
|
-> FilePath -- ^ Path to install to
|
||||||
-> Maybe Version -- ^ Nothing for isolated install
|
-> Maybe Version -- ^ Nothing for isolated install
|
||||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||||
installCabalUnpacked path inst mver' = do
|
installCabalUnpacked path inst mver' = do
|
||||||
lift $ $(logInfo) "Installing cabal"
|
lift $ logInfo "Installing cabal"
|
||||||
let cabalFile = "cabal"
|
let cabalFile = "cabal"
|
||||||
liftIO $ createDirRecursive' inst
|
liftIO $ createDirRecursive' inst
|
||||||
let destFileName = cabalFile
|
let destFileName = cabalFile
|
||||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
<> exeExt
|
<> exeExt
|
||||||
let destPath = inst </> destFileName
|
let destPath = inst </> destFileName
|
||||||
|
|
||||||
|
liftE $ throwIfFileAlreadyExists destPath
|
||||||
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> cabalFile <> exeExt)
|
(path </> cabalFile <> exeExt)
|
||||||
destPath
|
destPath
|
||||||
@@ -498,7 +489,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -515,9 +506,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
, FileAlreadyExistsError
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
@@ -535,7 +524,7 @@ installHLSBindist :: ( MonadMask m
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -553,14 +542,13 @@ installHLSBindist :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installHLSBindist dlinfo ver isoFilepath = do
|
installHLSBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
@@ -586,7 +574,7 @@ installHLSBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
Just isoDir -> do
|
Just isoDir -> do
|
||||||
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
|
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||||
liftE $ installHLSUnpacked workdir isoDir Nothing
|
liftE $ installHLSUnpacked workdir isoDir Nothing
|
||||||
|
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
@@ -599,13 +587,13 @@ installHLSBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Install an unpacked hls distribution.
|
-- | Install an unpacked hls distribution.
|
||||||
installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||||
-> FilePath -- ^ Path to install to
|
-> FilePath -- ^ Path to install to
|
||||||
-> Maybe Version -- ^ Nothing for isolated install
|
-> Maybe Version -- ^ Nothing for isolated install
|
||||||
-> Excepts '[CopyError] m ()
|
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||||
installHLSUnpacked path inst mver' = do
|
installHLSUnpacked path inst mver' = do
|
||||||
lift $ $(logInfo) "Installing HLS"
|
lift $ logInfo "Installing HLS"
|
||||||
liftIO $ createDirRecursive' inst
|
liftIO $ createDirRecursive' inst
|
||||||
|
|
||||||
-- install haskell-language-server-<ghcver>
|
-- install haskell-language-server-<ghcver>
|
||||||
@@ -619,20 +607,32 @@ installHLSUnpacked path inst mver' = do
|
|||||||
let toF = dropSuffix exeExt f
|
let toF = dropSuffix exeExt f
|
||||||
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
|
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
|
||||||
<> exeExt
|
<> exeExt
|
||||||
|
|
||||||
|
let srcPath = path </> f
|
||||||
|
let destPath = inst </> toF
|
||||||
|
|
||||||
|
liftE $ throwIfFileAlreadyExists destPath
|
||||||
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> f)
|
srcPath
|
||||||
(inst </> toF)
|
destPath
|
||||||
lift $ chmod_755 (inst </> toF)
|
lift $ chmod_755 destPath
|
||||||
|
|
||||||
-- install haskell-language-server-wrapper
|
-- install haskell-language-server-wrapper
|
||||||
let wrapper = "haskell-language-server-wrapper"
|
let wrapper = "haskell-language-server-wrapper"
|
||||||
toF = wrapper
|
toF = wrapper
|
||||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
<> exeExt
|
<> exeExt
|
||||||
|
srcWrapperPath = path </> wrapper <> exeExt
|
||||||
|
destWrapperPath = inst </> toF
|
||||||
|
|
||||||
|
liftE $ throwIfFileAlreadyExists destWrapperPath
|
||||||
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> wrapper <> exeExt)
|
srcWrapperPath
|
||||||
(inst </> toF)
|
destWrapperPath
|
||||||
lift $ chmod_755 (inst </> toF)
|
|
||||||
|
lift $ chmod_755 destWrapperPath
|
||||||
|
|
||||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||||
@@ -643,7 +643,7 @@ installHLSBin :: ( MonadMask m
|
|||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -660,9 +660,8 @@ installHLSBin :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
@@ -681,7 +680,7 @@ installStackBin :: ( MonadMask m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -698,9 +697,8 @@ installStackBin :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
@@ -717,7 +715,7 @@ installStackBindist :: ( MonadMask m
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
@@ -735,14 +733,13 @@ installStackBindist :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installStackBindist dlinfo ver isoFilepath = do
|
installStackBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
@@ -767,7 +764,7 @@ installStackBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
Just isoDir -> do -- isolated install
|
Just isoDir -> do -- isolated install
|
||||||
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
|
lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
|
||||||
liftE $ installStackUnpacked workdir isoDir Nothing
|
liftE $ installStackUnpacked workdir isoDir Nothing
|
||||||
Nothing -> do -- regular install
|
Nothing -> do -- regular install
|
||||||
liftE $ installStackUnpacked workdir binDir (Just ver)
|
liftE $ installStackUnpacked workdir binDir (Just ver)
|
||||||
@@ -779,19 +776,22 @@ installStackBindist dlinfo ver isoFilepath = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Install an unpacked stack distribution.
|
-- | Install an unpacked stack distribution.
|
||||||
installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
|
||||||
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
||||||
-> FilePath -- ^ Path to install to
|
-> FilePath -- ^ Path to install to
|
||||||
-> Maybe Version -- ^ Nothing for isolated installs
|
-> Maybe Version -- ^ Nothing for isolated installs
|
||||||
-> Excepts '[CopyError] m ()
|
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||||
installStackUnpacked path inst mver' = do
|
installStackUnpacked path inst mver' = do
|
||||||
lift $ $(logInfo) "Installing stack"
|
lift $ logInfo "Installing stack"
|
||||||
let stackFile = "stack"
|
let stackFile = "stack"
|
||||||
liftIO $ createDirRecursive' inst
|
liftIO $ createDirRecursive' inst
|
||||||
let destFileName = stackFile
|
let destFileName = stackFile
|
||||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
<> exeExt
|
<> exeExt
|
||||||
let destPath = inst </> destFileName
|
destPath = inst </> destFileName
|
||||||
|
|
||||||
|
liftE $ throwIfFileAlreadyExists destPath
|
||||||
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> stackFile <> exeExt)
|
(path </> stackFile <> exeExt)
|
||||||
destPath
|
destPath
|
||||||
@@ -815,7 +815,7 @@ installStackUnpacked path inst mver' = do
|
|||||||
-- for 'SetGHCOnly' constructor.
|
-- for 'SetGHCOnly' constructor.
|
||||||
setGHC :: ( MonadReader env m
|
setGHC :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -849,7 +849,7 @@ setGHC ver sghc = do
|
|||||||
SetGHCOnly -> pure $ Just file
|
SetGHCOnly -> pure $ Just file
|
||||||
SetGHC_XY -> do
|
SetGHC_XY -> do
|
||||||
handle
|
handle
|
||||||
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
|
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||||
$ do
|
$ do
|
||||||
(mj, mi) <- getMajorMinorV (_tvVersion ver)
|
(mj, mi) <- getMajorMinorV (_tvVersion ver)
|
||||||
let major' = intToText mj <> "." <> intToText mi
|
let major' = intToText mj <> "." <> intToText mi
|
||||||
@@ -874,7 +874,7 @@ setGHC ver sghc = do
|
|||||||
symlinkShareDir :: ( MonadReader env m
|
symlinkShareDir :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
@@ -891,9 +891,9 @@ setGHC ver sghc = do
|
|||||||
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
|
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
|
||||||
let fullF = destdir </> sharedir
|
let fullF = destdir </> sharedir
|
||||||
let targetF = "." </> "ghc" </> ver' </> sharedir
|
let targetF = "." </> "ghc" </> ver' </> sharedir
|
||||||
$(logDebug) [i|rm -f #{fullF}|]
|
logDebug $ "rm -f " <> T.pack fullF
|
||||||
hideError doesNotExistErrorType $ rmDirectoryLink fullF
|
hideError doesNotExistErrorType $ rmDirectoryLink fullF
|
||||||
$(logDebug) [i|ln -s #{targetF} #{fullF}|]
|
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||||
liftIO
|
liftIO
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
-- On windows we need to be more permissive
|
-- On windows we need to be more permissive
|
||||||
@@ -911,7 +911,7 @@ setGHC ver sghc = do
|
|||||||
setCabal :: ( MonadMask m
|
setCabal :: ( MonadMask m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -943,7 +943,7 @@ setCabal ver = do
|
|||||||
setHLS :: ( MonadCatch m
|
setHLS :: ( MonadCatch m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -959,7 +959,7 @@ setHLS ver = do
|
|||||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||||
oldSyms <- lift hlsSymlinks
|
oldSyms <- lift hlsSymlinks
|
||||||
forM_ oldSyms $ \f -> do
|
forM_ oldSyms $ \f -> do
|
||||||
lift $ $(logDebug) [i|rm #{binDir </> f}|]
|
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
||||||
lift $ rmLink (binDir </> f)
|
lift $ rmLink (binDir </> f)
|
||||||
|
|
||||||
-- set haskell-language-server-<ghcver> symlinks
|
-- set haskell-language-server-<ghcver> symlinks
|
||||||
@@ -984,7 +984,7 @@ setHLS ver = do
|
|||||||
setStack :: ( MonadMask m
|
setStack :: ( MonadMask m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -1047,9 +1047,9 @@ availableToolVersions av tool = view
|
|||||||
-- | List all versions from the download info, as well as stray
|
-- | List all versions from the download info, as well as stray
|
||||||
-- versions.
|
-- versions.
|
||||||
listVersions :: ( MonadCatch m
|
listVersions :: ( MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -1105,7 +1105,7 @@ listVersions lt' criteria = do
|
|||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map Version VersionInfo
|
||||||
@@ -1145,15 +1145,15 @@ listVersions lt' criteria = do
|
|||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
$(logWarn)
|
logWarn
|
||||||
[i|Could not parse version of stray directory #{e}|]
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
strayCabals :: ( MonadReader env m
|
strayCabals :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map Version VersionInfo
|
||||||
@@ -1180,15 +1180,15 @@ listVersions lt' criteria = do
|
|||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
$(logWarn)
|
logWarn
|
||||||
[i|Could not parse version of stray directory #{e}|]
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
strayHLS :: ( MonadReader env m
|
strayHLS :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m)
|
, MonadIO m)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map Version VersionInfo
|
||||||
-> Maybe Version
|
-> Maybe Version
|
||||||
@@ -1214,15 +1214,15 @@ listVersions lt' criteria = do
|
|||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
$(logWarn)
|
logWarn
|
||||||
[i|Could not parse version of stray directory #{e}|]
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
strayStacks :: ( MonadReader env m
|
strayStacks :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map Version VersionInfo
|
||||||
@@ -1249,8 +1249,8 @@ listVersions lt' criteria = do
|
|||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
$(logWarn)
|
logWarn
|
||||||
[i|Could not parse version of stray directory #{e}|]
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
||||||
@@ -1274,7 +1274,7 @@ listVersions lt' criteria = do
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- NOTE: this are not cross ones, because no bindists
|
-- NOTE: this are not cross ones, because no bindists
|
||||||
toListResult :: ( MonadLogger m
|
toListResult :: ( HasLog env
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
@@ -1376,7 +1376,7 @@ listVersions lt' criteria = do
|
|||||||
rmGHCVer :: ( MonadReader env m
|
rmGHCVer :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
@@ -1393,23 +1393,23 @@ rmGHCVer ver = do
|
|||||||
|
|
||||||
-- this isn't atomic, order matters
|
-- this isn't atomic, order matters
|
||||||
when isSetGHC $ do
|
when isSetGHC $ do
|
||||||
lift $ $(logInfo) [i|Removing ghc symlinks|]
|
lift $ logInfo "Removing ghc symlinks"
|
||||||
liftE $ rmPlain (_tvTarget ver)
|
liftE $ rmPlain (_tvTarget ver)
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
|
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||||
liftE $ rmMinorSymlinks ver
|
liftE $ rmMinorSymlinks ver
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
|
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||||
-- first remove
|
-- first remove
|
||||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
||||||
-- then fix them (e.g. with an earlier version)
|
-- then fix them (e.g. with an earlier version)
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Removing directory recursively: #{dir}|]
|
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
||||||
lift $ recyclePathForcibly dir
|
lift $ recyclePathForcibly dir
|
||||||
|
|
||||||
v' <-
|
v' <-
|
||||||
handle
|
handle
|
||||||
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
|
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||||
$ fmap Just
|
$ fmap Just
|
||||||
$ getMajorMinorV (_tvVersion ver)
|
$ getMajorMinorV (_tvVersion ver)
|
||||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
||||||
@@ -1426,7 +1426,7 @@ rmCabalVer :: ( MonadMask m
|
|||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
@@ -1457,7 +1457,7 @@ rmHLSVer :: ( MonadMask m
|
|||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
@@ -1480,7 +1480,7 @@ rmHLSVer ver = do
|
|||||||
oldSyms <- lift hlsSymlinks
|
oldSyms <- lift hlsSymlinks
|
||||||
forM_ oldSyms $ \f -> do
|
forM_ oldSyms $ \f -> do
|
||||||
let fullF = binDir </> f
|
let fullF = binDir </> f
|
||||||
lift $ $(logDebug) [i|rm #{fullF}|]
|
lift $ logDebug $ "rm " <> T.pack fullF
|
||||||
lift $ rmLink fullF
|
lift $ rmLink fullF
|
||||||
-- set latest hls
|
-- set latest hls
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
@@ -1495,7 +1495,7 @@ rmStackVer :: ( MonadMask m
|
|||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
@@ -1525,7 +1525,7 @@ rmGhcup :: ( MonadReader env m
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
@@ -1550,7 +1550,7 @@ rmGhcup = do
|
|||||||
|
|
||||||
let areEqualPaths = equalFilePath p1 p2
|
let areEqualPaths = equalFilePath p1 p2
|
||||||
|
|
||||||
unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||||
|
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
-- since it doesn't seem possible to delete a running exe on windows
|
-- since it doesn't seem possible to delete a running exe on windows
|
||||||
@@ -1566,7 +1566,7 @@ rmGhcup = do
|
|||||||
|
|
||||||
where
|
where
|
||||||
handlePathNotPresent fp _err = do
|
handlePathNotPresent fp _err = do
|
||||||
$logDebug $ "Error: The path does not exist, " <> T.pack fp
|
logDebug $ "Error: The path does not exist, " <> T.pack fp
|
||||||
pure fp
|
pure fp
|
||||||
|
|
||||||
nonStandardInstallLocationMsg path = T.pack $
|
nonStandardInstallLocationMsg path = T.pack $
|
||||||
@@ -1576,7 +1576,7 @@ rmGhcup = do
|
|||||||
|
|
||||||
rmTool :: ( MonadReader env m
|
rmTool :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadUnliftIO m)
|
, MonadUnliftIO m)
|
||||||
@@ -1596,7 +1596,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
|
|||||||
rmGhcupDirs :: ( MonadReader env m
|
rmGhcupDirs :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadMask m )
|
, MonadMask m )
|
||||||
=> m [FilePath]
|
=> m [FilePath]
|
||||||
@@ -1623,7 +1623,7 @@ rmGhcupDirs = do
|
|||||||
handleRm $ rmBinDir binDir
|
handleRm $ rmBinDir binDir
|
||||||
handleRm $ rmDir recycleDir
|
handleRm $ rmDir recycleDir
|
||||||
#if defined(IS_WINDOWS)
|
#if defined(IS_WINDOWS)
|
||||||
$logInfo [i|removing #{(baseDir </> "msys64")}|]
|
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||||
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@@ -1634,27 +1634,27 @@ rmGhcupDirs = do
|
|||||||
hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
|
hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
|
||||||
|
|
||||||
where
|
where
|
||||||
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
|
handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m) => m () -> m ()
|
||||||
handleRm = handleIO (\e -> $logDebug [i|Part of the cleanup action failed with error: #{displayException e}
|
handleRm = handleIO (\e -> logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
|
||||||
continuing regardless...|])
|
<> "continuing regardless...")
|
||||||
|
|
||||||
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
rmEnvFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||||
rmEnvFile enFilePath = do
|
rmEnvFile enFilePath = do
|
||||||
$logInfo "Removing Ghcup Environment File"
|
logInfo "Removing Ghcup Environment File"
|
||||||
hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
|
hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
|
||||||
|
|
||||||
rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
rmConfFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||||
rmConfFile confFilePath = do
|
rmConfFile confFilePath = do
|
||||||
$logInfo "removing Ghcup Config File"
|
logInfo "removing Ghcup Config File"
|
||||||
hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
|
hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
|
||||||
|
|
||||||
rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
rmDir :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||||
rmDir dir =
|
rmDir dir =
|
||||||
-- 'getDirectoryContentsRecursive' is lazy IO. In case
|
-- 'getDirectoryContentsRecursive' is lazy IO. In case
|
||||||
-- an error leaks through, we catch it here as well,
|
-- an error leaks through, we catch it here as well,
|
||||||
-- althought 'deleteFile' should already handle it.
|
-- althought 'deleteFile' should already handle it.
|
||||||
hideErrorDef [doesNotExistErrorType] () $ do
|
hideErrorDef [doesNotExistErrorType] () $ do
|
||||||
$logInfo [i|removing #{dir}|]
|
logInfo $ "removing " <> T.pack dir
|
||||||
contents <- liftIO $ getDirectoryContentsRecursive dir
|
contents <- liftIO $ getDirectoryContentsRecursive dir
|
||||||
forM_ contents (deleteFile . (dir </>))
|
forM_ contents (deleteFile . (dir </>))
|
||||||
|
|
||||||
@@ -1727,7 +1727,7 @@ getDebugInfo :: ( Alternative m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
@@ -1763,7 +1763,7 @@ compileGHC :: ( MonadMask m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
@@ -1791,9 +1791,7 @@ compileGHC :: ( MonadMask m
|
|||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
, DirNotEmpty
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
@@ -1805,7 +1803,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
Left tver -> do
|
Left tver -> do
|
||||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
|
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
@@ -1830,7 +1828,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
|
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
|
||||||
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||||
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
||||||
lift $ $(logInfo) [i|Fetching git repo #{rep} at ref #{ref} (this may take a while)|]
|
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||||
lEM $ git [ "init" ]
|
lEM $ git [ "init" ]
|
||||||
lEM $ git [ "remote"
|
lEM $ git [ "remote"
|
||||||
, "add"
|
, "add"
|
||||||
@@ -1857,7 +1855,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
|
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
|
||||||
|
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
|
||||||
lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|]
|
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
|
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
@@ -1869,10 +1867,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
when alreadyInstalled $ do
|
when alreadyInstalled $ do
|
||||||
case isolateDir of
|
case isolateDir of
|
||||||
Just isoDir ->
|
Just isoDir ->
|
||||||
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
|
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||||
Nothing ->
|
Nothing ->
|
||||||
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||||
lift $ $(logWarn)
|
lift $ logWarn
|
||||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
@@ -1899,7 +1897,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
-- only remove old ghc in regular installs
|
-- only remove old ghc in regular installs
|
||||||
when alreadyInstalled $ do
|
when alreadyInstalled $ do
|
||||||
lift $ $(logInfo) [i|Deleting existing installation|]
|
lift $ logInfo "Deleting existing installation"
|
||||||
liftE $ rmGHCVer tver
|
liftE $ rmGHCVer tver
|
||||||
|
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
@@ -1951,7 +1949,7 @@ endif|]
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
@@ -1974,11 +1972,11 @@ endif|]
|
|||||||
|
|
||||||
liftE $ configureBindist bghc tver workdir ghcdir
|
liftE $ configureBindist bghc tver workdir ghcdir
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
lift $ logInfo "Building (this may take a while)..."
|
||||||
hadrian_build <- liftE $ findHadrianFile workdir
|
hadrian_build <- liftE $ findHadrianFile workdir
|
||||||
lEM $ execLogged hadrian_build
|
lEM $ execLogged hadrian_build
|
||||||
( maybe [] (\j -> [[i|-j#{j}|]] ) jobs
|
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||||
++ maybe [] (\bf -> [[i|--flavour=#{bf}|]]) buildFlavour
|
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
||||||
++ ["binary-dist"]
|
++ ["binary-dist"]
|
||||||
)
|
)
|
||||||
(Just workdir) "ghc-make" Nothing
|
(Just workdir) "ghc-make" Nothing
|
||||||
@@ -2013,7 +2011,7 @@ endif|]
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
@@ -2040,19 +2038,19 @@ endif|]
|
|||||||
(FileDoesNotExistError bc)
|
(FileDoesNotExistError bc)
|
||||||
(liftIO $ copyFile bc (build_mk workdir))
|
(liftIO $ copyFile bc (build_mk workdir))
|
||||||
Nothing ->
|
Nothing ->
|
||||||
liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
|
liftIO $ T.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
|
||||||
|
|
||||||
liftE $ checkBuildConfig (build_mk workdir)
|
liftE $ checkBuildConfig (build_mk workdir)
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
lift $ logInfo "Building (this may take a while)..."
|
||||||
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
||||||
|
|
||||||
if | isCross tver -> do
|
if | isCross tver -> do
|
||||||
lift $ $(logInfo) [i|Installing cross toolchain...|]
|
lift $ logInfo "Installing cross toolchain..."
|
||||||
lEM $ make ["install"] (Just workdir)
|
lEM $ make ["install"] (Just workdir)
|
||||||
pure Nothing
|
pure Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
lift $ $(logInfo) [i|Creating bindist...|]
|
lift $ logInfo "Creating bindist..."
|
||||||
lEM $ make ["binary-dist"] (Just workdir)
|
lEM $ make ["binary-dist"] (Just workdir)
|
||||||
[tar] <- liftIO $ findFiles
|
[tar] <- liftIO $ findFiles
|
||||||
workdir
|
workdir
|
||||||
@@ -2071,7 +2069,7 @@ endif|]
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> FilePath -- ^ tar file
|
-> FilePath -- ^ tar file
|
||||||
@@ -2093,14 +2091,23 @@ endif|]
|
|||||||
. SHA256.hashlazy
|
. SHA256.hashlazy
|
||||||
$ c
|
$ c
|
||||||
cTime <- liftIO getCurrentTime
|
cTime <- liftIO getCurrentTime
|
||||||
let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|]
|
let tarName = makeValid ("ghc-"
|
||||||
|
<> T.unpack (tVerToText tver)
|
||||||
|
<> "-"
|
||||||
|
<> pfReqToString pfreq
|
||||||
|
<> "-"
|
||||||
|
<> iso8601Show cTime
|
||||||
|
<> "-"
|
||||||
|
<> T.unpack cDigest
|
||||||
|
<> ".tar"
|
||||||
|
<> takeExtension tar)
|
||||||
let tarPath = cacheDir </> tarName
|
let tarPath = cacheDir </> tarName
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||||
tarPath
|
tarPath
|
||||||
lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
|
lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
|
||||||
pure tarPath
|
pure tarPath
|
||||||
|
|
||||||
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
|
checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
|
||||||
=> FilePath
|
=> FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[FileDoesNotExistError, InvalidBuildConfig]
|
'[FileDoesNotExistError, InvalidBuildConfig]
|
||||||
@@ -2122,13 +2129,12 @@ endif|]
|
|||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
|
|
||||||
forM_ buildFlavour $ \bf ->
|
forM_ buildFlavour $ \bf ->
|
||||||
when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do
|
when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
|
||||||
lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|]
|
lift $ logWarn $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
|
||||||
liftIO $ threadDelay 5000000
|
liftIO $ threadDelay 5000000
|
||||||
|
|
||||||
addBuildFlavourToConf bc = case buildFlavour of
|
addBuildFlavourToConf bc = case buildFlavour of
|
||||||
Just bf -> [i|BuildFlavour = #{bf}
|
Just bf -> "BuildFlavour = " <> T.pack bf <> "\n" <> bc
|
||||||
|] <> [i|#{bc}|]
|
|
||||||
Nothing -> bc
|
Nothing -> bc
|
||||||
|
|
||||||
isCross :: GHCTargetVersion -> Bool
|
isCross :: GHCTargetVersion -> Bool
|
||||||
@@ -2141,7 +2147,7 @@ endif|]
|
|||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
@@ -2160,7 +2166,7 @@ endif|]
|
|||||||
m
|
m
|
||||||
()
|
()
|
||||||
configureBindist bghc tver workdir ghcdir = do
|
configureBindist bghc tver workdir ghcdir = do
|
||||||
lift $ $(logInfo) [s|configuring build|]
|
lift $ logInfo [s|configuring build|]
|
||||||
|
|
||||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||||
|
|
||||||
@@ -2224,7 +2230,7 @@ upgradeGHCup :: ( MonadMask m
|
|||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -2246,7 +2252,7 @@ upgradeGHCup mtarget force' = do
|
|||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
lift $ $(logInfo) [i|Upgrading GHCup...|]
|
lift $ logInfo "Upgrading GHCup..."
|
||||||
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
||||||
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||||
@@ -2255,20 +2261,28 @@ upgradeGHCup mtarget force' = do
|
|||||||
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
|
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
|
||||||
let destDir = takeDirectory destFile
|
let destDir = takeDirectory destFile
|
||||||
destFile = fromMaybe (binDir </> fn) mtarget
|
destFile = fromMaybe (binDir </> fn) mtarget
|
||||||
lift $ $(logDebug) [i|mkdir -p #{destDir}|]
|
lift $ logDebug $ "mkdir -p " <> T.pack destDir
|
||||||
liftIO $ createDirRecursive' destDir
|
liftIO $ createDirRecursive' destDir
|
||||||
lift $ $(logDebug) [i|rm -f #{destFile}|]
|
lift $ logDebug $ "rm -f " <> T.pack destFile
|
||||||
lift $ hideError NoSuchThing $ recycleFile destFile
|
lift $ hideError NoSuchThing $ recycleFile destFile
|
||||||
lift $ $(logDebug) [i|cp #{p} #{destFile}|]
|
lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||||
destFile
|
destFile
|
||||||
lift $ chmod_755 destFile
|
lift $ chmod_755 destFile
|
||||||
|
|
||||||
liftIO (isInPath destFile) >>= \b -> unless b $
|
liftIO (isInPath destFile) >>= \b -> unless b $
|
||||||
lift $ $(logWarn) [i|"#{takeFileName destFile}" is not in PATH! You have to add it in order to use ghcup.|]
|
lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
|
||||||
liftIO (isShadowed destFile) >>= \case
|
liftIO (isShadowed destFile) >>= \case
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{pa}". The upgrade will not be in effect, unless you remove "#{pa}" or make sure "#{destDir}" comes before "#{takeFileName pa}" in PATH.|]
|
Just pa -> lift $ logWarn $ "ghcup is shadowed by "
|
||||||
|
<> T.pack pa
|
||||||
|
<> ". The upgrade will not be in effect, unless you remove "
|
||||||
|
<> T.pack pa
|
||||||
|
<> " or make sure "
|
||||||
|
<> T.pack destDir
|
||||||
|
<> " comes before "
|
||||||
|
<> T.pack (takeFileName pa)
|
||||||
|
<> " in PATH."
|
||||||
|
|
||||||
pure latestVer
|
pure latestVer
|
||||||
|
|
||||||
@@ -2284,7 +2298,7 @@ upgradeGHCup mtarget force' = do
|
|||||||
-- both installing from source and bindist.
|
-- both installing from source and bindist.
|
||||||
postGHCInstall :: ( MonadReader env m
|
postGHCInstall :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -2300,7 +2314,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
|||||||
-- Create ghc-x.y symlinks. This may not be the current
|
-- Create ghc-x.y symlinks. This may not be the current
|
||||||
-- version, create it regardless.
|
-- version, create it regardless.
|
||||||
v' <-
|
v' <-
|
||||||
handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
|
handle (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||||
$ fmap Just
|
$ fmap Just
|
||||||
$ getMajorMinorV _tvVersion
|
$ getMajorMinorV _tvVersion
|
||||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
|
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
|
||||||
@@ -2316,7 +2330,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
|||||||
-- * for ghcup, this reports the location of the currently running executable
|
-- * for ghcup, this reports the location of the currently running executable
|
||||||
whereIsTool :: ( MonadReader env m
|
whereIsTool :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -2354,3 +2368,10 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
|||||||
liftIO $ canonicalizePath currentRunningExecPath
|
liftIO $ canonicalizePath currentRunningExecPath
|
||||||
|
|
||||||
|
|
||||||
|
throwIfFileAlreadyExists :: ( MonadIO m ) =>
|
||||||
|
FilePath ->
|
||||||
|
Excepts '[FileAlreadyExistsError] m ()
|
||||||
|
|
||||||
|
throwIfFileAlreadyExists fp = whenM (checkFileAlreadyExists fp)
|
||||||
|
(throwE $ FileAlreadyExistsError fp)
|
||||||
|
|
||||||
|
|||||||
@@ -1,10 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
@@ -34,8 +31,8 @@ import GHCup.Download.Utils
|
|||||||
#endif
|
#endif
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.JSON ( )
|
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Utils.Dirs
|
import GHCup.Utils.Dirs
|
||||||
import GHCup.Utils.File
|
import GHCup.Utils.File
|
||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
@@ -47,7 +44,6 @@ import Control.Monad
|
|||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
@@ -57,9 +53,8 @@ import Data.ByteString ( ByteString )
|
|||||||
#if defined(INTERNAL_DOWNLOADER)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import Data.CaseInsensitive ( mk )
|
import Data.CaseInsensitive ( mk )
|
||||||
#endif
|
#endif
|
||||||
import Data.List.Extra
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.List
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
@@ -73,6 +68,7 @@ import Prelude hiding ( abs
|
|||||||
, readFile
|
, readFile
|
||||||
, writeFile
|
, writeFile
|
||||||
)
|
)
|
||||||
|
import Safe
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
@@ -90,7 +86,7 @@ import qualified Data.Map.Strict as M
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.YAML.Aeson as Y
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -112,7 +108,7 @@ getDownloadsF :: ( FromJSONKey Tool
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
@@ -165,7 +161,7 @@ getBase :: ( MonadReader env m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
@@ -187,28 +183,27 @@ getBase uri = do
|
|||||||
|
|
||||||
-- if we didn't get a filepath from the download, use the cached yaml
|
-- if we didn't get a filepath from the download, use the cached yaml
|
||||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||||
lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|]
|
yamlContents <- liftIO $ L.readFile actualYaml
|
||||||
|
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||||
|
|
||||||
liftE
|
liftE
|
||||||
. onE_ (onError actualYaml)
|
. onE_ (onError actualYaml)
|
||||||
. lEM' @_ @_ @'[JSONError] JSONDecodeError
|
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
||||||
. fmap (first (\e -> [i|#{displayException e}
|
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||||
Consider removing "#{actualYaml}" manually.|]))
|
. Y.decode1
|
||||||
. liftIO
|
$ yamlContents
|
||||||
. Y.decodeFileEither
|
|
||||||
$ actualYaml
|
|
||||||
where
|
where
|
||||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||||
-- may re-download and succeed.
|
-- may re-download and succeed.
|
||||||
onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
||||||
onError fp = do
|
onError fp = do
|
||||||
let efp = etagsFile fp
|
let efp = etagsFile fp
|
||||||
handleIO (\e -> $(logWarn) [i|Couldn't remove file #{efp}, error was: #{displayException e}|])
|
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||||
(hideError doesNotExistErrorType $ rmFile efp)
|
(hideError doesNotExistErrorType $ rmFile efp)
|
||||||
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||||
warnCache s = do
|
warnCache s = do
|
||||||
lift $ $(logWarn) [i|Could not get download info, trying cached version (this may not be recent!)|]
|
lift $ logWarn "Could not get download info, trying cached version (this may not be recent!)"
|
||||||
lift $ $(logDebug) [i|Error was: #{s}|]
|
lift $ logDebug $ "Error was: " <> T.pack s
|
||||||
|
|
||||||
-- First check if the json file is in the ~/.ghcup/cache dir
|
-- First check if the json file is in the ~/.ghcup/cache dir
|
||||||
-- and check it's access time. If it has been accessed within the
|
-- and check it's access time. If it has been accessed within the
|
||||||
@@ -222,7 +217,7 @@ Consider removing "#{actualYaml}" manually.|]))
|
|||||||
, MonadCatch m1
|
, MonadCatch m1
|
||||||
, MonadIO m1
|
, MonadIO m1
|
||||||
, MonadFail m1
|
, MonadFail m1
|
||||||
, MonadLogger m1
|
, HasLog env1
|
||||||
, MonadMask m1
|
, MonadMask m1
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
@@ -313,7 +308,7 @@ download :: ( MonadReader env m
|
|||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
@@ -327,7 +322,7 @@ download uri eDigest dest mfn etags
|
|||||||
| scheme == "http" = dl
|
| scheme == "http" = dl
|
||||||
| scheme == "file" = do
|
| scheme == "file" = do
|
||||||
let destFile' = T.unpack . decUTF8Safe $ path
|
let destFile' = T.unpack . decUTF8Safe $ path
|
||||||
lift $ $(logDebug) [i|using local file: #{destFile'}|]
|
lift $ logDebug $ "using local file: " <> T.pack destFile'
|
||||||
forM_ eDigest (liftE . flip checkDigest destFile')
|
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||||
pure destFile'
|
pure destFile'
|
||||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||||
@@ -336,7 +331,7 @@ download uri eDigest dest mfn etags
|
|||||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||||
dl = do
|
dl = do
|
||||||
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
|
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
|
||||||
lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
|
lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
|
||||||
|
|
||||||
-- destination dir must exist
|
-- destination dir must exist
|
||||||
liftIO $ createDirRecursive' dest
|
liftIO $ createDirRecursive' dest
|
||||||
@@ -359,10 +354,10 @@ download uri eDigest dest mfn etags
|
|||||||
dh <- liftIO $ emptySystemTempFile "curl-header"
|
dh <- liftIO $ emptySystemTempFile "curl-header"
|
||||||
flip finally (try @_ @SomeException $ rmFile dh) $
|
flip finally (try @_ @SomeException $ rmFile dh) $
|
||||||
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
|
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
|
||||||
metag <- readETag destFile
|
metag <- lift $ readETag destFile
|
||||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||||
(o' ++ (if etags then ["--dump-header", dh] else [])
|
(o' ++ (if etags then ["--dump-header", dh] else [])
|
||||||
++ maybe [] (\t -> ["-H", [i|If-None-Match: #{t}|]]) metag
|
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
|
||||||
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
|
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
|
||||||
headers <- liftIO $ T.readFile dh
|
headers <- liftIO $ T.readFile dh
|
||||||
|
|
||||||
@@ -371,14 +366,14 @@ download uri eDigest dest mfn etags
|
|||||||
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
||||||
Just (http':sc:_)
|
Just (http':sc:_)
|
||||||
| sc == "304"
|
| sc == "304"
|
||||||
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|]
|
, T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
|
||||||
| T.pack "HTTP" `T.isPrefixOf` http' -> do
|
| T.pack "HTTP" `T.isPrefixOf` http' -> do
|
||||||
$logDebug [i|Status code was #{sc}, overwriting|]
|
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||||
liftIO $ copyFile (destFile <.> "tmp") destFile
|
liftIO $ copyFile (destFile <.> "tmp") destFile
|
||||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||||
:: V '[MalformedHeaders]))
|
:: V '[MalformedHeaders]))
|
||||||
|
|
||||||
writeEtags destFile (parseEtags headers)
|
lift $ writeEtags destFile (parseEtags headers)
|
||||||
else
|
else
|
||||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||||
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
||||||
@@ -388,20 +383,20 @@ download uri eDigest dest mfn etags
|
|||||||
o' <- liftIO getWgetOpts
|
o' <- liftIO getWgetOpts
|
||||||
if etags
|
if etags
|
||||||
then do
|
then do
|
||||||
metag <- readETag destFile
|
metag <- lift $ readETag destFile
|
||||||
let opts = o' ++ maybe [] (\t -> ["--header", [i|If-None-Match: #{t}|]]) metag
|
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
|
||||||
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
||||||
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
||||||
case _exitCode of
|
case _exitCode of
|
||||||
ExitSuccess -> do
|
ExitSuccess -> do
|
||||||
liftIO $ copyFile destFileTemp destFile
|
liftIO $ copyFile destFileTemp destFile
|
||||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||||
ExitFailure i'
|
ExitFailure i'
|
||||||
| i' == 8
|
| i' == 8
|
||||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||||
-> do
|
-> do
|
||||||
$logDebug "Not modified, skipping download"
|
lift $ logDebug "Not modified, skipping download"
|
||||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||||
else do
|
else do
|
||||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||||
@@ -412,14 +407,14 @@ download uri eDigest dest mfn etags
|
|||||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
|
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
|
||||||
if etags
|
if etags
|
||||||
then do
|
then do
|
||||||
metag <- readETag destFile
|
metag <- lift $ readETag destFile
|
||||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||||
, E.encodeUtf8 etag)]) metag
|
, E.encodeUtf8 etag)]) metag
|
||||||
liftE
|
liftE
|
||||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||||
$ do
|
$ do
|
||||||
r <- downloadToFile https host fullPath port destFile addHeaders
|
r <- downloadToFile https host fullPath port destFile addHeaders
|
||||||
writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||||
else void $ liftE $ catchE @HTTPNotModified
|
else void $ liftE $ catchE @HTTPNotModified
|
||||||
@'[DownloadFailed]
|
@'[DownloadFailed]
|
||||||
(\e@(HTTPNotModified _) ->
|
(\e@(HTTPNotModified _) ->
|
||||||
@@ -445,33 +440,33 @@ download uri eDigest dest mfn etags
|
|||||||
path = view pathL' uri
|
path = view pathL' uri
|
||||||
uri' = decUTF8Safe (serializeURIRef' uri)
|
uri' = decUTF8Safe (serializeURIRef' uri)
|
||||||
|
|
||||||
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
|
parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
|
||||||
parseEtags stderr = do
|
parseEtags stderr = do
|
||||||
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
|
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
|
||||||
case T.words <$> mEtag of
|
case T.words <$> mEtag of
|
||||||
(Just []) -> do
|
(Just []) -> do
|
||||||
$logDebug "Couldn't parse etags, no input: "
|
logDebug "Couldn't parse etags, no input: "
|
||||||
pure Nothing
|
pure Nothing
|
||||||
(Just [_, etag']) -> do
|
(Just [_, etag']) -> do
|
||||||
$logDebug [i|Parsed etag: #{etag'}|]
|
logDebug $ "Parsed etag: " <> etag'
|
||||||
pure (Just etag')
|
pure (Just etag')
|
||||||
(Just xs) -> do
|
(Just xs) -> do
|
||||||
$logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
|
logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
|
||||||
pure Nothing
|
pure Nothing
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
$logDebug "No etags header found"
|
logDebug "No etags header found"
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
|
writeEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
|
||||||
writeEtags destFile getTags = do
|
writeEtags destFile getTags = do
|
||||||
getTags >>= \case
|
getTags >>= \case
|
||||||
Just t -> do
|
Just t -> do
|
||||||
$logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]
|
logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
|
||||||
liftIO $ T.writeFile (etagsFile destFile) t
|
liftIO $ T.writeFile (etagsFile destFile) t
|
||||||
Nothing ->
|
Nothing ->
|
||||||
$logDebug [i|No etags files written|]
|
logDebug "No etags files written"
|
||||||
|
|
||||||
readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
|
readETag :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
|
||||||
readETag fp = do
|
readETag fp = do
|
||||||
e <- liftIO $ doesFileExist fp
|
e <- liftIO $ doesFileExist fp
|
||||||
if e
|
if e
|
||||||
@@ -479,13 +474,13 @@ download uri eDigest dest mfn etags
|
|||||||
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
|
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
|
||||||
case rE of
|
case rE of
|
||||||
(Right et) -> do
|
(Right et) -> do
|
||||||
$logDebug [i|Read etag: #{et}|]
|
logDebug $ "Read etag: " <> et
|
||||||
pure (Just et)
|
pure (Just et)
|
||||||
(Left _) -> do
|
(Left _) -> do
|
||||||
$logDebug [i|Etag file doesn't exist (yet)|]
|
logDebug "Etag file doesn't exist (yet)"
|
||||||
pure Nothing
|
pure Nothing
|
||||||
else do
|
else do
|
||||||
$logDebug [i|Skipping and deleting etags file because destination file #{fp} doesn't exist|]
|
logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist"
|
||||||
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
|
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
@@ -498,7 +493,7 @@ downloadCached :: ( MonadReader env m
|
|||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
@@ -519,7 +514,7 @@ downloadCached' :: ( MonadReader env m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
@@ -553,7 +548,7 @@ checkDigest :: ( MonadReader env m
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
)
|
)
|
||||||
=> T.Text -- ^ the hash
|
=> T.Text -- ^ the hash
|
||||||
-> FilePath
|
-> FilePath
|
||||||
@@ -563,7 +558,7 @@ checkDigest eDigest file = do
|
|||||||
let verify = not noVerify
|
let verify = not noVerify
|
||||||
when verify $ do
|
when verify $ do
|
||||||
let p' = takeFileName file
|
let p' = takeFileName file
|
||||||
lift $ $(logInfo) [i|verifying digest of: #{p'}|]
|
lift $ logInfo $ "verifying digest of: " <> T.pack p'
|
||||||
c <- liftIO $ L.readFile file
|
c <- liftIO $ L.readFile file
|
||||||
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
|
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
|
||||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||||
|
|||||||
@@ -4,7 +4,6 @@
|
|||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
@@ -21,15 +20,10 @@ module GHCup.Errors where
|
|||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
|
||||||
#if !defined(TAR)
|
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#else
|
|
||||||
import qualified Codec.Archive.Tar as Tar
|
|
||||||
#endif
|
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.CaseInsensitive ( CI )
|
import Data.CaseInsensitive ( CI )
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Haskus.Utils.Variant
|
import Haskus.Utils.Variant
|
||||||
@@ -38,6 +32,7 @@ import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
|||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -55,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
|
|||||||
pPrint (NoCompatiblePlatform str') =
|
pPrint (NoCompatiblePlatform str') =
|
||||||
text ("Could not find a compatible platform. Got: " ++ str')
|
text ("Could not find a compatible platform. Got: " ++ str')
|
||||||
|
|
||||||
-- | Unable to find a download for the requested versio/distro.
|
-- | Unable to find a download for the requested version/distro.
|
||||||
data NoDownload = NoDownload
|
data NoDownload = NoDownload
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
@@ -92,7 +87,7 @@ data UnknownArchive = UnknownArchive FilePath
|
|||||||
|
|
||||||
instance Pretty UnknownArchive where
|
instance Pretty UnknownArchive where
|
||||||
pPrint (UnknownArchive file) =
|
pPrint (UnknownArchive file) =
|
||||||
text [i|The archive format is unknown. We don't know how to extract the file "#{file}"|]
|
text $ "The archive format is unknown. We don't know how to extract the file " <> file
|
||||||
|
|
||||||
-- | The scheme is not supported (such as ftp).
|
-- | The scheme is not supported (such as ftp).
|
||||||
data UnsupportedScheme = UnsupportedScheme
|
data UnsupportedScheme = UnsupportedScheme
|
||||||
@@ -115,7 +110,7 @@ data TagNotFound = TagNotFound Tag Tool
|
|||||||
|
|
||||||
instance Pretty TagNotFound where
|
instance Pretty TagNotFound where
|
||||||
pPrint (TagNotFound tag tool) =
|
pPrint (TagNotFound tag tool) =
|
||||||
text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
|
text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
|
||||||
|
|
||||||
-- | Unable to find the next version of a tool (the one after the currently
|
-- | Unable to find the next version of a tool (the one after the currently
|
||||||
-- set one).
|
-- set one).
|
||||||
@@ -124,7 +119,7 @@ data NextVerNotFound = NextVerNotFound Tool
|
|||||||
|
|
||||||
instance Pretty NextVerNotFound where
|
instance Pretty NextVerNotFound where
|
||||||
pPrint (NextVerNotFound tool) =
|
pPrint (NextVerNotFound tool) =
|
||||||
text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|]
|
text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
|
||||||
|
|
||||||
-- | The tool (such as GHC) is already installed with that version.
|
-- | The tool (such as GHC) is already installed with that version.
|
||||||
data AlreadyInstalled = AlreadyInstalled Tool Version
|
data AlreadyInstalled = AlreadyInstalled Tool Version
|
||||||
@@ -132,14 +127,14 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
|
|||||||
|
|
||||||
instance Pretty AlreadyInstalled where
|
instance Pretty AlreadyInstalled where
|
||||||
pPrint (AlreadyInstalled tool ver') =
|
pPrint (AlreadyInstalled tool ver') =
|
||||||
text [i|#{tool}-#{prettyShow ver'} is already installed|]
|
pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
|
||||||
|
|
||||||
-- | The Directory is supposed to be empty, but wasn't.
|
-- | The Directory is supposed to be empty, but wasn't.
|
||||||
data DirNotEmpty = DirNotEmpty {path :: FilePath}
|
data DirNotEmpty = DirNotEmpty {path :: FilePath}
|
||||||
|
|
||||||
instance Pretty DirNotEmpty where
|
instance Pretty DirNotEmpty where
|
||||||
pPrint (DirNotEmpty path) = do
|
pPrint (DirNotEmpty path) = do
|
||||||
text [i|The directory was expected to be empty, but isn't: #{path}|]
|
text $ "The directory was expected to be empty, but isn't: " <> path
|
||||||
|
|
||||||
-- | The tool is not installed. Some operations rely on a tool
|
-- | The tool is not installed. Some operations rely on a tool
|
||||||
-- to be installed (such as setting the current GHC version).
|
-- to be installed (such as setting the current GHC version).
|
||||||
@@ -148,7 +143,7 @@ data NotInstalled = NotInstalled Tool GHCTargetVersion
|
|||||||
|
|
||||||
instance Pretty NotInstalled where
|
instance Pretty NotInstalled where
|
||||||
pPrint (NotInstalled tool ver) =
|
pPrint (NotInstalled tool ver) =
|
||||||
text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
|
text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
|
||||||
|
|
||||||
-- | An executable was expected to be in PATH, but was not found.
|
-- | An executable was expected to be in PATH, but was not found.
|
||||||
data NotFoundInPATH = NotFoundInPATH FilePath
|
data NotFoundInPATH = NotFoundInPATH FilePath
|
||||||
@@ -156,7 +151,7 @@ data NotFoundInPATH = NotFoundInPATH FilePath
|
|||||||
|
|
||||||
instance Pretty NotFoundInPATH where
|
instance Pretty NotFoundInPATH where
|
||||||
pPrint (NotFoundInPATH exe) =
|
pPrint (NotFoundInPATH exe) =
|
||||||
text [i|The exe "#{exe}" was not found in PATH.|]
|
text $ "The exe " <> exe <> " was not found in PATH."
|
||||||
|
|
||||||
-- | JSON decoding failed.
|
-- | JSON decoding failed.
|
||||||
data JSONError = JSONDecodeError String
|
data JSONError = JSONDecodeError String
|
||||||
@@ -164,7 +159,7 @@ data JSONError = JSONDecodeError String
|
|||||||
|
|
||||||
instance Pretty JSONError where
|
instance Pretty JSONError where
|
||||||
pPrint (JSONDecodeError err) =
|
pPrint (JSONDecodeError err) =
|
||||||
text [i|JSON decoding failed with: #{err}|]
|
text $ "JSON decoding failed with: " <> err
|
||||||
|
|
||||||
-- | A file that is supposed to exist does not exist
|
-- | A file that is supposed to exist does not exist
|
||||||
-- (e.g. when we use file scheme to "download" something).
|
-- (e.g. when we use file scheme to "download" something).
|
||||||
@@ -173,7 +168,7 @@ data FileDoesNotExistError = FileDoesNotExistError FilePath
|
|||||||
|
|
||||||
instance Pretty FileDoesNotExistError where
|
instance Pretty FileDoesNotExistError where
|
||||||
pPrint (FileDoesNotExistError file) =
|
pPrint (FileDoesNotExistError file) =
|
||||||
text [i|File "#{file}" does not exist.|]
|
text $ "File " <> file <> " does not exist."
|
||||||
|
|
||||||
-- | The file already exists
|
-- | The file already exists
|
||||||
-- (e.g. when we use isolated installs with the same path).
|
-- (e.g. when we use isolated installs with the same path).
|
||||||
@@ -183,7 +178,7 @@ data FileAlreadyExistsError = FileAlreadyExistsError FilePath
|
|||||||
|
|
||||||
instance Pretty FileAlreadyExistsError where
|
instance Pretty FileAlreadyExistsError where
|
||||||
pPrint (FileAlreadyExistsError file) =
|
pPrint (FileAlreadyExistsError file) =
|
||||||
text [i|File "#{file}" Already exists.|]
|
text $ "File " <> file <> " Already exists."
|
||||||
|
|
||||||
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
|
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
|
||||||
deriving Show
|
deriving Show
|
||||||
@@ -198,7 +193,7 @@ data DigestError = DigestError Text Text
|
|||||||
|
|
||||||
instance Pretty DigestError where
|
instance Pretty DigestError where
|
||||||
pPrint (DigestError currentDigest expectedDigest) =
|
pPrint (DigestError currentDigest expectedDigest) =
|
||||||
text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
|
text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
|
||||||
|
|
||||||
-- | Unexpected HTTP status.
|
-- | Unexpected HTTP status.
|
||||||
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
|
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
|
||||||
@@ -206,7 +201,7 @@ data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
|
|||||||
|
|
||||||
instance Pretty HTTPStatusError where
|
instance Pretty HTTPStatusError where
|
||||||
pPrint (HTTPStatusError status _) =
|
pPrint (HTTPStatusError status _) =
|
||||||
text [i|Unexpected HTTP status: #{status}|]
|
text "Unexpected HTTP status:" <+> pPrint status
|
||||||
|
|
||||||
-- | Malformed headers.
|
-- | Malformed headers.
|
||||||
data MalformedHeaders = MalformedHeaders Text
|
data MalformedHeaders = MalformedHeaders Text
|
||||||
@@ -214,7 +209,7 @@ data MalformedHeaders = MalformedHeaders Text
|
|||||||
|
|
||||||
instance Pretty MalformedHeaders where
|
instance Pretty MalformedHeaders where
|
||||||
pPrint (MalformedHeaders h) =
|
pPrint (MalformedHeaders h) =
|
||||||
text [i|Headers are malformed: #{h}|]
|
text "Headers are malformed: " <+> pPrint h
|
||||||
|
|
||||||
-- | Unexpected HTTP status.
|
-- | Unexpected HTTP status.
|
||||||
data HTTPNotModified = HTTPNotModified Text
|
data HTTPNotModified = HTTPNotModified Text
|
||||||
@@ -222,7 +217,7 @@ data HTTPNotModified = HTTPNotModified Text
|
|||||||
|
|
||||||
instance Pretty HTTPNotModified where
|
instance Pretty HTTPNotModified where
|
||||||
pPrint (HTTPNotModified etag) =
|
pPrint (HTTPNotModified etag) =
|
||||||
text [i|Remote resource not modifed, etag was: #{etag}|]
|
text "Remote resource not modifed, etag was:" <+> pPrint etag
|
||||||
|
|
||||||
-- | The 'Location' header was expected during a 3xx redirect, but not found.
|
-- | The 'Location' header was expected during a 3xx redirect, but not found.
|
||||||
data NoLocationHeader = NoLocationHeader
|
data NoLocationHeader = NoLocationHeader
|
||||||
@@ -230,7 +225,7 @@ data NoLocationHeader = NoLocationHeader
|
|||||||
|
|
||||||
instance Pretty NoLocationHeader where
|
instance Pretty NoLocationHeader where
|
||||||
pPrint NoLocationHeader =
|
pPrint NoLocationHeader =
|
||||||
text [i|The 'Location' header was expected during a 3xx redirect, but not found.|]
|
text "The 'Location' header was expected during a 3xx redirect, but not found."
|
||||||
|
|
||||||
-- | Too many redirects.
|
-- | Too many redirects.
|
||||||
data TooManyRedirs = TooManyRedirs
|
data TooManyRedirs = TooManyRedirs
|
||||||
@@ -238,7 +233,7 @@ data TooManyRedirs = TooManyRedirs
|
|||||||
|
|
||||||
instance Pretty TooManyRedirs where
|
instance Pretty TooManyRedirs where
|
||||||
pPrint TooManyRedirs =
|
pPrint TooManyRedirs =
|
||||||
text [i|Too many redirections.|]
|
text "Too many redirections."
|
||||||
|
|
||||||
-- | A patch could not be applied.
|
-- | A patch could not be applied.
|
||||||
data PatchFailed = PatchFailed
|
data PatchFailed = PatchFailed
|
||||||
@@ -246,7 +241,7 @@ data PatchFailed = PatchFailed
|
|||||||
|
|
||||||
instance Pretty PatchFailed where
|
instance Pretty PatchFailed where
|
||||||
pPrint PatchFailed =
|
pPrint PatchFailed =
|
||||||
text [i|A patch could not be applied.|]
|
text "A patch could not be applied."
|
||||||
|
|
||||||
-- | The tool requirements could not be found.
|
-- | The tool requirements could not be found.
|
||||||
data NoToolRequirements = NoToolRequirements
|
data NoToolRequirements = NoToolRequirements
|
||||||
@@ -254,35 +249,35 @@ data NoToolRequirements = NoToolRequirements
|
|||||||
|
|
||||||
instance Pretty NoToolRequirements where
|
instance Pretty NoToolRequirements where
|
||||||
pPrint NoToolRequirements =
|
pPrint NoToolRequirements =
|
||||||
text [i|The Tool requirements could not be found.|]
|
text "The Tool requirements could not be found."
|
||||||
|
|
||||||
data InvalidBuildConfig = InvalidBuildConfig Text
|
data InvalidBuildConfig = InvalidBuildConfig Text
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty InvalidBuildConfig where
|
instance Pretty InvalidBuildConfig where
|
||||||
pPrint (InvalidBuildConfig reason) =
|
pPrint (InvalidBuildConfig reason) =
|
||||||
text [i|The build config is invalid. Reason was: #{reason}|]
|
text "The build config is invalid. Reason was:" <+> pPrint reason
|
||||||
|
|
||||||
data NoToolVersionSet = NoToolVersionSet Tool
|
data NoToolVersionSet = NoToolVersionSet Tool
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoToolVersionSet where
|
instance Pretty NoToolVersionSet where
|
||||||
pPrint (NoToolVersionSet tool) =
|
pPrint (NoToolVersionSet tool) =
|
||||||
text [i|No version is set for tool "#{tool}".|]
|
text "No version is set for tool" <+> pPrint tool <+> text "."
|
||||||
|
|
||||||
data NoNetwork = NoNetwork
|
data NoNetwork = NoNetwork
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoNetwork where
|
instance Pretty NoNetwork where
|
||||||
pPrint NoNetwork =
|
pPrint NoNetwork =
|
||||||
text [i|A download was required or requested, but '--offline' was specified.|]
|
text "A download was required or requested, but '--offline' was specified."
|
||||||
|
|
||||||
data HadrianNotFound = HadrianNotFound
|
data HadrianNotFound = HadrianNotFound
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty HadrianNotFound where
|
instance Pretty HadrianNotFound where
|
||||||
pPrint HadrianNotFound =
|
pPrint HadrianNotFound =
|
||||||
text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|]
|
text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
@@ -304,17 +299,17 @@ data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FileP
|
|||||||
|
|
||||||
instance Pretty BuildFailed where
|
instance Pretty BuildFailed where
|
||||||
pPrint (BuildFailed path reason) =
|
pPrint (BuildFailed path reason) =
|
||||||
text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason
|
text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
|
||||||
|
|
||||||
deriving instance Show BuildFailed
|
deriving instance Show BuildFailed
|
||||||
|
|
||||||
|
|
||||||
-- | Setting the current GHC version failed.
|
-- | Setting the current GHC version failed.
|
||||||
data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
|
data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
|
||||||
|
|
||||||
instance Pretty GHCupSetError where
|
instance Pretty GHCupSetError where
|
||||||
pPrint (GHCupSetError reason) =
|
pPrint (GHCupSetError reason) =
|
||||||
text [i|Setting the current GHC version failed: #{reason}|]
|
text "Setting the current GHC version failed:" <+> pPrint reason
|
||||||
|
|
||||||
deriving instance Show GHCupSetError
|
deriving instance Show GHCupSetError
|
||||||
|
|
||||||
@@ -330,7 +325,7 @@ data ParseError = ParseError String
|
|||||||
|
|
||||||
instance Pretty ParseError where
|
instance Pretty ParseError where
|
||||||
pPrint (ParseError reason) =
|
pPrint (ParseError reason) =
|
||||||
text [i|Parsing failed: #{reason}|]
|
text "Parsing failed:" <+> pPrint reason
|
||||||
|
|
||||||
instance Exception ParseError
|
instance Exception ParseError
|
||||||
|
|
||||||
@@ -340,7 +335,7 @@ data UnexpectedListLength = UnexpectedListLength String
|
|||||||
|
|
||||||
instance Pretty UnexpectedListLength where
|
instance Pretty UnexpectedListLength where
|
||||||
pPrint (UnexpectedListLength reason) =
|
pPrint (UnexpectedListLength reason) =
|
||||||
text [i|List length unexpected: #{reason}|]
|
text "List length unexpected:" <+> pPrint reason
|
||||||
|
|
||||||
instance Exception UnexpectedListLength
|
instance Exception UnexpectedListLength
|
||||||
|
|
||||||
@@ -349,7 +344,7 @@ data NoUrlBase = NoUrlBase Text
|
|||||||
|
|
||||||
instance Pretty NoUrlBase where
|
instance Pretty NoUrlBase where
|
||||||
pPrint (NoUrlBase url) =
|
pPrint (NoUrlBase url) =
|
||||||
text [i|Couldn't get a base filename from url #{url}|]
|
text "Couldn't get a base filename from url" <+> pPrint url
|
||||||
|
|
||||||
instance Exception NoUrlBase
|
instance Exception NoUrlBase
|
||||||
|
|
||||||
@@ -374,23 +369,22 @@ instance
|
|||||||
|
|
||||||
instance Pretty URIParseError where
|
instance Pretty URIParseError where
|
||||||
pPrint (MalformedScheme reason) =
|
pPrint (MalformedScheme reason) =
|
||||||
text [i|Failed to parse URI. Malformed scheme: #{reason}|]
|
text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
|
||||||
pPrint MalformedUserInfo =
|
pPrint MalformedUserInfo =
|
||||||
text [i|Failed to parse URI. Malformed user info.|]
|
text "Failed to parse URI. Malformed user info."
|
||||||
pPrint MalformedQuery =
|
pPrint MalformedQuery =
|
||||||
text [i|Failed to parse URI. Malformed query.|]
|
text "Failed to parse URI. Malformed query."
|
||||||
pPrint MalformedFragment =
|
pPrint MalformedFragment =
|
||||||
text [i|Failed to parse URI. Malformed fragment.|]
|
text "Failed to parse URI. Malformed fragment."
|
||||||
pPrint MalformedHost =
|
pPrint MalformedHost =
|
||||||
text [i|Failed to parse URI. Malformed host.|]
|
text "Failed to parse URI. Malformed host."
|
||||||
pPrint MalformedPort =
|
pPrint MalformedPort =
|
||||||
text [i|Failed to parse URI. Malformed port.|]
|
text "Failed to parse URI. Malformed port."
|
||||||
pPrint MalformedPath =
|
pPrint MalformedPath =
|
||||||
text [i|Failed to parse URI. Malformed path.|]
|
text "Failed to parse URI. Malformed path."
|
||||||
pPrint (OtherError err) =
|
pPrint (OtherError err) =
|
||||||
text [i|Failed to parse URI: #{err}|]
|
text "Failed to parse URI:" <+> pPrint err
|
||||||
|
|
||||||
#if !defined(TAR)
|
|
||||||
instance Pretty ArchiveResult where
|
instance Pretty ArchiveResult where
|
||||||
pPrint ArchiveFatal = text "Archive result: fatal"
|
pPrint ArchiveFatal = text "Archive result: fatal"
|
||||||
pPrint ArchiveFailed = text "Archive result: failed"
|
pPrint ArchiveFailed = text "Archive result: failed"
|
||||||
@@ -398,14 +392,6 @@ instance Pretty ArchiveResult where
|
|||||||
pPrint ArchiveRetry = text "Archive result: retry"
|
pPrint ArchiveRetry = text "Archive result: retry"
|
||||||
pPrint ArchiveOk = text "Archive result: Ok"
|
pPrint ArchiveOk = text "Archive result: Ok"
|
||||||
pPrint ArchiveEOF = text "Archive result: EOF"
|
pPrint ArchiveEOF = text "Archive result: EOF"
|
||||||
#else
|
|
||||||
instance Pretty Tar.FormatError where
|
instance Pretty T.Text where
|
||||||
pPrint Tar.TruncatedArchive = text "Truncated archive"
|
pPrint = text . T.unpack
|
||||||
pPrint Tar.ShortTrailer = text "Short trailer"
|
|
||||||
pPrint Tar.BadTrailer = text "Bad trailer"
|
|
||||||
pPrint Tar.TrailingJunk = text "Trailing junk"
|
|
||||||
pPrint Tar.ChecksumIncorrect = text "Checksum incorrect"
|
|
||||||
pPrint Tar.NotTarFormat = text "Not a tar format"
|
|
||||||
pPrint Tar.UnrecognisedTarFormat = text "Unrecognised tar format"
|
|
||||||
pPrint Tar.HeaderBadNumericEncoding = text "Header has bad numeric encoding"
|
|
||||||
#endif
|
|
||||||
|
|||||||
@@ -20,6 +20,7 @@ module GHCup.Platform where
|
|||||||
|
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.Optics
|
||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Utils.File
|
import GHCup.Utils.File
|
||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
@@ -28,12 +29,10 @@ import GHCup.Utils.String.QQ
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@@ -58,7 +57,7 @@ import qualified Data.Text.IO as T
|
|||||||
|
|
||||||
|
|
||||||
-- | Get the full platform request, consisting of architecture, distro, ...
|
-- | Get the full platform request, consisting of architecture, distro, ...
|
||||||
platformRequest :: (Alternative m, MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
platformRequest :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||||
=> Excepts
|
=> Excepts
|
||||||
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||||
m
|
m
|
||||||
@@ -83,7 +82,7 @@ getArchitecture = case arch of
|
|||||||
what -> Left (NoCompatibleArch what)
|
what -> Left (NoCompatibleArch what)
|
||||||
|
|
||||||
|
|
||||||
getPlatform :: (Alternative m, MonadLogger m, MonadCatch m, MonadIO m, MonadFail m)
|
getPlatform :: (Alternative m, MonadReader env m, HasLog env, MonadCatch m, MonadIO m, MonadFail m)
|
||||||
=> Excepts
|
=> Excepts
|
||||||
'[NoCompatiblePlatform, DistroNotFound]
|
'[NoCompatiblePlatform, DistroNotFound]
|
||||||
m
|
m
|
||||||
@@ -108,7 +107,7 @@ getPlatform = do
|
|||||||
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
|
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
|
||||||
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
|
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
|
||||||
what -> throwE $ NoCompatiblePlatform what
|
what -> throwE $ NoCompatiblePlatform what
|
||||||
lift $ $(logDebug) [i|Identified Platform as: #{prettyShow pfr}|]
|
lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
|
||||||
pure pfr
|
pure pfr
|
||||||
where
|
where
|
||||||
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
|
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
|
||||||
@@ -139,12 +138,11 @@ getLinuxDistro = do
|
|||||||
| hasWord name ["exherbo"] -> Exherbo
|
| hasWord name ["exherbo"] -> Exherbo
|
||||||
| hasWord name ["gentoo"] -> Gentoo
|
| hasWord name ["gentoo"] -> Gentoo
|
||||||
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
||||||
|
| hasWord name ["solus"] -> Solus
|
||||||
| otherwise -> UnknownLinux
|
| otherwise -> UnknownLinux
|
||||||
pure (distro, parsedVer)
|
pure (distro, parsedVer)
|
||||||
where
|
where
|
||||||
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
|
hasWord t = any (\x -> match (regex x) (T.unpack t))
|
||||||
False
|
|
||||||
matches
|
|
||||||
where
|
where
|
||||||
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
|
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
|
||||||
|
|
||||||
|
|||||||
@@ -25,21 +25,17 @@ module GHCup.Types
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.DeepSeq ( NFData, rnf )
|
import Control.DeepSeq ( NFData, rnf )
|
||||||
import Control.Monad.Logger
|
|
||||||
import Data.Map.Strict ( Map )
|
import Data.Map.Strict ( Map )
|
||||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Haskus.Utils.Variant.Excepts
|
|
||||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
#if defined(BRICK)
|
#if defined(BRICK)
|
||||||
import Graphics.Vty ( Key(..) )
|
import Graphics.Vty ( Key(..) )
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import qualified Control.Monad.Trans.Class as Trans
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
|
|
||||||
@@ -115,6 +111,13 @@ data Tool = GHC
|
|||||||
| Stack
|
| Stack
|
||||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
||||||
|
|
||||||
|
instance Pretty Tool where
|
||||||
|
pPrint GHC = text "ghc"
|
||||||
|
pPrint Cabal = text "cabal"
|
||||||
|
pPrint GHCup = text "ghcup"
|
||||||
|
pPrint HLS = text "hls"
|
||||||
|
pPrint Stack = text "stack"
|
||||||
|
|
||||||
instance NFData Tool
|
instance NFData Tool
|
||||||
|
|
||||||
data GlobalTool = ShimGen
|
data GlobalTool = ShimGen
|
||||||
@@ -145,7 +148,7 @@ data Tag = Latest
|
|||||||
| Recommended
|
| Recommended
|
||||||
| Prerelease
|
| Prerelease
|
||||||
| Base PVP
|
| Base PVP
|
||||||
| Old -- ^ old version are hidden by default in TUI
|
| Old -- ^ old versions are hidden by default in TUI
|
||||||
| UnknownTag String -- ^ used for upwardscompat
|
| UnknownTag String -- ^ used for upwardscompat
|
||||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||||
|
|
||||||
@@ -220,6 +223,7 @@ data LinuxDistro = Debian
|
|||||||
| RedHat
|
| RedHat
|
||||||
| Alpine
|
| Alpine
|
||||||
| AmazonLinux
|
| AmazonLinux
|
||||||
|
| Solus
|
||||||
-- rolling
|
-- rolling
|
||||||
| Gentoo
|
| Gentoo
|
||||||
| Exherbo
|
| Exherbo
|
||||||
@@ -233,12 +237,13 @@ instance NFData LinuxDistro
|
|||||||
distroToString :: LinuxDistro -> String
|
distroToString :: LinuxDistro -> String
|
||||||
distroToString Debian = "debian"
|
distroToString Debian = "debian"
|
||||||
distroToString Ubuntu = "ubuntu"
|
distroToString Ubuntu = "ubuntu"
|
||||||
distroToString Mint= "mint"
|
distroToString Mint = "mint"
|
||||||
distroToString Fedora = "fedora"
|
distroToString Fedora = "fedora"
|
||||||
distroToString CentOS = "centos"
|
distroToString CentOS = "centos"
|
||||||
distroToString RedHat = "redhat"
|
distroToString RedHat = "redhat"
|
||||||
distroToString Alpine = "alpine"
|
distroToString Alpine = "alpine"
|
||||||
distroToString AmazonLinux = "amazon"
|
distroToString AmazonLinux = "amazon"
|
||||||
|
distroToString Solus = "solus"
|
||||||
distroToString Gentoo = "gentoo"
|
distroToString Gentoo = "gentoo"
|
||||||
distroToString Exherbo = "exherbo"
|
distroToString Exherbo = "exherbo"
|
||||||
distroToString UnknownLinux = "unknown"
|
distroToString UnknownLinux = "unknown"
|
||||||
@@ -387,6 +392,7 @@ data AppState = AppState
|
|||||||
, keyBindings :: KeyBindings
|
, keyBindings :: KeyBindings
|
||||||
, ghcupInfo :: GHCupInfo
|
, ghcupInfo :: GHCupInfo
|
||||||
, pfreq :: PlatformRequest
|
, pfreq :: PlatformRequest
|
||||||
|
, loggerConfig :: LoggerConfig
|
||||||
} deriving (Show, GHC.Generic)
|
} deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
instance NFData AppState
|
instance NFData AppState
|
||||||
@@ -395,6 +401,7 @@ data LeanAppState = LeanAppState
|
|||||||
{ settings :: Settings
|
{ settings :: Settings
|
||||||
, dirs :: Dirs
|
, dirs :: Dirs
|
||||||
, keyBindings :: KeyBindings
|
, keyBindings :: KeyBindings
|
||||||
|
, loggerConfig :: LoggerConfig
|
||||||
} deriving (Show, GHC.Generic)
|
} deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
instance NFData LeanAppState
|
instance NFData LeanAppState
|
||||||
@@ -546,14 +553,25 @@ instance Pretty Versioning where
|
|||||||
instance Pretty Version where
|
instance Pretty Version where
|
||||||
pPrint = text . T.unpack . prettyVer
|
pPrint = text . T.unpack . prettyVer
|
||||||
|
|
||||||
|
instance Show (a -> b) where
|
||||||
|
show _ = "<function>"
|
||||||
|
|
||||||
instance (Monad m, Alternative m) => Alternative (LoggingT m) where
|
instance Show (IO ()) where
|
||||||
empty = Trans.lift empty
|
show _ = "<io>"
|
||||||
{-# INLINE empty #-}
|
|
||||||
m <|> n = LoggingT $ \ r -> runLoggingT m r <|> runLoggingT n r
|
|
||||||
{-# INLINE (<|>) #-}
|
|
||||||
|
|
||||||
|
|
||||||
instance MonadLogger m => MonadLogger (Excepts e m) where
|
data LogLevel = Warn
|
||||||
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
|
| Info
|
||||||
|
| Debug
|
||||||
|
| Error
|
||||||
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
data LoggerConfig = LoggerConfig
|
||||||
|
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
||||||
|
, colorOutter :: T.Text -> IO () -- ^ how to write the color output
|
||||||
|
, rawOutter :: T.Text -> IO () -- ^ how to write the full raw output
|
||||||
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance NFData LoggerConfig where
|
||||||
|
rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug
|
||||||
|
|||||||
@@ -42,7 +42,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 } { 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
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
||||||
|
|||||||
@@ -6,6 +6,7 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Types.Optics
|
Module : GHCup.Types.Optics
|
||||||
@@ -21,9 +22,13 @@ module GHCup.Types.Optics where
|
|||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
|
import Data.Text ( Text )
|
||||||
import Optics
|
import Optics
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
import System.Console.Pretty
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
makePrisms ''Tool
|
makePrisms ''Tool
|
||||||
makePrisms ''Architecture
|
makePrisms ''Architecture
|
||||||
@@ -87,13 +92,15 @@ getLeanAppState :: ( MonadReader env m
|
|||||||
, LabelOptic' "settings" A_Lens env Settings
|
, LabelOptic' "settings" A_Lens env Settings
|
||||||
, LabelOptic' "dirs" A_Lens env Dirs
|
, LabelOptic' "dirs" A_Lens env Dirs
|
||||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
)
|
)
|
||||||
=> m LeanAppState
|
=> m LeanAppState
|
||||||
getLeanAppState = do
|
getLeanAppState = do
|
||||||
s <- gets @"settings"
|
s <- gets @"settings"
|
||||||
d <- gets @"dirs"
|
d <- gets @"dirs"
|
||||||
k <- gets @"keyBindings"
|
k <- gets @"keyBindings"
|
||||||
pure (LeanAppState s d k)
|
l <- gets @"loggerConfig"
|
||||||
|
pure (LeanAppState s d k l)
|
||||||
|
|
||||||
|
|
||||||
getSettings :: ( MonadReader env m
|
getSettings :: ( MonadReader env m
|
||||||
@@ -110,6 +117,87 @@ getDirs :: ( MonadReader env m
|
|||||||
getDirs = gets @"dirs"
|
getDirs = gets @"dirs"
|
||||||
|
|
||||||
|
|
||||||
|
logInfo :: ( MonadReader env m
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
|
=> Text
|
||||||
|
-> m ()
|
||||||
|
logInfo = logInternal Info
|
||||||
|
|
||||||
|
logWarn :: ( MonadReader env m
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
|
=> Text
|
||||||
|
-> m ()
|
||||||
|
logWarn = logInternal Warn
|
||||||
|
|
||||||
|
logDebug :: ( MonadReader env m
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
|
=> Text
|
||||||
|
-> m ()
|
||||||
|
logDebug = logInternal Debug
|
||||||
|
|
||||||
|
logError :: ( MonadReader env m
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
|
=> Text
|
||||||
|
-> m ()
|
||||||
|
logError = logInternal Error
|
||||||
|
|
||||||
|
|
||||||
|
logInternal :: ( MonadReader env m
|
||||||
|
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||||
|
, MonadIO m
|
||||||
|
) => LogLevel
|
||||||
|
-> Text
|
||||||
|
-> m ()
|
||||||
|
logInternal logLevel msg = do
|
||||||
|
LoggerConfig {..} <- gets @"loggerConfig"
|
||||||
|
let style' = case logLevel of
|
||||||
|
Debug -> style Bold . color Blue
|
||||||
|
Info -> style Bold . color Green
|
||||||
|
Warn -> style Bold . color Yellow
|
||||||
|
Error -> style Bold . color Red
|
||||||
|
let l = case logLevel of
|
||||||
|
Debug -> style' "[ Debug ]"
|
||||||
|
Info -> style' "[ Info ]"
|
||||||
|
Warn -> style' "[ Warn ]"
|
||||||
|
Error -> style' "[ Error ]"
|
||||||
|
let strs = T.split (== '\n') msg
|
||||||
|
let out = case strs of
|
||||||
|
[] -> T.empty
|
||||||
|
(x:xs) ->
|
||||||
|
foldr (\a b -> a <> "\n" <> b) mempty
|
||||||
|
. ((l <> " " <> x) :)
|
||||||
|
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||||
|
$ xs
|
||||||
|
|
||||||
|
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||||
|
$ liftIO $ colorOutter out
|
||||||
|
|
||||||
|
-- raw output
|
||||||
|
let lr = case logLevel of
|
||||||
|
Debug -> "Debug:"
|
||||||
|
Info -> "Info:"
|
||||||
|
Warn -> "Warn:"
|
||||||
|
Error -> "Error:"
|
||||||
|
let outr = lr <> " " <> msg <> "\n"
|
||||||
|
liftIO $ rawOutter outr
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getLogCleanup :: ( MonadReader env m
|
||||||
|
, LabelOptic' "logCleanup" A_Lens env (IO ())
|
||||||
|
)
|
||||||
|
=> m (IO ())
|
||||||
|
getLogCleanup = gets @"logCleanup"
|
||||||
|
|
||||||
|
|
||||||
getKeyBindings :: ( MonadReader env m
|
getKeyBindings :: ( MonadReader env m
|
||||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||||
)
|
)
|
||||||
@@ -136,6 +224,7 @@ type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
|
|||||||
type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
|
type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
|
||||||
type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
|
type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
|
||||||
type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
|
type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
|
||||||
|
type HasLog env = (LabelOptic' "loggerConfig" A_Lens env LoggerConfig)
|
||||||
|
|
||||||
|
|
||||||
getCache :: (MonadReader env m, HasSettings env) => m Bool
|
getCache :: (MonadReader env m, HasSettings env) => m Bool
|
||||||
|
|||||||
@@ -39,17 +39,13 @@ import GHCup.Utils.MegaParsec
|
|||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
import GHCup.Utils.String.QQ
|
import GHCup.Utils.String.QQ
|
||||||
|
|
||||||
#if !defined(TAR)
|
|
||||||
import Codec.Archive hiding ( Directory )
|
import Codec.Archive hiding ( Directory )
|
||||||
#endif
|
|
||||||
import Codec.Archive.Zip
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
@@ -61,10 +57,8 @@ import Data.ByteString ( ByteString )
|
|||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.List.Extra
|
|
||||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
@@ -83,9 +77,6 @@ import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
|||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
#if defined(TAR)
|
|
||||||
import qualified Codec.Archive.Tar as Tar
|
|
||||||
#endif
|
|
||||||
import qualified Codec.Compression.BZip as BZip
|
import qualified Codec.Compression.BZip as BZip
|
||||||
import qualified Codec.Compression.GZip as GZip
|
import qualified Codec.Compression.GZip as GZip
|
||||||
import qualified Codec.Compression.Lzma as Lzma
|
import qualified Codec.Compression.Lzma as Lzma
|
||||||
@@ -121,7 +112,7 @@ ghcLinkDestination tool ver = do
|
|||||||
rmMinorSymlinks :: ( MonadReader env m
|
rmMinorSymlinks :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
@@ -135,14 +126,14 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
|||||||
forM_ files $ \f -> do
|
forM_ files $ \f -> do
|
||||||
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
||||||
let fullF = binDir </> f_xyz
|
let fullF = binDir </> f_xyz
|
||||||
lift $ $(logDebug) [i|rm -f #{fullF}|]
|
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||||
|
|
||||||
|
|
||||||
-- | Removes the set ghc version for the given target, if any.
|
-- | Removes the set ghc version for the given target, if any.
|
||||||
rmPlain :: ( MonadReader env m
|
rmPlain :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
@@ -157,11 +148,11 @@ rmPlain target = do
|
|||||||
files <- liftE $ ghcToolFiles tv
|
files <- liftE $ ghcToolFiles tv
|
||||||
forM_ files $ \f -> do
|
forM_ files $ \f -> do
|
||||||
let fullF = binDir </> f <> exeExt
|
let fullF = binDir </> f <> exeExt
|
||||||
lift $ $(logDebug) [i|rm -f #{fullF}|]
|
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||||
-- old ghcup
|
-- old ghcup
|
||||||
let hdc_file = binDir </> "haddock-ghc" <> exeExt
|
let hdc_file = binDir </> "haddock-ghc" <> exeExt
|
||||||
lift $ $(logDebug) [i|rm -f #{hdc_file}|]
|
lift $ logDebug ("rm -f " <> T.pack hdc_file)
|
||||||
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
|
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
|
||||||
|
|
||||||
|
|
||||||
@@ -169,7 +160,7 @@ rmPlain target = do
|
|||||||
rmMajorSymlinks :: ( MonadReader env m
|
rmMajorSymlinks :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
@@ -185,7 +176,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
|||||||
forM_ files $ \f -> do
|
forM_ files $ \f -> do
|
||||||
let f_xy = f <> "-" <> T.unpack v' <> exeExt
|
let f_xy = f <> "-" <> T.unpack v' <> exeExt
|
||||||
let fullF = binDir </> f_xy
|
let fullF = binDir </> f_xy
|
||||||
lift $ $(logDebug) [i|rm -f #{fullF}|]
|
lift $ logDebug "rm -f #{fullF}"
|
||||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||||
|
|
||||||
|
|
||||||
@@ -257,9 +248,9 @@ getInstalledGHCs = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||||
getInstalledCabals :: ( MonadLogger m
|
getInstalledCabals :: ( MonadReader env m
|
||||||
, MonadReader env m
|
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
@@ -277,14 +268,14 @@ getInstalledCabals = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Whether the given cabal version is installed.
|
-- | Whether the given cabal version is installed.
|
||||||
cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||||
cabalInstalled ver = do
|
cabalInstalled ver = do
|
||||||
vers <- fmap rights getInstalledCabals
|
vers <- fmap rights getInstalledCabals
|
||||||
pure $ elem ver vers
|
pure $ elem ver vers
|
||||||
|
|
||||||
|
|
||||||
-- Return the currently set cabal version, if any.
|
-- Return the currently set cabal version, if any.
|
||||||
cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||||
cabalSet = do
|
cabalSet = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let cabalbin = binDir </> "cabal" <> exeExt
|
let cabalbin = binDir </> "cabal" <> exeExt
|
||||||
@@ -301,7 +292,11 @@ cabalSet = do
|
|||||||
case linkVersion =<< link of
|
case linkVersion =<< link of
|
||||||
Right v -> pure $ Just v
|
Right v -> pure $ Just v
|
||||||
Left err -> do
|
Left err -> do
|
||||||
$(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|]
|
logWarn $ "Failed to parse cabal symlink target with: "
|
||||||
|
<> T.pack (displayException err)
|
||||||
|
<> ". The symlink "
|
||||||
|
<> T.pack cabalbin
|
||||||
|
<> " needs to point to valid cabal binary, such as 'cabal-3.4.0.0'."
|
||||||
pure Nothing
|
pure Nothing
|
||||||
where
|
where
|
||||||
-- We try to be extra permissive with link destination parsing,
|
-- We try to be extra permissive with link destination parsing,
|
||||||
@@ -368,7 +363,7 @@ getInstalledStacks = do
|
|||||||
|
|
||||||
-- Return the currently set stack version, if any.
|
-- Return the currently set stack version, if any.
|
||||||
-- TODO: there's a lot of code duplication here :>
|
-- TODO: there's a lot of code duplication here :>
|
||||||
stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
|
stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, HasLog env) => m (Maybe Version)
|
||||||
stackSet = do
|
stackSet = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let stackBin = binDir </> "stack" <> exeExt
|
let stackBin = binDir </> "stack" <> exeExt
|
||||||
@@ -385,7 +380,11 @@ stackSet = do
|
|||||||
case linkVersion =<< link of
|
case linkVersion =<< link of
|
||||||
Right v -> pure $ Just v
|
Right v -> pure $ Just v
|
||||||
Left err -> do
|
Left err -> do
|
||||||
$(logWarn) [i|Failed to parse stack symlink target with: "#{err}". The symlink #{stackBin} needs to point to valid stack binary, such as 'stack-2.7.1'.|]
|
logWarn $ "Failed to parse stack symlink target with: "
|
||||||
|
<> T.pack (displayException err)
|
||||||
|
<> ". The symlink "
|
||||||
|
<> T.pack stackBin
|
||||||
|
<> " needs to point to valid stack binary, such as 'stack-2.7.1'."
|
||||||
pure Nothing
|
pure Nothing
|
||||||
where
|
where
|
||||||
linkVersion :: MonadThrow m => FilePath -> m Version
|
linkVersion :: MonadThrow m => FilePath -> m Version
|
||||||
@@ -599,31 +598,21 @@ getLatestGHCFor major' minor' dls =
|
|||||||
|
|
||||||
|
|
||||||
-- | Unpack an archive to a temporary directory and return that path.
|
-- | Unpack an archive to a temporary directory and return that path.
|
||||||
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||||
=> FilePath -- ^ destination dir
|
=> FilePath -- ^ destination dir
|
||||||
-> FilePath -- ^ archive path
|
-> FilePath -- ^ archive path
|
||||||
-> Excepts '[UnknownArchive
|
-> Excepts '[UnknownArchive
|
||||||
#if !defined(TAR)
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
] m ()
|
] m ()
|
||||||
unpackToDir dfp av = do
|
unpackToDir dfp av = do
|
||||||
let fn = takeFileName av
|
let fn = takeFileName av
|
||||||
lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|]
|
lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
|
||||||
|
|
||||||
#if defined(TAR)
|
|
||||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
|
|
||||||
untar = liftIO . Tar.unpack dfp . Tar.read
|
|
||||||
|
|
||||||
rf :: MonadIO m => FilePath -> Excepts '[] m BL.ByteString
|
|
||||||
rf = liftIO . BL.readFile
|
|
||||||
#else
|
|
||||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
|
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
|
||||||
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
|
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
|
||||||
|
|
||||||
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
|
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
|
||||||
rf = liftIO . BL.readFile
|
rf = liftIO . BL.readFile
|
||||||
#endif
|
|
||||||
|
|
||||||
-- extract, depending on file extension
|
-- extract, depending on file extension
|
||||||
if
|
if
|
||||||
@@ -636,42 +625,23 @@ unpackToDir dfp av = do
|
|||||||
| ".tar.bz2" `isSuffixOf` fn ->
|
| ".tar.bz2" `isSuffixOf` fn ->
|
||||||
liftE (untar . BZip.decompress =<< rf av)
|
liftE (untar . BZip.decompress =<< rf av)
|
||||||
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||||
| ".zip" `isSuffixOf` fn ->
|
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||||
withArchive av (unpackInto dfp)
|
|
||||||
| otherwise -> throwE $ UnknownArchive fn
|
| otherwise -> throwE $ UnknownArchive fn
|
||||||
|
|
||||||
|
|
||||||
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
|
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||||
=> FilePath -- ^ archive path
|
=> FilePath -- ^ archive path
|
||||||
-> Excepts '[UnknownArchive
|
-> Excepts '[UnknownArchive
|
||||||
#if defined(TAR)
|
|
||||||
, Tar.FormatError
|
|
||||||
#else
|
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
|
||||||
] m [FilePath]
|
] m [FilePath]
|
||||||
getArchiveFiles av = do
|
getArchiveFiles av = do
|
||||||
let fn = takeFileName av
|
let fn = takeFileName av
|
||||||
|
|
||||||
#if defined(TAR)
|
|
||||||
let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [FilePath]
|
|
||||||
entries =
|
|
||||||
lE @Tar.FormatError
|
|
||||||
. Tar.foldEntries
|
|
||||||
(\e x -> fmap (Tar.entryPath e :) x)
|
|
||||||
(Right [])
|
|
||||||
(\e -> Left e)
|
|
||||||
. Tar.read
|
|
||||||
|
|
||||||
rf :: MonadIO m => FilePath -> Excepts '[Tar.FormatError] m BL.ByteString
|
|
||||||
rf = liftIO . BL.readFile
|
|
||||||
#else
|
|
||||||
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
|
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
|
||||||
entries = (fmap . fmap) filepath . lE . readArchiveBSL
|
entries = (fmap . fmap) filepath . lE . readArchiveBSL
|
||||||
|
|
||||||
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
|
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
|
||||||
rf = liftIO . BL.readFile
|
rf = liftIO . BL.readFile
|
||||||
#endif
|
|
||||||
|
|
||||||
-- extract, depending on file extension
|
-- extract, depending on file extension
|
||||||
if
|
if
|
||||||
@@ -684,14 +654,11 @@ getArchiveFiles av = do
|
|||||||
| ".tar.bz2" `isSuffixOf` fn ->
|
| ".tar.bz2" `isSuffixOf` fn ->
|
||||||
liftE (entries . BZip.decompress =<< rf av)
|
liftE (entries . BZip.decompress =<< rf av)
|
||||||
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||||
| ".zip" `isSuffixOf` fn ->
|
| ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||||
withArchive av $ do
|
|
||||||
entries' <- getEntries
|
|
||||||
pure $ fmap unEntrySelector $ Map.keys entries'
|
|
||||||
| otherwise -> throwE $ UnknownArchive fn
|
| otherwise -> throwE $ UnknownArchive fn
|
||||||
|
|
||||||
|
|
||||||
intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
|
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
|
||||||
=> FilePath -- ^ unpacked tar dir
|
=> FilePath -- ^ unpacked tar dir
|
||||||
-> TarDir -- ^ how to descend
|
-> TarDir -- ^ how to descend
|
||||||
-> Excepts '[TarDirDoesNotExist] m FilePath
|
-> Excepts '[TarDirDoesNotExist] m FilePath
|
||||||
@@ -819,14 +786,14 @@ makeOut args workdir = do
|
|||||||
|
|
||||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
||||||
-- on first failure.
|
-- on first failure.
|
||||||
applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
|
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||||
=> FilePath -- ^ dir containing patches
|
=> FilePath -- ^ dir containing patches
|
||||||
-> FilePath -- ^ dir to apply patches in
|
-> FilePath -- ^ dir to apply patches in
|
||||||
-> Excepts '[PatchFailed] m ()
|
-> Excepts '[PatchFailed] m ()
|
||||||
applyPatches pdir ddir = do
|
applyPatches pdir ddir = do
|
||||||
patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
|
patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
|
||||||
forM_ (sort patches) $ \patch' -> do
|
forM_ (sort patches) $ \patch' -> do
|
||||||
lift $ $(logInfo) [i|Applying patch #{patch'}|]
|
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
||||||
fmap (either (const Nothing) Just)
|
fmap (either (const Nothing) Just)
|
||||||
(exec
|
(exec
|
||||||
"patch"
|
"patch"
|
||||||
@@ -867,7 +834,7 @@ runBuildAction :: ( Pretty (V e)
|
|||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> FilePath -- ^ build directory (cleaned up depending on Settings)
|
=> FilePath -- ^ build directory (cleaned up depending on Settings)
|
||||||
@@ -895,10 +862,10 @@ runBuildAction bdir instdir action = do
|
|||||||
|
|
||||||
-- | Remove a build directory, ignoring if it doesn't exist and gracefully
|
-- | Remove a build directory, ignoring if it doesn't exist and gracefully
|
||||||
-- printing other errors without crashing.
|
-- printing other errors without crashing.
|
||||||
rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
|
rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
|
||||||
rmBDir dir = withRunInIO (\run -> run $
|
rmBDir dir = withRunInIO (\run -> run $
|
||||||
liftIO $ handleIO (\e -> run $ $(logWarn)
|
liftIO $ handleIO (\e -> run $ logWarn $
|
||||||
[i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
|
"Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
|
||||||
$ hideError doesNotExistErrorType
|
$ hideError doesNotExistErrorType
|
||||||
$ rmPathForcibly dir)
|
$ rmPathForcibly dir)
|
||||||
|
|
||||||
@@ -1010,7 +977,7 @@ rmLink = hideError doesNotExistErrorType . recycleFile
|
|||||||
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
||||||
createLink :: ( MonadMask m
|
createLink :: ( MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -1032,24 +999,24 @@ createLink link exe = do
|
|||||||
fullLink = takeDirectory exe </> link
|
fullLink = takeDirectory exe </> link
|
||||||
shimContents = "path = " <> fullLink
|
shimContents = "path = " <> fullLink
|
||||||
|
|
||||||
$(logDebug) [i|rm -f #{exe}|]
|
logDebug $ "rm -f " <> T.pack exe
|
||||||
rmLink exe
|
rmLink exe
|
||||||
|
|
||||||
$(logDebug) [i|ln -s #{fullLink} #{exe}|]
|
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
|
||||||
liftIO $ copyFile shimGen exe
|
liftIO $ copyFile shimGen exe
|
||||||
liftIO $ writeFile shim shimContents
|
liftIO $ writeFile shim shimContents
|
||||||
#else
|
#else
|
||||||
$(logDebug) [i|rm -f #{exe}|]
|
logDebug $ "rm -f " <> T.pack exe
|
||||||
hideError doesNotExistErrorType $ recycleFile exe
|
hideError doesNotExistErrorType $ recycleFile exe
|
||||||
|
|
||||||
$(logDebug) [i|ln -s #{link} #{exe}|]
|
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
|
||||||
liftIO $ createFileLink link exe
|
liftIO $ createFileLink link exe
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
ensureGlobalTools :: ( MonadMask m
|
ensureGlobalTools :: ( MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -1067,8 +1034,8 @@ ensureGlobalTools = do
|
|||||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||||
void $ (\(DigestError _ _) -> do
|
void $ (\(DigestError _ _) -> do
|
||||||
lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
|
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||||
lift $ $(logDebug) [i|rm -f #{shimDownload}|]
|
lift $ logDebug "rm -f #{shimDownload}"
|
||||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||||
liftE @'[DigestError , DownloadFailed] $ dl
|
liftE @'[DigestError , DownloadFailed] $ dl
|
||||||
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
|
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
|
||||||
|
|||||||
@@ -2,9 +2,7 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Utils.Dirs
|
Module : GHCup.Utils.Dirs
|
||||||
@@ -45,12 +43,10 @@ import GHCup.Utils.Prelude
|
|||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Unlift
|
import Control.Monad.IO.Unlift
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource hiding (throwM)
|
import Control.Monad.Trans.Resource hiding (throwM)
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
|
||||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
@@ -62,7 +58,7 @@ import System.IO.Temp
|
|||||||
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.YAML.Aeson as Y
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
|
|
||||||
@@ -225,7 +221,7 @@ ghcupConfigFile = do
|
|||||||
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
||||||
case contents of
|
case contents of
|
||||||
Nothing -> pure defaultUserSettings
|
Nothing -> pure defaultUserSettings
|
||||||
Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'
|
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
|
||||||
|
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
@@ -262,7 +258,7 @@ parseGHCupGHCDir (T.pack -> fp) =
|
|||||||
mkGhcupTmpDir :: ( MonadReader env m
|
mkGhcupTmpDir :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadLogger m
|
, HasLog env
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
@@ -274,15 +270,21 @@ mkGhcupTmpDir = do
|
|||||||
let minSpace = 5000 -- a rough guess, aight?
|
let minSpace = 5000 -- a rough guess, aight?
|
||||||
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
|
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
|
||||||
when (maybe False (toBytes minSpace >) space) $ do
|
when (maybe False (toBytes minSpace >) space) $ do
|
||||||
$(logWarn) [i|Possibly insufficient disk space on #{tmpdir}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
|
logWarn ("Possibly insufficient disk space on "
|
||||||
$(logWarn)
|
<> T.pack tmpdir
|
||||||
|
<> ". At least "
|
||||||
|
<> T.pack (show minSpace)
|
||||||
|
<> " MB are recommended, but only "
|
||||||
|
<> toMB (fromJust space)
|
||||||
|
<> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
|
||||||
|
logWarn
|
||||||
"...waiting for 10 seconds before continuing anyway, you can still abort..."
|
"...waiting for 10 seconds before continuing anyway, you can still abort..."
|
||||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
liftIO $ createTempDirectory tmpdir "ghcup"
|
liftIO $ createTempDirectory tmpdir "ghcup"
|
||||||
where
|
where
|
||||||
toBytes mb = mb * 1024 * 1024
|
toBytes mb = mb * 1024 * 1024
|
||||||
toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
|
toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
|
||||||
truncate' :: Double -> Int -> Double
|
truncate' :: Double -> Int -> Double
|
||||||
truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
|
truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
|
||||||
where t = 10^n
|
where t = 10^n
|
||||||
@@ -290,8 +292,9 @@ mkGhcupTmpDir = do
|
|||||||
|
|
||||||
withGHCupTmpDir :: ( MonadReader env m
|
withGHCupTmpDir :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
|
, HasSettings env
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadLogger m
|
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
@@ -304,7 +307,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
|
|||||||
(run mkGhcupTmpDir)
|
(run mkGhcupTmpDir)
|
||||||
(\fp ->
|
(\fp ->
|
||||||
handleIO (\e -> run
|
handleIO (\e -> run
|
||||||
$ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|])
|
$ logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
|
||||||
. rmPathForcibly
|
. rmPathForcibly
|
||||||
$ fp))
|
$ fp))
|
||||||
|
|
||||||
@@ -336,9 +339,10 @@ relativeSymlink p1 p2 =
|
|||||||
|
|
||||||
cleanupTrash :: ( MonadIO m
|
cleanupTrash :: ( MonadIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
, MonadLogger m
|
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
|
, HasLog env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasSettings env
|
||||||
)
|
)
|
||||||
=> m ()
|
=> m ()
|
||||||
cleanupTrash = do
|
cleanupTrash = do
|
||||||
@@ -347,8 +351,8 @@ cleanupTrash = do
|
|||||||
if null contents
|
if null contents
|
||||||
then pure ()
|
then pure ()
|
||||||
else do
|
else do
|
||||||
$(logWarn) [i|Removing leftover files in #{recycleDir}|]
|
logWarn ("Removing leftover files in " <> T.pack recycleDir)
|
||||||
forM_ contents (\fp -> handleIO (\e ->
|
forM_ contents (\fp -> handleIO (\e ->
|
||||||
$(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]
|
logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
|
||||||
) $ liftIO $ removePathForcibly (recycleDir </> fp))
|
) $ liftIO $ removePathForcibly (recycleDir </> fp))
|
||||||
|
|
||||||
|
|||||||
@@ -1,4 +1,3 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
@@ -8,10 +7,8 @@ module GHCup.Utils.File.Common where
|
|||||||
|
|
||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
|
|
||||||
import Control.Monad.Extra
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
import Optics hiding ((<|), (|>))
|
import Optics hiding ((<|), (|>))
|
||||||
import System.Directory
|
import System.Directory
|
||||||
@@ -31,13 +28,13 @@ data ProcessError = NonZeroExit Int FilePath [String]
|
|||||||
|
|
||||||
instance Pretty ProcessError where
|
instance Pretty ProcessError where
|
||||||
pPrint (NonZeroExit e exe args) =
|
pPrint (NonZeroExit e exe args) =
|
||||||
text [i|Process "#{exe}" with arguments #{args} failed with exit code #{e}.|]
|
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
|
||||||
pPrint (PTerminated exe args) =
|
pPrint (PTerminated exe args) =
|
||||||
text [i|Process "#{exe}" with arguments #{args} terminated.|]
|
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
|
||||||
pPrint (PStopped exe args) =
|
pPrint (PStopped exe args) =
|
||||||
text [i|Process "#{exe}" with arguments #{args} stopped.|]
|
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
|
||||||
pPrint (NoSuchPid exe args) =
|
pPrint (NoSuchPid exe args) =
|
||||||
text [i|Could not find PID for process running "#{exe}" with arguments #{args}.|]
|
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||||
|
|
||||||
data CapturedProcess = CapturedProcess
|
data CapturedProcess = CapturedProcess
|
||||||
{ _exitCode :: ExitCode
|
{ _exitCode :: ExitCode
|
||||||
@@ -104,3 +101,6 @@ findFiles path regex = do
|
|||||||
contents <- listDirectory path
|
contents <- listDirectory path
|
||||||
pure $ filter (match regex) contents
|
pure $ filter (match regex) contents
|
||||||
|
|
||||||
|
|
||||||
|
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
|
||||||
|
checkFileAlreadyExists fp = liftIO $ doesFileExist fp
|
||||||
|
|||||||
@@ -1,8 +1,5 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Utils.File.Posix
|
Module : GHCup.Utils.File.Posix
|
||||||
@@ -28,14 +25,12 @@ import Control.Concurrent.Async
|
|||||||
import Control.Exception ( evaluate )
|
import Control.Exception ( evaluate )
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.State.Strict
|
import Control.Monad.Trans.State.Strict
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.Sequence ( Seq, (|>) )
|
import Data.Sequence ( Seq, (|>) )
|
||||||
import Data.String.Interpolate
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Word8
|
import Data.Word8
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
@@ -132,7 +127,7 @@ execLogged exe args chdir lfile env = do
|
|||||||
pure e
|
pure e
|
||||||
|
|
||||||
tee :: Fd -> Fd -> IO ()
|
tee :: Fd -> Fd -> IO ()
|
||||||
tee fileFd fdIn = readTilEOF lineAction fdIn
|
tee fileFd = readTilEOF lineAction
|
||||||
|
|
||||||
where
|
where
|
||||||
lineAction :: ByteString -> IO ()
|
lineAction :: ByteString -> IO ()
|
||||||
@@ -351,7 +346,7 @@ toProcessError exe args mps = case mps of
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
chmod_755 :: (MonadLogger m, MonadIO m) => FilePath -> m ()
|
chmod_755 :: (MonadReader env m, HasLog env, MonadIO m) => FilePath -> m ()
|
||||||
chmod_755 fp = do
|
chmod_755 fp = do
|
||||||
let exe_mode =
|
let exe_mode =
|
||||||
nullFileMode
|
nullFileMode
|
||||||
@@ -362,7 +357,7 @@ chmod_755 fp = do
|
|||||||
`unionFileModes` groupReadMode
|
`unionFileModes` groupReadMode
|
||||||
`unionFileModes` otherExecuteMode
|
`unionFileModes` otherExecuteMode
|
||||||
`unionFileModes` otherReadMode
|
`unionFileModes` otherReadMode
|
||||||
$(logDebug) [i|chmod 755 #{fp}|]
|
logDebug ("chmod 755 " <> T.pack fp)
|
||||||
liftIO $ setFileMode fp exe_mode
|
liftIO $ setFileMode fp exe_mode
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -22,11 +22,8 @@ import GHCup.Utils.String.QQ
|
|||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Logger
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Char ( ord )
|
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Console.Pretty
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
@@ -35,53 +32,6 @@ import qualified Data.ByteString as B
|
|||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
|
|
||||||
|
|
||||||
data LoggerConfig = LoggerConfig
|
|
||||||
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
|
||||||
, colorOutter :: B.ByteString -> IO () -- ^ how to write the color output
|
|
||||||
, rawOutter :: B.ByteString -> IO () -- ^ how to write the full raw output
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
myLoggerT :: LoggerConfig -> LoggingT m a -> m a
|
|
||||||
myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
|
|
||||||
where
|
|
||||||
mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
|
|
||||||
mylogger _ _ level str' = do
|
|
||||||
-- color output
|
|
||||||
let style' = case level of
|
|
||||||
LevelDebug -> style Bold . color Blue
|
|
||||||
LevelInfo -> style Bold . color Green
|
|
||||||
LevelWarn -> style Bold . color Yellow
|
|
||||||
LevelError -> style Bold . color Red
|
|
||||||
LevelOther _ -> id
|
|
||||||
let l = case level of
|
|
||||||
LevelDebug -> toLogStr (style' "[ Debug ]")
|
|
||||||
LevelInfo -> toLogStr (style' "[ Info ]")
|
|
||||||
LevelWarn -> toLogStr (style' "[ Warn ]")
|
|
||||||
LevelError -> toLogStr (style' "[ Error ]")
|
|
||||||
LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
|
|
||||||
let strs = fmap toLogStr . B.split (fromIntegral $ ord '\n') . fromLogStr $ str'
|
|
||||||
let out = case strs of
|
|
||||||
[] -> B.empty
|
|
||||||
(x:xs) -> fromLogStr
|
|
||||||
. foldr (\a b -> a <> toLogStr "\n" <> b) mempty
|
|
||||||
. ((l <> toLogStr " " <> x) :)
|
|
||||||
. fmap (\line' -> toLogStr (style' "[ ... ] ") <> line' )
|
|
||||||
$ xs
|
|
||||||
|
|
||||||
when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
|
|
||||||
$ colorOutter out
|
|
||||||
|
|
||||||
-- raw output
|
|
||||||
let lr = case level of
|
|
||||||
LevelDebug -> toLogStr "Debug:"
|
|
||||||
LevelInfo -> toLogStr "Info:"
|
|
||||||
LevelWarn -> toLogStr "Warn:"
|
|
||||||
LevelError -> toLogStr "Error:"
|
|
||||||
LevelOther t -> toLogStr t <> toLogStr ":"
|
|
||||||
let outr = fromLogStr (lr <> toLogStr " " <> str' <> toLogStr "\n")
|
|
||||||
rawOutter outr
|
|
||||||
|
|
||||||
|
|
||||||
initGHCupFileLogging :: ( MonadReader env m
|
initGHCupFileLogging :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
|||||||
@@ -5,7 +5,6 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Utils.Prelude
|
Module : GHCup.Utils.Prelude
|
||||||
@@ -30,10 +29,10 @@ import Control.Exception.Safe
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Logger
|
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.List ( nub, intercalate )
|
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
|
||||||
|
import Data.Maybe
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
@@ -75,8 +74,9 @@ import qualified System.Win32.File as Win32
|
|||||||
-- >>> import Data.ByteString.Internal (c2w, w2c)
|
-- >>> import Data.ByteString.Internal (c2w, w2c)
|
||||||
-- >>> import Test.QuickCheck
|
-- >>> import Test.QuickCheck
|
||||||
-- >>> import Data.Word8
|
-- >>> import Data.Word8
|
||||||
-- >>> import Data.Word8
|
|
||||||
-- >>> import qualified Data.Text as T
|
-- >>> import qualified Data.Text as T
|
||||||
|
-- >>> import qualified Data.Char as C
|
||||||
|
-- >>> import Data.List
|
||||||
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
|
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
|
||||||
|
|
||||||
|
|
||||||
@@ -174,8 +174,12 @@ lEM' :: forall e' e es a m
|
|||||||
lEM' f em = lift em >>= lE . first f
|
lEM' f em = lift em >>= lE . first f
|
||||||
|
|
||||||
-- for some obscure reason... this won't type-check if we move it to a different module
|
-- for some obscure reason... this won't type-check if we move it to a different module
|
||||||
catchWarn :: forall es m . (Pretty (V es), MonadLogger m, Monad m) => Excepts es m () -> Excepts '[] m ()
|
catchWarn :: forall es m env . ( Pretty (V es)
|
||||||
catchWarn = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
|
, MonadReader env m
|
||||||
|
, HasLog env
|
||||||
|
, MonadIO m
|
||||||
|
, Monad m) => Excepts es m () -> Excepts '[] m ()
|
||||||
|
catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyShow $ v))
|
||||||
|
|
||||||
fromEither :: Either a b -> VEither '[a] b
|
fromEither :: Either a b -> VEither '[a] b
|
||||||
fromEither = either (VLeft . V) VRight
|
fromEither = either (VLeft . V) VRight
|
||||||
@@ -520,7 +524,7 @@ forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
|
|||||||
forFold = \t -> (`traverseFold` t)
|
forFold = \t -> (`traverseFold` t)
|
||||||
|
|
||||||
|
|
||||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
-- | Strip @\\r@ and @\\n@ from 'String's
|
||||||
--
|
--
|
||||||
-- >>> stripNewline "foo\n\n\n"
|
-- >>> stripNewline "foo\n\n\n"
|
||||||
-- "foo"
|
-- "foo"
|
||||||
@@ -532,13 +536,10 @@ forFold = \t -> (`traverseFold` t)
|
|||||||
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
|
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
|
||||||
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
|
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
|
||||||
stripNewline :: String -> String
|
stripNewline :: String -> String
|
||||||
stripNewline s
|
stripNewline = filter (`notElem` "\n\r")
|
||||||
| null s = []
|
|
||||||
| head s `elem` "\n\r" = stripNewline (tail s)
|
|
||||||
| otherwise = head s : stripNewline (tail s)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
-- | Strip @\\r@ and @\\n@ from 'Text's
|
||||||
--
|
--
|
||||||
-- >>> stripNewline' "foo\n\n\n"
|
-- >>> stripNewline' "foo\n\n\n"
|
||||||
-- "foo"
|
-- "foo"
|
||||||
@@ -550,10 +551,7 @@ stripNewline s
|
|||||||
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
|
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
|
||||||
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
|
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
|
||||||
stripNewline' :: T.Text -> T.Text
|
stripNewline' :: T.Text -> T.Text
|
||||||
stripNewline' s
|
stripNewline' = T.filter (`notElem` "\n\r")
|
||||||
| T.null s = mempty
|
|
||||||
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
|
|
||||||
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Is the word8 a newline?
|
-- | Is the word8 a newline?
|
||||||
@@ -587,3 +585,117 @@ splitOnPVP c s = case Split.splitOn c s of
|
|||||||
| otherwise -> def
|
| otherwise -> def
|
||||||
where
|
where
|
||||||
def = (s, "")
|
def = (s, "")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Like 'find', but where the test can be monadic.
|
||||||
|
--
|
||||||
|
-- >>> findM (Just . C.isUpper) "teST"
|
||||||
|
-- Just (Just 'S')
|
||||||
|
-- >>> findM (Just . C.isUpper) "test"
|
||||||
|
-- Just Nothing
|
||||||
|
-- >>> findM (Just . const True) ["x",undefined]
|
||||||
|
-- Just (Just "x")
|
||||||
|
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
|
||||||
|
findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Drops the given suffix from a list.
|
||||||
|
-- It returns the original sequence if the sequence doesn't end with the given suffix.
|
||||||
|
--
|
||||||
|
-- >>> dropSuffix "!" "Hello World!"
|
||||||
|
-- "Hello World"
|
||||||
|
-- >>> dropSuffix "!" "Hello World!!"
|
||||||
|
-- "Hello World!"
|
||||||
|
-- >>> dropSuffix "!" "Hello World."
|
||||||
|
-- "Hello World."
|
||||||
|
dropSuffix :: Eq a => [a] -> [a] -> [a]
|
||||||
|
dropSuffix a b = fromMaybe b $ stripSuffix a b
|
||||||
|
|
||||||
|
-- | Return the prefix of the second list if its suffix
|
||||||
|
-- matches the entire first list.
|
||||||
|
--
|
||||||
|
-- >>> stripSuffix "bar" "foobar"
|
||||||
|
-- Just "foo"
|
||||||
|
-- >>> stripSuffix "" "baz"
|
||||||
|
-- Just "baz"
|
||||||
|
-- >>> stripSuffix "foo" "quux"
|
||||||
|
-- Nothing
|
||||||
|
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
|
||||||
|
stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Drops the given prefix from a list.
|
||||||
|
-- It returns the original sequence if the sequence doesn't start with the given prefix.
|
||||||
|
--
|
||||||
|
-- >>> dropPrefix "Mr. " "Mr. Men"
|
||||||
|
-- "Men"
|
||||||
|
-- >>> dropPrefix "Mr. " "Dr. Men"
|
||||||
|
-- "Dr. Men"
|
||||||
|
dropPrefix :: Eq a => [a] -> [a] -> [a]
|
||||||
|
dropPrefix a b = fromMaybe b $ stripPrefix a b
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Break a list into pieces separated by the first
|
||||||
|
-- list argument, consuming the delimiter. An empty delimiter is
|
||||||
|
-- invalid, and will cause an error to be raised.
|
||||||
|
--
|
||||||
|
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
|
||||||
|
-- ["a","b","d","e"]
|
||||||
|
-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
|
||||||
|
-- ["","X","X","X",""]
|
||||||
|
-- >>> splitOn "x" "x"
|
||||||
|
-- ["",""]
|
||||||
|
-- >>> splitOn "x" ""
|
||||||
|
-- [""]
|
||||||
|
--
|
||||||
|
-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x
|
||||||
|
-- prop> \c x -> splitOn [c] x == split (==c) x
|
||||||
|
splitOn :: Eq a => [a] -> [a] -> [[a]]
|
||||||
|
splitOn [] _ = error "splitOn, needle may not be empty"
|
||||||
|
splitOn _ [] = [[]]
|
||||||
|
splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
|
||||||
|
where (a,b) = breakOn needle haystack
|
||||||
|
|
||||||
|
|
||||||
|
-- | Splits a list into components delimited by separators,
|
||||||
|
-- where the predicate returns True for a separator element. The
|
||||||
|
-- resulting components do not contain the separators. Two adjacent
|
||||||
|
-- separators result in an empty component in the output.
|
||||||
|
--
|
||||||
|
-- >>> split (== 'a') "aabbaca"
|
||||||
|
-- ["","","bb","c",""]
|
||||||
|
-- >>> split (== 'a') ""
|
||||||
|
-- [""]
|
||||||
|
-- >>> split (== ':') "::xyz:abc::123::"
|
||||||
|
-- ["","","xyz","abc","","123","",""]
|
||||||
|
-- >>> split (== ',') "my,list,here"
|
||||||
|
-- ["my","list","here"]
|
||||||
|
split :: (a -> Bool) -> [a] -> [[a]]
|
||||||
|
split _ [] = [[]]
|
||||||
|
split f (x:xs)
|
||||||
|
| f x = [] : split f xs
|
||||||
|
| y:ys <- split f xs = (x:y) : ys
|
||||||
|
| otherwise = [[]]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Find the first instance of @needle@ in @haystack@.
|
||||||
|
-- The first element of the returned tuple
|
||||||
|
-- is the prefix of @haystack@ before @needle@ is matched. The second
|
||||||
|
-- is the remainder of @haystack@, starting with the match.
|
||||||
|
-- If you want the remainder /without/ the match, use 'stripInfix'.
|
||||||
|
--
|
||||||
|
-- >>> breakOn "::" "a::b::c"
|
||||||
|
-- ("a","::b::c")
|
||||||
|
-- >>> breakOn "/" "foobar"
|
||||||
|
-- ("foobar","")
|
||||||
|
--
|
||||||
|
-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
|
||||||
|
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
|
||||||
|
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
|
||||||
|
breakOn _ [] = ([], [])
|
||||||
|
breakOn needle (x:xs) = first (x:) $ breakOn needle xs
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -44,15 +44,14 @@ import Language.Haskell.TH.Quote
|
|||||||
-- The pattern portion is undefined.
|
-- The pattern portion is undefined.
|
||||||
s :: QuasiQuoter
|
s :: QuasiQuoter
|
||||||
s = QuasiQuoter
|
s = QuasiQuoter
|
||||||
(\s' -> case and $ fmap isAscii s' of
|
(\s' -> case all isAscii s' of
|
||||||
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
|
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
|
||||||
False -> fail "Not ascii"
|
False -> fail "Not ascii"
|
||||||
)
|
)
|
||||||
(error "Cannot use q as a pattern")
|
(error "Cannot use s as a pattern")
|
||||||
(error "Cannot use q as a type")
|
(error "Cannot use s as a type")
|
||||||
(error "Cannot use q as a dec")
|
(error "Cannot use s as a dec")
|
||||||
where
|
where
|
||||||
removeCRs = filter (/= '\r')
|
removeCRs = filter (/= '\r')
|
||||||
trimLeadingNewline ('\n' : xs) = xs
|
trimLeadingNewline ('\n' : xs) = xs
|
||||||
trimLeadingNewline xs = xs
|
trimLeadingNewline xs = xs
|
||||||
|
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ import qualified Data.Text as T
|
|||||||
|
|
||||||
-- | This reflects the API version of the YAML.
|
-- | This reflects the API version of the YAML.
|
||||||
ghcupURL :: URI
|
ghcupURL :: URI
|
||||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
|
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
|
||||||
|
|
||||||
-- | The current ghcup version.
|
-- | The current ghcup version.
|
||||||
ghcUpVer :: PVP
|
ghcUpVer :: PVP
|
||||||
|
|||||||
20
stack.yaml
20
stack.yaml
@@ -4,15 +4,13 @@ packages:
|
|||||||
- .
|
- .
|
||||||
|
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- git: https://github.com/hasufell/text-conversions.git
|
- git: https://github.com/bgamari/terminal-size
|
||||||
commit: 9abf0e5e5664a3178367597c32db19880477a53c
|
commit: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||||
|
|
||||||
- git: https://github.com/Bodigrim/tar
|
- git: https://github.com/hasufell/libarchive
|
||||||
commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
|
commit: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||||
|
|
||||||
- git: https://github.com/jtdaugherty/brick.git
|
|
||||||
commit: b3b96cfe66dfd398d338e3feb2b6855e66a35190
|
|
||||||
|
|
||||||
|
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
||||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
||||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
||||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
||||||
@@ -31,7 +29,6 @@ extra-deps:
|
|||||||
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
|
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
|
||||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
||||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||||
- libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
|
|
||||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||||
@@ -45,7 +42,6 @@ extra-deps:
|
|||||||
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
||||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||||
- zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
|
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
http-io-streams:
|
http-io-streams:
|
||||||
@@ -57,6 +53,12 @@ flags:
|
|||||||
regex-posix:
|
regex-posix:
|
||||||
_regex-posix-clib: true
|
_regex-posix-clib: true
|
||||||
|
|
||||||
|
aeson-pretty:
|
||||||
|
lib-only: true
|
||||||
|
|
||||||
|
cabal-plan:
|
||||||
|
exe: false
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
"$locals": -O2
|
"$locals": -O2
|
||||||
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||||
|
|||||||
@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
|
|||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
instance Arbitrary Scheme where
|
instance Arbitrary Scheme where
|
||||||
arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ]
|
arbitrary = elements [ Scheme "http", Scheme "https" ]
|
||||||
|
|
||||||
instance Arbitrary Host where
|
instance Arbitrary Host where
|
||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
|
|||||||
Reference in New Issue
Block a user