Add binutils gold for alpine pkgs

Unhide stack
Merge branch 'mlang-cursor'
2021-07-25 19:06:22 +02:00 · 2021-07-23 16:13:07 +02:00 · 2021-07-23 14:46:06 +02:00 · 2021-07-23 14:45:50 +02:00 · 2021-07-23 14:38:49 +02:00 · 2021-07-23 14:35:07 +02:00
25 changed files with 1915 additions and 754 deletions
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -21,6 +21,7 @@ variables:
    OS: "LINUX"
    ARCH: "64"
    CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+    CROSS: ""

 .alpine:64bit:
  image: "alpine:3.12"
@@ -268,6 +269,44 @@ 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
+  allow_failure: true
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps.sh
+  script:
+    - ./.gitlab/script/ghcup_cross.sh
+
+test:linux:git:hadrian:
+  stage: test
+  extends:
+    - .test_ghcup_version
+    - .debian
+  variables:
+    GHC_VERSION: "8.10.5"
+    GHC_GIT_TAG: "ghc-9.0.1-release"
+    GHC_GIT_VERSION: "9.0.1"
+    CABAL_VERSION: "3.4.0.0"
+    CROSS: ""
+  needs: []
+  when: manual
+  allow_failure: true
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps.sh
+  script:
+    - ./.gitlab/script/ghcup_git.sh
+
+
 ######## linux 32bit test ########

 test:linux:recommended:32bit:
@@ -286,6 +325,7 @@ test:linux:recommended:armv7:
  variables:
    GHC_VERSION: "8.10.4"
    CABAL_VERSION: "3.4.0.0"
+    CROSS: ""
  when: manual
  needs: []

@@ -295,6 +335,7 @@ test:linux:recommended:aarch64:
  variables:
    GHC_VERSION: "8.10.4"
    CABAL_VERSION: "3.4.0.0"
+    CROSS: ""
  when: manual
  needs: []

@@ -394,6 +435,7 @@ release:linux:armv7:
    ARTIFACT: "armv7-linux-ghcup"
    GHC_VERSION: "8.10.4"
    CABAL_VERSION: "3.4.0.0"
+    CROSS: ""

 release:linux:aarch64:
  stage: release
@@ -407,6 +449,7 @@ release:linux:aarch64:
    ARTIFACT: "aarch64-linux-ghcup"
    GHC_VERSION: "8.10.4"
    CABAL_VERSION: "3.4.0.0"
+    CROSS: ""

 ######## darwin release ########

--- a/.gitlab/before_script/linux/install_deps.sh
+++ b/.gitlab/before_script/linux/install_deps.sh
@@ -9,6 +9,13 @@ 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
@@ -57,9 +64,9 @@ case "${ARCH}" in
 		chmod +x ghcup-bin

 		./ghcup-bin upgrade -i -f
-		./ghcup-bin install ${GHC_VERSION}
-		./ghcup-bin set ${GHC_VERSION}
-		./ghcup-bin install-cabal ${CABAL_VERSION}
+		./ghcup-bin install ghc ${GHC_VERSION}
+		./ghcup-bin set ghc ${GHC_VERSION}
+		./ghcup-bin install cabal ${CABAL_VERSION}

 		;;
 esac
--- a/.gitlab/script/ghcup_cross.sh
+++ b/.gitlab/script/ghcup_cross.sh
@@ -0,0 +1,52 @@
+#!/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" ]
+
--- a/.gitlab/script/ghcup_git.sh
+++ b/.gitlab/script/ghcup_git.sh
@@ -0,0 +1,52 @@
+#!/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) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} -- --enable-unregisterised
+eghcup set ghc ${GHC_GIT_VERSION}
+
+[ `$(eghcup whereis ghc ${GHC_GIT_VERSION}) --numeric-version` = "${GHC_GIT_VERSION}" ]
+
+# nuke
+eghcup nuke
+[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
+
--- a/.gitlab/script/ghcup_release.sh
+++ b/.gitlab/script/ghcup_release.sh
@@ -15,10 +15,6 @@ 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
--- a/.gitlab/script/ghcup_version.sh
+++ b/.gitlab/script/ghcup_version.sh
@@ -26,11 +26,6 @@ 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
@@ -83,10 +78,10 @@ ghcup-gen check -f ghcup-${JSON_VERSION}.yaml

 eghcup --numeric-version

-eghcup install ${GHC_VERSION}
+eghcup install ghc ${GHC_VERSION}
 [ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
-eghcup set ${GHC_VERSION}
-eghcup install-cabal ${CABAL_VERSION}
+eghcup set ghc ${GHC_VERSION}
+eghcup install cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]

 cabal --version
@@ -112,17 +107,19 @@ 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 install 8.10.3
+		eghcup --downloader=wget prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
 	else # test wget a bit
-		eghcup install 8.10.3
+		eghcup prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
 	fi
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
-	eghcup set 8.10.3
+	eghcup --offline 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 rm 8.10.3
+	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]

 	if [ "${OS}" = "DARWIN" ] ; then
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@@ -12,7 +12,7 @@ import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Platform
-import           GHCup.Types
+import           GHCup.Types                  hiding ( LeanAppState (..) )
 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 getDirs
+    dirs <- liftIO getAllDirs

    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) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
+    let appstate = AppState (Settings True False Never Curl False GHCupURL False) 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 (settings appstate) dli tmpUnpack Nothing
+            _ <- liftE $ download dli tmpUnpack Nothing
            pure Nothing
          Right _ -> do
-            p <- liftE $ downloadCached (settings appstate) dirs dli Nothing
+            p <- liftE $ downloadCached dli Nothing
            fmap (Just . head . splitDirectories . head)
              . liftE
              . getArchiveFiles
              $ p
          Left ShimGen -> do
            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
+            _ <- liftE $ download dli tmpUnpack Nothing
            pure Nothing
    case r of
      VRight (Just basePath) -> do
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@@ -13,7 +13,7 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
-import           GHCup.Types
+import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
@@ -53,15 +53,13 @@ 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


 hiddenTools :: [Tool]
-hiddenTools = [Stack]
+hiddenTools = []


 data BrickData = BrickData
@@ -171,7 +169,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
          | elem Latest lTag && not lInstalled =
              withAttr "hooray"
          | otherwise = id
-        active = if b then forceAttr "active" else id
+        active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
    in  hooray $ active $ dim
          (   marks
          <+> padLeft (Pad 2)
@@ -259,7 +257,7 @@ app attrs dimAttrs =
  , appHandleEvent  = eventHandler
  , appStartEvent   = return
  , appAttrMap      = const attrs
-  , appChooseCursor = neverShowCursor
+  , appChooseCursor = showFirstCursor
  }

 defaultAttributes :: Bool -> AttrMap
@@ -550,13 +548,14 @@ changelog' _ (_, ListResult {..}) = do
 settings' :: IORef AppState
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO $ do
-  dirs <- getDirs
+  dirs <- getAllDirs
  newIORef $ AppState (Settings { cache      = True
                                , noVerify   = False
                                , keepDirs   = Never
                                , downloader = Curl
                                , verbose    = False
                                , urlSource  = GHCupURL
+                                , noNetwork  = False
                                , ..
                                })
                      dirs
@@ -578,9 +577,8 @@ logger' = unsafePerformIO

 brickMain :: AppState
          -> LoggerConfig
-          -> GHCupInfo
          -> IO ()
-brickMain s l gi = do
+brickMain s l = do
  writeIORef settings' s
  -- logger interpreter
  writeIORef logger'   l
@@ -588,7 +586,7 @@ brickMain s l gi = do

  no_color <- isJust <$> lookupEnv "NO_COLOR"

