Compare commits
1 Commits
issue-180
...
www-fix-tr
| Author | SHA1 | Date | |
|---|---|---|---|
9e9402a3a2
|
@@ -21,7 +21,6 @@ variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
CROSS: ""
|
||||
|
||||
.alpine:64bit:
|
||||
image: "alpine:3.12"
|
||||
@@ -269,24 +268,6 @@ test:linux:latest:
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
needs: []
|
||||
|
||||
test:linux:cross-armv7:
|
||||
stage: test
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
variables:
|
||||
GHC_VERSION: "8.10.4"
|
||||
GHC_TARGET_VERSION: "8.10.5"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
CROSS: "arm-linux-gnueabihf"
|
||||
needs: []
|
||||
when: manual
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_cross.sh
|
||||
|
||||
|
||||
######## linux 32bit test ########
|
||||
|
||||
test:linux:recommended:32bit:
|
||||
@@ -305,7 +286,6 @@ test:linux:recommended:armv7:
|
||||
variables:
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
CROSS: ""
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
@@ -315,7 +295,6 @@ test:linux:recommended:aarch64:
|
||||
variables:
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
CROSS: ""
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
@@ -415,7 +394,6 @@ release:linux:armv7:
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
CROSS: ""
|
||||
|
||||
release:linux:aarch64:
|
||||
stage: release
|
||||
@@ -429,7 +407,6 @@ release:linux:aarch64:
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
CROSS: ""
|
||||
|
||||
######## darwin release ########
|
||||
|
||||
|
||||
@@ -9,13 +9,6 @@ mkdir -p "${TMPDIR}"
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https
|
||||
|
||||
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
|
||||
sudo apt-get install -y autoconf build-essential gcc-arm-linux-gnueabihf
|
||||
sudo dpkg --add-architecture armhf
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libncurses-dev:armhf
|
||||
fi
|
||||
|
||||
case "${ARCH}" in
|
||||
ARM*)
|
||||
case "${ARCH}" in
|
||||
@@ -64,9 +57,9 @@ case "${ARCH}" in
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ghc ${GHC_VERSION}
|
||||
./ghcup-bin set ghc ${GHC_VERSION}
|
||||
./ghcup-bin install cabal ${CABAL_VERSION}
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
;;
|
||||
esac
|
||||
|
||||
@@ -1,52 +0,0 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
}
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile ghc -j $(nproc) -v ${GHC_TARGET_VERSION} -b ${GHC_VERSION} -x ${CROSS} -- --enable-unregisterised
|
||||
eghcup set ghc ${CROSS}-${GHC_TARGET_VERSION}
|
||||
|
||||
[ `$(eghcup whereis ghc ${CROSS}-${GHC_TARGET_VERSION}) --numeric-version` = "${GHC_TARGET_VERSION}" ]
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
|
||||
|
||||
@@ -15,6 +15,10 @@ git describe
|
||||
# build
|
||||
ecabal update
|
||||
|
||||
(
|
||||
cd /tmp
|
||||
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
|
||||
)
|
||||
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
|
||||
@@ -26,6 +26,11 @@ git describe --always
|
||||
|
||||
ecabal update
|
||||
|
||||
(
|
||||
cd /tmp
|
||||
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
|
||||
)
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -ftui
|
||||
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
|
||||
@@ -78,10 +83,10 @@ ghcup-gen check -f ghcup-${JSON_VERSION}.yaml
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup install ${GHC_VERSION}
|
||||
[ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
eghcup set ${GHC_VERSION}
|
||||
eghcup install-cabal ${CABAL_VERSION}
|
||||
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
|
||||
|
||||
cabal --version
|
||||
@@ -107,19 +112,17 @@ else
|
||||
# test installing new ghc doesn't mess with currently set GHC
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
eghcup --downloader=wget prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
eghcup --downloader=wget install 8.10.3
|
||||
else # test wget a bit
|
||||
eghcup prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
eghcup install 8.10.3
|
||||
fi
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup --offline set 8.10.3
|
||||
eghcup set 8.10.3
|
||||
eghcup set 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||
eghcup set ${GHC_VERSION}
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup --offline rm 8.10.3
|
||||
eghcup rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
|
||||
@@ -12,7 +12,7 @@ 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
|
||||
@@ -226,7 +226,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
downloadAll dli = do
|
||||
dirs <- liftIO getAllDirs
|
||||
dirs <- liftIO getDirs
|
||||
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
@@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
liftIO $ exitWith (ExitFailure 2)
|
||||
|
||||
let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
|
||||
let appstate = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
@@ -256,17 +256,17 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
case etool of
|
||||
Right (Just GHCup) -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
_ <- liftE $ download dli tmpUnpack Nothing
|
||||
_ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
|
||||
pure Nothing
|
||||
Right _ -> do
|
||||
p <- liftE $ downloadCached dli Nothing
|
||||
p <- liftE $ downloadCached (settings appstate) dirs dli Nothing
|
||||
fmap (Just . head . splitDirectories . head)
|
||||
. liftE
|
||||
. getArchiveFiles
|
||||
$ p
|
||||
Left ShimGen -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
_ <- liftE $ download dli tmpUnpack Nothing
|
||||
_ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
|
||||
pure Nothing
|
||||
case r of
|
||||
VRight (Just basePath) -> do
|
||||
|
||||
@@ -13,7 +13,7 @@ module BrickMain where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Types
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
@@ -53,6 +53,8 @@ import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified GHCup.Types as GT
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
@@ -548,14 +550,13 @@ changelog' _ (_, ListResult {..}) = do
|
||||
settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
dirs <- getDirs
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
, downloader = Curl
|
||||
, verbose = False
|
||||
, urlSource = GHCupURL
|
||||
, noNetwork = False
|
||||
, ..
|
||||
})
|
||||
dirs
|
||||
@@ -577,8 +578,9 @@ logger' = unsafePerformIO
|
||||
|
||||
brickMain :: AppState
|
||||
-> LoggerConfig
|
||||
-> GHCupInfo
|
||||
-> IO ()
|
||||
brickMain s l = do
|
||||
brickMain s l gi = do
|
||||
writeIORef settings' s
|
||||
-- logger interpreter
|
||||
writeIORef logger' l
|
||||
@@ -586,7 +588,7 @@ brickMain s l = do
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
eAppData <- getAppData (Just $ ghcupInfo s)
|
||||
eAppData <- getAppData (Just gi)
|
||||
case eAppData of
|
||||
Right ad ->
|
||||
defaultMain
|
||||
@@ -594,7 +596,7 @@ brickMain s l = do
|
||||
(BrickState ad
|
||||
defaultAppSettings
|
||||
(constructList ad defaultAppSettings Nothing)
|
||||
(keyBindings (s :: AppState))
|
||||
(keyBindings s)
|
||||
|
||||
)
|
||||
$> ()
|
||||
@@ -618,7 +620,7 @@ getGHCupInfo = do
|
||||
. flip runReaderT settings
|
||||
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
$ getDownloadsF (GT.settings settings) (GT.dirs settings)
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
|
||||
@@ -21,7 +21,6 @@ import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Requirements
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
@@ -67,6 +66,7 @@ import System.Environment
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import System.IO hiding ( appendFile )
|
||||
import System.IO.Unsafe ( unsafeInterleaveIO )
|
||||
import Text.Read hiding ( lift )
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString
|
||||
@@ -91,7 +91,6 @@ data Options = Options
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
, optsDownloader :: Maybe Downloader
|
||||
, optNoNetwork :: Maybe Bool
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
}
|
||||
@@ -112,7 +111,6 @@ data Command
|
||||
#if defined(BRICK)
|
||||
| Interactive
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
| ToolTag Tag
|
||||
@@ -202,21 +200,6 @@ data WhereisOptions = WhereisOptions {
|
||||
directory :: Bool
|
||||
}
|
||||
|
||||
data PrefetchOptions = PrefetchOptions {
|
||||
pfCacheDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
data PrefetchCommand = PrefetchGHC PrefetchGHCOptions (Maybe ToolVersion)
|
||||
| PrefetchCabal PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchHLS PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchStack PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchMetadata
|
||||
|
||||
data PrefetchGHCOptions = PrefetchGHCOptions {
|
||||
pfGHCSrc :: Bool
|
||||
, pfGHCCacheDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
|
||||
-- https://github.com/pcapriotti/optparse-applicative/issues/148
|
||||
|
||||
@@ -294,7 +277,6 @@ opts =
|
||||
#endif
|
||||
<> hidden
|
||||
))
|
||||
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
|
||||
<*> com
|
||||
where
|
||||
parseUri s' =
|
||||
@@ -375,16 +357,6 @@ com =
|
||||
(progDesc "Find a tools location"
|
||||
<> footerDoc ( Just $ text whereisFooter ))
|
||||
)
|
||||
<> command
|
||||
"prefetch"
|
||||
(info
|
||||
( (Prefetch
|
||||
<$> prefetchP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Prefetch assets"
|
||||
<> footerDoc ( Just $ text prefetchFooter ))
|
||||
)
|
||||
<> commandGroup "Main commands:"
|
||||
)
|
||||
<|> subparser
|
||||
@@ -468,17 +440,6 @@ Examples:
|
||||
# outputs ~/.ghcup/bin/
|
||||
ghcup whereis --directory cabal 3.4.0.0|]
|
||||
|
||||
prefetchFooter :: String
|
||||
prefetchFooter = [s|Discussion:
|
||||
Prefetches tools or assets into "~/.ghcup/cache" directory. This can
|
||||
be then combined later with '--offline' flag, ensuring all assets that
|
||||
are required for offline use have been prefetched.
|
||||
|
||||
Examples:
|
||||
ghcup prefetch metadata
|
||||
ghcup prefetch ghc 8.10.5
|
||||
ghcup --offline install ghc 8.10.5|]
|
||||
|
||||
|
||||
installCabalFooter :: String
|
||||
installCabalFooter = [s|Discussion:
|
||||
@@ -864,55 +825,6 @@ Examples:
|
||||
ghcup whereis --directory stack 2.7.1|]
|
||||
|
||||
|
||||
prefetchP :: Parser PrefetchCommand
|
||||
prefetchP = subparser
|
||||
( command
|
||||
"ghc"
|
||||
(info
|
||||
(PrefetchGHC
|
||||
<$> (PrefetchGHCOptions
|
||||
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
||||
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just GHC)) ))
|
||||
( progDesc "Download GHC assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"cabal"
|
||||
(info
|
||||
(PrefetchCabal
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
|
||||
( progDesc "Download cabal assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"hls"
|
||||
(info
|
||||
(PrefetchHLS
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
|
||||
( progDesc "Download HLS assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"stack"
|
||||
(info
|
||||
(PrefetchStack
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
|
||||
( progDesc "Download stack assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"metadata"
|
||||
(const PrefetchMetadata <$> info
|
||||
helper
|
||||
( progDesc "Download ghcup's metadata, needed for various operations")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
ghcCompileOpts :: Parser GHCCompileOptions
|
||||
ghcCompileOpts =
|
||||
GHCCompileOptions
|
||||
@@ -1030,20 +942,14 @@ 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
|
||||
|
||||
dirs' <- liftIO getDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
|
||||
mGhcUpInfo <- runLogger . flip runReaderT appState . runE $ getDownloadsF
|
||||
mGhcUpInfo <- runLogger . runE $ readFromCache dirs'
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (\t -> t /= Old)
|
||||
@@ -1056,24 +962,19 @@ tagCompleter tool add = listIOCompleter $ do
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
dirs' <- liftIO getDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
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
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
mGhcUpInfo <- runLogger . runE $ readFromCache dirs'
|
||||
mpFreq <- runLogger . runE $ platformRequest
|
||||
forFold mpFreq $ \pfreq ->
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
settings
|
||||
(Settings True False Never Curl False GHCupURL)
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
ghcupInfo
|
||||
@@ -1222,7 +1123,6 @@ toSettings options = do
|
||||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
||||
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
|
||||
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
|
||||
in (Settings {..}, keyBindings)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
defaultDownloader = Internal
|
||||
@@ -1267,10 +1167,8 @@ describe_result :: String
|
||||
describe_result = $( LitE . StringL <$>
|
||||
runIO (do
|
||||
CapturedProcess{..} <- do
|
||||
dirs <- liftIO getAllDirs
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL False)
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
dirs <- liftIO getDirs
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings
|
||||
flip runReaderT settings $ executeOut "git" ["describe"] Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> pure . T.unpack . decUTF8Safe' $ _stdOut
|
||||
@@ -1322,7 +1220,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(footerDoc (Just $ text main_footer))
|
||||
)
|
||||
>>= \opt@Options {..} -> do
|
||||
dirs@Dirs{..} <- getAllDirs
|
||||
dirs <- getDirs
|
||||
|
||||
-- create ~/.ghcup dir
|
||||
ensureDirectories dirs
|
||||
@@ -1330,7 +1228,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(settings, keybindings) <- toSettings opt
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- initGHCupFileLogging logsDir
|
||||
logfile <- initGHCupFileLogging (logsDir dirs)
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = verbose settings
|
||||
, colorOutter = B.hPut stderr
|
||||
@@ -1342,64 +1240,68 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
|
||||
|
||||
----------------------------------------
|
||||
-- Getting download and platform info --
|
||||
----------------------------------------
|
||||
|
||||
|
||||
pfreq <- unsafeInterleaveIO $ (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <- unsafeInterleaveIO $
|
||||
( runLogger
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF settings dirs
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Setting up appstate --
|
||||
-------------------------
|
||||
|
||||
|
||||
let leanAppstate = LeanAppState settings dirs keybindings
|
||||
appState = do
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
( runLogger
|
||||
. flip runReaderT leanAppstate
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
let s' = AppState settings dirs keybindings ghcupInfo pfreq
|
||||
|
||||
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
(siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 30)
|
||||
pure s'
|
||||
let appstate@AppState{dirs = Dirs{..}
|
||||
, ghcupInfo = ~GHCupInfo { _ghcupDownloads = dls, .. }
|
||||
} = AppState settings dirs keybindings ghcupInfo pfreq
|
||||
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
-- FIXME: windows needs 'ensureGlobalTools', which requires
|
||||
-- full appstate
|
||||
runLeanAppState = runAppState
|
||||
#else
|
||||
runLeanAppState = flip runReaderT leanAppstate
|
||||
#endif
|
||||
runAppState action' = do
|
||||
s' <- liftIO appState
|
||||
flip runReaderT s' action'
|
||||
|
||||
---------------------------
|
||||
-- Running startup tasks --
|
||||
---------------------------
|
||||
|
||||
case optCommand of
|
||||
Upgrade _ _ -> pure ()
|
||||
Whereis _ _ -> pure ()
|
||||
_ -> do
|
||||
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT appstate $ checkForUpdates
|
||||
Just _ -> pure ()
|
||||
|
||||
|
||||
-- ensure global tools
|
||||
case optCommand of
|
||||
Whereis _ _ -> pure ()
|
||||
_ -> do
|
||||
(siletRunLogger $ flip runReaderT appstate $ runE ensureGlobalTools) >>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 30)
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -1408,7 +1310,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 }) mInstPlatform)
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1429,25 +1331,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
let runInstTool mInstPlatform action' = do
|
||||
s' <- liftIO appState
|
||||
runInstTool' s' mInstPlatform action'
|
||||
let runInstTool = runInstTool' appstate
|
||||
|
||||
let
|
||||
runLeanSetGHC =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
runSetGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
@@ -1457,19 +1346,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
let
|
||||
runLeanSetCabal =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
runSetCabal =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1480,7 +1359,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
let
|
||||
runSetHLS =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1488,30 +1367,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
runLeanSetHLS =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runAppState
|
||||
let runListGHC = runLogger . flip runReaderT appstate
|
||||
|
||||
let runRm =
|
||||
runLogger . runAppState . runE @'[NotInstalled]
|
||||
runLogger . flip runReaderT appstate . runE @'[NotInstalled]
|
||||
|
||||
let runDebugInfo =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runE
|
||||
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
||||
|
||||
let runCompileGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1531,21 +1400,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
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
, NextVerNotFound
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
runWhereIs =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
@@ -1555,7 +1412,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let runUpgrade =
|
||||
runLogger
|
||||
. runAppState
|
||||
. flip runReaderT appstate
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
@@ -1566,21 +1423,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, DownloadFailed
|
||||
]
|
||||
|
||||
let runPrefetch =
|
||||
runLogger
|
||||
. runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NoDownload
|
||||
, DigestError
|
||||
, DownloadFailed
|
||||
, JSONError
|
||||
, FileDoesNotExistError
|
||||
]
|
||||
|
||||
|
||||
-----------------------
|
||||
-- Command functions --
|
||||
@@ -1593,15 +1435,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
liftE $ installGHCBin (_tvVersion v)
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- liftIO appState
|
||||
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
Just uri -> runInstTool' appstate{ settings = settings {noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -1633,14 +1473,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBin (_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -1664,14 +1502,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBin (_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -1695,14 +1531,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBin (_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -1721,13 +1555,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure $ ExitFailure 4
|
||||
|
||||
|
||||
let setGHC' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runLeanSetGHC (liftE $ setGHC v SetGHCOnly >> pure v)
|
||||
_ -> runSetGHC (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly
|
||||
)
|
||||
let setGHC' SetOptions{..} =
|
||||
runSetGHC (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
@@ -1738,14 +1570,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 5
|
||||
|
||||
let setCabal' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runLeanSetCabal (liftE $ setCabal (_tvVersion v) >> pure v)
|
||||
_ -> runSetCabal (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
let setCabal' SetOptions{..} =
|
||||
runSetCabal (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
@@ -1756,14 +1586,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setHLS' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runLeanSetHLS (liftE $ setHLS (_tvVersion v) >> pure v)
|
||||
_ -> runSetHLS (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
let setHLS' SetOptions{..} =
|
||||
runSetHLS (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
@@ -1774,14 +1602,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setStack' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetCabal (liftE $ setStack (_tvVersion v) >> pure v)
|
||||
_ -> runSetCabal (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||
liftE $ setStack (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
let setStack' SetOptions{..} =
|
||||
runSetCabal (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||
liftE $ setStack (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
@@ -1796,7 +1622,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runRm (do
|
||||
liftE $
|
||||
rmGHCVer ghcVer
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
|
||||
)
|
||||
>>= \case
|
||||
@@ -1812,7 +1637,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runRm (do
|
||||
liftE $
|
||||
rmCabalVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Cabal dls)
|
||||
)
|
||||
>>= \case
|
||||
@@ -1828,7 +1652,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runRm (do
|
||||
liftE $
|
||||
rmHLSVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv HLS dls)
|
||||
)
|
||||
>>= \case
|
||||
@@ -1844,7 +1667,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runRm (do
|
||||
liftE $
|
||||
rmStackVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Stack dls)
|
||||
)
|
||||
>>= \case
|
||||
@@ -1859,8 +1681,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
res <- case optCommand of
|
||||
#if defined(BRICK)
|
||||
Interactive -> do
|
||||
s' <- appState
|
||||
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
|
||||
liftIO $ brickMain appstate loggerConfig ghcupInfo >> pure ExitSuccess
|
||||
#endif
|
||||
Install (Right iopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
|
||||
@@ -1910,7 +1731,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runCompileGHC (do
|
||||
case targetGhc of
|
||||
Left targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ $(logInfo) msg
|
||||
@@ -1926,7 +1746,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
buildConfig
|
||||
patchDir
|
||||
addConfArgs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||
when setCompile $ void $ liftE $
|
||||
setGHC targetVer SetGHCOnly
|
||||
@@ -1954,21 +1773,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
|
||||
Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
|
||||
runLeanWhereIs (do
|
||||
loc <- liftE $ whereIsTool tool v
|
||||
if directory
|
||||
then pure $ takeDirectory loc
|
||||
else pure loc
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> do
|
||||
putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
|
||||
runWhereIs (do
|
||||
(v, _) <- liftE $ fromVersion whereVer tool
|
||||
@@ -1993,7 +1797,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
|
||||
runUpgrade (liftE $ upgradeGHCup target force') >>= \case
|
||||
VRight v' -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ $(logInfo)
|
||||
@@ -2008,26 +1811,23 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
|
||||
ToolRequirements -> do
|
||||
s' <- appState
|
||||
flip runReaderT s'
|
||||
$ runLogger
|
||||
(runE
|
||||
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
||||
$ do
|
||||
GHCupInfo { .. } <- lift getGHCupInfo
|
||||
platform' <- liftE getPlatform
|
||||
req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
|
||||
liftIO $ T.hPutStr stdout (prettyRequirements req)
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 12
|
||||
ToolRequirements ->
|
||||
flip runReaderT appstate
|
||||
$ runLogger
|
||||
(runE
|
||||
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
||||
$ do
|
||||
platform <- liftE getPlatform
|
||||
req <- getCommonRequirements platform _toolRequirements ?? NoToolRequirements
|
||||
liftIO $ T.hPutStr stdout (prettyRequirements req)
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 12
|
||||
|
||||
ChangeLog ChangeLogOptions{..} -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||
let tool = fromMaybe GHC clTool
|
||||
ver' = maybe
|
||||
(Right Latest)
|
||||
@@ -2045,7 +1845,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
)
|
||||
pure ExitSuccess
|
||||
Just uri -> do
|
||||
pfreq <- runAppState getPlatformReq
|
||||
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
||||
cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
@@ -2054,23 +1853,21 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
Windows -> "start"
|
||||
|
||||
if clOpen
|
||||
then do
|
||||
s' <- appState
|
||||
flip runReaderT s' $
|
||||
exec cmd
|
||||
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
|
||||
Nothing
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> runLogger ($(logError) [i|#{e}|])
|
||||
>> pure (ExitFailure 13)
|
||||
then
|
||||
flip runReaderT appstate $
|
||||
exec cmd
|
||||
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
|
||||
Nothing
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> runLogger ($(logError) [i|#{e}|])
|
||||
>> pure (ExitFailure 13)
|
||||
else putStrLn uri' >> pure ExitSuccess
|
||||
|
||||
Nuke ->
|
||||
runRm (do
|
||||
s' <- liftIO appState
|
||||
void $ liftIO $ evaluate $ force s'
|
||||
void $ liftIO $ evaluate $ force appstate
|
||||
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
|
||||
@@ -2097,37 +1894,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
Prefetch pfCom ->
|
||||
runPrefetch (do
|
||||
case pfCom of
|
||||
PrefetchGHC
|
||||
(PrefetchGHCOptions pfGHCSrc pfCacheDir) mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt GHC
|
||||
if pfGHCSrc
|
||||
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
|
||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
||||
PrefetchCabal (PrefetchOptions {pfCacheDir}) mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Cabal
|
||||
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
|
||||
PrefetchHLS (PrefetchOptions {pfCacheDir}) mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt HLS
|
||||
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
|
||||
PrefetchStack (PrefetchOptions {pfCacheDir}) mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Stack
|
||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
||||
PrefetchMetadata -> do
|
||||
_ <- liftE $ getDownloadsF
|
||||
pure ""
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
|
||||
case res of
|
||||
@@ -2137,46 +1903,22 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
|
||||
pure ()
|
||||
|
||||
fromVersion :: ( MonadLogger m
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
fromVersion :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
|
||||
=> Maybe ToolVersion
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
-> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion tv = fromVersion' (toSetToolVer tv)
|
||||
|
||||
fromVersion' :: ( MonadLogger m
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
fromVersion' :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
|
||||
=> SetToolVersion
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
-> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion' SetRecommended tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getRecommended dls tool
|
||||
?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
~AppState { ghcupInfo = ~GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of
|
||||
Left _ -> pure (v, vi)
|
||||
@@ -2186,16 +1928,16 @@ fromVersion' (SetToolVersion v) tool = do
|
||||
Nothing -> pure (v, vi)
|
||||
Right _ -> pure (v, vi)
|
||||
fromVersion' (SetToolTag Latest) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
fromVersion' (SetToolTag Recommended) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||
fromVersion' SetNext tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
next <- case tool of
|
||||
GHC -> do
|
||||
set <- fmap _tvVersion $ ghcSet Nothing !? NoToolVersionSet tool
|
||||
@@ -2396,10 +2138,7 @@ printListResult raw lr = do
|
||||
| otherwise -> 1
|
||||
|
||||
|
||||
checkForUpdates :: ( MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
checkForUpdates :: ( MonadReader AppState m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
@@ -2409,7 +2148,7 @@ checkForUpdates :: ( MonadReader env m
|
||||
)
|
||||
=> m ()
|
||||
checkForUpdates = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||
|
||||
|
||||
@@ -116,7 +116,7 @@ library
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, optics >=0.2 && <0.5
|
||||
, optics-vl ^>=0.2
|
||||
, os-release ^>=1.0.0
|
||||
, parsec ^>=3.1
|
||||
@@ -279,7 +279,7 @@ executable ghcup-gen
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, optics >=0.2 && <0.5
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
|
||||
445
lib/GHCup.hs
445
lib/GHCup.hs
@@ -95,69 +95,6 @@ import GHCup.Utils.MegaParsec
|
||||
import Control.Concurrent (threadDelay)
|
||||
|
||||
|
||||
---------------------
|
||||
--[ Tool fetching ]--
|
||||
---------------------
|
||||
|
||||
|
||||
fetchToolBindist :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
-> Tool
|
||||
-> Maybe FilePath
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
]
|
||||
m
|
||||
FilePath
|
||||
fetchToolBindist v t mfp = do
|
||||
dlinfo <- liftE $ getDownloadInfo t v
|
||||
liftE $ downloadCached' dlinfo Nothing mfp
|
||||
|
||||
|
||||
fetchGHCSrc :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
-> Maybe FilePath
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
]
|
||||
m
|
||||
FilePath
|
||||
fetchGHCSrc v mfp = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
liftE $ downloadCached' dlInfo Nothing mfp
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
--[ Tool installation ]--
|
||||
@@ -169,10 +106,7 @@ fetchGHCSrc v mfp = do
|
||||
installGHCBindist :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -196,12 +130,14 @@ installGHCBindist :: ( MonadFail m
|
||||
m
|
||||
()
|
||||
installGHCBindist dlinfo ver = do
|
||||
AppState { dirs , settings } <- lift ask
|
||||
|
||||
let tver = mkTVer ver
|
||||
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
||||
whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
|
||||
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
dl <- liftE $ downloadCached settings dirs dlinfo Nothing
|
||||
|
||||
-- prepare paths
|
||||
ghcdir <- lift $ ghcupGHCDir tver
|
||||
@@ -227,10 +163,7 @@ installGHCBindist dlinfo ver = do
|
||||
-- build system and nothing else.
|
||||
installPackedGHC :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -249,7 +182,7 @@ installPackedGHC :: ( MonadMask m
|
||||
#endif
|
||||
] m ()
|
||||
installPackedGHC dl msubdir inst ver = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
AppState { pfreq = PlatformRequest {..} } <- lift ask
|
||||
|
||||
-- unpack
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
@@ -268,10 +201,7 @@ installPackedGHC dl msubdir inst ver = do
|
||||
|
||||
-- | Install an unpacked GHC distribution. This only deals with the GHC
|
||||
-- build system and nothing else.
|
||||
installUnpackedGHC :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
installUnpackedGHC :: ( MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -288,7 +218,7 @@ installUnpackedGHC path inst _ = do
|
||||
liftIO $ copyDirectoryRecursive path inst
|
||||
#else
|
||||
installUnpackedGHC path inst ver = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
AppState { pfreq = PlatformRequest {..} } <- lift ask
|
||||
|
||||
let alpineArgs
|
||||
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
||||
@@ -320,11 +250,7 @@ installUnpackedGHC path inst ver = do
|
||||
installGHCBin :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -347,7 +273,9 @@ installGHCBin :: ( MonadFail m
|
||||
m
|
||||
()
|
||||
installGHCBin ver = do
|
||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
||||
AppState { pfreq
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
dlinfo <- lE $ getDownloadInfo GHC ver pfreq dls
|
||||
installGHCBindist dlinfo ver
|
||||
|
||||
|
||||
@@ -355,10 +283,7 @@ installGHCBin ver = do
|
||||
-- argument instead of looking it up from 'GHCupDownloads'.
|
||||
installCabalBindist :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -385,8 +310,9 @@ installCabalBindist :: ( MonadMask m
|
||||
installCabalBindist dlinfo ver = do
|
||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = dirs@Dirs {..}
|
||||
, pfreq = PlatformRequest {..}
|
||||
, settings } <- lift ask
|
||||
|
||||
whenM
|
||||
(lift (cabalInstalled ver) >>= \a -> liftIO $
|
||||
@@ -398,10 +324,10 @@ installCabalBindist dlinfo ver = do
|
||||
(throwE $ AlreadyInstalled Cabal ver)
|
||||
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
dl <- liftE $ downloadCached settings dirs dlinfo Nothing
|
||||
|
||||
-- unpack
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
void $ lift $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
@@ -438,11 +364,7 @@ installCabalBindist dlinfo ver = do
|
||||
-- the latest installed version.
|
||||
installCabalBin :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -466,7 +388,9 @@ installCabalBin :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
installCabalBin ver = do
|
||||
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
||||
AppState { pfreq
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq dls
|
||||
installCabalBindist dlinfo ver
|
||||
|
||||
|
||||
@@ -474,10 +398,7 @@ installCabalBin ver = do
|
||||
-- argument instead of looking it up from 'GHCupDownloads'.
|
||||
installHLSBindist :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -504,17 +425,18 @@ installHLSBindist :: ( MonadMask m
|
||||
installHLSBindist dlinfo ver = do
|
||||
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = dirs@Dirs {..}
|
||||
, pfreq = PlatformRequest {..}
|
||||
, settings } <- lift ask
|
||||
|
||||
whenM (lift (hlsInstalled ver))
|
||||
(throwE $ AlreadyInstalled HLS ver)
|
||||
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
dl <- liftE $ downloadCached settings dirs dlinfo Nothing
|
||||
|
||||
-- unpack
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
void $ lift $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
@@ -566,11 +488,7 @@ installHLSBindist dlinfo ver = do
|
||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||
installHLSBin :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -594,7 +512,9 @@ installHLSBin :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
installHLSBin ver = do
|
||||
dlinfo <- liftE $ getDownloadInfo HLS ver
|
||||
AppState { pfreq
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
dlinfo <- lE $ getDownloadInfo HLS ver pfreq dls
|
||||
installHLSBindist dlinfo ver
|
||||
|
||||
|
||||
@@ -603,11 +523,7 @@ installHLSBin ver = do
|
||||
-- the latest installed version.
|
||||
installStackBin :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -631,7 +547,8 @@ installStackBin :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
installStackBin ver = do
|
||||
dlinfo <- liftE $ getDownloadInfo Stack ver
|
||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
|
||||
dlinfo <- lE $ getDownloadInfo Stack ver pfreq dls
|
||||
installStackBindist dlinfo ver
|
||||
|
||||
|
||||
@@ -639,10 +556,7 @@ installStackBin ver = do
|
||||
-- argument instead of looking it up from 'GHCupDownloads'.
|
||||
installStackBindist :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -669,17 +583,19 @@ installStackBindist :: ( MonadMask m
|
||||
installStackBindist dlinfo ver = do
|
||||
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = dirs@Dirs {..}
|
||||
, pfreq = PlatformRequest {..}
|
||||
, settings
|
||||
} <- lift ask
|
||||
|
||||
whenM (lift (stackInstalled ver))
|
||||
(throwE $ AlreadyInstalled Stack ver)
|
||||
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
dl <- liftE $ downloadCached settings dirs dlinfo Nothing
|
||||
|
||||
-- unpack
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
void $ lift $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
@@ -728,8 +644,7 @@ installStackBindist dlinfo ver = do
|
||||
--
|
||||
-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
|
||||
-- for 'SetGHCOnly' constructor.
|
||||
setGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
setGHC :: ( MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -748,7 +663,7 @@ setGHC ver sghc = do
|
||||
whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))
|
||||
|
||||
-- symlink destination
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
|
||||
-- first delete the old symlinks (this fixes compatibility issues
|
||||
-- with old ghcup)
|
||||
@@ -786,15 +701,12 @@ setGHC ver sghc = do
|
||||
|
||||
where
|
||||
|
||||
symlinkShareDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m)
|
||||
symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m)
|
||||
=> FilePath
|
||||
-> String
|
||||
-> m ()
|
||||
symlinkShareDir ghcdir ver' = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
let destdir = baseDir
|
||||
case sghc of
|
||||
SetGHCOnly -> do
|
||||
@@ -821,8 +733,7 @@ setGHC ver sghc = do
|
||||
|
||||
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
|
||||
setCabal :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -834,7 +745,7 @@ setCabal ver = do
|
||||
let targetFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
|
||||
-- symlink destination
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
|
||||
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
||||
$ throwE
|
||||
@@ -853,8 +764,7 @@ setCabal ver = do
|
||||
|
||||
-- | Set the haskell-language-server symlinks.
|
||||
setHLS :: ( MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -865,7 +775,7 @@ setHLS :: ( MonadCatch m
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
setHLS ver = do
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
|
||||
-- Delete old symlinks, since these might have different ghc versions than the
|
||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||
@@ -894,8 +804,7 @@ setHLS ver = do
|
||||
|
||||
-- | Set the @~\/.ghcup\/bin\/stack@ symlink.
|
||||
setStack :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -908,7 +817,7 @@ setStack ver = do
|
||||
let targetFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
|
||||
-- symlink destination
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
|
||||
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
||||
$ throwE
|
||||
@@ -963,10 +872,7 @@ listVersions :: ( MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadReader AppState m
|
||||
)
|
||||
=> Maybe Tool
|
||||
-> Maybe ListCriteria
|
||||
@@ -985,7 +891,7 @@ listVersions lt' criteria = do
|
||||
go lt cSet cabals hlsSet' hlses sSet stacks = do
|
||||
case lt of
|
||||
Just t -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
-- get versions from GHCupDownloads
|
||||
let avTools = availableToolVersions dls t
|
||||
lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses sSet stacks)
|
||||
@@ -1011,13 +917,7 @@ listVersions lt' criteria = do
|
||||
ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks
|
||||
stackvers <- go (Just Stack) cSet cabals hlsSet' hlses sSet stacks
|
||||
pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
|
||||
strayGHCs :: ( MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
|
||||
=> Map.Map Version [Tag]
|
||||
-> m [ListResult]
|
||||
strayGHCs avTools = do
|
||||
@@ -1059,13 +959,7 @@ listVersions lt' criteria = do
|
||||
[i|Could not parse version of stray directory #{e}|]
|
||||
pure Nothing
|
||||
|
||||
strayCabals :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
|
||||
=> Map.Map Version [Tag]
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
@@ -1094,12 +988,7 @@ listVersions lt' criteria = do
|
||||
[i|Could not parse version of stray directory #{e}|]
|
||||
pure Nothing
|
||||
|
||||
strayHLS :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m)
|
||||
strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
|
||||
=> Map.Map Version [Tag]
|
||||
-> m [ListResult]
|
||||
strayHLS avTools = do
|
||||
@@ -1127,13 +1016,7 @@ listVersions lt' criteria = do
|
||||
[i|Could not parse version of stray directory #{e}|]
|
||||
pure Nothing
|
||||
|
||||
strayStacks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
strayStacks :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
|
||||
=> Map.Map Version [Tag]
|
||||
-> m [ListResult]
|
||||
strayStacks avTools = do
|
||||
@@ -1162,14 +1045,7 @@ listVersions lt' criteria = do
|
||||
pure Nothing
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: ( MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasGHCupInfo env
|
||||
, HasPlatformReq env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
|
||||
=> Tool
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
@@ -1180,9 +1056,12 @@ listVersions lt' criteria = do
|
||||
-> (Version, [Tag])
|
||||
-> m ListResult
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do
|
||||
AppState { pfreq
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
case t of
|
||||
GHC -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
||||
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq dls
|
||||
let tver = mkTVer v
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
||||
lInstalled <- ghcInstalled tver
|
||||
@@ -1190,7 +1069,7 @@ listVersions lt' criteria = do
|
||||
hlsPowered <- fmap (elem v) hlsGHCVersions
|
||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
||||
Cabal -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
||||
let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq dls
|
||||
let lSet = cSet == Just v
|
||||
let lInstalled = elem v $ rights cabals
|
||||
pure ListResult { lVer = v
|
||||
@@ -1216,7 +1095,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
HLS -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo HLS v
|
||||
let lNoBindist = isLeft $ getDownloadInfo HLS v pfreq dls
|
||||
let lSet = hlsSet' == Just v
|
||||
let lInstalled = elem v $ rights hlses
|
||||
pure ListResult { lVer = v
|
||||
@@ -1229,7 +1108,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Stack -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Stack v
|
||||
let lNoBindist = isLeft $ getDownloadInfo Stack v pfreq dls
|
||||
let lSet = stackSet' == Just v
|
||||
let lInstalled = elem v $ rights stacks
|
||||
pure ListResult { lVer = v
|
||||
@@ -1261,8 +1140,7 @@ listVersions lt' criteria = do
|
||||
-- This may leave GHCup without a "set" version.
|
||||
-- Will try to fix the ghc-x.y symlink after removal (e.g. to an
|
||||
-- older version).
|
||||
rmGHCVer :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmGHCVer :: ( MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -1303,7 +1181,7 @@ rmGHCVer ver = do
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
|
||||
liftIO
|
||||
$ hideError doesNotExistErrorType
|
||||
@@ -1313,8 +1191,7 @@ rmGHCVer ver = do
|
||||
-- | Delete a cabal version. Will try to fix the @cabal@ symlink
|
||||
-- after removal (e.g. setting it to an older version).
|
||||
rmCabalVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -1329,7 +1206,7 @@ rmCabalVer ver = do
|
||||
|
||||
cSet <- lift cabalSet
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
|
||||
let cabalFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
liftIO $ hideError doesNotExistErrorType $ rmFile (binDir </> cabalFile)
|
||||
@@ -1344,8 +1221,7 @@ rmCabalVer ver = do
|
||||
-- | Delete a hls version. Will try to fix the hls symlinks
|
||||
-- after removal (e.g. setting it to an older version).
|
||||
rmHLSVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -1360,7 +1236,7 @@ rmHLSVer ver = do
|
||||
|
||||
isHlsSet <- lift hlsSet
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
|
||||
bins <- lift $ hlsAllBinaries ver
|
||||
forM_ bins $ \f -> liftIO $ rmFile (binDir </> f)
|
||||
@@ -1382,8 +1258,7 @@ rmHLSVer ver = do
|
||||
-- | Delete a stack version. Will try to fix the @stack@ symlink
|
||||
-- after removal (e.g. setting it to an older version).
|
||||
rmStackVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
@@ -1398,7 +1273,7 @@ rmStackVer ver = do
|
||||
|
||||
sSet <- lift stackSet
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
|
||||
let stackFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
liftIO $ hideError doesNotExistErrorType $ rmFile (binDir </> stackFile)
|
||||
@@ -1411,15 +1286,15 @@ rmStackVer ver = do
|
||||
|
||||
|
||||
-- assuming the current scheme of having just 1 ghcup bin, no version info is required.
|
||||
rmGhcup :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmGhcup :: ( MonadReader AppState m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> m ()
|
||||
|
||||
rmGhcup = do
|
||||
Dirs {binDir} <- getDirs
|
||||
AppState {dirs = Dirs {binDir}} <- ask
|
||||
let ghcupFilename = "ghcup" <> exeExt
|
||||
let ghcupFilepath = binDir </> ghcupFilename
|
||||
|
||||
@@ -1463,14 +1338,14 @@ rmGhcup = do
|
||||
<> path <>
|
||||
"\n you may have to uninstall it manually."
|
||||
|
||||
rmTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m)
|
||||
=> ListResult
|
||||
-> Excepts '[NotInstalled ] m ()
|
||||
rmTool :: ( MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m)
|
||||
=> ListResult
|
||||
-> Excepts '[NotInstalled ] m ()
|
||||
|
||||
rmTool ListResult {lVer, lTool, lCross} = do
|
||||
case lTool of
|
||||
GHC ->
|
||||
@@ -1482,8 +1357,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
|
||||
GHCup -> lift rmGhcup
|
||||
|
||||
|
||||
rmGhcupDirs :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmGhcupDirs :: ( MonadReader AppState m
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, MonadCatch m
|
||||
@@ -1495,7 +1369,7 @@ rmGhcupDirs = do
|
||||
, binDir
|
||||
, logsDir
|
||||
, cacheDir
|
||||
} <- getDirs
|
||||
} <- asks dirs
|
||||
|
||||
let envFilePath = baseDir </> "env"
|
||||
|
||||
@@ -1603,20 +1477,13 @@ rmGhcupDirs = do
|
||||
------------------
|
||||
|
||||
|
||||
getDebugInfo :: ( Alternative m
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
)
|
||||
getDebugInfo :: (Alternative m, MonadFail m, MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m)
|
||||
=> Excepts
|
||||
'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
||||
m
|
||||
DebugInfo
|
||||
getDebugInfo = do
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
let diBaseDir = baseDir
|
||||
let diBinDir = binDir
|
||||
diGHCDir <- lift ghcupGHCBaseDir
|
||||
@@ -1636,11 +1503,7 @@ getDebugInfo = do
|
||||
-- | Compile a GHC from source. This behaves wrt symlinks and installation
|
||||
-- the same as 'installGHCBin'.
|
||||
compileGHC :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadResource m
|
||||
, MonadLogger m
|
||||
@@ -1675,9 +1538,10 @@ compileGHC :: ( MonadMask m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
|
||||
= do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
AppState { pfreq = PlatformRequest {..}
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }
|
||||
, settings
|
||||
, dirs } <- lift ask
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
@@ -1687,7 +1551,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
dl <- liftE $ downloadCached settings dirs dlInfo Nothing
|
||||
|
||||
-- unpack
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
@@ -1754,11 +1618,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
|
||||
Right g -> pure $ Right g
|
||||
Left bver -> pure $ Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
||||
|
||||
(mBindist, bmk) <- liftE $ runBuildAction
|
||||
(bindist, bmk) <- liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
Nothing
|
||||
(do
|
||||
b <- compileBindist bghc tver workdir ghcdir
|
||||
b <- compileBindist bghc tver workdir
|
||||
bmk <- liftIO $ B.readFile (build_mk workdir)
|
||||
pure (b, bmk)
|
||||
)
|
||||
@@ -1766,12 +1630,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
|
||||
when alreadyInstalled $ do
|
||||
lift $ $(logInfo) [i|Deleting existing installation|]
|
||||
liftE $ rmGHCVer tver
|
||||
|
||||
forM_ mBindist $ \bindist -> do
|
||||
liftE $ installPackedGHC bindist
|
||||
(Just $ RegexDir "ghc-.*")
|
||||
ghcdir
|
||||
(tver ^. tvVersion)
|
||||
liftE $ installPackedGHC bindist
|
||||
(Just $ RegexDir "ghc-.*")
|
||||
ghcdir
|
||||
(tver ^. tvVersion)
|
||||
|
||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||
|
||||
@@ -1798,10 +1660,7 @@ BUILD_SPHINX_HTML = NO
|
||||
BUILD_SPHINX_PDF = NO
|
||||
HADDOCK_DOCS = YES|]
|
||||
|
||||
compileBindist :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
compileBindist :: ( MonadReader AppState m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
@@ -1811,17 +1670,15 @@ HADDOCK_DOCS = YES|]
|
||||
=> Either FilePath FilePath
|
||||
-> GHCTargetVersion
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> Excepts
|
||||
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError]
|
||||
m
|
||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||
compileBindist bghc tver workdir ghcdir = do
|
||||
FilePath -- ^ output path of bindist
|
||||
compileBindist bghc tver workdir = do
|
||||
lift $ $(logInfo) [i|configuring build|]
|
||||
liftE checkBuildConfig
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
pfreq <- lift getPlatformReq
|
||||
|
||||
AppState { dirs = Dirs {..}, pfreq } <- lift ask
|
||||
|
||||
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
|
||||
|
||||
@@ -1838,7 +1695,6 @@ HADDOCK_DOCS = YES|]
|
||||
("./configure" : maybe mempty
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
#if defined(IS_WINDOWS)
|
||||
++ ["--enable-tarballs-autodownload"]
|
||||
#endif
|
||||
@@ -1855,9 +1711,8 @@ HADDOCK_DOCS = YES|]
|
||||
++ maybe mempty
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
#if defined(IS_WINDOWS)
|
||||
++ ["--enable-tarballs-autodownload"]
|
||||
++ ["--enable-tarballs-autodownload"]
|
||||
#endif
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
@@ -1876,35 +1731,30 @@ HADDOCK_DOCS = YES|]
|
||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
||||
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
||||
|
||||
if | isCross tver -> do
|
||||
lift $ $(logInfo) [i|Installing cross toolchain...|]
|
||||
lEM $ make ["install"] (Just workdir)
|
||||
pure Nothing
|
||||
| otherwise -> do
|
||||
lift $ $(logInfo) [i|Creating bindist...|]
|
||||
lEM $ make ["binary-dist"] (Just workdir)
|
||||
[tar] <- liftIO $ findFiles
|
||||
workdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|^ghc-.*\.tar\..*$|] :: ByteString)
|
||||
)
|
||||
c <- liftIO $ BL.readFile (workdir </> tar)
|
||||
cDigest <-
|
||||
fmap (T.take 8)
|
||||
. lift
|
||||
. throwEither
|
||||
. E.decodeUtf8'
|
||||
. B16.encode
|
||||
. SHA256.hashlazy
|
||||
$ c
|
||||
cTime <- liftIO getCurrentTime
|
||||
let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|]
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
tarPath
|
||||
lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
|
||||
pure $ Just tarPath
|
||||
lift $ $(logInfo) [i|Creating bindist...|]
|
||||
lEM $ make ["binary-dist"] (Just workdir)
|
||||
[tar] <- liftIO $ findFiles
|
||||
workdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|^ghc-.*\.tar\..*$|] :: ByteString)
|
||||
)
|
||||
c <- liftIO $ BL.readFile (workdir </> tar)
|
||||
cDigest <-
|
||||
fmap (T.take 8)
|
||||
. lift
|
||||
. throwEither
|
||||
. E.decodeUtf8'
|
||||
. B16.encode
|
||||
. SHA256.hashlazy
|
||||
$ c
|
||||
cTime <- liftIO getCurrentTime
|
||||
let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|]
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
tarPath
|
||||
lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
|
||||
pure tarPath
|
||||
|
||||
build_mk workdir = workdir </> "mk" </> "build.mk"
|
||||
|
||||
@@ -1931,9 +1781,6 @@ HADDOCK_DOCS = YES|]
|
||||
)
|
||||
_ -> pure ()
|
||||
|
||||
isCross :: GHCTargetVersion -> Bool
|
||||
isCross = isJust . _tvTarget
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1945,11 +1792,7 @@ HADDOCK_DOCS = YES|]
|
||||
-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
|
||||
-- if no path is provided.
|
||||
upgradeGHCup :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasSettings env
|
||||
, MonadReader AppState m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
@@ -1970,16 +1813,17 @@ upgradeGHCup :: ( MonadMask m
|
||||
m
|
||||
Version
|
||||
upgradeGHCup mtarget force' = do
|
||||
Dirs {..} <- lift getDirs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
AppState { dirs = Dirs {..}
|
||||
, pfreq
|
||||
, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }
|
||||
, settings } <- lift ask
|
||||
lift $ $(logInfo) [i|Upgrading GHCup...|]
|
||||
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
||||
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
|
||||
tmp <- lift withGHCupTmpDir
|
||||
let fn = "ghcup" <> exeExt
|
||||
p <- liftE $ download dli tmp (Just fn)
|
||||
p <- liftE $ download settings dli tmp (Just fn)
|
||||
let destDir = takeDirectory destFile
|
||||
destFile = fromMaybe (binDir </> fn <> exeExt) mtarget
|
||||
lift $ $(logDebug) [i|mkdir -p #{destDir}|]
|
||||
@@ -2021,8 +1865,7 @@ upgradeGHCup mtarget force' = do
|
||||
|
||||
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
|
||||
-- both installing from source and bindist.
|
||||
postGHCInstall :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
postGHCInstall :: ( MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -2053,8 +1896,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
-- * for hls, this reports @~\/.ghcup\/bin\/haskell-language-server-wrapper-\<ver\>@
|
||||
-- * for stack, this reports @~\/.ghcup\/bin\/stack-\<ver\>@
|
||||
-- * for ghcup, this reports the location of the currently running executable
|
||||
whereIsTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
whereIsTool :: ( MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -2067,14 +1909,14 @@ whereIsTool :: ( MonadReader env m
|
||||
-> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m FilePath
|
||||
whereIsTool tool ver@GHCTargetVersion {..} = do
|
||||
dirs <- lift getDirs
|
||||
AppState { dirs } <- lift ask
|
||||
|
||||
case tool of
|
||||
GHC -> do
|
||||
whenM (lift $ fmap not $ ghcInstalled ver)
|
||||
$ throwE (NotInstalled GHC ver)
|
||||
bdir <- lift $ ghcupGHCDir ver
|
||||
pure (bdir </> "bin" </> ghcBinaryName ver)
|
||||
pure (bdir </> "bin" </> "ghc" <> exeExt)
|
||||
Cabal -> do
|
||||
whenM (lift $ fmap not $ cabalInstalled _tvVersion)
|
||||
$ throwE (NotInstalled Cabal (GHCTargetVersion Nothing _tvVersion))
|
||||
@@ -2091,6 +1933,3 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
||||
GHCup -> do
|
||||
currentRunningExecPath <- liftIO getExecutablePath
|
||||
liftIO $ canonicalizePath currentRunningExecPath
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -107,31 +107,32 @@ import qualified Data.Yaml as Y
|
||||
getDownloadsF :: ( FromJSONKey Tool
|
||||
, FromJSONKey Version
|
||||
, FromJSON VersionInfo
|
||||
, MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts
|
||||
=> Settings
|
||||
-> Dirs
|
||||
-> Excepts
|
||||
'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
m
|
||||
GHCupInfo
|
||||
getDownloadsF = do
|
||||
Settings { urlSource } <- lift getSettings
|
||||
getDownloadsF settings@Settings{ urlSource } dirs = do
|
||||
case urlSource of
|
||||
GHCupURL -> liftE $ getBase ghcupURL
|
||||
(OwnSource url) -> liftE $ getBase url
|
||||
GHCupURL -> liftE $ getBase dirs settings
|
||||
(OwnSource url) -> do
|
||||
bs <- reThrowAll DownloadFailed $ downloadBS (downloader settings) url
|
||||
lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
|
||||
(OwnSpec av) -> pure av
|
||||
(AddSource (Left ext)) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
base <- liftE $ getBase dirs settings
|
||||
pure (mergeGhcupInfo base ext)
|
||||
(AddSource (Right uri)) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ getBase uri
|
||||
base <- liftE $ getBase dirs settings
|
||||
bsExt <- reThrowAll DownloadFailed $ downloadBS (downloader settings) uri
|
||||
ext <- lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bsExt)
|
||||
pure (mergeGhcupInfo base ext)
|
||||
|
||||
where
|
||||
@@ -148,49 +149,33 @@ getDownloadsF = do
|
||||
in GHCupInfo tr newDownloads newGlobalTools
|
||||
|
||||
|
||||
readFromCache :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m)
|
||||
=> URI
|
||||
-> Excepts '[JSONError, FileDoesNotExistError] m L.ByteString
|
||||
readFromCache uri = do
|
||||
Dirs{..} <- lift getDirs
|
||||
let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)
|
||||
handleIO' NoSuchThing (\_ -> throwE $ FileDoesNotExistError yaml_file)
|
||||
. liftIO
|
||||
. L.readFile
|
||||
$ yaml_file
|
||||
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m)
|
||||
=> Dirs
|
||||
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
readFromCache Dirs {..} = do
|
||||
lift $ $(logWarn)
|
||||
[i|Could not get download info, trying cached version (this may not be recent!)|]
|
||||
let path = view pathL' ghcupURL
|
||||
let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
|
||||
bs <-
|
||||
handleIO' NoSuchThing
|
||||
(\_ -> throwE $ FileDoesNotExistError yaml_file)
|
||||
$ liftIO
|
||||
$ L.readFile yaml_file
|
||||
lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
|
||||
|
||||
|
||||
getBase :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> URI
|
||||
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m)
|
||||
=> Dirs
|
||||
-> Settings
|
||||
-> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
|
||||
getBase uri = do
|
||||
Settings { noNetwork } <- lift getSettings
|
||||
bs <- if noNetwork
|
||||
then readFromCache uri
|
||||
else handleIO (\_ -> warnCache >> readFromCache uri)
|
||||
. catchE @_ @'[JSONError, FileDoesNotExistError] (\(DownloadFailed _) -> warnCache >> readFromCache uri)
|
||||
. reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed
|
||||
$ smartDl uri
|
||||
liftE
|
||||
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. first show
|
||||
. Y.decodeEither'
|
||||
. L.toStrict
|
||||
$ bs
|
||||
where
|
||||
warnCache = lift $ $(logWarn)
|
||||
[i|Could not get download info, trying cached version (this may not be recent!)|]
|
||||
|
||||
getBase dirs@Dirs{..} Settings{ downloader } =
|
||||
handleIO (\_ -> readFromCache dirs)
|
||||
$ catchE @_ @'[JSONError, FileDoesNotExistError]
|
||||
(\(DownloadFailed _) -> readFromCache dirs)
|
||||
(reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed (smartDl ghcupURL)
|
||||
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . first show . Y.decodeEither' . L.toStrict))
|
||||
where
|
||||
-- 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
|
||||
-- last 5 minutes, just reuse it.
|
||||
@@ -200,11 +185,8 @@ getBase uri = do
|
||||
-- than the local file.
|
||||
--
|
||||
-- Always save the local file with the mod time of the remote file.
|
||||
smartDl :: forall m1 env1
|
||||
. ( MonadReader env1 m1
|
||||
, HasDirs env1
|
||||
, HasSettings env1
|
||||
, MonadCatch m1
|
||||
smartDl :: forall m1
|
||||
. ( MonadCatch m1
|
||||
, MonadIO m1
|
||||
, MonadFail m1
|
||||
, MonadLogger m1
|
||||
@@ -218,15 +200,13 @@ getBase uri = do
|
||||
, NoLocationHeader
|
||||
, TooManyRedirs
|
||||
, ProcessError
|
||||
, NoNetwork
|
||||
]
|
||||
m1
|
||||
L.ByteString
|
||||
smartDl uri' = do
|
||||
Dirs{..} <- lift getDirs
|
||||
let path = view pathL' uri'
|
||||
let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
|
||||
e <- liftIO $ doesFileExist json_file
|
||||
e <- liftIO $ doesFileExist json_file
|
||||
if e
|
||||
then do
|
||||
accessTime <- liftIO $ getAccessTime json_file
|
||||
@@ -257,11 +237,11 @@ getBase uri = do
|
||||
|
||||
where
|
||||
dlWithMod modTime json_file = do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
bs <- liftE $ downloadBS downloader uri'
|
||||
liftIO $ writeFileWithModTime modTime json_file bs
|
||||
pure bs
|
||||
dlWithoutMod json_file = do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
bs <- liftE $ downloadBS downloader uri'
|
||||
liftIO $ hideError doesNotExistErrorType $ rmFile json_file
|
||||
liftIO $ L.writeFile json_file bs
|
||||
liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||
@@ -299,46 +279,39 @@ getBase uri = do
|
||||
setModificationTime path utctime
|
||||
|
||||
|
||||
getDownloadInfo :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
)
|
||||
=> Tool
|
||||
getDownloadInfo :: Tool
|
||||
-> Version
|
||||
-- ^ tool version
|
||||
-> Excepts
|
||||
'[NoDownload]
|
||||
m
|
||||
DownloadInfo
|
||||
getDownloadInfo t v = do
|
||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
-> PlatformRequest
|
||||
-> GHCupDownloads
|
||||
-> Either NoDownload DownloadInfo
|
||||
getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
|
||||
(Left NoDownload)
|
||||
Right
|
||||
(case p of
|
||||
-- non-musl won't work on alpine
|
||||
Linux Alpine -> with_distro <|> without_distro_ver
|
||||
_ -> with_distro <|> without_distro_ver <|> without_distro
|
||||
)
|
||||
|
||||
let distro_preview f g =
|
||||
let platformVersionSpec =
|
||||
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
|
||||
mv' = g mv
|
||||
in fmap snd
|
||||
. find
|
||||
(\(mverRange, _) -> maybe
|
||||
(isNothing mv')
|
||||
(\range -> maybe False (`versionRange` range) mv')
|
||||
mverRange
|
||||
)
|
||||
. M.toList
|
||||
=<< platformVersionSpec
|
||||
with_distro = distro_preview id id
|
||||
without_distro_ver = distro_preview id (const Nothing)
|
||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||
where
|
||||
with_distro = distro_preview id id
|
||||
without_distro_ver = distro_preview id (const Nothing)
|
||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||
|
||||
maybe
|
||||
(throwE NoDownload)
|
||||
pure
|
||||
(case p of
|
||||
-- non-musl won't work on alpine
|
||||
Linux Alpine -> with_distro <|> without_distro_ver
|
||||
_ -> with_distro <|> without_distro_ver <|> without_distro
|
||||
)
|
||||
distro_preview f g =
|
||||
let platformVersionSpec =
|
||||
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
|
||||
mv' = g mv
|
||||
in fmap snd
|
||||
. find
|
||||
(\(mverRange, _) -> maybe
|
||||
(isNothing mv')
|
||||
(\range -> maybe False (`versionRange` range) mv')
|
||||
mverRange
|
||||
)
|
||||
. M.toList
|
||||
=<< platformVersionSpec
|
||||
|
||||
|
||||
-- | Tries to download from the given http or https url
|
||||
@@ -348,19 +321,17 @@ getDownloadInfo t v = do
|
||||
-- 2. otherwise create a random file
|
||||
--
|
||||
-- The file must not exist.
|
||||
download :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, MonadMask m
|
||||
download :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
=> DownloadInfo
|
||||
=> Settings
|
||||
-> DownloadInfo
|
||||
-> FilePath -- ^ destination dir
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
download dli dest mfn
|
||||
download settings@Settings{ downloader } dli dest mfn
|
||||
| scheme == "https" = dl
|
||||
| scheme == "http" = dl
|
||||
| scheme == "file" = cp
|
||||
@@ -391,8 +362,6 @@ download dli dest mfn
|
||||
liftIO (hideError doesNotExistErrorType $ rmFile destFile)
|
||||
>> (throwE . DownloadFailed $ e)
|
||||
) $ do
|
||||
Settings{ downloader, noNetwork } <- lift getSettings
|
||||
when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
|
||||
case downloader of
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
@@ -408,66 +377,58 @@ download dli dest mfn
|
||||
liftE $ downloadToFile https host fullPath port destFile
|
||||
#endif
|
||||
|
||||
liftE $ checkDigest dli destFile
|
||||
liftE $ checkDigest settings dli destFile
|
||||
pure destFile
|
||||
|
||||
-- Manage to find a file we can write the body into.
|
||||
getDestFile :: FilePath
|
||||
getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
|
||||
(dest </>)
|
||||
mfn
|
||||
getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path))) (dest </>) mfn
|
||||
|
||||
path = view (dlUri % pathL') dli
|
||||
path = view (dlUri % pathL') dli
|
||||
|
||||
|
||||
-- | Download into tmpdir or use cached version, if it exists. If filename
|
||||
-- is omitted, infers the filename from the url.
|
||||
downloadCached :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadMask m
|
||||
downloadCached :: ( MonadMask m
|
||||
, MonadResource m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> DownloadInfo
|
||||
=> Settings
|
||||
-> Dirs
|
||||
-> DownloadInfo
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
downloadCached dli mfn = do
|
||||
Settings{ cache } <- lift getSettings
|
||||
downloadCached settings@Settings{ cache } dirs dli mfn = do
|
||||
case cache of
|
||||
True -> downloadCached' dli mfn Nothing
|
||||
True -> downloadCached' settings dirs dli mfn
|
||||
False -> do
|
||||
tmp <- lift withGHCupTmpDir
|
||||
liftE $ download dli tmp mfn
|
||||
liftE $ download settings dli tmp mfn
|
||||
|
||||
|
||||
downloadCached' :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadMask m
|
||||
downloadCached' :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> DownloadInfo
|
||||
=> Settings
|
||||
-> Dirs
|
||||
-> DownloadInfo
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Maybe FilePath -- ^ optional destination dir (default: cacheDir)
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
downloadCached' dli mfn mDestDir = do
|
||||
Dirs { cacheDir } <- lift getDirs
|
||||
let destDir = fromMaybe cacheDir mDestDir
|
||||
downloadCached' settings Dirs{..} dli mfn = do
|
||||
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
|
||||
let cachfile = destDir </> fn
|
||||
let cachfile = cacheDir </> fn
|
||||
fileExists <- liftIO $ doesFileExist cachfile
|
||||
if
|
||||
| fileExists -> do
|
||||
liftE $ checkDigest dli cachfile
|
||||
liftE $ checkDigest settings dli cachfile
|
||||
pure cachfile
|
||||
| otherwise -> liftE $ download dli destDir mfn
|
||||
| otherwise -> liftE $ download settings dli cacheDir mfn
|
||||
|
||||
|
||||
|
||||
@@ -480,13 +441,9 @@ downloadCached' dli mfn mDestDir = do
|
||||
|
||||
|
||||
-- | This is used for downloading the JSON.
|
||||
downloadBS :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> URI
|
||||
downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
|
||||
=> Downloader
|
||||
-> URI
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
, HTTPStatusError
|
||||
@@ -495,11 +452,10 @@ downloadBS :: ( MonadReader env m
|
||||
, NoLocationHeader
|
||||
, TooManyRedirs
|
||||
, ProcessError
|
||||
, NoNetwork
|
||||
]
|
||||
m
|
||||
L.ByteString
|
||||
downloadBS uri'
|
||||
downloadBS downloader uri'
|
||||
| scheme == "https"
|
||||
= dl True
|
||||
| scheme == "http"
|
||||
@@ -519,8 +475,6 @@ downloadBS uri'
|
||||
dl _ = do
|
||||
#endif
|
||||
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
|
||||
Settings{ downloader, noNetwork } <- lift getSettings
|
||||
when noNetwork $ throwE NoNetwork
|
||||
case downloader of
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
@@ -545,18 +499,12 @@ downloadBS uri'
|
||||
#endif
|
||||
|
||||
|
||||
checkDigest :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> DownloadInfo
|
||||
checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m)
|
||||
=> Settings
|
||||
-> DownloadInfo
|
||||
-> FilePath
|
||||
-> Excepts '[DigestError] m ()
|
||||
checkDigest dli file = do
|
||||
Settings{ noVerify } <- lift getSettings
|
||||
checkDigest Settings{ noVerify } dli file = do
|
||||
let verify = not noVerify
|
||||
when verify $ do
|
||||
let p' = takeFileName file
|
||||
|
||||
@@ -233,13 +233,6 @@ instance Pretty NoToolVersionSet where
|
||||
pPrint (NoToolVersionSet tool) =
|
||||
text [i|No version is set for tool "#{tool}".|]
|
||||
|
||||
data NoNetwork = NoNetwork
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoNetwork where
|
||||
pPrint NoNetwork =
|
||||
text [i|A download was required or requested, but '--offline' was specified.|]
|
||||
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
|
||||
@@ -1,12 +1,9 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types
|
||||
@@ -297,12 +294,11 @@ data UserSettings = UserSettings
|
||||
, uDownloader :: Maybe Downloader
|
||||
, uKeyBindings :: Maybe UserKeyBindings
|
||||
, uUrlSource :: Maybe URLSource
|
||||
, uNoNetwork :: Maybe Bool
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
defaultUserSettings :: UserSettings
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
data UserKeyBindings = UserKeyBindings
|
||||
{ kUp :: Maybe Key
|
||||
@@ -350,21 +346,12 @@ data AppState = AppState
|
||||
{ settings :: Settings
|
||||
, dirs :: Dirs
|
||||
, keyBindings :: KeyBindings
|
||||
, ghcupInfo :: GHCupInfo
|
||||
, pfreq :: PlatformRequest
|
||||
, ghcupInfo :: ~GHCupInfo
|
||||
, pfreq :: ~PlatformRequest
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData AppState
|
||||
|
||||
data LeanAppState = LeanAppState
|
||||
{ settings :: Settings
|
||||
, dirs :: Dirs
|
||||
, keyBindings :: KeyBindings
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData LeanAppState
|
||||
|
||||
|
||||
data Settings = Settings
|
||||
{ cache :: Bool
|
||||
, noVerify :: Bool
|
||||
@@ -372,7 +359,6 @@ data Settings = Settings
|
||||
, downloader :: Downloader
|
||||
, verbose :: Bool
|
||||
, urlSource :: URLSource
|
||||
, noNetwork :: Bool
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@@ -521,3 +507,4 @@ instance (Monad m, Alternative m) => Alternative (LoggingT m) where
|
||||
instance MonadLogger m => MonadLogger (Excepts e m) where
|
||||
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
|
||||
|
||||
|
||||
|
||||
@@ -1,9 +1,4 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.Optics
|
||||
@@ -18,7 +13,6 @@ module GHCup.Types.Optics where
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Optics
|
||||
import URI.ByteString
|
||||
@@ -64,82 +58,3 @@ pathL' = lensVL pathL
|
||||
|
||||
queryL' :: Lens' (URIRef a) Query
|
||||
queryL' = lensVL queryL
|
||||
|
||||
|
||||
|
||||
----------------------
|
||||
--[ Lens utilities ]--
|
||||
----------------------
|
||||
|
||||
|
||||
gets :: forall f a env m . (MonadReader env m, LabelOptic' f A_Lens env a)
|
||||
=> m a
|
||||
gets = asks (^. labelOptic @f)
|
||||
|
||||
|
||||
getAppState :: MonadReader AppState m => m AppState
|
||||
getAppState = ask
|
||||
|
||||
|
||||
getLeanAppState :: ( MonadReader env m
|
||||
, LabelOptic' "settings" A_Lens env Settings
|
||||
, LabelOptic' "dirs" A_Lens env Dirs
|
||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||
)
|
||||
=> m LeanAppState
|
||||
getLeanAppState = do
|
||||
s <- gets @"settings"
|
||||
d <- gets @"dirs"
|
||||
k <- gets @"keyBindings"
|
||||
pure (LeanAppState s d k)
|
||||
|
||||
|
||||
getSettings :: ( MonadReader env m
|
||||
, LabelOptic' "settings" A_Lens env Settings
|
||||
)
|
||||
=> m Settings
|
||||
getSettings = gets @"settings"
|
||||
|
||||
|
||||
getDirs :: ( MonadReader env m
|
||||
, LabelOptic' "dirs" A_Lens env Dirs
|
||||
)
|
||||
=> m Dirs
|
||||
getDirs = gets @"dirs"
|
||||
|
||||
|
||||
getKeyBindings :: ( MonadReader env m
|
||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||
)
|
||||
=> m KeyBindings
|
||||
getKeyBindings = gets @"keyBindings"
|
||||
|
||||
|
||||
getGHCupInfo :: ( MonadReader env m
|
||||
, LabelOptic' "ghcupInfo" A_Lens env GHCupInfo
|
||||
)
|
||||
=> m GHCupInfo
|
||||
getGHCupInfo = gets @"ghcupInfo"
|
||||
|
||||
|
||||
getPlatformReq :: ( MonadReader env m
|
||||
, LabelOptic' "pfreq" A_Lens env PlatformRequest
|
||||
)
|
||||
=> m PlatformRequest
|
||||
getPlatformReq = gets @"pfreq"
|
||||
|
||||
|
||||
type HasSettings env = (LabelOptic' "settings" A_Lens env Settings)
|
||||
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)
|
||||
|
||||
|
||||
getCache :: (MonadReader env m, HasSettings env) => m Bool
|
||||
getCache = getSettings <&> cache
|
||||
|
||||
|
||||
getDownloader :: (MonadReader env m, HasSettings env) => m Downloader
|
||||
getDownloader = getSettings <&> downloader
|
||||
|
||||
|
||||
@@ -103,30 +103,28 @@ import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
-- | The symlink destination of a ghc tool.
|
||||
ghcLinkDestination :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m, MonadIO m)
|
||||
ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
|
||||
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
|
||||
-> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcLinkDestination tool ver = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
ghcd <- ghcupGHCDir ver
|
||||
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
|
||||
|
||||
|
||||
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmMinorSymlinks :: ( MonadReader AppState m
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadReader AppState m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
@@ -137,8 +135,7 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmPlain :: ( MonadReader AppState m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
@@ -147,7 +144,7 @@ rmPlain :: ( MonadReader env m
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlain target = do
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
mtv <- lift $ ghcSet target
|
||||
forM_ mtv $ \tv -> do
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
@@ -162,17 +159,17 @@ rmPlain target = do
|
||||
|
||||
|
||||
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
rmMajorSymlinks :: ( MonadReader AppState m
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadReader AppState m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
AppState { dirs = Dirs {..} } <- lift ask
|
||||
(mj, mi) <- getMajorMinorV _tvVersion
|
||||
let v' = intToText mj <> "." <> intToText mi
|
||||
|
||||
@@ -192,26 +189,26 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
|
||||
|
||||
-- | Whether the given GHC versin is installed.
|
||||
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcInstalled ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
liftIO $ doesDirectoryExist ghcdir
|
||||
|
||||
|
||||
-- | Whether the given GHC version is installed from source.
|
||||
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcSrcInstalled ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
|
||||
|
||||
|
||||
-- | Whether the given GHC version is set as the current.
|
||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
|
||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||
-- (e.g. armv7-unknown-linux-gnueabihf)
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
ghcSet mtarget = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState {dirs = Dirs {..}} <- ask
|
||||
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
|
||||
let ghcBin = binDir </> ghc <> exeExt
|
||||
|
||||
@@ -242,7 +239,7 @@ ghcSet mtarget = do
|
||||
|
||||
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
|
||||
-- If a dir cannot be parsed, returns left.
|
||||
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||
getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||
getInstalledGHCs = do
|
||||
ghcdir <- ghcupGHCBaseDir
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
|
||||
@@ -252,15 +249,10 @@ getInstalledGHCs = do
|
||||
|
||||
|
||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||
getInstalledCabals :: ( MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
|
||||
=> m [Either FilePath Version]
|
||||
getInstalledCabals = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState {dirs = Dirs {..}} <- ask
|
||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
|
||||
@@ -272,16 +264,16 @@ 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 :: (MonadLogger m, MonadIO m, MonadReader AppState m, 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 :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
cabalSet = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState {dirs = Dirs {..}} <- ask
|
||||
let cabalbin = binDir </> "cabal" <> exeExt
|
||||
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
@@ -325,10 +317,10 @@ cabalSet = do
|
||||
|
||||
-- | Get all installed hls, by matching on
|
||||
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
|
||||
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||
getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
|
||||
=> m [Either FilePath Version]
|
||||
getInstalledHLSs = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended
|
||||
@@ -345,10 +337,10 @@ getInstalledHLSs = do
|
||||
|
||||
-- | Get all installed stacks, by matching on
|
||||
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
||||
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||
getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
|
||||
=> m [Either FilePath Version]
|
||||
getInstalledStacks = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended
|
||||
@@ -363,9 +355,9 @@ 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 AppState m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
|
||||
stackSet = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState {dirs = Dirs {..}} <- ask
|
||||
let stackBin = binDir </> "stack" <> exeExt
|
||||
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
@@ -403,13 +395,13 @@ stackSet = do
|
||||
stripRelativePath = MP.many (MP.try stripPathComponet)
|
||||
|
||||
-- | Whether the given Stack version is installed.
|
||||
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||
stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
|
||||
stackInstalled ver = do
|
||||
vers <- fmap rights getInstalledStacks
|
||||
pure $ elem ver vers
|
||||
|
||||
-- | Whether the given HLS version is installed.
|
||||
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
|
||||
hlsInstalled ver = do
|
||||
vers <- fmap rights getInstalledHLSs
|
||||
pure $ elem ver vers
|
||||
@@ -417,9 +409,9 @@ hlsInstalled ver = do
|
||||
|
||||
|
||||
-- Return the currently set hls version, if any.
|
||||
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState {dirs = Dirs {..}} <- ask
|
||||
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
|
||||
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
@@ -451,8 +443,7 @@ hlsSet = do
|
||||
|
||||
|
||||
-- | Return the GHC versions the currently selected HLS supports.
|
||||
hlsGHCVersions :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
hlsGHCVersions :: ( MonadReader AppState m
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
@@ -475,11 +466,11 @@ hlsGHCVersions = do
|
||||
|
||||
|
||||
-- | Get all server binaries for an hls version, if any.
|
||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
|
||||
=> Version
|
||||
-> m [FilePath]
|
||||
hlsServerBinaries ver = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts
|
||||
@@ -491,12 +482,12 @@ hlsServerBinaries ver = do
|
||||
|
||||
|
||||
-- | Get the wrapper binary for an hls version, if any.
|
||||
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
|
||||
=> Version
|
||||
-> m (Maybe FilePath)
|
||||
hlsWrapperBinary ver = do
|
||||
Dirs {..} <- getDirs
|
||||
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts
|
||||
compExtended
|
||||
@@ -512,7 +503,7 @@ hlsWrapperBinary ver = do
|
||||
|
||||
|
||||
-- | Get all binaries for an hls version, if any.
|
||||
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
|
||||
hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [FilePath]
|
||||
hlsAllBinaries ver = do
|
||||
hls <- hlsServerBinaries ver
|
||||
wrapper <- hlsWrapperBinary ver
|
||||
@@ -520,9 +511,9 @@ hlsAllBinaries ver = do
|
||||
|
||||
|
||||
-- | Get the active symlinks for hls.
|
||||
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
|
||||
hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [FilePath]
|
||||
hlsSymlinks = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended
|
||||
@@ -558,7 +549,7 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
|
||||
|
||||
-- | Get the latest installed full GHC version that satisfies X.Y.
|
||||
-- This reads `ghcupGHCBaseDir`.
|
||||
getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
|
||||
=> Int -- ^ major version component
|
||||
-> Int -- ^ minor version component
|
||||
-> Maybe Text -- ^ the target triple
|
||||
@@ -738,6 +729,19 @@ getLatestBaseVersion av pvpVer =
|
||||
|
||||
|
||||
|
||||
-----------------------
|
||||
--[ AppState Getter ]--
|
||||
-----------------------
|
||||
|
||||
|
||||
getCache :: MonadReader AppState m => m Bool
|
||||
getCache = ask <&> cache . settings
|
||||
|
||||
|
||||
getDownloader :: MonadReader AppState m => m Downloader
|
||||
getDownloader = ask <&> downloader . settings
|
||||
|
||||
|
||||
|
||||
-------------
|
||||
--[ Other ]--
|
||||
@@ -750,7 +754,7 @@ getLatestBaseVersion av pvpVer =
|
||||
-- Returns unversioned relative files without extension, e.g.:
|
||||
--
|
||||
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
|
||||
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||
ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m [FilePath]
|
||||
ghcToolFiles ver = do
|
||||
@@ -813,12 +817,7 @@ ghcUpSrcBuiltFile = ".ghcup_src_built"
|
||||
|
||||
|
||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||
make :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
)
|
||||
make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
|
||||
=> [String]
|
||||
-> Maybe FilePath
|
||||
-> m (Either ProcessError ())
|
||||
@@ -828,7 +827,7 @@ make args workdir = do
|
||||
let mymake = if has_gmake then "gmake" else "make"
|
||||
execLogged mymake args workdir "ghc-make" Nothing
|
||||
|
||||
makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
makeOut :: (MonadReader AppState m, MonadIO m)
|
||||
=> [String]
|
||||
-> Maybe FilePath
|
||||
-> m CapturedProcess
|
||||
@@ -841,7 +840,7 @@ 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 AppState m, MonadLogger m, MonadIO m)
|
||||
=> FilePath -- ^ dir containing patches
|
||||
-> FilePath -- ^ dir to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
@@ -859,7 +858,7 @@ applyPatches pdir ddir = do
|
||||
|
||||
|
||||
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
|
||||
darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
darwinNotarization :: (MonadReader AppState m, MonadIO m)
|
||||
=> Platform
|
||||
-> FilePath
|
||||
-> m (Either ProcessError ())
|
||||
@@ -882,13 +881,13 @@ getChangeLog dls tool (Right tag) =
|
||||
--
|
||||
-- 1. the build directory, depending on the KeepDirs setting
|
||||
-- 2. the install destination, depending on whether the build failed
|
||||
runBuildAction :: (Show (V e), MonadReader env m, HasDirs env, HasSettings env, MonadIO m, MonadMask m)
|
||||
runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
|
||||
=> FilePath -- ^ build directory (cleaned up depending on Settings)
|
||||
-> Maybe FilePath -- ^ dir to *always* clean up on exception
|
||||
-> Excepts e m a
|
||||
-> Excepts '[BuildFailed] m a
|
||||
runBuildAction bdir instdir action = do
|
||||
Settings {..} <- lift getSettings
|
||||
AppState { settings = Settings {..} } <- lift ask
|
||||
let exAction = do
|
||||
forM_ instdir $ \dir ->
|
||||
liftIO $ hideError doesNotExistErrorType $ rmPath dir
|
||||
@@ -1017,8 +1016,7 @@ createLink :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadReader AppState m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -1027,7 +1025,7 @@ createLink :: ( MonadMask m
|
||||
-> m ()
|
||||
createLink link exe = do
|
||||
#if defined(IS_WINDOWS)
|
||||
dirs <- getDirs
|
||||
AppState { dirs } <- ask
|
||||
let shimGen = cacheDir dirs </> "gs.exe"
|
||||
|
||||
let shim = dropExtension exe <.> "shim"
|
||||
@@ -1056,22 +1054,17 @@ ensureGlobalTools :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasGHCupInfo env
|
||||
, MonadReader AppState m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts '[DigestError , DownloadFailed, NoDownload] m ()
|
||||
ensureGlobalTools = do
|
||||
#if defined(IS_WINDOWS)
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
settings <- lift getSettings
|
||||
dirs <- lift getDirs
|
||||
AppState { ghcupInfo = GHCupInfo _ _ gTools, settings, dirs } <- lift ask
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
let dl = downloadCached' settings dirs shimDownload (Just "gs.exe")
|
||||
void $ (\(DigestError _ _) -> do
|
||||
lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
|
||||
lift $ $(logDebug) [i|rm -f #{shimDownload}|]
|
||||
@@ -1100,16 +1093,3 @@ ensureDirectories dirs = do
|
||||
createDirRecursive' logsDir
|
||||
createDirRecursive' confDir
|
||||
pure ()
|
||||
|
||||
|
||||
-- | For ghc without arch triple, this is:
|
||||
--
|
||||
-- - ghc-<ver> (e.g. ghc-8.10.4)
|
||||
--
|
||||
-- For ghc with arch triple:
|
||||
--
|
||||
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4)
|
||||
ghcBinaryName :: GHCTargetVersion -> String
|
||||
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
|
||||
|
||||
@@ -16,7 +16,7 @@ Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Utils.Dirs
|
||||
( getAllDirs
|
||||
( getDirs
|
||||
, ghcupBaseDir
|
||||
, ghcupConfigFile
|
||||
, ghcupCacheDir
|
||||
@@ -37,7 +37,6 @@ where
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
@@ -191,8 +190,8 @@ ghcupLogsDir = do
|
||||
#endif
|
||||
|
||||
|
||||
getAllDirs :: IO Dirs
|
||||
getAllDirs = do
|
||||
getDirs :: IO Dirs
|
||||
getDirs = do
|
||||
baseDir <- ghcupBaseDir
|
||||
binDir <- ghcupBinDir
|
||||
cacheDir <- ghcupCacheDir
|
||||
@@ -227,9 +226,9 @@ ghcupConfigFile = do
|
||||
|
||||
|
||||
-- | ~/.ghcup/ghc by default.
|
||||
ghcupGHCBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
|
||||
ghcupGHCBaseDir :: (MonadReader AppState m) => m FilePath
|
||||
ghcupGHCBaseDir = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
pure (baseDir </> "ghc")
|
||||
|
||||
|
||||
@@ -237,7 +236,7 @@ ghcupGHCBaseDir = do
|
||||
-- The dir may be of the form
|
||||
-- * armv7-unknown-linux-gnueabihf-8.8.3
|
||||
-- * 8.8.4
|
||||
ghcupGHCDir :: (MonadReader env m, HasDirs env, MonadThrow m)
|
||||
ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
|
||||
=> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcupGHCDir ver = do
|
||||
|
||||
@@ -21,7 +21,6 @@ module GHCup.Utils.File.Posix where
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
@@ -75,11 +74,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
||||
SPP.executeFile path True args Nothing
|
||||
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ thing to execute
|
||||
-> [String] -- ^ args for the thing
|
||||
-> Maybe FilePath -- ^ optionally chdir into this
|
||||
@@ -87,8 +82,7 @@ execLogged :: ( MonadReader env m
|
||||
-> Maybe [(String, String)] -- ^ optional environment
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe args chdir lfile env = do
|
||||
Settings {..} <- getSettings
|
||||
Dirs {..} <- getDirs
|
||||
AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
|
||||
let logfile = logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
|
||||
@@ -19,7 +19,6 @@ import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.DeepSeq
|
||||
@@ -147,11 +146,7 @@ executeOut path args chdir = do
|
||||
pure $ CapturedProcess exit out err
|
||||
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ thing to execute
|
||||
-> [String] -- ^ args for the thing
|
||||
-> Maybe FilePath -- ^ optionally chdir into this
|
||||
@@ -159,7 +154,7 @@ execLogged :: ( MonadReader env m
|
||||
-> Maybe [(String, String)] -- ^ optional environment
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe args chdir lfile env = do
|
||||
Dirs {..} <- getDirs
|
||||
AppState { dirs = Dirs {..} } <- ask
|
||||
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
|
||||
stderrLogfile = logsDir </> lfile <> ".stderr.log"
|
||||
cp <- createProcessWithMingwPath ((proc exe args)
|
||||
|
||||
@@ -31,10 +31,6 @@ extra-deps:
|
||||
- libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
|
||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
|
||||
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
|
||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||
- regex-posix-clib-2.7
|
||||
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
|
||||
|
||||
@@ -67,7 +67,7 @@
|
||||
<div>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>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 $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run an interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
<p class="other-help">If you want to run an non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
</div>
|
||||
</p>
|
||||
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
|
||||
Reference in New Issue
Block a user