Compare commits
35 Commits
remove-zip
...
issue-221
| 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
|
|||
|
|
df758d828b | ||
|
|
8c486e8d46 |
@@ -14,7 +14,7 @@ variables:
|
||||
############################################################
|
||||
|
||||
.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:
|
||||
- x86_64-linux
|
||||
variables:
|
||||
@@ -527,15 +527,9 @@ release:windows:
|
||||
hlint:
|
||||
stage: hlint
|
||||
extends:
|
||||
- .alpine:64bit
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
- .debian
|
||||
script:
|
||||
- ./.gitlab/script/hlint.sh
|
||||
variables:
|
||||
GHC_VERSION: "8.10.6"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
JSON_VERSION: "0.0.4"
|
||||
- curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
|
||||
allow_failure: true
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
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)
|
||||
* [Installing custom bindists](#installing-custom-bindists)
|
||||
* [Isolated Installs](#isolated-installs)
|
||||
* [CI](#ci)
|
||||
* [Tips and tricks](#tips-and-tricks)
|
||||
* [Design goals](#design-goals)
|
||||
* [How](#how)
|
||||
@@ -190,6 +191,126 @@ Examples:-
|
||||
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`
|
||||
---
|
||||
|
||||
### 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
|
||||
|
||||
|
||||
@@ -11,22 +11,31 @@
|
||||
module Main where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Char ( toLower )
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Data.Semigroup ( (<>) )
|
||||
#endif
|
||||
import Options.Applicative hiding ( style )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.Console.Pretty
|
||||
import System.Exit
|
||||
import System.IO ( stdout )
|
||||
import System.IO ( stderr )
|
||||
import Text.Regex.Posix
|
||||
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.Yaml as Y
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
|
||||
|
||||
data Options = Options
|
||||
@@ -105,10 +114,27 @@ com = subparser
|
||||
|
||||
main :: IO ()
|
||||
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)
|
||||
>>= \Options {..} -> case optCommand of
|
||||
ValidateYAML vopts -> withValidateYamlOpts vopts validate
|
||||
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter)
|
||||
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
|
||||
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
|
||||
pure ()
|
||||
|
||||
where
|
||||
@@ -120,8 +146,8 @@ main = do
|
||||
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
||||
B.readFile file >>= valAndExit f
|
||||
valAndExit f contents = do
|
||||
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
|
||||
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
|
||||
Right r -> pure r
|
||||
Left e -> die (color Red $ show e)
|
||||
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av gt)
|
||||
Left (_, e) -> die (color Red $ show e)
|
||||
f av gt
|
||||
>>= exitWith
|
||||
|
||||
@@ -12,11 +12,9 @@ module Validate where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Types hiding ( LeanAppState (..) )
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
||||
import Codec.Archive
|
||||
@@ -24,7 +22,6 @@ import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader.Class
|
||||
import Control.Monad.Trans.Class ( lift )
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
@@ -39,12 +36,10 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
import System.FilePath
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Version as V
|
||||
@@ -62,7 +57,7 @@ addError = do
|
||||
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
|
||||
-> M.Map GlobalTool DownloadInfo
|
||||
-> m ExitCode
|
||||
@@ -89,23 +84,23 @@ validate dls _ = do
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
lift $ $(logInfo) "All good"
|
||||
lift $ logInfo "All good"
|
||||
pure ExitSuccess
|
||||
where
|
||||
checkHasRequiredPlatforms t v tags arch pspecs = do
|
||||
let v' = prettyVer v
|
||||
arch' = prettyShow arch
|
||||
when (notElem (Linux UnknownLinux) pspecs) $ do
|
||||
lift $ $(logError) $
|
||||
lift $ logError $
|
||||
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
when ((notElem Darwin pspecs) && arch == A_64) $ do
|
||||
lift $ $(logError) $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) $
|
||||
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
|
||||
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
when (notElem Windows pspecs && arch == A_64) $ do
|
||||
lift $ $(logError) $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
|
||||
-- alpine needs to be set explicitly, because
|
||||
@@ -113,12 +108,12 @@ validate dls _ = do
|
||||
-- (although it could be static)
|
||||
when (notElem (Linux Alpine) pspecs) $
|
||||
case t of
|
||||
GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow 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|]
|
||||
, arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow 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
|
||||
, arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
|
||||
_ -> lift $ $(logWarn) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
|
||||
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
|
||||
_ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
|
||||
|
||||
checkUniqueTags tool = do
|
||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
@@ -138,7 +133,7 @@ validate dls _ = do
|
||||
case join nonUnique of
|
||||
[] -> pure ()
|
||||
xs -> do
|
||||
lift $ $(logError) $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
|
||||
lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
|
||||
addError
|
||||
where
|
||||
isUniqueTag Latest = True
|
||||
@@ -154,7 +149,7 @@ validate dls _ = do
|
||||
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
|
||||
[_] -> pure ()
|
||||
_ -> do
|
||||
lift $ $(logError) $ "GHC version " <> prettyVer v <> " is not valid"
|
||||
lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
|
||||
addError
|
||||
|
||||
-- a tool must have at least one of each mandatory tags
|
||||
@@ -162,7 +157,7 @@ validate dls _ = do
|
||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
|
||||
False -> do
|
||||
lift $ $(logError) $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
|
||||
lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
|
||||
addError
|
||||
True -> pure ()
|
||||
|
||||
@@ -171,7 +166,7 @@ validate dls _ = do
|
||||
let allTags = M.toList $ availableToolVersions dls GHC
|
||||
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
|
||||
False -> do
|
||||
lift $ $(logError) $ "Base tag missing from GHC ver " <> prettyVer ver
|
||||
lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
|
||||
addError
|
||||
True -> pure ()
|
||||
|
||||
@@ -184,7 +179,10 @@ data TarballFilter = TarballFilter
|
||||
}
|
||||
|
||||
validateTarballs :: ( Monad m
|
||||
, MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -199,45 +197,37 @@ validateTarballs :: ( Monad m
|
||||
validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
ref <- liftIO $ newIORef 0
|
||||
|
||||
flip runReaderT ref $ do
|
||||
-- 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 gdlis = nubOrd $ gt ^.. each
|
||||
let allDls = either (const gdlis) (const dlis) etool
|
||||
when (null allDls) $ $(logError) "no tarballs selected by filter" *> addError
|
||||
forM_ allDls downloadAll
|
||||
-- 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 gdlis = nubOrd $ gt ^.. each
|
||||
let allDls = either (const gdlis) (const dlis) etool
|
||||
when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
|
||||
forM_ allDls (downloadAll ref)
|
||||
|
||||
-- exit
|
||||
e <- liftIO $ readIORef ref
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
lift $ $(logInfo) "All good"
|
||||
pure ExitSuccess
|
||||
-- exit
|
||||
e <- liftIO $ readIORef ref
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
logInfo "All good"
|
||||
pure ExitSuccess
|
||||
|
||||
where
|
||||
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = B.hPut stderr
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
downloadAll dli = do
|
||||
dirs <- liftIO getAllDirs
|
||||
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
lift $ runLogger
|
||||
($(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
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
. flip runReaderT appstate
|
||||
. runResourceT
|
||||
downloadAll :: ( MonadUnliftIO m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadCatch m
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
)
|
||||
=> IORef Int
|
||||
-> DownloadInfo
|
||||
-> m ()
|
||||
downloadAll ref dli = do
|
||||
r <- runResourceT
|
||||
. runE @'[DigestError
|
||||
, DownloadFailed
|
||||
, UnknownArchive
|
||||
@@ -263,26 +253,26 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
VRight (Just basePath) -> do
|
||||
case _dlSubdir dli of
|
||||
Just (RealDir prel) -> do
|
||||
lift $ $(logInfo)
|
||||
logInfo
|
||||
$ " verifying subdir: " <> T.pack prel
|
||||
when (basePath /= prel) $ do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
|
||||
addError
|
||||
(flip runReaderT ref addError)
|
||||
Just (RegexDir regexString) -> do
|
||||
lift $ $(logInfo) $
|
||||
logInfo $
|
||||
"verifying subdir (regex): " <> T.pack regexString
|
||||
let regex = makeRegexOpts
|
||||
compIgnoreCase
|
||||
execBlank
|
||||
regexString
|
||||
when (not (match regex basePath)) $ do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
|
||||
addError
|
||||
(flip runReaderT ref addError)
|
||||
Nothing -> pure ()
|
||||
VRight Nothing -> pure ()
|
||||
VLeft e -> do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"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.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
@@ -29,7 +29,6 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||
)
|
||||
import Codec.Archive
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Resource
|
||||
@@ -417,12 +416,8 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, Monad
|
||||
install' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run =
|
||||
runLogger
|
||||
. runResourceT
|
||||
runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, ArchiveResult
|
||||
@@ -462,7 +457,7 @@ install' _ (_, ListResult {..}) = do
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
myLoggerT l $ $(logInfo) msg
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
@@ -473,12 +468,9 @@ install' _ (_, ListResult {..}) = do
|
||||
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
||||
set' _ (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run =
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
flip runReaderT settings
|
||||
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||
|
||||
run (do
|
||||
@@ -501,9 +493,7 @@ del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnlif
|
||||
del' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
let run = myLoggerT l . runE @'[NotInstalled]
|
||||
let run = runE @'[NotInstalled]
|
||||
|
||||
run (do
|
||||
let vi = getVersionInfo lVer lTool dls
|
||||
@@ -517,7 +507,7 @@ del' _ (_, ListResult {..}) = do
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
|
||||
@@ -546,6 +536,10 @@ settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
@@ -559,27 +553,14 @@ settings' = unsafePerformIO $ do
|
||||
defaultKeyBindings
|
||||
(GHCupInfo mempty mempty mempty)
|
||||
(PlatformRequest A_64 Darwin Nothing)
|
||||
loggerConfig
|
||||
|
||||
|
||||
|
||||
logger' :: IORef LoggerConfig
|
||||
{-# NOINLINE logger' #-}
|
||||
logger' = unsafePerformIO
|
||||
(newIORef $ LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
brickMain :: AppState
|
||||
-> LoggerConfig
|
||||
-> IO ()
|
||||
brickMain s l = do
|
||||
brickMain s = do
|
||||
writeIORef settings' s
|
||||
-- logger interpreter
|
||||
writeIORef logger' l
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
@@ -596,7 +577,7 @@ brickMain s l = do
|
||||
)
|
||||
$> ()
|
||||
Left e -> do
|
||||
runLogger ($(logError) $ "Error building app state: " <> T.pack (show e))
|
||||
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
|
||||
exitWith $ ExitFailure 2
|
||||
|
||||
|
||||
@@ -607,12 +588,9 @@ defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = Fal
|
||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||
getGHCupInfo = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
flip runReaderT settings
|
||||
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
@@ -625,14 +603,11 @@ getGHCupInfo = do
|
||||
getAppData :: Maybe GHCupInfo
|
||||
-> IO (Either String BrickData)
|
||||
getAppData mgi = runExceptT $ do
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
|
||||
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
runLogger . flip runReaderT settings $ do
|
||||
flip runReaderT settings $ do
|
||||
lV <- listVersions Nothing Nothing
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
|
||||
@@ -30,6 +30,7 @@ import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Version
|
||||
|
||||
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
|
||||
import Codec.Archive
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
@@ -39,9 +40,10 @@ import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Aeson ( decodeStrict', Value )
|
||||
import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||
import Data.Bifunctor
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
@@ -75,8 +77,7 @@ import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Yaml as Y
|
||||
import qualified Data.Yaml.Pretty as YP
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
@@ -204,6 +205,11 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
|
||||
|
||||
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||
| WhereisBaseDir
|
||||
| WhereisBinDir
|
||||
| WhereisCacheDir
|
||||
| WhereisLogsDir
|
||||
| WhereisConfDir
|
||||
|
||||
data WhereisOptions = WhereisOptions {
|
||||
directory :: Bool
|
||||
@@ -832,7 +838,8 @@ configP = subparser
|
||||
|
||||
whereisP :: Parser WhereisCommand
|
||||
whereisP = subparser
|
||||
( command
|
||||
(commandGroup "Tools locations:" <>
|
||||
command
|
||||
"ghc"
|
||||
(WhereisTool GHC <$> info
|
||||
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
||||
@@ -867,6 +874,37 @@ whereisP = subparser
|
||||
command
|
||||
"ghcup"
|
||||
(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
|
||||
whereisGHCFooter = [s|Discussion:
|
||||
@@ -1096,19 +1134,18 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
|
||||
tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let appState = LeanAppState
|
||||
(Settings True False Never Curl False GHCupURL True)
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = 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
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (\t -> t /= Old)
|
||||
@@ -1128,14 +1165,14 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
settings = Settings True False Never Curl False GHCupURL True
|
||||
let settings = Settings True False Never Curl False GHCupURL True
|
||||
let leanAppState = LeanAppState
|
||||
settings
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
loggerConfig
|
||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
@@ -1144,8 +1181,9 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
ghcupInfo
|
||||
pfreq
|
||||
loggerConfig
|
||||
|
||||
runEnv = runLogger . flip runReaderT appState
|
||||
runEnv = flip runReaderT appState
|
||||
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||
@@ -1316,7 +1354,7 @@ toSettings options = do
|
||||
|
||||
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
||||
updateSettings config settings = do
|
||||
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
|
||||
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config
|
||||
pure $ mergeConf settings' settings
|
||||
where
|
||||
mergeConf :: UserSettings -> Settings -> Settings
|
||||
@@ -1363,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 settings
|
||||
= UTF8.toString . YP.encodePretty yamlConfig $ settings
|
||||
where
|
||||
yamlConfig = YP.setConfCompare compare YP.defConfig
|
||||
= UTF8.toString . Y.encode1Strict $ settings
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@@ -1381,6 +1427,9 @@ main = do
|
||||
(head . lines $ describe_result)
|
||||
)
|
||||
(long "version" <> help "Show version" <> hidden)
|
||||
let planJson = infoOption
|
||||
plan_json
|
||||
(long "plan-json" <> help "Show the build-time configuration" <> internal)
|
||||
let numericVersionHelp = infoOption
|
||||
numericVer
|
||||
( long "numeric-version"
|
||||
@@ -1408,7 +1457,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
customExecParser
|
||||
(prefs showHelpOnError)
|
||||
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands)
|
||||
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> planJson <**> listCommands)
|
||||
(footerDoc (Just $ text main_footer))
|
||||
)
|
||||
>>= \opt@Options {..} -> do
|
||||
@@ -1419,18 +1468,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
(settings, keybindings) <- toSettings opt
|
||||
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- flip runReaderT dirs $ initGHCupFileLogging
|
||||
logfile <- flip runReaderT dirs initGHCupFileLogging
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = verbose settings
|
||||
, colorOutter = B.hPut stderr
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter =
|
||||
case optCommand of
|
||||
Nuke -> \_ -> pure ()
|
||||
_ -> B.appendFile logfile
|
||||
_ -> T.appendFile logfile
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
|
||||
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
|
||||
let runLogger = flip runReaderT leanAppstate
|
||||
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -1438,7 +1489,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
-------------------------
|
||||
|
||||
|
||||
let leanAppstate = LeanAppState settings dirs keybindings
|
||||
appState = do
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
@@ -1446,12 +1496,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
( runLogger
|
||||
. flip runReaderT leanAppstate
|
||||
( flip runReaderT leanAppstate
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
@@ -1460,12 +1509,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
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)
|
||||
(threadDelay 5000000 >> runLogger ($(logWarn) $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
|
||||
race_ (liftIO $ flip runReaderT s' cleanupTrash)
|
||||
(threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
|
||||
|
||||
case optCommand of
|
||||
Nuke -> pure ()
|
||||
@@ -1477,7 +1526,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
||||
Nothing -> flip runReaderT s' checkForUpdates
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
@@ -1485,7 +1534,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 30)
|
||||
pure s'
|
||||
|
||||
@@ -1510,8 +1559,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
|
||||
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
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1539,8 +1587,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanSetGHC =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
@@ -1550,8 +1597,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runSetGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
@@ -1562,8 +1608,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanSetCabal =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1572,8 +1617,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runSetCabal =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1583,8 +1627,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runSetHLS =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1593,8 +1636,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runLeanSetHLS =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1602,23 +1644,21 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runAppState
|
||||
let runListGHC = runAppState
|
||||
|
||||
let runRm =
|
||||
runLogger . runAppState . runE @'[NotInstalled]
|
||||
runAppState . runE @'[NotInstalled]
|
||||
|
||||
let runNuke s' =
|
||||
runLogger . flip runReaderT s' . runE @'[NotInstalled]
|
||||
flip runReaderT s' . runE @'[NotInstalled]
|
||||
|
||||
let runDebugInfo =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
||||
|
||||
let runCompileGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1638,10 +1678,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanWhereIs =
|
||||
runLogger
|
||||
-- Don't use runLeanAppState here, which is disabled on windows.
|
||||
-- This is the only command on all platforms that doesn't need full appstate.
|
||||
. flip runReaderT leanAppstate
|
||||
flip runReaderT leanAppstate
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
@@ -1650,8 +1689,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runWhereIs =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
@@ -1660,8 +1698,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
let runUpgrade =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
@@ -1673,8 +1710,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
let runPrefetch =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ TagNotFound
|
||||
@@ -1712,25 +1748,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "GHC installation successful"
|
||||
runLogger $ logInfo "GHC installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"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
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
|
||||
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ (logError $ T.pack $ prettyShow err)
|
||||
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 3
|
||||
|
||||
|
||||
@@ -1752,18 +1788,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "Cabal installation successful"
|
||||
runLogger $ logInfo "Cabal installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"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
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
let installHLS InstallOptions{..} =
|
||||
@@ -1784,12 +1820,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "HLS installation successful"
|
||||
runLogger $ logInfo "HLS installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"HLS ver "
|
||||
<> prettyVer v
|
||||
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
|
||||
@@ -1798,8 +1834,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
let installStack InstallOptions{..} =
|
||||
@@ -1820,18 +1856,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "Stack installation successful"
|
||||
runLogger $ logInfo "Stack installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"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
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
|
||||
@@ -1845,11 +1881,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 5
|
||||
|
||||
let setCabal' SetOptions{ sToolVer } =
|
||||
@@ -1863,11 +1899,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setHLS' SetOptions{ sToolVer } =
|
||||
@@ -1881,11 +1917,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setStack' SetOptions{ sToolVer } =
|
||||
@@ -1899,11 +1935,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let rmGHC' RmOptions{..} =
|
||||
@@ -1916,10 +1952,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 7
|
||||
|
||||
let rmCabal' tv =
|
||||
@@ -1932,10 +1968,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
let rmHLS' tv =
|
||||
@@ -1948,10 +1984,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
let rmStack' tv =
|
||||
@@ -1964,31 +2000,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
res <- case optCommand of
|
||||
#if defined(BRICK)
|
||||
Interactive -> do
|
||||
s' <- appState
|
||||
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
|
||||
liftIO $ brickMain s' >> pure ExitSuccess
|
||||
#endif
|
||||
Install (Right iopts) -> do
|
||||
runLogger ($(logWarn) "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
|
||||
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
||||
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
||||
Install (Left (InstallHLS iopts)) -> installHLS iopts
|
||||
Install (Left (InstallStack iopts)) -> installStack iopts
|
||||
InstallCabalLegacy iopts -> do
|
||||
runLogger ($(logWarn) "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
|
||||
|
||||
Set (Right sopts) -> do
|
||||
runLogger ($(logWarn) "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
|
||||
Set (Left (SetGHC sopts)) -> setGHC' sopts
|
||||
Set (Left (SetCabal sopts)) -> setCabal' sopts
|
||||
@@ -2003,7 +2039,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
|
||||
Rm (Right rmopts) -> do
|
||||
runLogger ($(logWarn) "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
|
||||
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
|
||||
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
|
||||
@@ -2017,11 +2053,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
putStrLn $ prettyDebugInfo dinfo
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 8
|
||||
|
||||
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
|
||||
Compile (CompileGHC GHCCompileOptions {..}) ->
|
||||
runCompileGHC (do
|
||||
@@ -2030,8 +2066,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ $(logInfo) msg
|
||||
lift $ $(logInfo)
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
@@ -2054,32 +2090,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, tv) -> do
|
||||
runLogger $ $(logInfo)
|
||||
runLogger $ logInfo
|
||||
"GHC successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
putStr (T.unpack $ tVerToText tv)
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"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
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
|
||||
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack logsDir <> " and the build directory "
|
||||
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 9
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
|
||||
Config InitConfig -> do
|
||||
path <- getConfigFilePath
|
||||
writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
runLogger $ $(logDebug) $ "config.yaml initialized at " <> T.pack path
|
||||
runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
|
||||
pure ExitSuccess
|
||||
|
||||
Config ShowConfig -> do
|
||||
@@ -2089,20 +2125,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Config (SetConfig k v) -> do
|
||||
case v of
|
||||
"" -> do
|
||||
runLogger $ $(logError) "Empty values are not allowed"
|
||||
runLogger $ logError "Empty values are not allowed"
|
||||
pure $ ExitFailure 55
|
||||
_ -> do
|
||||
r <- runE @'[JSONError] $ do
|
||||
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
runLogger $ $(logDebug) $ T.pack $ show settings'
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
|
||||
case r of
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft (V (JSONDecodeError e)) -> do
|
||||
runLogger $ $(logError) $ "Error decoding config: " <> T.pack e
|
||||
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
|
||||
@@ -2118,7 +2154,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
|
||||
@@ -2134,9 +2170,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
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
|
||||
target <- case uOpts of
|
||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||
@@ -2151,23 +2207,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight (v', dls) -> do
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ $(logInfo) $
|
||||
runLogger $ logInfo $
|
||||
"Successfully upgraded GHCup to version " <> pretty_v
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
runLogger $ $(logWarn) "No GHCup update available"
|
||||
runLogger $ logWarn "No GHCup update available"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
|
||||
ToolRequirements -> do
|
||||
s' <- appState
|
||||
flip runReaderT s'
|
||||
$ runLogger
|
||||
(runE
|
||||
$ (runE
|
||||
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
||||
$ do
|
||||
GHCupInfo { .. } <- lift getGHCupInfo
|
||||
@@ -2178,7 +2233,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 12
|
||||
|
||||
ChangeLog ChangeLogOptions{..} -> do
|
||||
@@ -2195,7 +2250,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
case muri of
|
||||
Nothing -> do
|
||||
runLogger
|
||||
($(logWarn) $
|
||||
(logWarn $
|
||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
||||
)
|
||||
pure ExitSuccess
|
||||
@@ -2218,7 +2273,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> runLogger ($(logError) (T.pack $ prettyShow e))
|
||||
Left e -> logError (T.pack $ prettyShow e)
|
||||
>> pure (ExitFailure 13)
|
||||
else putStrLn uri' >> pure ExitSuccess
|
||||
|
||||
@@ -2226,12 +2281,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
s' <- liftIO appState
|
||||
void $ liftIO $ evaluate $ force s'
|
||||
runNuke s' (do
|
||||
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 "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."
|
||||
liftIO $ threadDelay 10000000 -- wait 10s
|
||||
|
||||
lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ $logInfo "Nuking in 3...2...1"
|
||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ logInfo "Nuking in 3...2...1"
|
||||
|
||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
||||
|
||||
@@ -2242,15 +2297,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
) >>= \case
|
||||
VRight leftOverFiles
|
||||
| null leftOverFiles -> do
|
||||
runLogger $ $logInfo "Nuclear Annihilation complete!"
|
||||
runLogger $ logInfo "Nuclear Annihilation complete!"
|
||||
pure ExitSuccess
|
||||
| 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
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
Prefetch pfCom ->
|
||||
runPrefetch (do
|
||||
@@ -2281,7 +2336,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
|
||||
@@ -2292,7 +2347,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
pure ()
|
||||
|
||||
fromVersion :: ( MonadLogger m
|
||||
fromVersion :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
@@ -2310,7 +2365,7 @@ fromVersion :: ( MonadLogger m
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion tv = fromVersion' (toSetToolVer tv)
|
||||
|
||||
fromVersion' :: ( MonadLogger m
|
||||
fromVersion' :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
@@ -2556,11 +2611,10 @@ checkForUpdates :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> m ()
|
||||
checkForUpdates = do
|
||||
@@ -2571,35 +2625,35 @@ checkForUpdates = do
|
||||
forM_ (getLatest dls GHCup) $ \(l, _) -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
|
||||
|
||||
forM_ (getLatest dls GHC) $ \(l, _) -> do
|
||||
let mghc_ver = latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls Cabal) $ \(l, _) -> do
|
||||
let mcabal_ver = latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls HLS) $ \(l, _) -> do
|
||||
let mhls_ver = latestInstalled HLS
|
||||
forM mhls_ver $ \hls_ver ->
|
||||
when (l > hls_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls Stack) $ \(l, _) -> do
|
||||
let mstack_ver = latestInstalled Stack
|
||||
forM mstack_ver $ \stack_ver ->
|
||||
when (l > stack_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
|
||||
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
# Main settings:
|
||||
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
||||
# * 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
|
||||
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
|
||||
# * 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"
|
||||
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
|
||||
break ;;
|
||||
|
||||
@@ -591,10 +599,12 @@ ask_bashrc
|
||||
ask_bashrc_answer=$?
|
||||
ask_cabal_config_init
|
||||
ask_cabal_config_init_answer=$?
|
||||
ask_hls
|
||||
ask_hls_answer=$?
|
||||
ask_stack
|
||||
ask_stack_answer=$?
|
||||
if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||
ask_hls
|
||||
ask_hls_answer=$?
|
||||
ask_stack
|
||||
ask_stack_answer=$?
|
||||
fi
|
||||
|
||||
edo mkdir -p "${GHCUP_BIN}"
|
||||
|
||||
@@ -620,14 +630,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
|
||||
read -r answer </dev/tty
|
||||
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 --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
||||
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_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
|
||||
1)
|
||||
|
||||
@@ -15,24 +15,26 @@
|
||||
param (
|
||||
# Run an interactive installation
|
||||
[switch]$Interactive,
|
||||
# Specify the install root (default: 'C:\')
|
||||
[string]$InstallDir,
|
||||
# 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,
|
||||
# Do minimal installation of ghcup and msys2 only
|
||||
[switch]$Minimal,
|
||||
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
|
||||
[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
|
||||
[switch]$InstallStack,
|
||||
# Whether to install hls as well
|
||||
[switch]$InstallHLS,
|
||||
# Skip adjusting cabal.config with mingw paths
|
||||
[switch]$NoAdjustCabalConfig
|
||||
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
|
||||
[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
|
||||
@@ -180,7 +182,7 @@ elevated command prompt:
|
||||
|
||||
if ($GhcupBasePrefixEnv) {
|
||||
$defaultGhcupBasePrefix = $GhcupBasePrefixEnv
|
||||
} else {
|
||||
} elseif (!($InstallDir)) {
|
||||
$partitions = Get-CimInstance win32_logicaldisk
|
||||
$defaultGhcupBasePrefix = $null
|
||||
foreach ($p in $partitions){
|
||||
@@ -209,10 +211,10 @@ if ($Silent -and !($InstallDir)) {
|
||||
$GhcupBasePrefix = $defaultGhcupBasePrefix
|
||||
} elseif ($InstallDir) {
|
||||
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
|
||||
} 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
|
||||
} else {
|
||||
$GhcupBasePrefix = $InstallDir
|
||||
@@ -243,7 +245,20 @@ $null = [Environment]::SetEnvironmentVariable("GHCUP_INSTALL_BASE_PREFIX", $Ghcu
|
||||
|
||||
|
||||
$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)
|
||||
if (!($BootstrapUrl)) {
|
||||
$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...'
|
||||
Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
|
||||
|
||||
} elseif ($msys2Decision -eq 1) {
|
||||
Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
|
||||
while ($true) {
|
||||
@@ -529,10 +545,14 @@ if (!($NoAdjustCabalConfig)) {
|
||||
$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) {
|
||||
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 {
|
||||
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
|
||||
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
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
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
|
||||
constraints: any.Cabal ==3.2.1.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,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
aeson-pretty -lib-only,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
@@ -22,8 +25,7 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.auto-update ==0.1.6,
|
||||
any.base ==4.14.2.0,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.11.2,
|
||||
any.base-compat-batteries ==0.11.2,
|
||||
any.base-orphans ==0.8.4,
|
||||
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.bindings-DSL ==1.0.25,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.63,
|
||||
any.brick ==0.64,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.0,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.cereal ==0.5.8.1,
|
||||
cereal -bytestring-builder,
|
||||
any.chs-cabal ==0.1.1.0,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.cmdargs ==0.10.21,
|
||||
cmdargs +quotation -testprog,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
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,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.4.1,
|
||||
any.contravariant ==1.5.4,
|
||||
any.containers ==0.6.5.1,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
@@ -74,44 +69,32 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.1,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.4.0,
|
||||
any.digest ==0.0.1.3,
|
||||
digest -bytestring-in-base,
|
||||
any.directory ==1.3.6.0,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.easy-file ==0.2.2,
|
||||
any.errors ==2.3.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.extra ==1.7.9,
|
||||
any.fast-logger ==3.0.5,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.generics-sop ==0.5.1.1,
|
||||
any.ghc-boot-th ==8.10.5,
|
||||
any.ghc-boot-th ==8.10.7,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.2.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
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-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hpath-filepath ==0.10.4,
|
||||
any.hpath-posix ==0.13.3,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==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-golden-aeson ==0.9.0.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,
|
||||
any.libarchive ==3.0.2.2,
|
||||
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.megaparsec ==9.0.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
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.network ==3.1.2.2,
|
||||
network -devel,
|
||||
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.optics ==0.4,
|
||||
any.optics-core ==0.4,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optics-vl ==0.2.1,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
@@ -167,8 +138,8 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.1.0,
|
||||
any.process ==1.6.9.0,
|
||||
any.primitive ==0.7.2.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.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-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.2,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.rts ==1.0.1,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.semigroupoids ==5.3.5,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.sop-core ==0.5.0.1,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
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,
|
||||
strict +assoc,
|
||||
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,
|
||||
tagged +deepseq +transformers,
|
||||
any.tar ==0.6.0.0,
|
||||
any.template-haskell ==2.16.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-conversions ==0.3.1,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.2.0,
|
||||
any.th-compat ==0.1.2,
|
||||
any.th-expand-syns ==0.4.8.0,
|
||||
any.th-lift ==0.8.2,
|
||||
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,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.5.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7,
|
||||
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-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unix-time ==0.4.7,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.0,
|
||||
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.vty ==5.33,
|
||||
any.word-wrap ==0.4.1,
|
||||
any.word8 ==0.1.3,
|
||||
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,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.2.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||
@@ -8,26 +8,27 @@ package ghcup
|
||||
tests: True
|
||||
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
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-9.0.1
|
||||
|
||||
@@ -1,15 +1,18 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.4.0.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,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
aeson-pretty -lib-only,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
@@ -22,7 +25,6 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.auto-update ==0.1.6,
|
||||
any.base ==4.15.0.0,
|
||||
any.base-compat ==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,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.bindings-DSL ==1.0.25,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.63,
|
||||
any.brick ==0.64,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.cereal ==0.5.8.1,
|
||||
cereal -bytestring-builder,
|
||||
any.chs-cabal ==0.1.1.0,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.cmdargs ==0.10.21,
|
||||
cmdargs +quotation -testprog,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
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,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.4.1,
|
||||
any.contravariant ==1.5.4,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
@@ -74,45 +69,33 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.1,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.5.0,
|
||||
any.digest ==0.0.1.3,
|
||||
digest -bytestring-in-base,
|
||||
any.directory ==1.3.6.1,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.easy-file ==0.2.2,
|
||||
any.errors ==2.3.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.extra ==1.7.9,
|
||||
any.fast-logger ==3.0.5,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.generics-sop ==0.5.1.1,
|
||||
any.ghc-bignum ==1.0,
|
||||
any.ghc-boot-th ==9.0.1,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.7.0,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.2.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
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-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hpath-filepath ==0.10.4,
|
||||
any.hpath-posix ==0.13.3,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==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-golden-aeson ==0.9.0.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,
|
||||
any.libarchive ==3.0.2.2,
|
||||
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.megaparsec ==9.0.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
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.network ==3.1.2.2,
|
||||
network -devel,
|
||||
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.optics ==0.4,
|
||||
any.optics-core ==0.4,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optics-vl ==0.2.1,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
@@ -167,7 +138,7 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
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.profunctors ==5.6.2,
|
||||
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-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.2,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.rts ==1.0,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.semigroupoids ==5.3.5,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.sop-core ==0.5.0.1,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
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,
|
||||
strict +assoc,
|
||||
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,
|
||||
tagged +deepseq +transformers,
|
||||
any.tar ==0.6.0.0,
|
||||
any.template-haskell ==2.17.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-conversions ==0.3.1,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.2.0,
|
||||
any.th-compat ==0.1.2,
|
||||
any.th-expand-syns ==0.4.8.0,
|
||||
any.th-lift ==0.8.2,
|
||||
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,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.5.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7,
|
||||
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-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unix-time ==0.4.7,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.0,
|
||||
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.vty ==5.33,
|
||||
any.word-wrap ==0.4.1,
|
||||
any.word8 ==0.1.3,
|
||||
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,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.2.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||
|
||||
@@ -16,11 +16,17 @@ source-repository-package
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
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
|
||||
8.10.6:
|
||||
viTags:
|
||||
- Recommended
|
||||
- base-4.14.3.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
||||
viSourceDL:
|
||||
@@ -1789,6 +1788,107 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
|
||||
dlSubdir: ghc-8.10.6
|
||||
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:
|
||||
viTags:
|
||||
- Latest
|
||||
|
||||
102
ghcup-0.0.7.yaml
102
ghcup-0.0.7.yaml
@@ -1746,7 +1746,6 @@ ghcupDownloads:
|
||||
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
|
||||
8.10.6:
|
||||
viTags:
|
||||
- Recommended
|
||||
- base-4.14.3.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
||||
viSourceDL:
|
||||
@@ -1847,6 +1846,107 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
|
||||
dlSubdir: ghc-8.10.6
|
||||
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:
|
||||
viTags:
|
||||
- Latest
|
||||
|
||||
14
ghcup.cabal
14
ghcup.cabal
@@ -104,14 +104,12 @@ library
|
||||
, deepseq ^>=1.4.4.0
|
||||
, directory ^>=1.3.6.0
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, extra ^>=1.7.9
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, os-release ^>=1.0.0
|
||||
@@ -134,8 +132,7 @@ library
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml ^>=0.11.4.0
|
||||
, zip ^>=1.7.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, zlib ^>=0.6.2.2
|
||||
|
||||
if (flag(internal-downloader) && !os(windows))
|
||||
@@ -186,9 +183,12 @@ executable ghcup
|
||||
-fwarn-incomplete-record-updates -threaded
|
||||
|
||||
build-depends:
|
||||
, aeson >=1.4 && <1.6
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.13 && <5
|
||||
, bytestring ^>=0.10
|
||||
, cabal-plan ^>=0.7.2
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, filepath ^>=1.4.2.1
|
||||
@@ -196,7 +196,6 @@ executable ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, pretty ^>=1.1.3.1
|
||||
@@ -209,7 +208,7 @@ executable ghcup
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml ^>=0.11.4.0
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -258,7 +257,6 @@ executable ghcup-gen
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
@@ -270,7 +268,7 @@ executable ghcup-gen
|
||||
, text ^>=1.2.4.0
|
||||
, transformers ^>=0.5
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml ^>=0.11.4.0
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
261
lib/GHCup.hs
261
lib/GHCup.hs
@@ -48,7 +48,6 @@ import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -58,7 +57,6 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
import Data.String ( fromString )
|
||||
import Data.Text ( Text )
|
||||
@@ -112,7 +110,7 @@ fetchToolBindist :: ( MonadFail m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -140,7 +138,7 @@ fetchGHCSrc :: ( MonadFail m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -177,7 +175,7 @@ installGHCBindist :: ( MonadFail m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -202,7 +200,7 @@ installGHCBindist :: ( MonadFail m
|
||||
installGHCBindist dlinfo ver isoFilepath = do
|
||||
let tver = mkTVer ver
|
||||
|
||||
lift $ $(logDebug) $ "Requested to install GHC with " <> prettyVer ver
|
||||
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
||||
|
||||
case isoFilepath of
|
||||
-- we only care for already installed errors in regular (non-isolated) installs
|
||||
@@ -219,7 +217,7 @@ installGHCBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
lift $ $(logInfo) $ "isolated installing GHC to " <> T.pack isoDir
|
||||
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
||||
@@ -233,9 +231,9 @@ installGHCBindist dlinfo ver isoFilepath = do
|
||||
case catMaybes r of
|
||||
[] -> pure ()
|
||||
_ -> do
|
||||
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"
|
||||
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
|
||||
lift $ logWarn $ "CC/LD environment variable is set. This will change the compiler/linker"
|
||||
<> "\n" <> "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
|
||||
<> "\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
|
||||
@@ -247,7 +245,7 @@ installPackedGHC :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -305,7 +303,7 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadMask m
|
||||
@@ -316,7 +314,7 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
-> Excepts '[ProcessError] m ()
|
||||
installUnpackedGHC path inst ver = do
|
||||
#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
|
||||
-- to run configure.
|
||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||
@@ -333,7 +331,7 @@ installUnpackedGHC path inst ver = do
|
||||
| otherwise
|
||||
= []
|
||||
|
||||
lift $ $(logInfo) "Installing GHC (this may take a while)"
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> inst)
|
||||
: alpineArgs
|
||||
@@ -359,7 +357,7 @@ installGHCBin :: ( MonadFail m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -393,7 +391,7 @@ installCabalBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -417,7 +415,7 @@ installCabalBindist :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
installCabalBindist dlinfo ver isoFilepath = do
|
||||
lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver
|
||||
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -448,7 +446,7 @@ installCabalBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir
|
||||
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
|
||||
liftE $ installCabalUnpacked workdir isoDir Nothing
|
||||
|
||||
Nothing -> do -- regular install
|
||||
@@ -460,19 +458,22 @@ installCabalBindist dlinfo ver isoFilepath = do
|
||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installCabalUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing cabal"
|
||||
lift $ logInfo "Installing cabal"
|
||||
let cabalFile = "cabal"
|
||||
liftIO $ createDirRecursive' inst
|
||||
let destFileName = cabalFile
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> exeExt
|
||||
let destPath = inst </> destFileName
|
||||
|
||||
liftE $ throwIfFileAlreadyExists destPath
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
(path </> cabalFile <> exeExt)
|
||||
destPath
|
||||
@@ -488,7 +489,7 @@ installCabalBin :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -523,7 +524,7 @@ installHLSBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -542,11 +543,12 @@ installHLSBindist :: ( MonadMask m
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
]
|
||||
m
|
||||
()
|
||||
installHLSBindist dlinfo ver isoFilepath = do
|
||||
lift $ $(logDebug) $ "Requested to install hls version " <> prettyVer ver
|
||||
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -572,7 +574,7 @@ installHLSBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do
|
||||
lift $ $(logInfo) $ "isolated installing HLS to " <> T.pack isoDir
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
liftE $ installHLSUnpacked workdir isoDir Nothing
|
||||
|
||||
Nothing -> do
|
||||
@@ -585,13 +587,13 @@ installHLSBindist dlinfo ver isoFilepath = do
|
||||
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Excepts '[CopyError] m ()
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installHLSUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing HLS"
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
|
||||
-- install haskell-language-server-<ghcver>
|
||||
@@ -605,20 +607,32 @@ installHLSUnpacked path inst mver' = do
|
||||
let toF = dropSuffix exeExt f
|
||||
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
|
||||
<> exeExt
|
||||
|
||||
let srcPath = path </> f
|
||||
let destPath = inst </> toF
|
||||
|
||||
liftE $ throwIfFileAlreadyExists destPath
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
(path </> f)
|
||||
(inst </> toF)
|
||||
lift $ chmod_755 (inst </> toF)
|
||||
srcPath
|
||||
destPath
|
||||
lift $ chmod_755 destPath
|
||||
|
||||
-- install haskell-language-server-wrapper
|
||||
let wrapper = "haskell-language-server-wrapper"
|
||||
toF = wrapper
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> exeExt
|
||||
srcWrapperPath = path </> wrapper <> exeExt
|
||||
destWrapperPath = inst </> toF
|
||||
|
||||
liftE $ throwIfFileAlreadyExists destWrapperPath
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
(path </> wrapper <> exeExt)
|
||||
(inst </> toF)
|
||||
lift $ chmod_755 (inst </> toF)
|
||||
srcWrapperPath
|
||||
destWrapperPath
|
||||
|
||||
lift $ chmod_755 destWrapperPath
|
||||
|
||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||
@@ -629,7 +643,7 @@ installHLSBin :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -647,6 +661,7 @@ installHLSBin :: ( MonadMask m
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -665,7 +680,7 @@ installStackBin :: ( MonadMask m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -683,6 +698,7 @@ installStackBin :: ( MonadMask m
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -699,7 +715,7 @@ installStackBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -718,11 +734,12 @@ installStackBindist :: ( MonadMask m
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
]
|
||||
m
|
||||
()
|
||||
installStackBindist dlinfo ver isoFilepath = do
|
||||
lift $ $(logDebug) $ "Requested to install stack version " <> prettyVer ver
|
||||
lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -747,7 +764,7 @@ installStackBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
lift $ $(logInfo) $ "isolated installing Stack to " <> T.pack isoDir
|
||||
lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
|
||||
liftE $ installStackUnpacked workdir isoDir Nothing
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installStackUnpacked workdir binDir (Just ver)
|
||||
@@ -759,19 +776,22 @@ installStackBindist dlinfo ver isoFilepath = do
|
||||
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated installs
|
||||
-> Excepts '[CopyError] m ()
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installStackUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing stack"
|
||||
lift $ logInfo "Installing stack"
|
||||
let stackFile = "stack"
|
||||
liftIO $ createDirRecursive' inst
|
||||
let destFileName = stackFile
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> exeExt
|
||||
let destPath = inst </> destFileName
|
||||
destPath = inst </> destFileName
|
||||
|
||||
liftE $ throwIfFileAlreadyExists destPath
|
||||
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
(path </> stackFile <> exeExt)
|
||||
destPath
|
||||
@@ -795,7 +815,7 @@ installStackUnpacked path inst mver' = do
|
||||
-- for 'SetGHCOnly' constructor.
|
||||
setGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -829,7 +849,7 @@ setGHC ver sghc = do
|
||||
SetGHCOnly -> pure $ Just file
|
||||
SetGHC_XY -> do
|
||||
handle
|
||||
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
|
||||
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ do
|
||||
(mj, mi) <- getMajorMinorV (_tvVersion ver)
|
||||
let major' = intToText mj <> "." <> intToText mi
|
||||
@@ -854,7 +874,7 @@ setGHC ver sghc = do
|
||||
symlinkShareDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadMask m
|
||||
)
|
||||
@@ -871,9 +891,9 @@ setGHC ver sghc = do
|
||||
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
|
||||
let fullF = destdir </> sharedir
|
||||
let targetF = "." </> "ghc" </> ver' </> sharedir
|
||||
$(logDebug) $ "rm -f " <> T.pack fullF
|
||||
logDebug $ "rm -f " <> T.pack fullF
|
||||
hideError doesNotExistErrorType $ rmDirectoryLink fullF
|
||||
$(logDebug) $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||
liftIO
|
||||
#if defined(IS_WINDOWS)
|
||||
-- On windows we need to be more permissive
|
||||
@@ -891,7 +911,7 @@ setGHC ver sghc = do
|
||||
setCabal :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -923,7 +943,7 @@ setCabal ver = do
|
||||
setHLS :: ( MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -939,7 +959,7 @@ setHLS ver = do
|
||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
lift $ $(logDebug) $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ rmLink (binDir </> f)
|
||||
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
@@ -964,7 +984,7 @@ setHLS ver = do
|
||||
setStack :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -1027,9 +1047,9 @@ availableToolVersions av tool = view
|
||||
-- | List all versions from the download info, as well as stray
|
||||
-- versions.
|
||||
listVersions :: ( MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1085,7 +1105,7 @@ listVersions lt' criteria = do
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1125,7 +1145,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1133,7 +1153,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1160,7 +1180,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1168,7 +1188,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m)
|
||||
=> Map.Map Version VersionInfo
|
||||
-> Maybe Version
|
||||
@@ -1194,7 +1214,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1202,7 +1222,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1229,7 +1249,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1254,7 +1274,7 @@ listVersions lt' criteria = do
|
||||
}
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: ( MonadLogger m
|
||||
toListResult :: ( HasLog env
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasGHCupInfo env
|
||||
@@ -1356,7 +1376,7 @@ listVersions lt' criteria = do
|
||||
rmGHCVer :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1373,23 +1393,23 @@ rmGHCVer ver = do
|
||||
|
||||
-- this isn't atomic, order matters
|
||||
when isSetGHC $ do
|
||||
lift $ $(logInfo) "Removing ghc symlinks"
|
||||
lift $ logInfo "Removing ghc symlinks"
|
||||
liftE $ rmPlain (_tvTarget ver)
|
||||
|
||||
lift $ $(logInfo) "Removing ghc-x.y.z symlinks"
|
||||
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||
liftE $ rmMinorSymlinks ver
|
||||
|
||||
lift $ $(logInfo) "Removing/rewiring ghc-x.y symlinks"
|
||||
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||
-- first remove
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
||||
-- then fix them (e.g. with an earlier version)
|
||||
|
||||
lift $ $(logInfo) $ "Removing directory recursively: " <> T.pack dir
|
||||
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
||||
lift $ recyclePathForcibly dir
|
||||
|
||||
v' <-
|
||||
handle
|
||||
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
|
||||
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ fmap Just
|
||||
$ getMajorMinorV (_tvVersion ver)
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
||||
@@ -1406,7 +1426,7 @@ rmCabalVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1437,7 +1457,7 @@ rmHLSVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1460,7 +1480,7 @@ rmHLSVer ver = do
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ $(logDebug) $ "rm " <> T.pack fullF
|
||||
lift $ logDebug $ "rm " <> T.pack fullF
|
||||
lift $ rmLink fullF
|
||||
-- set latest hls
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
@@ -1475,7 +1495,7 @@ rmStackVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1505,7 +1525,7 @@ rmGhcup :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -1530,7 +1550,7 @@ rmGhcup = do
|
||||
|
||||
let areEqualPaths = equalFilePath p1 p2
|
||||
|
||||
unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
-- since it doesn't seem possible to delete a running exe on windows
|
||||
@@ -1546,7 +1566,7 @@ rmGhcup = do
|
||||
|
||||
where
|
||||
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
|
||||
|
||||
nonStandardInstallLocationMsg path = T.pack $
|
||||
@@ -1556,7 +1576,7 @@ rmGhcup = do
|
||||
|
||||
rmTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m)
|
||||
@@ -1576,7 +1596,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
|
||||
rmGhcupDirs :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadMask m )
|
||||
=> m [FilePath]
|
||||
@@ -1603,7 +1623,7 @@ rmGhcupDirs = do
|
||||
handleRm $ rmBinDir binDir
|
||||
handleRm $ rmDir recycleDir
|
||||
#if defined(IS_WINDOWS)
|
||||
$logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
||||
#endif
|
||||
|
||||
@@ -1614,27 +1634,27 @@ rmGhcupDirs = do
|
||||
hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
|
||||
|
||||
where
|
||||
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
|
||||
handleRm = handleIO (\e -> $logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
|
||||
handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m) => m () -> m ()
|
||||
handleRm = handleIO (\e -> logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
|
||||
<> "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
|
||||
$logInfo "Removing Ghcup Environment File"
|
||||
logInfo "Removing Ghcup Environment File"
|
||||
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
|
||||
$logInfo "removing Ghcup Config File"
|
||||
logInfo "removing Ghcup Config File"
|
||||
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 =
|
||||
-- 'getDirectoryContentsRecursive' is lazy IO. In case
|
||||
-- an error leaks through, we catch it here as well,
|
||||
-- althought 'deleteFile' should already handle it.
|
||||
hideErrorDef [doesNotExistErrorType] () $ do
|
||||
$logInfo $ "removing " <> T.pack dir
|
||||
logInfo $ "removing " <> T.pack dir
|
||||
contents <- liftIO $ getDirectoryContentsRecursive dir
|
||||
forM_ contents (deleteFile . (dir </>))
|
||||
|
||||
@@ -1707,7 +1727,7 @@ getDebugInfo :: ( Alternative m
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
)
|
||||
@@ -1743,7 +1763,7 @@ compileGHC :: ( MonadMask m
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadResource m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
@@ -1783,7 +1803,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
lift $ $(logDebug) $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||
|
||||
-- download source tarball
|
||||
dlInfo <-
|
||||
@@ -1808,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
|
||||
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
||||
lift $ $(logInfo) $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack 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 [ "remote"
|
||||
, "add"
|
||||
@@ -1835,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))
|
||||
|
||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
|
||||
lift $ $(logInfo) $ "Git version " <> T.pack 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)
|
||||
-- the version that's installed may differ from the
|
||||
@@ -1847,10 +1867,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
when alreadyInstalled $ do
|
||||
case isolateDir of
|
||||
Just isoDir ->
|
||||
lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||
Nothing ->
|
||||
lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||
lift $ $(logWarn)
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||
lift $ logWarn
|
||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||
|
||||
@@ -1877,7 +1897,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
Nothing ->
|
||||
-- only remove old ghc in regular installs
|
||||
when alreadyInstalled $ do
|
||||
lift $ $(logInfo) "Deleting existing installation"
|
||||
lift $ logInfo "Deleting existing installation"
|
||||
liftE $ rmGHCVer tver
|
||||
|
||||
_ -> pure ()
|
||||
@@ -1929,7 +1949,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -1952,7 +1972,7 @@ endif|]
|
||||
|
||||
liftE $ configureBindist bghc tver workdir ghcdir
|
||||
|
||||
lift $ $(logInfo) "Building (this may take a while)..."
|
||||
lift $ logInfo "Building (this may take a while)..."
|
||||
hadrian_build <- liftE $ findHadrianFile workdir
|
||||
lEM $ execLogged hadrian_build
|
||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||
@@ -1991,7 +2011,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -2022,15 +2042,15 @@ endif|]
|
||||
|
||||
liftE $ checkBuildConfig (build_mk workdir)
|
||||
|
||||
lift $ $(logInfo) "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)
|
||||
|
||||
if | isCross tver -> do
|
||||
lift $ $(logInfo) "Installing cross toolchain..."
|
||||
lift $ logInfo "Installing cross toolchain..."
|
||||
lEM $ make ["install"] (Just workdir)
|
||||
pure Nothing
|
||||
| otherwise -> do
|
||||
lift $ $(logInfo) "Creating bindist..."
|
||||
lift $ logInfo "Creating bindist..."
|
||||
lEM $ make ["binary-dist"] (Just workdir)
|
||||
[tar] <- liftIO $ findFiles
|
||||
workdir
|
||||
@@ -2049,7 +2069,7 @@ endif|]
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath -- ^ tar file
|
||||
@@ -2084,10 +2104,10 @@ endif|]
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
tarPath
|
||||
lift $ $(logInfo) $ "Copied bindist to " <> T.pack tarPath
|
||||
lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
|
||||
pure tarPath
|
||||
|
||||
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
|
||||
checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
|
||||
=> FilePath
|
||||
-> Excepts
|
||||
'[FileDoesNotExistError, InvalidBuildConfig]
|
||||
@@ -2110,7 +2130,7 @@ endif|]
|
||||
|
||||
forM_ buildFlavour $ \bf ->
|
||||
when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
|
||||
lift $ $(logWarn) $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
|
||||
lift $ logWarn $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
|
||||
liftIO $ threadDelay 5000000
|
||||
|
||||
addBuildFlavourToConf bc = case buildFlavour of
|
||||
@@ -2127,7 +2147,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -2146,7 +2166,7 @@ endif|]
|
||||
m
|
||||
()
|
||||
configureBindist bghc tver workdir ghcdir = do
|
||||
lift $ $(logInfo) [s|configuring build|]
|
||||
lift $ logInfo [s|configuring build|]
|
||||
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
|
||||
@@ -2210,7 +2230,7 @@ upgradeGHCup :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasSettings env
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -2232,7 +2252,7 @@ upgradeGHCup mtarget force' = do
|
||||
Dirs {..} <- lift getDirs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
lift $ $(logInfo) "Upgrading GHCup..."
|
||||
lift $ logInfo "Upgrading GHCup..."
|
||||
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
||||
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||
@@ -2241,20 +2261,20 @@ upgradeGHCup mtarget force' = do
|
||||
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
|
||||
let destDir = takeDirectory destFile
|
||||
destFile = fromMaybe (binDir </> fn) mtarget
|
||||
lift $ $(logDebug) $ "mkdir -p " <> T.pack destDir
|
||||
lift $ logDebug $ "mkdir -p " <> T.pack destDir
|
||||
liftIO $ createDirRecursive' destDir
|
||||
lift $ $(logDebug) $ "rm -f " <> T.pack destFile
|
||||
lift $ logDebug $ "rm -f " <> T.pack destFile
|
||||
lift $ hideError NoSuchThing $ recycleFile destFile
|
||||
lift $ $(logDebug) $ "cp " <> T.pack p <> " " <> T.pack destFile
|
||||
lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
|
||||
destFile
|
||||
lift $ chmod_755 destFile
|
||||
|
||||
liftIO (isInPath destFile) >>= \b -> unless b $
|
||||
lift $ $(logWarn) $ T.pack (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
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ $(logWarn) $ "ghcup is shadowed by "
|
||||
Just pa -> lift $ logWarn $ "ghcup is shadowed by "
|
||||
<> T.pack pa
|
||||
<> ". The upgrade will not be in effect, unless you remove "
|
||||
<> T.pack pa
|
||||
@@ -2278,7 +2298,7 @@ upgradeGHCup mtarget force' = do
|
||||
-- both installing from source and bindist.
|
||||
postGHCInstall :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -2294,7 +2314,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
-- Create ghc-x.y symlinks. This may not be the current
|
||||
-- version, create it regardless.
|
||||
v' <-
|
||||
handle (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
|
||||
handle (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ fmap Just
|
||||
$ getMajorMinorV _tvVersion
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
|
||||
@@ -2310,7 +2330,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
-- * for ghcup, this reports the location of the currently running executable
|
||||
whereIsTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -2348,3 +2368,10 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
||||
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 DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
@@ -34,8 +31,8 @@ import GHCup.Download.Utils
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
@@ -47,7 +44,6 @@ import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -57,8 +53,8 @@ import Data.ByteString ( ByteString )
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import Data.CaseInsensitive ( mk )
|
||||
#endif
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Versions
|
||||
@@ -72,6 +68,7 @@ import Prelude hiding ( abs
|
||||
, readFile
|
||||
, writeFile
|
||||
)
|
||||
import Safe
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
@@ -89,7 +86,7 @@ import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Yaml as Y
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
|
||||
|
||||
|
||||
@@ -111,7 +108,7 @@ getDownloadsF :: ( FromJSONKey Tool
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -164,7 +161,7 @@ getBase :: ( MonadReader env m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
)
|
||||
=> URI
|
||||
@@ -186,28 +183,27 @@ getBase uri = do
|
||||
|
||||
-- if we didn't get a filepath from the download, use the cached yaml
|
||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||
lift $ $(logDebug) $ "Decoding yaml at: " <> T.pack actualYaml
|
||||
yamlContents <- liftIO $ L.readFile actualYaml
|
||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||
|
||||
liftE
|
||||
. onE_ (onError actualYaml)
|
||||
. lEM' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. fmap (first (\e -> unlines [displayException e
|
||||
,"Consider removing " <> actualYaml <> " manually."]))
|
||||
. liftIO
|
||||
. Y.decodeFileEither
|
||||
$ actualYaml
|
||||
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. Y.decode1
|
||||
$ yamlContents
|
||||
where
|
||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||
-- may re-download and succeed.
|
||||
onError :: (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
|
||||
let efp = etagsFile fp
|
||||
handleIO (\e -> $(logWarn) $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||
(hideError doesNotExistErrorType $ rmFile efp)
|
||||
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||
warnCache s = do
|
||||
lift $ $(logWarn) "Could not get download info, trying cached version (this may not be recent!)"
|
||||
lift $ $(logDebug) $ "Error was: " <> T.pack s
|
||||
lift $ logWarn "Could not get download info, trying cached version (this may not be recent!)"
|
||||
lift $ logDebug $ "Error was: " <> T.pack s
|
||||
|
||||
-- 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
|
||||
@@ -221,7 +217,7 @@ getBase uri = do
|
||||
, MonadCatch m1
|
||||
, MonadIO m1
|
||||
, MonadFail m1
|
||||
, MonadLogger m1
|
||||
, HasLog env1
|
||||
, MonadMask m1
|
||||
)
|
||||
=> URI
|
||||
@@ -312,7 +308,7 @@ download :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> URI
|
||||
@@ -326,7 +322,7 @@ download uri eDigest dest mfn etags
|
||||
| scheme == "http" = dl
|
||||
| scheme == "file" = do
|
||||
let destFile' = T.unpack . decUTF8Safe $ path
|
||||
lift $ $(logDebug) $ "using local file: " <> T.pack destFile'
|
||||
lift $ logDebug $ "using local file: " <> T.pack destFile'
|
||||
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||
pure destFile'
|
||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||
@@ -335,7 +331,7 @@ download uri eDigest dest mfn etags
|
||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||
dl = do
|
||||
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
|
||||
lift $ $(logInfo) $ "downloading: " <> uri' <> " as file " <> T.pack destFile
|
||||
lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
|
||||
|
||||
-- destination dir must exist
|
||||
liftIO $ createDirRecursive' dest
|
||||
@@ -358,7 +354,7 @@ download uri eDigest dest mfn etags
|
||||
dh <- liftIO $ emptySystemTempFile "curl-header"
|
||||
flip finally (try @_ @SomeException $ rmFile dh) $
|
||||
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ (if etags then ["--dump-header", dh] else [])
|
||||
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
|
||||
@@ -370,14 +366,14 @@ download uri eDigest dest mfn etags
|
||||
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
||||
Just (http':sc:_)
|
||||
| sc == "304"
|
||||
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug "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
|
||||
$logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
liftIO $ copyFile (destFile <.> "tmp") destFile
|
||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||
:: V '[MalformedHeaders]))
|
||||
|
||||
writeEtags destFile (parseEtags headers)
|
||||
lift $ writeEtags destFile (parseEtags headers)
|
||||
else
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
||||
@@ -387,20 +383,20 @@ download uri eDigest dest mfn etags
|
||||
o' <- liftIO getWgetOpts
|
||||
if etags
|
||||
then do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
||||
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> do
|
||||
liftIO $ copyFile destFileTemp destFile
|
||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
ExitFailure i'
|
||||
| i' == 8
|
||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||
-> do
|
||||
$logDebug "Not modified, skipping download"
|
||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
lift $ logDebug "Not modified, skipping download"
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||
else do
|
||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||
@@ -411,14 +407,14 @@ download uri eDigest dest mfn etags
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
|
||||
if etags
|
||||
then do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||
, E.encodeUtf8 etag)]) metag
|
||||
liftE
|
||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||
$ do
|
||||
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
|
||||
@'[DownloadFailed]
|
||||
(\e@(HTTPNotModified _) ->
|
||||
@@ -444,33 +440,33 @@ download uri eDigest dest mfn etags
|
||||
path = view pathL' 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
|
||||
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
|
||||
case T.words <$> mEtag of
|
||||
(Just []) -> do
|
||||
$logDebug "Couldn't parse etags, no input: "
|
||||
logDebug "Couldn't parse etags, no input: "
|
||||
pure Nothing
|
||||
(Just [_, etag']) -> do
|
||||
$logDebug $ "Parsed etag: " <> etag'
|
||||
logDebug $ "Parsed etag: " <> etag'
|
||||
pure (Just etag')
|
||||
(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
|
||||
Nothing -> do
|
||||
$logDebug "No etags header found"
|
||||
logDebug "No etags header found"
|
||||
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
|
||||
getTags >>= \case
|
||||
Just t -> do
|
||||
$logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
|
||||
logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
|
||||
liftIO $ T.writeFile (etagsFile destFile) t
|
||||
Nothing ->
|
||||
$logDebug "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
|
||||
e <- liftIO $ doesFileExist fp
|
||||
if e
|
||||
@@ -478,13 +474,13 @@ download uri eDigest dest mfn etags
|
||||
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
|
||||
case rE of
|
||||
(Right et) -> do
|
||||
$logDebug $ "Read etag: " <> et
|
||||
logDebug $ "Read etag: " <> et
|
||||
pure (Just et)
|
||||
(Left _) -> do
|
||||
$logDebug "Etag file doesn't exist (yet)"
|
||||
logDebug "Etag file doesn't exist (yet)"
|
||||
pure Nothing
|
||||
else do
|
||||
$logDebug $ "Skipping and deleting etags file because destination file " <> T.pack 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)
|
||||
pure Nothing
|
||||
|
||||
@@ -497,7 +493,7 @@ downloadCached :: ( MonadReader env m
|
||||
, MonadMask m
|
||||
, MonadResource m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -518,7 +514,7 @@ downloadCached' :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -552,7 +548,7 @@ checkDigest :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
)
|
||||
=> T.Text -- ^ the hash
|
||||
-> FilePath
|
||||
@@ -562,7 +558,7 @@ checkDigest eDigest file = do
|
||||
let verify = not noVerify
|
||||
when verify $ do
|
||||
let p' = takeFileName file
|
||||
lift $ $(logInfo) $ "verifying digest of: " <> T.pack p'
|
||||
lift $ logInfo $ "verifying digest of: " <> T.pack p'
|
||||
c <- liftIO $ L.readFile file
|
||||
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
|
||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||
|
||||
@@ -50,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
|
||||
pPrint (NoCompatiblePlatform str') =
|
||||
text ("Could not find a compatible platform. Got: " ++ str')
|
||||
|
||||
-- | Unable to find a download for the requested versio/distro.
|
||||
-- | Unable to find a download for the requested version/distro.
|
||||
data NoDownload = NoDownload
|
||||
deriving Show
|
||||
|
||||
|
||||
@@ -20,6 +20,7 @@ module GHCup.Platform where
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
@@ -28,7 +29,6 @@ import GHCup.Utils.String.QQ
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Foldable
|
||||
@@ -57,7 +57,7 @@ import qualified Data.Text.IO as T
|
||||
|
||||
|
||||
-- | 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
|
||||
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
m
|
||||
@@ -82,7 +82,7 @@ getArchitecture = case arch of
|
||||
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
|
||||
'[NoCompatiblePlatform, DistroNotFound]
|
||||
m
|
||||
@@ -107,7 +107,7 @@ getPlatform = do
|
||||
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
|
||||
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
|
||||
what -> throwE $ NoCompatiblePlatform what
|
||||
lift $ $(logDebug) $ "Identified Platform as: " <> T.pack (prettyShow pfr)
|
||||
lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
|
||||
pure pfr
|
||||
where
|
||||
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
|
||||
@@ -138,12 +138,11 @@ getLinuxDistro = do
|
||||
| hasWord name ["exherbo"] -> Exherbo
|
||||
| hasWord name ["gentoo"] -> Gentoo
|
||||
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
||||
| hasWord name ["solus"] -> Solus
|
||||
| otherwise -> UnknownLinux
|
||||
pure (distro, parsedVer)
|
||||
where
|
||||
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
|
||||
False
|
||||
matches
|
||||
hasWord t = any (\x -> match (regex x) (T.unpack t))
|
||||
where
|
||||
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
|
||||
|
||||
|
||||
@@ -25,21 +25,17 @@ module GHCup.Types
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.DeepSeq ( NFData, rnf )
|
||||
import Control.Monad.Logger
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
#endif
|
||||
|
||||
import qualified Control.Monad.Trans.Class as Trans
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
@@ -152,7 +148,7 @@ data Tag = Latest
|
||||
| Recommended
|
||||
| Prerelease
|
||||
| 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
|
||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||
|
||||
@@ -241,7 +237,7 @@ instance NFData LinuxDistro
|
||||
distroToString :: LinuxDistro -> String
|
||||
distroToString Debian = "debian"
|
||||
distroToString Ubuntu = "ubuntu"
|
||||
distroToString Mint= "mint"
|
||||
distroToString Mint = "mint"
|
||||
distroToString Fedora = "fedora"
|
||||
distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
@@ -396,6 +392,7 @@ data AppState = AppState
|
||||
, keyBindings :: KeyBindings
|
||||
, ghcupInfo :: GHCupInfo
|
||||
, pfreq :: PlatformRequest
|
||||
, loggerConfig :: LoggerConfig
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData AppState
|
||||
@@ -404,6 +401,7 @@ data LeanAppState = LeanAppState
|
||||
{ settings :: Settings
|
||||
, dirs :: Dirs
|
||||
, keyBindings :: KeyBindings
|
||||
, loggerConfig :: LoggerConfig
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData LeanAppState
|
||||
@@ -555,14 +553,25 @@ instance Pretty Versioning where
|
||||
instance Pretty Version where
|
||||
pPrint = text . T.unpack . prettyVer
|
||||
|
||||
instance Show (a -> b) where
|
||||
show _ = "<function>"
|
||||
|
||||
instance (Monad m, Alternative m) => Alternative (LoggingT m) where
|
||||
empty = Trans.lift empty
|
||||
{-# INLINE empty #-}
|
||||
m <|> n = LoggingT $ \ r -> runLoggingT m r <|> runLoggingT n r
|
||||
{-# INLINE (<|>) #-}
|
||||
instance Show (IO ()) where
|
||||
show _ = "<io>"
|
||||
|
||||
|
||||
instance MonadLogger m => MonadLogger (Excepts e m) where
|
||||
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
|
||||
data LogLevel = Warn
|
||||
| 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
|
||||
|
||||
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.Optics
|
||||
@@ -21,9 +22,13 @@ module GHCup.Types.Optics where
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import URI.ByteString
|
||||
import System.Console.Pretty
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
makePrisms ''Tool
|
||||
makePrisms ''Architecture
|
||||
@@ -87,13 +92,15 @@ getLeanAppState :: ( MonadReader env m
|
||||
, LabelOptic' "settings" A_Lens env Settings
|
||||
, LabelOptic' "dirs" A_Lens env Dirs
|
||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
)
|
||||
=> m LeanAppState
|
||||
getLeanAppState = do
|
||||
s <- gets @"settings"
|
||||
d <- gets @"dirs"
|
||||
k <- gets @"keyBindings"
|
||||
pure (LeanAppState s d k)
|
||||
l <- gets @"loggerConfig"
|
||||
pure (LeanAppState s d k l)
|
||||
|
||||
|
||||
getSettings :: ( MonadReader env m
|
||||
@@ -110,6 +117,87 @@ getDirs :: ( MonadReader env m
|
||||
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
|
||||
, 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 HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
|
||||
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
|
||||
|
||||
@@ -40,14 +40,12 @@ import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Codec.Archive.Zip
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -59,7 +57,6 @@ import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
import Data.List
|
||||
import Data.List.Extra
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
@@ -115,7 +112,7 @@ ghcLinkDestination tool ver = do
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -129,14 +126,14 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
forM_ files $ \f -> do
|
||||
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
||||
let fullF = binDir </> f_xyz
|
||||
lift $ $(logDebug) ("rm -f " <> T.pack fullF)
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -151,11 +148,11 @@ rmPlain target = do
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
let fullF = binDir </> f <> exeExt
|
||||
lift $ $(logDebug) ("rm -f " <> T.pack fullF)
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
-- old ghcup
|
||||
let hdc_file = binDir </> "haddock-ghc" <> exeExt
|
||||
lift $ $(logDebug) ("rm -f " <> T.pack hdc_file)
|
||||
lift $ logDebug ("rm -f " <> T.pack hdc_file)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
|
||||
|
||||
|
||||
@@ -163,7 +160,7 @@ rmPlain target = do
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -179,7 +176,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
forM_ files $ \f -> do
|
||||
let f_xy = f <> "-" <> T.unpack v' <> exeExt
|
||||
let fullF = binDir </> f_xy
|
||||
lift $ $(logDebug) "rm -f #{fullF}"
|
||||
lift $ logDebug "rm -f #{fullF}"
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
@@ -251,9 +248,9 @@ getInstalledGHCs = do
|
||||
|
||||
|
||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||
getInstalledCabals :: ( MonadLogger m
|
||||
, MonadReader env m
|
||||
getInstalledCabals :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
@@ -271,14 +268,14 @@ getInstalledCabals = do
|
||||
|
||||
|
||||
-- | 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
|
||||
vers <- fmap rights getInstalledCabals
|
||||
pure $ elem ver vers
|
||||
|
||||
|
||||
-- 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
|
||||
Dirs {..} <- getDirs
|
||||
let cabalbin = binDir </> "cabal" <> exeExt
|
||||
@@ -295,7 +292,7 @@ cabalSet = do
|
||||
case linkVersion =<< link of
|
||||
Right v -> pure $ Just v
|
||||
Left err -> do
|
||||
$(logWarn) $ "Failed to parse cabal symlink target with: "
|
||||
logWarn $ "Failed to parse cabal symlink target with: "
|
||||
<> T.pack (displayException err)
|
||||
<> ". The symlink "
|
||||
<> T.pack cabalbin
|
||||
@@ -366,7 +363,7 @@ getInstalledStacks = do
|
||||
|
||||
-- Return the currently set stack version, if any.
|
||||
-- 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
|
||||
Dirs {..} <- getDirs
|
||||
let stackBin = binDir </> "stack" <> exeExt
|
||||
@@ -383,7 +380,7 @@ stackSet = do
|
||||
case linkVersion =<< link of
|
||||
Right v -> pure $ Just v
|
||||
Left err -> do
|
||||
$(logWarn) $ "Failed to parse stack symlink target with: "
|
||||
logWarn $ "Failed to parse stack symlink target with: "
|
||||
<> T.pack (displayException err)
|
||||
<> ". The symlink "
|
||||
<> T.pack stackBin
|
||||
@@ -601,7 +598,7 @@ getLatestGHCFor major' minor' dls =
|
||||
|
||||
|
||||
-- | 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 -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
@@ -609,7 +606,7 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
] m ()
|
||||
unpackToDir dfp av = do
|
||||
let fn = takeFileName av
|
||||
lift $ $(logInfo) $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
|
||||
lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
|
||||
|
||||
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
|
||||
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
|
||||
@@ -628,12 +625,11 @@ unpackToDir dfp av = do
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (untar . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn ->
|
||||
withArchive av (unpackInto dfp)
|
||||
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| otherwise -> throwE $ UnknownArchive fn
|
||||
|
||||
|
||||
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
, ArchiveResult
|
||||
@@ -658,14 +654,11 @@ getArchiveFiles av = do
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn ->
|
||||
withArchive av $ do
|
||||
entries' <- getEntries
|
||||
pure $ fmap unEntrySelector $ Map.keys entries'
|
||||
| ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| 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
|
||||
-> TarDir -- ^ how to descend
|
||||
-> Excepts '[TarDirDoesNotExist] m FilePath
|
||||
@@ -793,14 +786,14 @@ makeOut args workdir = do
|
||||
|
||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
||||
-- 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 to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
applyPatches pdir ddir = do
|
||||
patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
|
||||
forM_ (sort patches) $ \patch' -> do
|
||||
lift $ $(logInfo) $ "Applying patch " <> T.pack patch'
|
||||
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
||||
fmap (either (const Nothing) Just)
|
||||
(exec
|
||||
"patch"
|
||||
@@ -841,7 +834,7 @@ runBuildAction :: ( Pretty (V e)
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> FilePath -- ^ build directory (cleaned up depending on Settings)
|
||||
@@ -869,9 +862,9 @@ runBuildAction bdir instdir action = do
|
||||
|
||||
-- | Remove a build directory, ignoring if it doesn't exist and gracefully
|
||||
-- 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 $
|
||||
liftIO $ handleIO (\e -> run $ $(logWarn) $
|
||||
liftIO $ handleIO (\e -> run $ logWarn $
|
||||
"Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
|
||||
$ hideError doesNotExistErrorType
|
||||
$ rmPathForcibly dir)
|
||||
@@ -984,7 +977,7 @@ rmLink = hideError doesNotExistErrorType . recycleFile
|
||||
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
||||
createLink :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1006,24 +999,24 @@ createLink link exe = do
|
||||
fullLink = takeDirectory exe </> link
|
||||
shimContents = "path = " <> fullLink
|
||||
|
||||
$(logDebug) $ "rm -f " <> T.pack exe
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
rmLink exe
|
||||
|
||||
$(logDebug) $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
|
||||
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
|
||||
liftIO $ copyFile shimGen exe
|
||||
liftIO $ writeFile shim shimContents
|
||||
#else
|
||||
$(logDebug) $ "rm -f " <> T.pack exe
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
hideError doesNotExistErrorType $ recycleFile exe
|
||||
|
||||
$(logDebug) $ "ln -s " <> T.pack link <> " " <> T.pack exe
|
||||
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
|
||||
liftIO $ createFileLink link exe
|
||||
#endif
|
||||
|
||||
|
||||
ensureGlobalTools :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1041,8 +1034,8 @@ ensureGlobalTools = do
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\(DigestError _ _) -> do
|
||||
lift $ $(logWarn) "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ $(logDebug) "rm -f #{shimDownload}"
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ logDebug "rm -f #{shimDownload}"
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||
liftE @'[DigestError , DownloadFailed] $ dl
|
||||
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
|
||||
|
||||
@@ -2,9 +2,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Dirs
|
||||
@@ -45,7 +43,6 @@ import GHCup.Utils.Prelude
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource hiding (throwM)
|
||||
import Data.Bifunctor
|
||||
@@ -61,7 +58,7 @@ import System.IO.Temp
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
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 Control.Concurrent (threadDelay)
|
||||
|
||||
@@ -224,7 +221,7 @@ ghcupConfigFile = do
|
||||
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
||||
case contents of
|
||||
Nothing -> pure defaultUserSettings
|
||||
Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'
|
||||
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -261,7 +258,7 @@ parseGHCupGHCDir (T.pack -> fp) =
|
||||
mkGhcupTmpDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadUnliftIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadMask m
|
||||
@@ -273,14 +270,14 @@ mkGhcupTmpDir = do
|
||||
let minSpace = 5000 -- a rough guess, aight?
|
||||
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
|
||||
when (maybe False (toBytes minSpace >) space) $ do
|
||||
$(logWarn) ("Possibly insufficient disk space on "
|
||||
logWarn ("Possibly insufficient disk space on "
|
||||
<> 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)
|
||||
logWarn
|
||||
"...waiting for 10 seconds before continuing anyway, you can still abort..."
|
||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||
|
||||
@@ -295,8 +292,9 @@ mkGhcupTmpDir = do
|
||||
|
||||
withGHCupTmpDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
, MonadUnliftIO m
|
||||
, MonadLogger m
|
||||
, MonadCatch m
|
||||
, MonadResource m
|
||||
, MonadThrow m
|
||||
@@ -309,7 +307,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
|
||||
(run mkGhcupTmpDir)
|
||||
(\fp ->
|
||||
handleIO (\e -> run
|
||||
$ $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
|
||||
$ logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
|
||||
. rmPathForcibly
|
||||
$ fp))
|
||||
|
||||
@@ -341,9 +339,10 @@ relativeSymlink p1 p2 =
|
||||
|
||||
cleanupTrash :: ( MonadIO m
|
||||
, MonadMask m
|
||||
, MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
)
|
||||
=> m ()
|
||||
cleanupTrash = do
|
||||
@@ -352,8 +351,8 @@ cleanupTrash = do
|
||||
if null contents
|
||||
then pure ()
|
||||
else do
|
||||
$(logWarn) ("Removing leftover files in " <> T.pack recycleDir)
|
||||
logWarn ("Removing leftover files in " <> T.pack recycleDir)
|
||||
forM_ contents (\fp -> handleIO (\e ->
|
||||
$(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
|
||||
logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
|
||||
) $ liftIO $ removePathForcibly (recycleDir </> fp))
|
||||
|
||||
|
||||
@@ -7,7 +7,6 @@ module GHCup.Utils.File.Common where
|
||||
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.Monad.Extra
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
import GHC.IO.Exception
|
||||
@@ -102,3 +101,6 @@ findFiles path regex = do
|
||||
contents <- listDirectory path
|
||||
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 FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.File.Posix
|
||||
@@ -28,7 +25,6 @@ import Control.Concurrent.Async
|
||||
import Control.Exception ( evaluate )
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.State.Strict
|
||||
import Data.ByteString ( ByteString )
|
||||
@@ -131,7 +127,7 @@ execLogged exe args chdir lfile env = do
|
||||
pure e
|
||||
|
||||
tee :: Fd -> Fd -> IO ()
|
||||
tee fileFd fdIn = readTilEOF lineAction fdIn
|
||||
tee fileFd = readTilEOF lineAction
|
||||
|
||||
where
|
||||
lineAction :: ByteString -> IO ()
|
||||
@@ -350,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
|
||||
let exe_mode =
|
||||
nullFileMode
|
||||
@@ -361,7 +357,7 @@ chmod_755 fp = do
|
||||
`unionFileModes` groupReadMode
|
||||
`unionFileModes` otherExecuteMode
|
||||
`unionFileModes` otherReadMode
|
||||
$(logDebug) ("chmod 755 " <> T.pack fp)
|
||||
logDebug ("chmod 755 " <> T.pack fp)
|
||||
liftIO $ setFileMode fp exe_mode
|
||||
|
||||
|
||||
|
||||
@@ -22,11 +22,8 @@ import GHCup.Utils.String.QQ
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Data.Char ( ord )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Console.Pretty
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
@@ -35,53 +32,6 @@ import qualified Data.ByteString as B
|
||||
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
|
||||
, HasDirs env
|
||||
|
||||
@@ -5,7 +5,6 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Prelude
|
||||
@@ -30,10 +29,10 @@ import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Logger
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List ( nub, intercalate )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
|
||||
import Data.Maybe
|
||||
import Data.Foldable
|
||||
import Data.String
|
||||
import Data.Text ( Text )
|
||||
@@ -75,8 +74,9 @@ import qualified System.Win32.File as Win32
|
||||
-- >>> import Data.ByteString.Internal (c2w, w2c)
|
||||
-- >>> import Test.QuickCheck
|
||||
-- >>> import Data.Word8
|
||||
-- >>> import Data.Word8
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import qualified Data.Char as C
|
||||
-- >>> import Data.List
|
||||
-- >>> 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
|
||||
|
||||
-- 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 = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
|
||||
catchWarn :: forall es m env . ( Pretty (V es)
|
||||
, 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 (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)
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
||||
-- | Strip @\\r@ and @\\n@ from 'String's
|
||||
--
|
||||
-- >>> stripNewline "foo\n\n\n"
|
||||
-- "foo"
|
||||
@@ -532,13 +536,10 @@ forFold = \t -> (`traverseFold` t)
|
||||
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
|
||||
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
|
||||
stripNewline :: String -> String
|
||||
stripNewline s
|
||||
| null s = []
|
||||
| head s `elem` "\n\r" = stripNewline (tail s)
|
||||
| otherwise = head s : stripNewline (tail s)
|
||||
stripNewline = filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
||||
-- | Strip @\\r@ and @\\n@ from 'Text's
|
||||
--
|
||||
-- >>> stripNewline' "foo\n\n\n"
|
||||
-- "foo"
|
||||
@@ -550,10 +551,7 @@ stripNewline s
|
||||
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
|
||||
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
|
||||
stripNewline' :: T.Text -> T.Text
|
||||
stripNewline' s
|
||||
| T.null s = mempty
|
||||
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
|
||||
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
|
||||
stripNewline' = T.filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Is the word8 a newline?
|
||||
@@ -587,3 +585,117 @@ splitOnPVP c s = case Split.splitOn c s of
|
||||
| otherwise -> def
|
||||
where
|
||||
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.
|
||||
s :: QuasiQuoter
|
||||
s = QuasiQuoter
|
||||
(\s' -> case and $ fmap isAscii s' of
|
||||
(\s' -> case all isAscii s' of
|
||||
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
|
||||
False -> fail "Not ascii"
|
||||
)
|
||||
(error "Cannot use q as a pattern")
|
||||
(error "Cannot use q as a type")
|
||||
(error "Cannot use q as a dec")
|
||||
(error "Cannot use s as a pattern")
|
||||
(error "Cannot use s as a type")
|
||||
(error "Cannot use s as a dec")
|
||||
where
|
||||
removeCRs = filter (/= '\r')
|
||||
trimLeadingNewline ('\n' : xs) = xs
|
||||
trimLeadingNewline xs = xs
|
||||
|
||||
|
||||
12
stack.yaml
12
stack.yaml
@@ -1,4 +1,4 @@
|
||||
resolver: lts-18.7
|
||||
resolver: lts-18.2
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -6,8 +6,9 @@ packages:
|
||||
extra-deps:
|
||||
- git: https://github.com/bgamari/terminal-size
|
||||
commit: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
- git: https://github.com/hasufell/libarchive
|
||||
commit: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
|
||||
commit: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
||||
@@ -41,7 +42,6 @@ extra-deps:
|
||||
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
@@ -53,6 +53,12 @@ flags:
|
||||
regex-posix:
|
||||
_regex-posix-clib: true
|
||||
|
||||
aeson-pretty:
|
||||
lib-only: true
|
||||
|
||||
cabal-plan:
|
||||
exe: false
|
||||
|
||||
ghc-options:
|
||||
"$locals": -O2
|
||||
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||
|
||||
@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
|
||||
---------------------
|
||||
|
||||
instance Arbitrary Scheme where
|
||||
arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ]
|
||||
arbitrary = elements [ Scheme "http", Scheme "https" ]
|
||||
|
||||
instance Arbitrary Host where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
Reference in New Issue
Block a user