-  eAppData <- getAppData (Just gi)
+  eAppData <- getAppData (Just $ ghcupInfo s)
  case eAppData of
    Right ad ->
      defaultMain
@@ -596,7 +594,7 @@ brickMain s l gi = do
          (BrickState ad
                    defaultAppSettings
                    (constructList ad defaultAppSettings Nothing)
-                    (keyBindings s)
+                    (keyBindings (s :: AppState))

          )
        $> ()
@@ -620,7 +618,7 @@ getGHCupInfo = do
    . flip runReaderT settings
    . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
    $ liftE
-    $ getDownloadsF (GT.settings settings) (GT.dirs settings)
+    $ getDownloadsF

  case r of
    VRight a -> pure $ Right a
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
--- a/63
+++ b/63
@@ -290,7 +290,16 @@ ask_bashrc() {

 			read -r bashrc_answer </dev/tty
 		else
-			return 1
+			# On windows .bashrc isn't an important user config, so we adjust it
+			# always. On other platforms, let's be a bit more conservative.
+			case "${plat}" in
+					MSYS*|MINGW*)
+						return 1
+						;;
+					*)
+						return 0
+						;;
+			esac
 		fi
 		case $bashrc_answer in
 			[Pp]* | "")
@@ -326,7 +335,7 @@ adjust_bashrc() {
 			;;
 		2)
 			cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
-				export PATH="\$HOME/.cabal/bin:\$PATH:${GHCUP_BIN}"
+				export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}"
 				EOF
 			;;
 		*) ;;
@@ -335,7 +344,10 @@ adjust_bashrc() {
 	case $1 in
 		1 | 2)
 			case $MY_SHELL in
-				"") break ;;
+				"")
+					warn_path "Couldn't figure out login shell!"
+					return
+					;;
 				fish)
 					mkdir -p "${GHCUP_PROFILE_FILE%/*}"
 					sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
@@ -365,15 +377,30 @@ adjust_bashrc() {
 					echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
 					break ;;
 			esac
+			echo
+			echo "==============================================================================="
+			echo
 			warn "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
 			warn "or type \"source ${GHCUP_DIR}/env\" to apply them in your current terminal session."
 			return
 			;;
 		*)
+			warn_path
 			;;
 	esac
 }

+warn_path() {
+	echo
+	echo "==============================================================================="
+	echo
+	[ -n "$1" ] && warn "$1"
+	yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
+	yellow "To do so, you may want run 'source $GHCUP_DIR/env' in your current terminal"
+	yellow "session as well as your shell configuration (e.g. ~/.bashrc)."
+
+}
+
 adjust_cabal_config() {
 	edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$HOME"/AppData/Roaming/cabal/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
 }
@@ -615,36 +642,8 @@ case $ask_stack_answer in
 esac


+adjust_bashrc $ask_bashrc_answer

-# short-circuit script based on platform
-case "${plat}" in
-        MSYS*|MINGW*)
-			# For windows we always adjust bashrc, since it's inside msys2
-			adjust_bashrc $adjust_bashrc_answer
-			;;
-		*)
-        	if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
-				case $ask_bashrc_answer in
-					1 | 2)
-						echo
-						echo "==============================================================================="
-						echo
-						yellow "In order to run ghc and cabal, start a new shell or"
-						yellow "run 'source $GHCUP_DIR/env' in your current shell session."
-						adjust_bashrc $adjust_bashrc_answer
-						;;
-					*)
-						echo
-						echo "==============================================================================="
-						echo
-						yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
-						yellow "You may want to source '$GHCUP_DIR/env' in your shell"
-						yellow "configuration to do so (e.g. ~/.bashrc)."
-						;;
-				esac
-			fi
-			;;
-esac

 _done

--- a/cabal.project
+++ b/cabal.project
@@ -8,6 +8,11 @@ package ghcup
    tests: True
    flags: +tui

+source-repository-package
+    type: git
+    location: https://github.com/jtdaugherty/brick.git
+    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
+
 source-repository-package
    type: git
    location: https://github.com/Bodigrim/tar
--- a/ghcup-0.0.5.yaml
+++ b/ghcup-0.0.5.yaml
@@ -96,6 +96,7 @@ toolRequirements:
      Linux_Alpine:
        unknown_versioning:
          distroPKGs:
+          - binutils-gold
          - curl
          - gcc
          - g++
@@ -2155,14 +2156,13 @@ ghcupDownloads:
            unknown_versioning: *stack-251-64
    2.7.1:
      viTags:
-        - Recommended
-        - Latest
+        - old
      viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v271
      viPostInstall: *stack-post
      viArch:
        A_64:
          Linux_UnknownLinux:
-            unknown_versioning: &stack-64
+            unknown_versioning: &stack-271-64
              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-linux-x86_64.tar.gz
              dlHash: 2bc47749ee4be5eccb52a2d4a6a00b0f3b28b92517742b40c675836d7db2777d
              dlSubdir:
@@ -2180,5 +2180,33 @@ ghcupDownloads:
              dlSubdir:
                RegexDir: "stack-.*"
          Linux_Alpine:
-            unknown_versioning: *stack-64
+            unknown_versioning: *stack-271-64
+    2.7.3:
+      viTags:
+        - Latest
+        - Recommended
+      viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v273
+      viPostInstall: *stack-post
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &stack-273-64
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-linux-x86_64.tar.gz
+              dlHash: a6c090555fa1c64aa61c29aa4449765a51d79e870cf759cde192937cd614e72b
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-osx-x86_64.tar.gz
+              dlHash: 42e5000a00af44a7b26852421ac63ce75f510ad1a97742cb131107088ee9fe30
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-windows-x86_64.tar.gz
+              dlHash: e6ba12e0ecabf0df2567d88a0d247da238bc114bcccfca4195f5e86472c9330c
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Linux_Alpine:
+            unknown_versioning: *stack-273-64

--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -116,7 +116,7 @@ library
    , megaparsec            >=8.0.0      && <9.1
    , monad-logger          ^>=0.3.31
    , mtl                   ^>=2.2
-    , optics                >=0.2        && <0.5
+    , optics                ^>=0.4
    , optics-vl             ^>=0.2
    , os-release            ^>=1.0.0
    , parsec                ^>=3.1
@@ -202,6 +202,7 @@ executable ghcup
    -fwarn-incomplete-record-updates -threaded

  build-depends:
+    , async                 ^>=2.2.3
    , base                  >=4.13     && <5
    , bytestring            ^>=0.10
    , containers            ^>=0.6
@@ -232,7 +233,7 @@ executable ghcup
    cpp-options:   -DBRICK
    other-modules: BrickMain
    build-depends:
-      , brick         >=0.5    && <0.62
+      , brick         >=0.5    && <0.64
      , transformers  ^>=0.5
      , vector        ^>=0.12
      , vty           >=5.28.2 && <5.34
@@ -279,7 +280,7 @@ executable ghcup-gen
    , haskus-utils-variant  >=3.0      && <3.2
    , monad-logger          ^>=0.3.31
    , mtl                   ^>=2.2
-    , optics                >=0.2      && <0.5
+    , optics                ^>=0.4
    , optparse-applicative  >=0.15.1.0 && <0.17
    , pretty                ^>=1.1.3.1
    , pretty-terminal       ^>=0.1.0.0
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
--- a/lib/GHCup/Download.hs
+++ b/lib/GHCup/Download.hs
@@ -107,32 +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
+                 , MonadMask m
                 )
-              => Settings
-              -> Dirs
-              -> Excepts
+              => Excepts
                   '[JSONError , DownloadFailed , FileDoesNotExistError]
                   m
                   GHCupInfo
-getDownloadsF settings@Settings{ urlSource } dirs = do
+getDownloadsF = do
+  Settings { urlSource } <- lift getSettings
  case urlSource of
-    GHCupURL -> liftE $ getBase dirs settings
-    (OwnSource url) -> do
-      bs <- reThrowAll DownloadFailed $ downloadBS (downloader settings) url
-      lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
+    GHCupURL -> liftE $ getBase ghcupURL
+    (OwnSource url) -> liftE $ getBase url
    (OwnSpec av) -> pure av
    (AddSource (Left ext)) -> do
-      base <- liftE $ getBase dirs settings
+      base <- liftE $ getBase ghcupURL
      pure (mergeGhcupInfo base ext)
    (AddSource (Right uri)) -> do
-      base <- liftE $ getBase dirs settings
-      bsExt <- reThrowAll DownloadFailed $ downloadBS (downloader settings) uri
-      ext <- lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bsExt)
+      base <- liftE $ getBase ghcupURL
+      ext  <- liftE $ getBase uri
      pure (mergeGhcupInfo base ext)

    where
@@ -149,33 +149,50 @@ getDownloadsF settings@Settings{ urlSource } dirs = do
    in GHCupInfo tr newDownloads newGlobalTools


-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)
+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


-getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m)
-        => Dirs
-        -> Settings
+getBase :: ( MonadReader env m
+           , HasDirs env
+           , HasSettings env
+           , MonadFail m
+           , MonadIO m
+           , MonadCatch m
+           , MonadLogger m
+           , MonadMask m
+           )
+        => URI
        -> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
-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
+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!)|]
+
  -- 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.
@@ -185,11 +202,15 @@ getBase dirs@Dirs{..} Settings{ downloader }  =
  -- than the local file.
  --
  -- Always save the local file with the mod time of the remote file.
-  smartDl :: forall m1
-           . ( MonadCatch m1
+  smartDl :: forall m1 env1
+           . ( MonadReader env1 m1
+             , HasDirs env1
+             , HasSettings env1
+             , MonadCatch m1
             , MonadIO m1
             , MonadFail m1
             , MonadLogger m1
+             , MonadMask m1
             )
          => URI
          -> Excepts
@@ -200,13 +221,15 @@ getBase dirs@Dirs{..} Settings{ downloader }  =
                , 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
@@ -237,12 +260,12 @@ getBase dirs@Dirs{..} Settings{ downloader }  =

   where
    dlWithMod modTime json_file = do
-      bs <- liftE $ downloadBS downloader uri'
+      bs <- liftE $ downloadBS uri'
      liftIO $ writeFileWithModTime modTime json_file bs
      pure bs
    dlWithoutMod json_file = do
-      bs <- liftE $ downloadBS downloader uri'
-      liftIO $ hideError doesNotExistErrorType $ rmFile json_file
+      bs <- liftE $ downloadBS uri'
+      lift $ hideError doesNotExistErrorType $ recycleFile json_file
      liftIO $ L.writeFile json_file bs
      liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
      pure bs
@@ -279,39 +302,46 @@ getBase dirs@Dirs{..} Settings{ downloader }  =
    setModificationTime path utctime


-getDownloadInfo :: Tool
+getDownloadInfo :: ( MonadReader env m
+                   , HasPlatformReq env
+                   , HasGHCupInfo env
+                   )
+                => Tool
                -> Version
                -- ^ tool version
-                -> 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
-  )
+                -> Excepts
+                     '[NoDownload]
+                     m
+                     DownloadInfo
+getDownloadInfo t v = do
+  (PlatformRequest a p mv) <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo

- where
-  with_distro        = distro_preview id id
-  without_distro_ver = distro_preview id (const Nothing)
-  without_distro     = distro_preview (set _Linux UnknownLinux) (const Nothing)
+  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)

-  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
+  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
+    )


 -- | Tries to download from the given http or https url
@@ -321,17 +351,19 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
 --   2. otherwise create a random file
 --
 -- The file must not exist.
-download :: ( MonadMask m
+download :: ( MonadReader env m
+            , HasSettings env
+            , HasDirs env
+            , MonadMask m
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
            )
-         => Settings
-         -> DownloadInfo
+         => DownloadInfo
         -> FilePath          -- ^ destination dir
         -> Maybe FilePath    -- ^ optional filename
         -> Excepts '[DigestError , DownloadFailed] m FilePath
-download settings@Settings{ downloader } dli dest mfn
+download dli dest mfn
  | scheme == "https" = dl
  | scheme == "http"  = dl
  | scheme == "file"  = cp
@@ -356,12 +388,14 @@ download settings@Settings{ downloader } dli dest mfn

    -- download
    flip onException
-         (liftIO $ hideError doesNotExistErrorType $ rmFile destFile)
+         (lift $ hideError doesNotExistErrorType $ recycleFile destFile)
     $ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
          (\e ->
-            liftIO (hideError doesNotExistErrorType $ rmFile destFile)
+            lift (hideError doesNotExistErrorType $ recycleFile 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
@@ -377,58 +411,66 @@ download settings@Settings{ downloader } dli dest mfn
                  liftE $ downloadToFile https host fullPath port destFile
 #endif

-    liftE $ checkDigest settings dli destFile
+    liftE $ checkDigest 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 :: ( MonadMask m
+downloadCached :: ( MonadReader env m
+                  , HasDirs env
+                  , HasSettings env
+                  , MonadMask m
                  , MonadResource m
                  , MonadThrow m
                  , MonadLogger m
                  , MonadIO m
                  , MonadUnliftIO m
                  )
-               => Settings
-               -> Dirs
-               -> DownloadInfo
+               => DownloadInfo
               -> Maybe FilePath  -- ^ optional filename
               -> Excepts '[DigestError , DownloadFailed] m FilePath
-downloadCached settings@Settings{ cache } dirs dli mfn = do
+downloadCached dli mfn = do
+  Settings{ cache } <- lift getSettings
  case cache of
-    True -> downloadCached' settings dirs dli mfn
+    True -> downloadCached' dli mfn Nothing
    False -> do
      tmp <- lift withGHCupTmpDir
-      liftE $ download settings dli tmp mfn
+      liftE $ download dli tmp mfn


-downloadCached' :: ( MonadMask m
+downloadCached' :: ( MonadReader env m
+                   , HasDirs env
+                   , HasSettings env
+                   , MonadMask m
                   , MonadThrow m
                   , MonadLogger m
                   , MonadIO m
                   , MonadUnliftIO m
                   )
-                => Settings
-                -> Dirs
-                -> DownloadInfo
+                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
+                -> Maybe FilePath  -- ^ optional destination dir (default: cacheDir)
                -> Excepts '[DigestError , DownloadFailed] m FilePath
-downloadCached' settings Dirs{..} dli mfn = do
+downloadCached' dli mfn mDestDir = do
+  Dirs { cacheDir } <- lift getDirs
+  let destDir = fromMaybe cacheDir mDestDir
  let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
-  let cachfile = cacheDir </> fn
+  let cachfile = destDir </> fn
  fileExists <- liftIO $ doesFileExist cachfile
  if
    | fileExists -> do
-      liftE $ checkDigest settings dli cachfile
+      liftE $ checkDigest dli cachfile
      pure cachfile
-    | otherwise -> liftE $ download settings dli cacheDir mfn
+    | otherwise -> liftE $ download dli destDir mfn



@@ -441,9 +483,13 @@ downloadCached' settings Dirs{..} dli mfn = do


 -- | This is used for downloading the JSON.
-downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
-           => Downloader
-           -> URI
+downloadBS :: ( MonadReader env m
+              , HasSettings env
+              , MonadCatch m
+              , MonadIO m
+              , MonadLogger m
+              )
+           => URI
           -> Excepts
                '[ FileDoesNotExistError
                 , HTTPStatusError
@@ -452,10 +498,11 @@ downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
                 , NoLocationHeader
                 , TooManyRedirs
                 , ProcessError
+                 , NoNetwork
                 ]
                m
                L.ByteString
-downloadBS downloader uri'
+downloadBS uri'
  | scheme == "https"
  = dl True
  | scheme == "http"
@@ -475,6 +522,8 @@ downloadBS downloader 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
@@ -499,12 +548,18 @@ downloadBS downloader uri'
 #endif


-checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m)
-            => Settings
-            -> DownloadInfo
+checkDigest :: ( MonadReader env m
+               , HasDirs env
+               , HasSettings env
+               , MonadIO m
+               , MonadThrow m
+               , MonadLogger m
+               )
+            => DownloadInfo
            -> FilePath
            -> Excepts '[DigestError] m ()
-checkDigest Settings{ noVerify } dli file = do
+checkDigest dli file = do
+  Settings{ noVerify } <- lift getSettings
  let verify = not noVerify
  when verify $ do
    let p' = takeFileName file
--- a/lib/GHCup/Errors.hs
+++ b/lib/GHCup/Errors.hs
@@ -31,8 +31,8 @@ import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant
-import           Text.PrettyPrint
-import           Text.PrettyPrint.HughesPJClass
+import           Text.PrettyPrint               hiding ( (<>) )
+import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           URI.ByteString


@@ -233,6 +233,20 @@ 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.|]
+
+data HadrianNotFound = HadrianNotFound
+  deriving Show
+
+instance Pretty HadrianNotFound where
+  pPrint HadrianNotFound =
+    text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|]
+

    -------------------------
    --[ High-level errors ]--
@@ -249,11 +263,11 @@ deriving instance Show DownloadFailed


 -- | A build failed.
-data BuildFailed = forall es . Show (V es) => BuildFailed FilePath (V es)
+data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)

 instance Pretty BuildFailed where
  pPrint (BuildFailed path reason) =
-    text [i|BuildFailed failed in dir "#{path}": #{reason}|]
+    text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason

 deriving instance Show BuildFailed

--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@@ -1,9 +1,12 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DuplicateRecordFields #-}

 {-|
 Module      : GHCup.Types
@@ -294,11 +297,12 @@ 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
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

 data UserKeyBindings = UserKeyBindings
  { kUp        :: Maybe Key
@@ -346,12 +350,21 @@ 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
@@ -359,6 +372,7 @@ data Settings = Settings
  , downloader :: Downloader
  , verbose    :: Bool
  , urlSource  :: URLSource
+  , noNetwork  :: Bool
  }
  deriving (Show, GHC.Generic)

@@ -370,6 +384,7 @@ data Dirs = Dirs
  , cacheDir :: FilePath
  , logsDir  :: FilePath
  , confDir  :: FilePath
+  , recycleDir :: FilePath -- mainly used on windows
  }
  deriving (Show, GHC.Generic)

@@ -507,4 +522,3 @@ 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

-
--- a/lib/GHCup/Types/Optics.hs
+++ b/lib/GHCup/Types/Optics.hs
@@ -1,4 +1,11 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}

 {-|
 Module      : GHCup.Types.Optics
@@ -13,6 +20,7 @@ module GHCup.Types.Optics where

 import           GHCup.Types

+import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Optics
 import           URI.ByteString
@@ -58,3 +66,85 @@ 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
+
+
+instance LabelOptic "dirs" A_Lens Dirs Dirs Dirs Dirs where
+  labelOptic = lens id (\_ d -> d)
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -53,6 +53,7 @@ import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
+import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
 #if defined(IS_WINDOWS)
 import           Data.Bits
 #endif
@@ -78,6 +79,7 @@ import           System.Win32.Console
 import           System.Win32.File     hiding ( copyFile )
 import           System.Win32.Types
 #endif
+import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 import           URI.ByteString

@@ -103,73 +105,79 @@ import qualified Text.Megaparsec               as MP


 -- | The symlink destination of a ghc tool.
-ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
+ghcLinkDestination :: ( MonadReader env m
+                      , HasDirs env
+                      , MonadThrow m, MonadIO m)
                   => FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
                   -> GHCTargetVersion
                   -> m FilePath
 ghcLinkDestination tool ver = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  ghcd <- ghcupGHCDir ver
  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))


 -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-rmMinorSymlinks :: ( MonadReader AppState m
+rmMinorSymlinks :: ( MonadReader env m
+                   , HasDirs env
                   , MonadIO m
                   , MonadLogger m
                   , MonadThrow m
                   , MonadFail m
-                   , MonadReader AppState m
+                   , MonadMask m
                   )
                => GHCTargetVersion
                -> Excepts '[NotInstalled] m ()
 rmMinorSymlinks tv@GHCTargetVersion{..} = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs

  files                         <- liftE $ ghcToolFiles tv
  forM_ files $ \f -> do
    let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
    let fullF = binDir </> f_xyz
    lift $ $(logDebug) [i|rm -f #{fullF}|]
-    liftIO $ hideError doesNotExistErrorType $ rmLink fullF
+    lift $ hideError doesNotExistErrorType $ rmLink fullF


 -- | Removes the set ghc version for the given target, if any.
-rmPlain :: ( MonadReader AppState m
+rmPlain :: ( MonadReader env m
+           , HasDirs env
           , MonadLogger m
           , MonadThrow m
           , MonadFail m
           , MonadIO m
+           , MonadMask m
           )
        => Maybe Text -- ^ target
        -> Excepts '[NotInstalled] m ()
 rmPlain target = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs
  mtv                           <- lift $ ghcSet target
  forM_ mtv $ \tv -> do
    files <- liftE $ ghcToolFiles tv
    forM_ files $ \f -> do
      let fullF = binDir </> f <> exeExt
      lift $ $(logDebug) [i|rm -f #{fullF}|]
-      liftIO $ hideError doesNotExistErrorType $ rmLink fullF
+      lift $ hideError doesNotExistErrorType $ rmLink fullF
    -- old ghcup
    let hdc_file = binDir </> "haddock-ghc" <> exeExt
    lift $ $(logDebug) [i|rm -f #{hdc_file}|]
-    liftIO $ hideError doesNotExistErrorType $ rmLink hdc_file
+    lift $ hideError doesNotExistErrorType $ rmLink hdc_file


 -- | Remove the major GHC symlink, e.g. ghc-8.6.
-rmMajorSymlinks :: ( MonadReader AppState m
+rmMajorSymlinks :: ( MonadReader env m
+                   , HasDirs env
                   , MonadIO m
                   , MonadLogger m
                   , MonadThrow m
                   , MonadFail m
-                   , MonadReader AppState m
+                   , MonadMask m
                   )
                => GHCTargetVersion
                -> Excepts '[NotInstalled] m ()
 rmMajorSymlinks tv@GHCTargetVersion{..} = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs
  (mj, mi) <- getMajorMinorV _tvVersion
  let v' = intToText mj <> "." <> intToText mi

@@ -178,7 +186,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
    let f_xy = f <> "-" <> T.unpack v' <> exeExt
    let fullF = binDir </> f_xy
    lift $ $(logDebug) [i|rm -f #{fullF}|]
-    liftIO $ hideError doesNotExistErrorType $ rmLink fullF
+    lift $ hideError doesNotExistErrorType $ rmLink fullF



@@ -189,26 +197,26 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do


 -- | Whether the given GHC versin is installed.
-ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
+ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, 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 AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
+ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, 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 AppState m, MonadThrow m, MonadIO m)
+ghcSet :: (MonadReader env m, HasDirs env, 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
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
  let ghcBin = binDir </> ghc <> exeExt

@@ -239,7 +247,7 @@ ghcSet mtarget = do

 -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
 -- If a dir cannot be parsed, returns left.
-getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either FilePath GHCTargetVersion]
+getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
 getInstalledGHCs = do
  ghcdir <- ghcupGHCBaseDir
  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
@@ -249,10 +257,15 @@ getInstalledGHCs = do


 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
-getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledCabals :: ( MonadLogger m
+                      , MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , MonadCatch m
+                      )
                   => m [Either FilePath Version]
 getInstalledCabals = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..} <- getDirs
  bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
@@ -264,16 +277,16 @@ getInstalledCabals = do


 -- | Whether the given cabal version is installed.
-cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 cabalInstalled ver = do
  vers <- fmap rights getInstalledCabals
  pure $ elem ver vers


 -- Return the currently set cabal version, if any.
-cabalSet :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 cabalSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let cabalbin = binDir </> "cabal" <> exeExt

  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -317,10 +330,10 @@ cabalSet = do

 -- | Get all installed hls, by matching on
 -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
-getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                 => m [Either FilePath Version]
 getInstalledHLSs = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -337,10 +350,10 @@ getInstalledHLSs = do

 -- | Get all installed stacks, by matching on
 -- @~\/.ghcup\/bin/stack-<\stackver\>@.
-getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                   => m [Either FilePath Version]
 getInstalledStacks = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -355,9 +368,9 @@ getInstalledStacks = do

 -- Return the currently set stack version, if any.
 -- TODO: there's a lot of code duplication here :>
-stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
+stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
 stackSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let stackBin = binDir </> "stack" <> exeExt

  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -395,13 +408,13 @@ stackSet = do
    stripRelativePath = MP.many (MP.try stripPathComponet)

 -- | Whether the given Stack version is installed.
-stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, 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 AppState m, MonadCatch m) => Version -> m Bool
+hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 hlsInstalled ver = do
  vers <- fmap rights getInstalledHLSs
  pure $ elem ver vers
@@ -409,9 +422,9 @@ hlsInstalled ver = do


 -- Return the currently set hls version, if any.
-hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 hlsSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt

  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -443,7 +456,8 @@ hlsSet = do


 -- | Return the GHC versions the currently selected HLS supports.
-hlsGHCVersions :: ( MonadReader AppState m
+hlsGHCVersions :: ( MonadReader env m
+                  , HasDirs env
                  , MonadIO m
                  , MonadThrow m
                  , MonadCatch m
@@ -466,11 +480,11 @@ hlsGHCVersions = do


 -- | Get all server binaries for an hls version, if any.
-hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
+hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
                  => Version
                  -> m [FilePath]
 hlsServerBinaries ver = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts
@@ -482,12 +496,12 @@ hlsServerBinaries ver = do


 -- | Get the wrapper binary for an hls version, if any.
-hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
+hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
                 => Version
                 -> m (Maybe FilePath)
 hlsWrapperBinary ver = do
-  AppState { dirs = Dirs {..} } <- ask
-  wrapper                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+  Dirs {..}  <- getDirs
+  wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts
      compExtended
@@ -503,7 +517,7 @@ hlsWrapperBinary ver = do


 -- | Get all binaries for an hls version, if any.
-hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [FilePath]
+hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
 hlsAllBinaries ver = do
  hls     <- hlsServerBinaries ver
  wrapper <- hlsWrapperBinary ver
@@ -511,9 +525,9 @@ hlsAllBinaries ver = do


 -- | Get the active symlinks for hls.
-hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [FilePath]
+hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
 hlsSymlinks = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -549,7 +563,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 AppState m, MonadIO m, MonadThrow m)
+getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
               => Int        -- ^ major version component
               -> Int        -- ^ minor version component
               -> Maybe Text -- ^ the target triple
@@ -729,19 +743,6 @@ 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 ]--
@@ -754,7 +755,7 @@ getDownloader = ask <&> downloader . settings
 -- Returns unversioned relative files without extension, e.g.:
 --
 --   - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
-ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
+ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
             => GHCTargetVersion
             -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
@@ -817,7 +818,12 @@ ghcUpSrcBuiltFile = ".ghcup_src_built"


 -- | Calls gmake if it exists in PATH, otherwise make.
-make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
+make :: ( MonadThrow m
+        , MonadIO m
+        , MonadReader env m
+        , HasDirs env
+        , HasSettings env
+        )
     => [String]
     -> Maybe FilePath
     -> m (Either ProcessError ())
@@ -827,7 +833,7 @@ make args workdir = do
  let mymake = if has_gmake then "gmake" else "make"
  execLogged mymake args workdir "ghc-make" Nothing

-makeOut :: (MonadReader AppState m, MonadIO m)
+makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
        => [String]
        -> Maybe FilePath
        -> m CapturedProcess
@@ -840,7 +846,7 @@ makeOut args workdir = do

 -- | Try to apply patches in order. Fails with 'PatchFailed'
 -- on first failure.
-applyPatches :: (MonadReader AppState m, MonadLogger m, MonadIO m)
+applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
             => FilePath   -- ^ dir containing patches
             -> FilePath   -- ^ dir to apply patches in
             -> Excepts '[PatchFailed] m ()
@@ -858,7 +864,7 @@ applyPatches pdir ddir = do


 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
-darwinNotarization :: (MonadReader AppState m, MonadIO m)
+darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
                   => Platform
                   -> FilePath
                   -> m (Either ProcessError ())
@@ -881,20 +887,27 @@ 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 AppState m, MonadIO m, MonadMask m)
-               => FilePath          -- ^ build directory (cleaned up depending on Settings)
+runBuildAction :: ( Pretty (V e)
+                  , Show (V e)
+                  , MonadReader env m
+                  , HasDirs env
+                  , HasSettings env
+                  , MonadIO m
+                  , MonadMask m
+                  , MonadLogger m
+                  , MonadUnliftIO 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
-  AppState { settings = Settings {..} } <- lift ask
+  Settings {..} <- lift getSettings
  let exAction = do
        forM_ instdir $ \dir ->
-          liftIO $ hideError doesNotExistErrorType $ rmPath dir
+          lift $ hideError doesNotExistErrorType $ recyclePathForcibly dir
        when (keepDirs == Never)
-          $ liftIO
-          $ hideError doesNotExistErrorType
-          $ rmPath bdir
+          $ lift $ rmBDir bdir
  v <-
    flip onException exAction
    $ catchAllE
@@ -903,10 +916,20 @@ runBuildAction bdir instdir action = do
          throwE (BuildFailed bdir es)
        ) action

-  when (keepDirs == Never || keepDirs == Errors) $ liftIO $ rmPath bdir
+  when (keepDirs == Never || keepDirs == Errors) $ lift $ rmBDir bdir
  pure v


+-- | Remove a build directory, ignoring if it doesn't exist and gracefully
+-- printing other errors without crashing.
+rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
+rmBDir dir = withRunInIO (\run -> run $
+           liftIO $ handleIO (\e -> run $ $(logWarn)
+               [i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
+           $ hideError doesNotExistErrorType
+           $ rmPathForcibly dir)
+
+
 getVersionInfo :: Version
               -> Tool
               -> GHCupDownloads
@@ -993,13 +1016,13 @@ pathIsLink = pathIsSymbolicLink
 #endif


-rmLink :: FilePath -> IO ()
+rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
 #if defined(IS_WINDOWS)
 rmLink fp = do
-  hideError doesNotExistErrorType . liftIO . rmFile $ fp
-  hideError doesNotExistErrorType . liftIO . rmFile $ (dropExtension fp <.> "shim")
+  hideError doesNotExistErrorType . recycleFile $ fp
+  hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
 #else
-rmLink = hideError doesNotExistErrorType . liftIO . rmFile
+rmLink = hideError doesNotExistErrorType . recycleFile
 #endif


@@ -1016,7 +1039,8 @@ createLink :: ( MonadMask m
              , MonadThrow m
              , MonadLogger m
              , MonadIO m
-              , MonadReader AppState m
+              , MonadReader env m
+              , HasDirs env
              , MonadUnliftIO m
              , MonadFail m
              )
@@ -1025,7 +1049,7 @@ createLink :: ( MonadMask m
           -> m ()
 createLink link exe = do
 #if defined(IS_WINDOWS)
-  AppState { dirs } <- ask
+  dirs <- getDirs
  let shimGen = cacheDir dirs </> "gs.exe"

  let shim = dropExtension exe <.> "shim"
@@ -1036,14 +1060,14 @@ createLink link exe = do
      shimContents = "path = " <> fullLink

  $(logDebug) [i|rm -f #{exe}|]
-  liftIO $ rmLink exe
+  rmLink exe

  $(logDebug) [i|ln -s #{fullLink} #{exe}|]
  liftIO $ copyFile shimGen exe
  liftIO $ writeFile shim shimContents
 #else
  $(logDebug) [i|rm -f #{exe}|]
-  liftIO $ hideError doesNotExistErrorType $ rmFile exe
+  hideError doesNotExistErrorType $ recycleFile exe

  $(logDebug) [i|ln -s #{link} #{exe}|]
  liftIO $ createFileLink link exe
@@ -1054,21 +1078,25 @@ ensureGlobalTools :: ( MonadMask m
                     , MonadThrow m
                     , MonadLogger m
                     , MonadIO m
-                     , MonadReader AppState m
+                     , MonadReader env m
+                     , HasDirs env
+                     , HasSettings env
+                     , HasGHCupInfo env
                     , MonadUnliftIO m
                     , MonadFail m
                     )
                  => Excepts '[DigestError , DownloadFailed, NoDownload] m ()
 ensureGlobalTools = do
 #if defined(IS_WINDOWS)
-  AppState { ghcupInfo = GHCupInfo _ _ gTools, settings, dirs } <- lift ask
+  (GHCupInfo _ _ gTools) <- lift getGHCupInfo
+  dirs <- lift getDirs
  shimDownload <- liftE $ lE @_ @'[NoDownload]
    $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
-  let dl = downloadCached' settings dirs shimDownload (Just "gs.exe")
+  let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
  void $ (\(DigestError _ _) -> do
      lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
      lift $ $(logDebug) [i|rm -f #{shimDownload}|]
-      liftIO $ hideError doesNotExistErrorType $ rmFile (cacheDir dirs </> "gs.exe")
+      lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
      liftE @'[DigestError , DownloadFailed] $ dl
    ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
  pure ()
@@ -1079,17 +1107,24 @@ ensureGlobalTools = do

 -- | Ensure ghcup directory structure exists.
 ensureDirectories :: Dirs -> IO ()
-ensureDirectories dirs = do
-  let Dirs
-        { baseDir
-        , binDir
-        , cacheDir
-        , logsDir
-        , confDir
-        } = dirs
+ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
  createDirRecursive' baseDir
+  createDirRecursive' (baseDir </> "ghc")
  createDirRecursive' binDir
  createDirRecursive' cacheDir
  createDirRecursive' logsDir
  createDirRecursive' confDir
+  createDirRecursive' trashDir
  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)
--- a/lib/GHCup/Utils/Dirs.hs
+++ b/lib/GHCup/Utils/Dirs.hs
@@ -16,7 +16,7 @@ Stability   : experimental
 Portability : portable
 -}
 module GHCup.Utils.Dirs
-  ( getDirs
+  ( getAllDirs
  , ghcupBaseDir
  , ghcupConfigFile
  , ghcupCacheDir
@@ -30,6 +30,7 @@ module GHCup.Utils.Dirs
 #if !defined(IS_WINDOWS)
  , useXDG
 #endif
+  , cleanupTrash
  )
 where

@@ -37,6 +38,7 @@ where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
+import           GHCup.Types.Optics
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude

@@ -52,9 +54,7 @@ import           Data.String.Interpolate
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
-#if !defined(IS_WINDOWS)
 import           System.Directory                                                
-#endif
 import           System.DiskSpace                                                
 import           System.Environment
 import           System.FilePath
@@ -190,13 +190,21 @@ ghcupLogsDir = do
 #endif


-getDirs :: IO Dirs
-getDirs = do
-  baseDir  <- ghcupBaseDir
-  binDir   <- ghcupBinDir
-  cacheDir <- ghcupCacheDir
-  logsDir  <- ghcupLogsDir
-  confDir  <- ghcupConfigDir
+-- | '~/.ghcup/trash'.
+-- Mainly used on windows to improve file removal operations
+ghcupRecycleDir :: IO FilePath
+ghcupRecycleDir = ghcupBaseDir <&> (</> "trash")
+
+
+
+getAllDirs :: IO Dirs
+getAllDirs = do
+  baseDir    <- ghcupBaseDir
+  binDir     <- ghcupBinDir
+  cacheDir   <- ghcupCacheDir
+  logsDir    <- ghcupLogsDir
+  confDir    <- ghcupConfigDir
+  recycleDir <- ghcupRecycleDir
  pure Dirs { .. }


@@ -226,9 +234,9 @@ ghcupConfigFile = do


 -- | ~/.ghcup/ghc by default.
-ghcupGHCBaseDir :: (MonadReader AppState m) => m FilePath
+ghcupGHCBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
 ghcupGHCBaseDir = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  pure (baseDir </> "ghc")


@@ -236,7 +244,7 @@ ghcupGHCBaseDir = do
 -- The dir may be of the form
 --   * armv7-unknown-linux-gnueabihf-8.8.3
 --   * 8.8.4
-ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
+ghcupGHCDir :: (MonadReader env m, HasDirs env, MonadThrow m)
            => GHCTargetVersion
            -> m FilePath
 ghcupGHCDir ver = do
@@ -251,7 +259,15 @@ parseGHCupGHCDir (T.pack -> fp) =
  throwEither $ MP.parse ghcTargetVerP "" fp


-mkGhcupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m) => m FilePath
+mkGhcupTmpDir :: ( MonadReader env m
+                 , HasDirs env
+                 , MonadUnliftIO m
+                 , MonadLogger m
+                 , MonadCatch m
+                 , MonadThrow m
+                 , MonadMask m
+                 , MonadIO m)
+              => m FilePath
 mkGhcupTmpDir = do
  tmpdir <- liftIO getCanonicalTemporaryDirectory

@@ -272,8 +288,25 @@ mkGhcupTmpDir = do
      where t = 10^n


-withGHCupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadResource m, MonadThrow m, MonadIO m) => m FilePath
-withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir) rmPath)
+withGHCupTmpDir :: ( MonadReader env m
+                   , HasDirs env
+                   , MonadUnliftIO m
+                   , MonadLogger m
+                   , MonadCatch m
+                   , MonadResource m
+                   , MonadThrow m
+                   , MonadMask m
+                   , MonadIO m)
+                => m FilePath
+withGHCupTmpDir = snd <$> withRunInIO (\run ->
+  run
+    $ allocate
+        (run mkGhcupTmpDir)
+        (\fp ->
+            handleIO (\e -> run
+                $ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|])
+            . rmPathForcibly
+            $ fp))



@@ -301,3 +334,21 @@ relativeSymlink p1 p2 =
        <> joinPath ([pathSeparator] : drop (length common) d2)


+cleanupTrash :: ( MonadIO m
+                , MonadMask m
+                , MonadLogger m
+                , MonadReader env m
+                , HasDirs env
+                )
+             => m ()
+cleanupTrash = do
+  Dirs { recycleDir } <- getDirs
+  contents <- liftIO $ listDirectory recycleDir
+  if null contents
+  then pure ()
+  else do
+    $(logWarn) [i|Removing leftover files in #{recycleDir}|]
+    forM_ contents (\fp -> handleIO (\e ->
+        $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]
+      ) $ liftIO $ removePathForcibly (recycleDir </> fp))
+
--- a/lib/GHCup/Utils/File/Posix.hs
+++ b/lib/GHCup/Utils/File/Posix.hs
@@ -21,6 +21,7 @@ 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
@@ -74,7 +75,11 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
  SPP.executeFile path True args Nothing


-execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+execLogged :: ( MonadReader env m
+              , HasSettings env
+              , HasDirs env
+              , MonadIO m
+              , MonadThrow m)
           => FilePath         -- ^ thing to execute
           -> [String]         -- ^ args for the thing
           -> Maybe FilePath   -- ^ optionally chdir into this
@@ -82,7 +87,8 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
           -> Maybe [(String, String)] -- ^ optional environment
           -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
-  AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
+  Settings {..} <- getSettings
+  Dirs {..} <- getDirs
  let logfile = logsDir </> lfile <> ".log"
  liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
                   closeFd
--- a/lib/GHCup/Utils/File/Windows.hs
+++ b/lib/GHCup/Utils/File/Windows.hs
@@ -19,6 +19,7 @@ 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
@@ -146,7 +147,11 @@ executeOut path args chdir = do
  pure $ CapturedProcess exit out err


-execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+execLogged :: ( MonadReader env m
+              , HasDirs env
+              , HasSettings env
+              , MonadIO m
+              , MonadThrow m)
           => FilePath         -- ^ thing to execute
           -> [String]         -- ^ args for the thing
           -> Maybe FilePath   -- ^ optionally chdir into this
@@ -154,7 +159,7 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
           -> Maybe [(String, String)] -- ^ optional environment
           -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..} <- getDirs
  let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
      stderrLogfile = logsDir </> lfile <> ".stderr.log"
  cp <- createProcessWithMingwPath ((proc exe args)
--- a/lib/GHCup/Utils/Logger.hs
+++ b/lib/GHCup/Utils/Logger.hs
@@ -14,12 +14,16 @@ Here we define our main logger.
 -}
 module GHCup.Utils.Logger where

+import           GHCup.Types
+import           GHCup.Types.Optics
 import           GHCup.Utils.File
 import           GHCup.Utils.String.QQ

+import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
+import           Control.Monad.Reader
 import           Data.Char               ( ord )
 import           Prelude                 hiding ( appendFile )
 import           System.Console.Pretty
@@ -79,17 +83,21 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
    rawOutter outr


-initGHCupFileLogging :: (MonadIO m) => FilePath -> m FilePath
-initGHCupFileLogging logsDir = do
+initGHCupFileLogging :: ( MonadReader env m
+                        , HasDirs env
+                        , MonadIO m
+                        , MonadMask m
+                        ) => m FilePath
+initGHCupFileLogging = do
+  Dirs { logsDir } <- getDirs
  let logfile = logsDir </> "ghcup.log"
-  liftIO $ do
-    logFiles <- findFiles
-      logsDir
-      (makeRegexOpts compExtended
-                     execBlank
-                     ([s|^.*\.log$|] :: B.ByteString)
-      )
-    forM_ logFiles $ hideError doesNotExistErrorType . rmFile . (logsDir </>)
+  logFiles <- liftIO $ findFiles
+    logsDir
+    (makeRegexOpts compExtended
+                   execBlank
+                   ([s|^.*\.log$|] :: B.ByteString)
+    )
+  forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (logsDir </>)

-    writeFile logfile ""
-    pure logfile
+  liftIO $ writeFile logfile ""
+  pure logfile
--- a/lib/GHCup/Utils/Prelude.hs
+++ b/lib/GHCup/Utils/Prelude.hs
@@ -19,11 +19,16 @@ GHCup specific prelude. Lots of Excepts functionality.
 -}
 module GHCup.Utils.Prelude where

+#if defined(IS_WINDOWS)
+import           GHCup.Types
+#endif
+import           GHCup.Types.Optics
+
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class      ( lift )
+import           Control.Monad.Reader
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 import           Data.List                      ( nub )
@@ -35,6 +40,9 @@ import           Data.Word8
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
 import           System.IO.Error
+#if defined(IS_WINDOWS)
+import           System.IO.Temp
+#endif
 import           System.IO.Unsafe
 import           System.Directory
 import           System.FilePath
@@ -54,6 +62,9 @@ import qualified Data.Text.Lazy                as TL
 import qualified Data.Text.Lazy.Builder        as B
 import qualified Data.Text.Lazy.Builder.Int    as B
 import qualified Data.Text.Lazy.Encoding       as TLE
+#if defined(IS_WINDOWS)
+import qualified System.Win32.File             as Win32
+#endif



@@ -312,17 +323,16 @@ createDirRecursive' p =
 -- | Recursively copy the contents of one directory to another path.
 --
 -- This is a rip-off of Cabal library.
-copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
-copyDirectoryRecursive srcDir destDir = do
+copyDirectoryRecursive :: FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
+copyDirectoryRecursive srcDir destDir doCopy = do
  srcFiles <- getDirectoryContentsRecursive srcDir
-  copyFilesWith copyFile destDir [ (srcDir, f)
-                                   | f <- srcFiles ]
+  copyFilesWith destDir [ (srcDir, f)
+                          | f <- srcFiles ]
  where
    -- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
    -- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
-    copyFilesWith :: (FilePath -> FilePath -> IO ())
-                  -> FilePath -> [(FilePath, FilePath)] -> IO ()
-    copyFilesWith doCopy targetDir srcFiles = do
+    copyFilesWith :: FilePath -> [(FilePath, FilePath)] -> IO ()
+    copyFilesWith targetDir srcFiles = do

      -- Create parent directories for everything
      let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
@@ -367,34 +377,101 @@ getDirectoryContentsRecursive topdir = recurseDirectories [""]
        ignore ['.', '.'] = True
        ignore _          = False

+
 -- https://github.com/haskell/directory/issues/110
 -- https://github.com/haskell/directory/issues/96
 -- https://www.sqlite.org/src/info/89f1848d7f
-rmPath :: (MonadIO m, MonadMask m)
-      => FilePath
-      -> m ()
-rmPath fp =
+recyclePathForcibly :: ( MonadIO m
+                       , MonadReader env m
+                       , HasDirs env
+                       , MonadMask m
+                       )
+                    => FilePath
+                    -> m ()
+recyclePathForcibly fp = do
+#if defined(IS_WINDOWS)
+  Dirs { recycleDir } <- getDirs
+  tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
+  let dest = tmp </> takeFileName fp
+  liftIO (Win32.moveFileEx fp (Just dest) 0)
+      `catch`
+      (\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
+      `finally`
+        (liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
+#else
+  liftIO $ removePathForcibly fp
+#endif
+
+
+rmPathForcibly :: ( MonadIO m
+                  , MonadMask m
+                  )
+               => FilePath
+               -> m ()
+rmPathForcibly fp =
+#if defined(IS_WINDOWS)
+  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+    [\_ -> Handler (\e -> pure $ isPermissionError e)
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
+    ]
+    (\_ -> liftIO $ removePathForcibly fp)
+#else
+  liftIO $ removePathForcibly fp
+#endif
+
+
+rmDirectory :: (MonadIO m, MonadMask m)
+            => FilePath
+            -> m ()
+rmDirectory fp =
 #if defined(IS_WINDOWS)
  recovering (fullJitterBackoff 25000 <> limitRetries 10)
    [\_ -> Handler (\e -> pure $ isPermissionError e)
    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
    ]
-    (\_ -> liftIO $ removePathForcibly fp)
+    (\_ -> liftIO $ removeDirectory fp)
 #else
-  liftIO $ removeDirectoryRecursive fp
+  liftIO $ removeDirectory fp
 #endif


 -- https://www.sqlite.org/src/info/89f1848d7f
 -- https://github.com/haskell/directory/issues/96
-rmFile :: (MonadIO m, MonadMask m)
+recycleFile :: ( MonadIO m
+               , MonadMask m
+               , MonadReader env m
+               , HasDirs env
+               )
+            => FilePath
+            -> m ()
+recycleFile fp = do
+#if defined(IS_WINDOWS)
+  Dirs { recycleDir } <- getDirs
+  liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
+  tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
+  let dest = tmp </> takeFileName fp
+  liftIO (Win32.moveFileEx fp (Just dest) 0)
+    `catch`
+      (\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
+    `finally`
+      (liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
+#else
+  liftIO $ removeFile fp
+#endif
+
+
+rmFile :: ( MonadIO m
+          , MonadMask m
+          )
      => FilePath
      -> m ()
 rmFile fp =
 #if defined(IS_WINDOWS)
  recovering (fullJitterBackoff 25000 <> limitRetries 10)
    [\_ -> Handler (\e -> pure $ isPermissionError e)
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
    ]
    (\_ -> liftIO $ removeFile fp)
@@ -403,6 +480,34 @@ rmFile fp =
 #endif


+rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
+                => FilePath
+                -> m ()
+rmDirectoryLink fp = 
+#if defined(IS_WINDOWS)
+  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+    [\_ -> Handler (\e -> pure $ isPermissionError e)
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
+    ]
+    (\_ -> liftIO $ removeDirectoryLink fp)
+#else
+  liftIO $ removeDirectoryLink fp
+#endif
+
+
+#if defined(IS_WINDOWS)
+recover :: (MonadIO m, MonadMask m) => m a -> m a
+recover action = 
+  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+    [\_ -> Handler (\e -> pure $ isPermissionError e)
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
+    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
+    ]
+    (\_ -> action)
+#endif
+
+
 -- Gathering monoidal values
 traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
 traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
--- a/stack.yaml
+++ b/stack.yaml
@@ -10,6 +10,9 @@ extra-deps:
  - git: https://github.com/Bodigrim/tar
    commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf

+  - git: https://github.com/jtdaugherty/brick.git
+    commit: b3b96cfe66dfd398d338e3feb2b6855e66a35190
+
  - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
  - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
  - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
@@ -31,6 +34,10 @@ 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
Author	SHA1	Message	Date
Julian Ospald	af8c097092	Add binutils gold for alpine pkgs	2021-07-25 19:06:22 +02:00
Julian Ospald	9639e695e2	Unhide stack	2021-07-23 16:13:07 +02:00
Julian Ospald	d2a2bde321	Merge branch 'mlang-cursor'	2021-07-23 14:46:06 +02:00
Julian Ospald	c85ff686b6	Fix cabal.project	2021-07-23 14:45:50 +02:00
Julian Ospald	48d3b3bc3e	Merge branch 'cursor' of https://github.com/mlang/ghcup-hs into mlang-cursor	2021-07-23 14:38:49 +02:00
Julian Ospald	94bd01aaca	Merge branch 'issue-165'	2021-07-23 14:35:07 +02:00
Mario Lang	761b8cc750	Place an (invisible) cursor at the beginning of the active list item This change is to support screen readers which use the cursor location to indicate the focus to the user. Brick.putCursor is unreleased, so grab the latest version from git via extra-deps.	2021-07-23 11:53:28 +02:00
Julian Ospald	3bdc82c99b	Redo file handling wrt #165 and #187	2021-07-22 17:44:03 +02:00
Julian Ospald	db4e9fa432	Merge branch 'issue-192'	2021-07-22 11:39:31 +02:00
Julian Ospald	530c25c6a1	Fix bootstrap haskell bashrc stuff	2021-07-22 11:21:45 +02:00
Julian Ospald	1c2cf98850	Fix file/dir removal on windows, fixes #165	2021-07-21 20:50:58 +02:00
Julian Ospald	b35dbca22e	Merge branch 'issue-183'	2021-07-20 23:54:37 +02:00
Julian Ospald	a4a7f73fb7	Allow to use Hadrian as build system, fixes #35	2021-07-20 23:51:31 +02:00
Julian Ospald	fd0ea3d858	Merge branch 'stack-2.7.3'	2021-07-20 23:11:21 +02:00
Julian Ospald	bbbe52f453	Bump stack to 2.7.3	2021-07-20 22:30:50 +02:00
Julian Ospald	9e181b8820	Allow passing "flavor" to 'ghcup compile ghc' Fixes #183	2021-07-20 13:39:39 +02:00
Julian Ospald	a6108f8319	Fix listVersion wrt #183	2021-07-20 11:54:14 +02:00
Julian Ospald	7a2570019a	Return the version during 'ghcup compile ghc -g <commit>' Fixes #181	2021-07-20 11:42:36 +02:00
Julian Ospald	c5b4e82b48	Merge branch 'issue-187'	2021-07-20 00:57:08 +02:00
Julian Ospald	4ed72fb517	Preserve mtimes on unpacked GHC tarballs on windows wrt #187	2021-07-19 23:33:01 +02:00
Julian Ospald	5217aa0a1d	Merge branch 'issue-180'	2021-07-19 20:55:17 +02:00
Julian Ospald	3caf91c640	Fix ensureGlobalTools	2021-07-19 19:08:43 +02:00
Julian Ospald	eb26a5133f	Merge branch 'www-fix-true'	2021-07-19 17:01:03 +02:00
Julian Ospald	bc13a4555d	Fix runLeanWhereIs on windows	2021-07-19 16:56:28 +02:00
Julian Ospald	eaad2caf25	Add prefetch command	2021-07-19 16:51:40 +02:00
Julian Ospald	6143cdf2e0	Add --offline switch wrt #186	2021-07-19 13:49:24 +02:00
Julian Ospald	2c7176d998	Use LabelOptic and add LeanAppState Wrt #186	2021-07-18 14:39:49 +02:00
Julian Ospald	327b80cf56	Add cross compilation to CI test	2021-07-15 23:26:48 +02:00
Julian Ospald	005c9fbb83	Modernize CI scripts	2021-07-15 22:44:54 +02:00
Julian Ospald	42134fd2a5	Fix whereIsTool for cross	2021-07-15 22:38:42 +02:00
Julian Ospald	bc85a7d9c3	Fix cross installation See https://gitlab.haskell.org/ghc/ghc/-/issues/14297	2021-07-15 20:32:09 +02:00
Julian Ospald	7e14fd4a08	Only run unsafeInterleaveIO when necessary	2021-07-15 20:30:14 +02:00