Fixup

.gitlab-ci.yml

@@ -14,7 +14,7 @@ variables:
 ############################################################
 
 .debian:
-  image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
+  image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
   tags:
     - x86_64-linux
   variables:
@@ -99,11 +99,11 @@ variables:
   script:
     - bash ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.6"
+    JSON_VERSION: "0.0.7"
   artifacts:
     expire_in: 2 week
     paths:
-      - golden
+      - test/golden
       - dist-newstyle/cache/
     when: on_failure
 
@@ -207,7 +207,7 @@ variables:
   only:
     - tags
   variables:
-    JSON_VERSION: "0.0.6"
+    JSON_VERSION: "0.0.7"
 
 ######## stack test ########
 
@@ -240,7 +240,7 @@ test:linux:bootstrap_script:
 test:windows:bootstrap_powershell_script:
   stage: test
   script:
-    - ./bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
+    - ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
   after_script:
     - "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)"
     - "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
@@ -527,15 +527,9 @@ release:windows:
 hlint:
   stage: hlint
   extends:
-    - .alpine:64bit
-  before_script:
-    - ./.gitlab/before_script/linux/alpine/install_deps.sh
+    - .debian
   script:
-    - ./.gitlab/script/hlint.sh
-  variables:
-    GHC_VERSION: "8.10.6"
-    CABAL_VERSION: "3.4.0.0"
-    JSON_VERSION: "0.0.4"
+    - curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
   allow_failure: true
   artifacts:
     expire_in: 2 week

.gitlab/script/ghcup_bootstrap.sh

@@ -24,7 +24,7 @@ export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
 export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
 export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
 
-./bootstrap-haskell
+./scripts/bootstrap/bootstrap-haskell
 
 [ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]
 

.gitlab/script/ghcup_cross.sh

@@ -13,7 +13,7 @@ ecabal() {
 }
 
 eghcup() {
-	ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
+	ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
 }
 
 git describe --always

.gitlab/script/ghcup_git.sh

@@ -13,7 +13,7 @@ ecabal() {
 }
 
 eghcup() {
-	ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
+	ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
 }
 
 git describe --always

.gitlab/script/ghcup_version.sh

@@ -18,9 +18,9 @@ raw_eghcup() {
 
 eghcup() {
 	if [ "${OS}" = "WINDOWS" ] ; then
-		ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
+		ghcup -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
 	else
-		ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
+		ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
 	fi
 }
 
@@ -92,7 +92,7 @@ rm -rf "${GHCUP_DIR}"
 ### manual cli based testing
 
 
-ghcup-gen check -f ghcup-${JSON_VERSION}.yaml
+ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
 
 eghcup --numeric-version
 
@@ -172,10 +172,10 @@ else
 fi
 
 # check that lazy loading works for 'whereis'
-cp "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak"
-echo '**' > "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml"
+cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
+echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
 eghcup whereis ghc $(ghc --numeric-version)
-mv -f "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml"
+mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
 
 eghcup rm $(ghc --numeric-version)
 

README.md

@@ -19,11 +19,12 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
      * [Configuration](#configuration)
      * [Manpages](#manpages)
      * [Shell-completion](#shell-completion)
-     * [Cross support](#cross-support)
+     * [Compiling from sourc](#compiling-from-source)
      * [XDG support](#xdg-support)
      * [Env variables](#env-variables)
      * [Installing custom bindists](#installing-custom-bindists)
      * [Isolated Installs](#isolated-installs)
+     * [CI](#ci)
      * [Tips and tricks](#tips-and-tricks)
    * [Design goals](#design-goals)
    * [How](#how)
@@ -90,7 +91,7 @@ handles your haskell packages and can demand that [a specific version](https://c
 ### Configuration
 
 A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
-explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml).
+explaining all possible configurations can be found in this repo: [config.yaml](./data/config.yaml).
 
 Partial configuration is fine. Command line options always override the config file settings.
 
@@ -101,14 +102,26 @@ For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man`
 
 ### Shell-completion
 
-Shell completions are in `shell-completions`.
+Shell completions are in [scripts/shell-completions](./scripts/shell-completions) directory of this repository.
 
 For bash: install `shell-completions/bash`
 as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
 and make sure your bashrc sources the startup script
 (`/usr/share/bash-completion/bash_completion` on some distros).
 
-### Cross support
+### Compiling from source
+
+Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
+for a list of all available options.
+
+If you need to overwrite the existing `build.mk`, check the default files
+in [data/build_mk](./data/build_mk), copy them somewhere, adjust them and
+pass `--config path/to/build.mk` to `ghcup compile ghc`.
+Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration).
+
+Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
+
+#### Cross support
 
 ghcup can compile and install a cross GHC for any target. However, this
 requires that the build host has a complete cross toolchain and various
@@ -190,6 +203,83 @@ Examples:-
 5. you can even compile ghc to an isolated location.  
    - `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc` 
    ---  
+
+### CI
+
+On windows, ghcup can be installed automatically on a CI runner like so:
+
+```ps
+Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
+```
+
+On linux/darwin/freebsd, run the following on your runner:
+
+```sh
+curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
+```
+
+This will just install `ghcup` and on windows additionally `msys2`.
+
+#### Example github workflow
+
+On github workflows you can use https://github.com/haskell/actions/
+
+If you want to install ghcup manually though, here's an example config:
+
+```yml
+name: Haskell CI
+
+on:
+  push:
+    branches: [ master ]
+  pull_request:
+    branches: [ master ]
+
+jobs:
+  build-cabal:
+
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        os: [ubuntu-latest, macOS-latest, windows-latest]
+        ghc: ['8.10.7', '9.0.1']
+        cabal: ['3.4.0.0']
+
+    steps:
+    - uses: actions/checkout@v2
+
+    - if: matrix.os == 'windows-latest'
+      name: Install ghcup on windows
+      run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
+
+    - if: matrix.os == 'windows-latest'
+      name: Add ghcup to PATH
+      run: echo "/c/ghcup/bin" >> $GITHUB_PATH
+      shell: bash
+
+    - if: matrix.os != 'windows-latest'
+      name: Install ghcup on non-windows
+      run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
+
+    - name: Install ghc/cabal
+      run: |
+        ghcup install ghc ${{ matrix.ghc }}
+        ghcup install cabal ${{ matrix.cabal }}
+      shell: bash
+
+    - name: Update cabal index
+      run: cabal update
+      shell: bash
+
+    - name: Build
+      run: cabal build --enable-tests --enable-benchmarks
+      shell: bash
+
+    - name: Run tests
+      run: cabal test
+      shell: bash
+```
    
 ### Tips and tricks
 
@@ -266,8 +356,13 @@ In addition this script can also install `cabal-install`.
 
 ## Known users
 
-* Github action [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
-* [vabal](https://github.com/Franciman/vabal)
+* Github actions:
+	- [actions/virtual-environments](https://github.com/actions/virtual-environments)
+	- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
+* mirrors:
+	- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
+* tools:
+	- [vabal](https://github.com/Franciman/vabal)
 
 ## Known problems
 

RELEASING.md

@@ -1,19 +0,0 @@
-# RELEASING
-
-1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version.
-
-2. Update version in ghcup.cabal
-
-3. Add ChangeLog entry
-
-4. Add/fix downloads in `ghcup-<ver>.yaml`, then verify with `ghcup-gen check -f ghcup-<ver>.yaml`
-
-5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
-
-6. Download release artifacts and upload them `downloads.haskell.org/ghcup`
-
-7. Add release artifacts to yaml file (see point 4.)
-
-8. Upload the final `ghcup-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.
-
-9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup`

app/ghcup-gen/Main.hs

@@ -11,22 +11,31 @@
 module Main where
 
 import           GHCup.Types
+import           GHCup.Types.Optics
+import           GHCup.Errors
+import           GHCup.Platform
+import           GHCup.Utils.Dirs
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Logger
 
+import           Control.Monad.Trans.Reader     ( runReaderT )
+import           Control.Monad.IO.Class
 import           Data.Char                      ( toLower )
 #if !MIN_VERSION_base(4,13,0)
 import           Data.Semigroup                 ( (<>) )
 #endif
 import           Options.Applicative     hiding ( style )
+import           Haskus.Utils.Variant.Excepts
 import           System.Console.Pretty
 import           System.Exit
-import           System.IO                      ( stdout )
+import           System.IO                      ( stderr )
 import           Text.Regex.Posix
 import           Validate
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
+import qualified Data.Text.IO                  as T
+import qualified Data.Text                     as T
 import qualified Data.ByteString               as B
-import qualified Data.Yaml                     as Y
+import qualified Data.YAML.Aeson               as Y
 
 
 data Options = Options
@@ -105,10 +114,27 @@ com = subparser
 
 main :: IO ()
 main = do
+  let loggerConfig = LoggerConfig { lcPrintDebug = True
+                                  , colorOutter  = T.hPutStr stderr
+                                  , rawOutter    = \_ -> pure ()
+                                  }
+  dirs <- liftIO getAllDirs
+  let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig
+
+  pfreq <- (
+    flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
+    ) >>= \case
+            VRight r -> pure r
+            VLeft e -> do
+              flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
+              liftIO $ exitWith (ExitFailure 2)
+
+  let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
+
   _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
     >>= \Options {..} -> case optCommand of
-          ValidateYAML vopts -> withValidateYamlOpts vopts validate
-          ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter)
+          ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
+          ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
   pure ()
 
  where
@@ -120,8 +146,8 @@ main = do
     ValidateYAMLOpts { vInput = Just (FileInput file) } ->
       B.readFile file >>= valAndExit f
   valAndExit f contents = do
-    (GHCupInfo _ av gt) <- case Y.decodeEither' contents of
+    (GHCupInfo _ av gt) <- case Y.decode1Strict contents of
       Right r -> pure r
-      Left  e -> die (color Red $ show e)
-    myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av gt)
+      Left  (_, e) -> die (color Red $ show e)
+    f av gt
       >>= exitWith

app/ghcup-gen/Validate.hs

@@ -5,17 +5,16 @@
 {-# LANGUAGE TemplateHaskell  #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns     #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Validate where
 
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
-import           GHCup.Platform
-import           GHCup.Types                  hiding ( LeanAppState (..) )
+import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Utils.Logger
 import           GHCup.Utils.Version.QQ
 
 import           Codec.Archive
@@ -23,7 +22,6 @@ import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Control.Monad.Logger
 import           Control.Monad.Reader.Class
 import           Control.Monad.Trans.Class      ( lift )
 import           Control.Monad.Trans.Reader     ( runReaderT )
@@ -33,18 +31,15 @@ import           Control.Monad.Trans.Resource   ( runResourceT
 import           Data.Containers.ListUtils      ( nubOrd )
 import           Data.IORef
 import           Data.List
-import           Data.String.Interpolate
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
 import           Optics
 import           System.FilePath
 import           System.Exit
-import           System.IO
 import           Text.ParserCombinators.ReadP
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
 
-import qualified Data.ByteString               as B
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Data.Version                  as V
@@ -62,7 +57,7 @@ addError = do
   liftIO $ modifyIORef ref (+ 1)
 
 
-validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m)
+validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
          => GHCupDownloads
          -> M.Map GlobalTool DownloadInfo
          -> m ExitCode
@@ -89,24 +84,23 @@ validate dls _ = do
     if e > 0
       then pure $ ExitFailure e
       else do
-        lift $ $(logInfo) [i|All good|]
+        lift $ logInfo "All good"
         pure ExitSuccess
  where
   checkHasRequiredPlatforms t v tags arch pspecs = do
     let v' = prettyVer v
         arch' = prettyShow arch
     when (notElem (Linux UnknownLinux) pspecs) $ do
-      lift $ $(logError)
-        [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
+      lift $ logError $
+        "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
       addError
     when ((notElem Darwin pspecs) && arch == A_64) $ do
-      lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|]
+      lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
       addError
-    when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn)
-      [i|FreeBSD missing for #{t} #{v'} #{arch'}|]
+    when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
+      "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
     when (notElem Windows pspecs && arch == A_64) $ do
-      lift $ $(logError)
-        [i|Windows missing for for #{t} #{v'} #{arch'}|]
+      lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
       addError
 
     -- alpine needs to be set explicitly, because
@@ -114,12 +108,12 @@ validate dls _ = do
     -- (although it could be static)
     when (notElem (Linux Alpine) pspecs) $
       case t of
-        GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
+        GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
         Cabal | v > [vver|2.4.1.0|]
-              , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError
+              , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
         GHC | Latest `elem` tags || Recommended `elem` tags
-            , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|])
-        _ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
+            , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
+        _ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
 
   checkUniqueTags tool = do
     let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
@@ -139,7 +133,7 @@ validate dls _ = do
     case join nonUnique of
       [] -> pure ()
       xs -> do
-        lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|]
+        lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
         addError
    where
     isUniqueTag Latest         = True
@@ -155,7 +149,7 @@ validate dls _ = do
       case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
         [_] -> pure ()
         _   -> do
-          lift $ $(logError) [i|GHC version #{v} is not valid |]
+          lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
           addError
 
   -- a tool must have at least one of each mandatory tags
@@ -163,7 +157,7 @@ validate dls _ = do
     let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
     forM_ [Latest, Recommended] $ \t -> case elem t allTags of
       False -> do
-        lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
+        lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
         addError
       True -> pure ()
 
@@ -172,7 +166,7 @@ validate dls _ = do
     let allTags = M.toList $ availableToolVersions dls GHC
     forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
       False -> do
-        lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
+        lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
         addError
       True -> pure ()
 
@@ -185,7 +179,10 @@ data TarballFilter = TarballFilter
   }
 
 validateTarballs :: ( Monad m
-                    , MonadLogger m
+                    , MonadReader env m
+                    , HasLog env
+                    , HasDirs env
+                    , HasSettings env
                     , MonadThrow m
                     , MonadIO m
                     , MonadUnliftIO m
@@ -200,45 +197,37 @@ validateTarballs :: ( Monad m
 validateTarballs (TarballFilter etool versionRegex) dls gt = do
   ref <- liftIO $ newIORef 0
 
-  flip runReaderT ref $ do
-     -- download/verify all tarballs
-    let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
-    let gdlis = nubOrd $ gt ^.. each
-    let allDls = either (const gdlis) (const dlis) etool
-    when (null allDls) $ $(logError) [i|no tarballs selected by filter|] *> addError
-    forM_ allDls downloadAll
+   -- download/verify all tarballs
+  let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
+  let gdlis = nubOrd $ gt ^.. each
+  let allDls = either (const gdlis) (const dlis) etool
+  when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
+  forM_ allDls (downloadAll ref)
 
-    -- exit
-    e <- liftIO $ readIORef ref
-    if e > 0
-      then pure $ ExitFailure e
-      else do
-        lift $ $(logInfo) [i|All good|]
-        pure ExitSuccess
+  -- exit
+  e <- liftIO $ readIORef ref
+  if e > 0
+    then pure $ ExitFailure e
+    else do
+      logInfo "All good"
+      pure ExitSuccess
 
  where
-  runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
-                                     , colorOutter  = B.hPut stderr
-                                     , rawOutter    = \_ -> pure ()
-                                     }
-  downloadAll dli = do
-    dirs <- liftIO getAllDirs
-
-    pfreq <- (
-      runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
-      ) >>= \case
-              VRight r -> pure r
-              VLeft e -> do
-                lift $ runLogger
-                  ($(logError) $ T.pack $ prettyShow e)
-                liftIO $ exitWith (ExitFailure 2)
-
-    let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
-
-    r <-
-      runLogger
-      . flip runReaderT appstate
-      . runResourceT
+  downloadAll :: ( MonadUnliftIO m
+                 , MonadIO m
+                 , MonadReader env m
+                 , HasLog env
+                 , HasDirs env
+                 , HasSettings env
+                 , MonadCatch m
+                 , MonadMask m
+                 , MonadThrow m
+                 )
+              => IORef Int
+              -> DownloadInfo
+              -> m ()
+  downloadAll ref dli = do
+    r <- runResourceT
       . runE @'[DigestError
                , DownloadFailed
                , UnknownArchive
@@ -264,26 +253,26 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
       VRight (Just basePath) -> do
         case _dlSubdir dli of
           Just (RealDir prel) -> do
-            lift $ $(logInfo)
-              [i|verifying subdir: #{prel}|]
+            logInfo
+              $ " verifying subdir: " <> T.pack prel
             when (basePath /= prel) $ do
-              lift $ $(logError)
-                [i|Subdir doesn't match: expected "#{prel}", got "#{basePath}"|]
-              addError
+              logError $
+                "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
+              (flip runReaderT ref addError)
           Just (RegexDir regexString) -> do
-            lift $ $(logInfo)
-              [i|verifying subdir (regex): #{regexString}|]
+            logInfo $
+              "verifying subdir (regex): " <> T.pack regexString
             let regex = makeRegexOpts
                   compIgnoreCase
                   execBlank
                   regexString
             when (not (match regex basePath)) $ do
-              lift $ $(logError)
-                [i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|]
-              addError
+              logError $
+                "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
+              (flip runReaderT ref addError)
           Nothing -> pure ()
       VRight Nothing -> pure ()
       VLeft  e -> do
-        lift $ $(logError)
-          [i|Could not download (or verify hash) of #{dli}, Error was: #{prettyShow e}|]
-        addError
+        logError $
+          "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
+        (flip runReaderT ref addError)

app/ghcup/BrickMain.hs

@@ -13,11 +13,11 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
+import           GHCup.Types.Optics  hiding ( getGHCupInfo )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
-import           GHCup.Utils.Logger
 
 import           Brick
 import           Brick.Widgets.Border
@@ -29,7 +29,6 @@ import           Brick.Widgets.List             ( listSelectedFocusedAttr
                                                 )
 import           Codec.Archive
 import           Control.Exception.Safe
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Resource
@@ -38,7 +37,6 @@ import           Data.Functor
 import           Data.List
 import           Data.Maybe
 import           Data.IORef
-import           Data.String.Interpolate
 import           Data.Vector                    ( Vector
                                                 , (!?)
                                                 )
@@ -418,12 +416,8 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, Monad
 install' _ (_, ListResult {..}) = do
   AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
 
-  l        <- liftIO $ readIORef logger'
-  let runLogger = myLoggerT l
-
   let run =
-        runLogger
-          . runResourceT
+        runResourceT
           . runE
             @'[ AlreadyInstalled
               , ArchiveResult
@@ -463,23 +457,20 @@ install' _ (_, ListResult {..}) = do
     >>= \case
           VRight vi                         -> do
             forM_ (_viPostInstall =<< vi) $ \msg ->
-              myLoggerT l $ $(logInfo) msg
+              logInfo msg
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
           VLeft (V NoUpdate) -> pure $ Right ()
-          VLeft e -> pure $ Left [i|#{prettyShow e}
-Also check the logs in ~/.ghcup/logs|]
+          VLeft e -> pure $ Left $ prettyShow e <> "\n"
+            <> "Also check the logs in ~/.ghcup/logs"
 
 
 set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
 set' _ (_, ListResult {..}) = do
   settings <- readIORef settings'
-  l        <- readIORef logger'
-  let runLogger = myLoggerT l
 
   let run =
-        runLogger
-          . flip runReaderT settings
+        flip runReaderT settings
           . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
 
   run (do
@@ -502,9 +493,7 @@ del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnlif
 del' _ (_, ListResult {..}) = do
   AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
 
-  l <- liftIO $ readIORef logger'
-  let runLogger = myLoggerT l
-  let run = myLoggerT l . runE @'[NotInstalled]
+  let run = runE @'[NotInstalled]
 
   run (do
       let vi = getVersionInfo lVer lTool dls
@@ -518,7 +507,7 @@ del' _ (_, ListResult {..}) = do
     >>= \case
           VRight vi -> do
             forM_ (join $ fmap _viPostRemove vi) $ \msg ->
-              runLogger $ $(logInfo) msg
+              logInfo msg
             pure $ Right ()
           VLeft  e -> pure $ Left (prettyShow e)
 
@@ -530,8 +519,8 @@ changelog' :: (MonadReader AppState m, MonadIO m)
 changelog' _ (_, ListResult {..}) = do
   AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
   case getChangeLog dls lTool (Left lVer) of
-    Nothing -> pure $ Left
-      [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
+    Nothing -> pure $ Left $
+      "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
     Just uri -> do
       let cmd = case _rPlatform pfreq of
             Darwin  -> "open"
@@ -547,6 +536,10 @@ settings' :: IORef AppState
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO $ do
   dirs <- getAllDirs
+  let loggerConfig = LoggerConfig { lcPrintDebug = False
+                                  , colorOutter  = \_ -> pure ()
+                                  , rawOutter    = \_ -> pure ()
+                                  }
   newIORef $ AppState (Settings { cache      = True
                                 , noVerify   = False
                                 , keepDirs   = Never
@@ -560,27 +553,14 @@ settings' = unsafePerformIO $ do
                       defaultKeyBindings
                       (GHCupInfo mempty mempty mempty)
                       (PlatformRequest A_64 Darwin Nothing)
+                      loggerConfig
 
 
 
-logger' :: IORef LoggerConfig
-{-# NOINLINE logger' #-}
-logger' = unsafePerformIO
-  (newIORef $ LoggerConfig { lcPrintDebug = False
-                           , colorOutter  = \_ -> pure ()
-                           , rawOutter    = \_ -> pure ()
-                           }
-  )
-
-
 brickMain :: AppState
-          -> LoggerConfig
           -> IO ()
-brickMain s l = do
+brickMain s = do
   writeIORef settings' s
-  -- logger interpreter
-  writeIORef logger'   l
-  let runLogger = myLoggerT l
 
   no_color <- isJust <$> lookupEnv "NO_COLOR"
 
@@ -597,7 +577,7 @@ brickMain s l = do
           )
         $> ()
     Left e -> do
-      runLogger ($(logError) [i|Error building app state: #{show e}|])
+      flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
       exitWith $ ExitFailure 2
 
 
@@ -608,12 +588,9 @@ defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = Fal
 getGHCupInfo :: IO (Either String GHCupInfo)
 getGHCupInfo = do
   settings <- readIORef settings'
-  l        <- readIORef logger'
-  let runLogger = myLoggerT l
 
   r <-
-    runLogger
-    . flip runReaderT settings
+    flip runReaderT settings
     . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
     $ liftE
     $ getDownloadsF
@@ -626,14 +603,11 @@ getGHCupInfo = do
 getAppData :: Maybe GHCupInfo
            -> IO (Either String BrickData)
 getAppData mgi = runExceptT $ do
-  l        <- liftIO $ readIORef logger'
-  let runLogger = myLoggerT l
-
   r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
   liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
   settings <- liftIO $ readIORef settings'
 
-  runLogger . flip runReaderT settings $ do
+  flip runReaderT settings $ do
     lV <- listVersions Nothing Nothing
     pure $ BrickData (reverse lV)
 

app/ghcup/Main.hs

@@ -30,6 +30,7 @@ import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 import           GHCup.Version
 
+import           Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
 import           Codec.Archive
 import           Control.Concurrent
 import           Control.Concurrent.Async
@@ -39,9 +40,10 @@ import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
+import           Data.Aeson                     ( decodeStrict', Value )
+import           Data.Aeson.Encode.Pretty       ( encodePretty )
 import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
@@ -49,13 +51,13 @@ import           Data.Functor
 import           Data.List                      ( intercalate, nub, sort, sortBy )
 import           Data.List.NonEmpty             (NonEmpty ((:|)))
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions           hiding ( str )
 import           Data.Void
 import           GHC.IO.Encoding
 import           Haskus.Utils.Variant.Excepts
 import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax     ( Quasi(qAddDependentFile) )
 import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
@@ -76,8 +78,7 @@ import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
-import qualified Data.Yaml                     as Y
-import qualified Data.Yaml.Pretty              as YP
+import qualified Data.YAML.Aeson               as Y
 import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
@@ -205,6 +206,11 @@ data ChangeLogOptions = ChangeLogOptions
 
 
 data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
+                    | WhereisBaseDir
+                    | WhereisBinDir
+                    | WhereisCacheDir
+                    | WhereisLogsDir
+                    | WhereisConfDir
 
 data WhereisOptions = WhereisOptions {
    directory :: Bool
@@ -833,7 +839,8 @@ configP = subparser
 
 whereisP :: Parser WhereisCommand
 whereisP = subparser
-  (  command
+  (commandGroup "Tools locations:" <> 
+    command
       "ghc"
       (WhereisTool GHC <$> info
         ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
@@ -868,6 +875,37 @@ whereisP = subparser
      command
       "ghcup"
       (WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" ))
+    ) <|> subparser ( commandGroup "Directory locations:"
+      <>
+     command
+      "basedir"
+      (info (pure WhereisBaseDir <**> helper)
+            ( progDesc "Get ghcup base directory location" )
+      )
+      <>
+     command
+      "bindir"
+      (info (pure WhereisBinDir <**> helper)
+            ( progDesc "Get ghcup binary directory location" )
+      )
+      <>
+     command
+      "cachedir"
+      (info (pure WhereisCacheDir <**> helper)
+            ( progDesc "Get ghcup cache directory location" )
+      )
+      <>
+     command
+      "logsdir"
+      (info (pure WhereisLogsDir <**> helper)
+            ( progDesc "Get ghcup logs directory location" )
+      )
+      <>
+     command
+      "confdir"
+      (info (pure WhereisConfDir <**> helper)
+            ( progDesc "Get ghcup config directory location" )
+      )
   )
  where
   whereisGHCFooter = [s|Discussion:
@@ -1008,7 +1046,7 @@ ghcCompileOpts =
           (option
             str
             (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
-              "Absolute path to patch directory (applied in order, uses -p1)"
+              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
             )
           )
     <*> optional
@@ -1087,7 +1125,7 @@ setVersionArgument criteria tool =
     <|> second SetToolVersion (tVersionEither s')
   parseSet s' = case fmap toLower s' of
                   "next" -> Right SetNext
-                  other  -> Left [i|Unknown tag/version #{other}|]
+                  other  -> Left $ "Unknown tag/version " <> other
 
 
 versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
@@ -1097,19 +1135,18 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 tagCompleter :: Tool -> [String] -> Completer
 tagCompleter tool add = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
-  let appState = LeanAppState
-        (Settings True False Never Curl False GHCupURL True)
-        dirs'
-        defaultKeyBindings
-
   let loggerConfig = LoggerConfig
         { lcPrintDebug = False
         , colorOutter  = mempty
         , rawOutter    = mempty
         }
-  let runLogger = myLoggerT loggerConfig
+  let appState = LeanAppState
+        (Settings True False Never Curl False GHCupURL True)
+        dirs'
+        defaultKeyBindings
+        loggerConfig
 
-  mGhcUpInfo <- runLogger . flip runReaderT appState . runE $ getDownloadsF
+  mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
   case mGhcUpInfo of
     VRight ghcupInfo -> do
       let allTags = filter (\t -> t /= Old)
@@ -1129,14 +1166,14 @@ versionCompleter criteria tool = listIOCompleter $ do
         , colorOutter  = mempty
         , rawOutter    = mempty
         }
-  let runLogger = myLoggerT loggerConfig
-      settings = Settings True False Never Curl False GHCupURL True
+  let settings = Settings True False Never Curl False GHCupURL True
   let leanAppState = LeanAppState
                    settings
                    dirs'
                    defaultKeyBindings
-  mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest
-  mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF
+                   loggerConfig
+  mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
+  mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
   forFold mpFreq $ \pfreq -> do
     forFold mGhcUpInfo $ \ghcupInfo -> do
       let appState = AppState
@@ -1145,8 +1182,9 @@ versionCompleter criteria tool = listIOCompleter $ do
             defaultKeyBindings
             ghcupInfo
             pfreq
+            loggerConfig
 
-          runEnv = runLogger . flip runReaderT appState
+          runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
       return $ T.unpack . prettyVer . lVer <$> installedVersions
@@ -1170,8 +1208,8 @@ tagEither s' = case fmap toLower s' of
   "latest"      -> Right Latest
   ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
                                   Right x -> Right (Base x)
-                                  Left  _ -> Left [i|Invalid PVP version for base #{ver'}|]
-  other         -> Left [i|Unknown tag #{other}|]
+                                  Left  _ -> Left $ "Invalid PVP version for base " <> ver'
+  other         -> Left $ "Unknown tag " <> other
 
 
 tVersionEither :: String -> Either String GHCTargetVersion
@@ -1317,7 +1355,7 @@ toSettings options = do
 
 updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
 updateSettings config settings = do
-  settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
+  settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config
   pure $ mergeConf settings' settings
   where
    mergeConf :: UserSettings -> Settings -> Settings
@@ -1364,11 +1402,19 @@ describe_result = $( LitE . StringL <$>
                      )
                    )
 
+plan_json :: String
+plan_json = $( do
+                (fp, c) <- runIO (handleIO (\_ -> pure ("", "")) $ do
+                             fp <- findPlanJson (ProjectRelativeToDir ".")
+                             c <- B.readFile fp
+                             (Just res) <- pure $ decodeStrict' @Value c
+                             pure (fp, T.unpack $ decUTF8Safe' $ encodePretty res))
+                when (not . null $ fp ) $ qAddDependentFile fp
+                pure . LitE . StringL $ c)
+
 formatConfig :: UserSettings -> String
 formatConfig settings
-  = UTF8.toString . YP.encodePretty yamlConfig $ settings
- where
-  yamlConfig = YP.setConfCompare compare YP.defConfig
+  = UTF8.toString . Y.encode1Strict $ settings
 
 main :: IO ()
 main = do
@@ -1382,6 +1428,9 @@ main = do
           (head . lines $ describe_result)
         )
         (long "version" <> help "Show version" <> hidden)
+  let planJson = infoOption
+        plan_json
+        (long "plan-json" <> help "Show the build-time configuration" <> internal)
   let numericVersionHelp = infoOption
         numericVer
         (  long "numeric-version"
@@ -1409,7 +1458,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
   customExecParser
       (prefs showHelpOnError)
-      (info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands)
+      (info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> planJson <**> listCommands)
             (footerDoc (Just $ text main_footer))
       )
     >>= \opt@Options {..} -> do
@@ -1420,18 +1469,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           (settings, keybindings) <- toSettings opt
 
+
           -- logger interpreter
-          logfile <- flip runReaderT dirs $ initGHCupFileLogging
+          logfile <- flip runReaderT dirs initGHCupFileLogging
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
-                , colorOutter  = B.hPut stderr
+                , colorOutter  = T.hPutStr stderr
                 , rawOutter    =
                     case optCommand of
                       Nuke -> \_ -> pure ()
-                      _ -> B.appendFile logfile
+                      _ -> T.appendFile logfile
                 }
-          let runLogger = myLoggerT loggerConfig
-          let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
+          let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
+          let runLogger = flip runReaderT leanAppstate
+          let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
 
 
           -------------------------
@@ -1439,7 +1490,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           -------------------------
 
 
-          let leanAppstate = LeanAppState settings dirs keybindings
               appState = do
                 pfreq <- (
                   runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
@@ -1447,12 +1497,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           VRight r -> pure r
                           VLeft e -> do
                             runLogger
-                              ($(logError) $ T.pack $ prettyShow e)
+                              (logError $ T.pack $ prettyShow e)
                             exitWith (ExitFailure 2)
 
                 ghcupInfo <-
-                  ( runLogger
-                    . flip runReaderT leanAppstate
+                  ( flip runReaderT leanAppstate
                     . runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
                     $ liftE
                     $ getDownloadsF
@@ -1461,12 +1510,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           VRight r -> pure r
                           VLeft  e -> do
                             runLogger
-                              ($(logError) $ T.pack $ prettyShow e)
+                              (logError $ T.pack $ prettyShow e)
                             exitWith (ExitFailure 2)
-                let s' = AppState settings dirs keybindings ghcupInfo pfreq
+                let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
 
-                race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
-                      (threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
+                race_ (liftIO $ flip runReaderT s' cleanupTrash)
+                      (threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
 
                 case optCommand of
                   Nuke -> pure ()
@@ -1478,7 +1527,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   Interactive -> pure ()
 #endif
                   _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
-                         Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
+                         Nothing -> flip runReaderT s' checkForUpdates
                          Just _ -> pure ()
 
                 -- TODO: always run for windows
@@ -1486,7 +1535,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   VRight _ -> pure ()
                   VLeft e -> do
                     runLogger
-                      ($(logError) $ T.pack $ prettyShow e)
+                      (logError $ T.pack $ prettyShow e)
                     exitWith (ExitFailure 30)
                 pure s'
 
@@ -1511,8 +1560,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
 
           let runInstTool' appstate' mInstPlatform =
-                runLogger
-                  . flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+                  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
                   . runResourceT
                   . runE
                     @'[ AlreadyInstalled
@@ -1540,8 +1588,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           let
             runLeanSetGHC =
-              runLogger
-                . runLeanAppState
+                runLeanAppState
                 . runE
                   @'[ FileDoesNotExistError
                     , NotInstalled
@@ -1551,8 +1598,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     ]
 
             runSetGHC =
-              runLogger
-                . runAppState
+                runAppState
                 . runE
                   @'[ FileDoesNotExistError
                     , NotInstalled
@@ -1563,8 +1609,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           let
             runLeanSetCabal =
-              runLogger
-                . runLeanAppState
+                runLeanAppState
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
@@ -1573,8 +1618,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     ]
 
             runSetCabal =
-              runLogger
-                . runAppState
+                runAppState
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
@@ -1584,8 +1628,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           let
             runSetHLS =
-              runLogger
-                . runAppState
+                runAppState
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
@@ -1594,8 +1637,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     ]
 
             runLeanSetHLS =
-              runLogger
-                . runLeanAppState
+                runLeanAppState
                 . runE
                   @'[ NotInstalled
                     , TagNotFound
@@ -1603,23 +1645,21 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , NoToolVersionSet
                     ]
 
-          let runListGHC = runLogger . runAppState
+          let runListGHC = runAppState
 
           let runRm =
-                runLogger . runAppState . runE @'[NotInstalled]
+                runAppState . runE @'[NotInstalled]
 
           let runNuke s' =
-                runLogger . flip runReaderT s' . runE @'[NotInstalled]
+                flip runReaderT s' . runE @'[NotInstalled]
 
           let runDebugInfo =
-                runLogger
-                  . runAppState
+                  runAppState
                   . runE
                     @'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
 
           let runCompileGHC =
-                runLogger
-                  . runAppState
+                  runAppState
                   . runResourceT
                   . runE
                     @'[ AlreadyInstalled
@@ -1639,10 +1679,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           let
             runLeanWhereIs =
-              runLogger
                 -- Don't use runLeanAppState here, which is disabled on windows.
                 -- This is the only command on all platforms that doesn't need full appstate.
-                . flip runReaderT leanAppstate
+                flip runReaderT leanAppstate
                 . runE
                   @'[ NotInstalled
                     , NoToolVersionSet
@@ -1651,8 +1690,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     ]
 
             runWhereIs =
-              runLogger
-                . runAppState
+                runAppState
                 . runE
                   @'[ NotInstalled
                     , NoToolVersionSet
@@ -1661,8 +1699,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     ]
 
           let runUpgrade =
-                runLogger
-                  . runAppState
+                  runAppState
                   . runResourceT
                   . runE
                     @'[ DigestError
@@ -1674,8 +1711,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       ]
 
           let runPrefetch =
-                runLogger
-                  . runAppState
+                  runAppState
                   . runResourceT
                   . runE
                     @'[ TagNotFound
@@ -1713,25 +1749,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   )
                     >>= \case
                           VRight vi -> do
-                            runLogger $ $(logInfo) "GHC installation successful"
+                            runLogger $ logInfo "GHC installation successful"
                             forM_ (_viPostInstall =<< vi) $ \msg ->
-                              runLogger $ $(logInfo) msg
+                              runLogger $ logInfo msg
                             pure ExitSuccess
                           VLeft (V (AlreadyInstalled _ v)) -> do
-                            runLogger $ $(logWarn)
-                              [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
+                            runLogger $ logWarn $
+                              "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
                             pure ExitSuccess
                           VLeft err@(V (BuildFailed tmpdir _)) -> do
                             case keepDirs settings of
-                              Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
-                              _ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
-    Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
-    Make sure to clean up #{tmpdir} afterwards.|])
+                              Never -> runLogger $ (logError $ T.pack $ prettyShow err)
+                              _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
+                                "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
+                                "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                             pure $ ExitFailure 3
                           VLeft e -> do
                             runLogger $ do
-                              $(logError) $ T.pack $ prettyShow e
-                              $(logError) [i|Also check the logs in #{logsDir}|]
+                              logError $ T.pack $ prettyShow e
+                              logError $ "Also check the logs in " <> T.pack logsDir
                             pure $ ExitFailure 3
 
 
@@ -1753,18 +1789,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   )
                   >>= \case
                         VRight vi -> do
-                          runLogger $ $(logInfo) "Cabal installation successful"
+                          runLogger $ logInfo "Cabal installation successful"
                           forM_ (_viPostInstall =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
-                            [i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|]
+                          runLogger $ logWarn $
+                            "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
-                            $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            logError $ T.pack $ prettyShow e
+                            logError $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
           let installHLS InstallOptions{..} =
@@ -1785,18 +1821,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   )
                   >>= \case
                         VRight vi -> do
-                          runLogger $ $(logInfo) "HLS installation successful"
+                          runLogger $ logInfo "HLS installation successful"
                           forM_ (_viPostInstall =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
-                            [i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
+                          runLogger $ logWarn $
+                              "HLS ver "
+                            <> prettyVer v
+                            <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
+                            <> prettyVer v
+                            <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
-                            $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            logError $ T.pack $ prettyShow e
+                            logError $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
           let installStack InstallOptions{..} =
@@ -1817,18 +1857,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   )
                   >>= \case
                         VRight vi -> do
-                          runLogger $ $(logInfo) "Stack installation successful"
+                          runLogger $ logInfo "Stack installation successful"
                           forM_ (_viPostInstall =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
-                            [i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|]
+                          runLogger $ logWarn $
+                            "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
-                            $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            logError $ T.pack $ prettyShow e
+                            logError $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
 
@@ -1842,11 +1882,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
-                                [i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
+                            $ logInfo $
+                                "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
                           pure ExitSuccess
                         VLeft e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 5
 
           let setCabal' SetOptions{ sToolVer } =
@@ -1860,11 +1900,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
-                                [i|Cabal #{prettyVer _tvVersion} successfully set as default version|]
+                            $ logInfo $
+                                "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
           let setHLS' SetOptions{ sToolVer } =
@@ -1878,11 +1918,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
-                                [i|HLS #{prettyVer _tvVersion} successfully set as default version|]
+                            $ logInfo $
+                                "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
           let setStack' SetOptions{ sToolVer } =
@@ -1896,11 +1936,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
-                                [i|Stack #{prettyVer _tvVersion} successfully set as default version|]
+                            $ logInfo $
+                                "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
           let rmGHC' RmOptions{..} =
@@ -1913,10 +1953,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           forM_ (_viPostRemove =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 7
 
           let rmCabal' tv =
@@ -1929,10 +1969,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           forM_ (_viPostRemove =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
           let rmHLS' tv =
@@ -1945,10 +1985,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           forM_ (_viPostRemove =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
           let rmStack' tv =
@@ -1961,31 +2001,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight vi -> do
                           forM_ (_viPostRemove =<< vi) $ \msg ->
-                            runLogger $ $(logInfo) msg
+                            runLogger $ logInfo msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
           res <- case optCommand of
 #if defined(BRICK)
             Interactive -> do
               s' <- appState
-              liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
+              liftIO $ brickMain s' >> pure ExitSuccess
 #endif
             Install (Right iopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
+              runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
               installGHC iopts
             Install (Left (InstallGHC iopts)) -> installGHC iopts
             Install (Left (InstallCabal iopts)) -> installCabal iopts
             Install (Left (InstallHLS iopts)) -> installHLS iopts
             Install (Left (InstallStack iopts)) -> installStack iopts
             InstallCabalLegacy iopts -> do
-              runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
+              runLogger (logWarn "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.")
               installCabal iopts
 
             Set (Right sopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|])
+              runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
               setGHC' sopts
             Set (Left (SetGHC sopts)) -> setGHC' sopts
             Set (Left (SetCabal sopts)) -> setCabal' sopts
@@ -2000,7 +2040,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 )
 
             Rm (Right rmopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
+              runLogger (logWarn "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
               rmGHC' rmopts
             Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
             Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
@@ -2014,11 +2054,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         putStrLn $ prettyDebugInfo dinfo
                         pure ExitSuccess
                       VLeft e -> do
-                        runLogger $ $(logError) $ T.pack $ prettyShow e
+                        runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 8
 
             Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
-              runLogger $ $(logError) "Hadrian cross compile support is not yet implemented!"
+              runLogger $ logError "Hadrian cross compile support is not yet implemented!"
               pure $ ExitFailure 9
             Compile (CompileGHC GHCCompileOptions {..}) ->
               runCompileGHC (do
@@ -2027,8 +2067,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
                     let vi = getVersionInfo targetVer GHC dls
                     forM_ (_viPreCompile =<< vi) $ \msg -> do
-                      lift $ $(logInfo) msg
-                      lift $ $(logInfo)
+                      lift $ logInfo msg
+                      lift $ logInfo
                         "...waiting for 5 seconds, you can still abort..."
                       liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
                   Right _ -> pure ()
@@ -2051,31 +2091,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 )
                 >>= \case
                       VRight (vi, tv) -> do
-                        runLogger $ $(logInfo)
+                        runLogger $ logInfo
                           "GHC successfully compiled and installed"
                         forM_ (_viPostInstall =<< vi) $ \msg ->
-                          runLogger $ $(logInfo) msg
+                          runLogger $ logInfo msg
                         putStr (T.unpack $ tVerToText tv)
                         pure ExitSuccess
                       VLeft (V (AlreadyInstalled _ v)) -> do
-                        runLogger $ $(logWarn)
-                          [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
+                        runLogger $ logWarn $
+                          "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
                         pure ExitSuccess
                       VLeft err@(V (BuildFailed tmpdir _)) -> do
                         case keepDirs settings of
-                          Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
-                          _ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
-Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
-Make sure to clean up #{tmpdir} afterwards.|])
+                          Never -> runLogger $ logError $ T.pack $ prettyShow err
+                          _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
+                                "Check the logs at " <> T.pack logsDir <> " and the build directory "
+                                <> T.pack tmpdir <> " for more clues." <> "\n" <>
+                                "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                         pure $ ExitFailure 9
                       VLeft e -> do
-                        runLogger $ $(logError) $ T.pack $ prettyShow e
+                        runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 9
 
             Config InitConfig -> do
               path <- getConfigFilePath
               writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
-              runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
+              runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
               pure ExitSuccess
 
             Config ShowConfig -> do
@@ -2085,21 +2126,20 @@ Make sure to clean up #{tmpdir} afterwards.|])
             Config (SetConfig k v) -> do
               case v of
                 "" -> do
-                  runLogger $ $(logError) "Empty values are not allowed"
+                  runLogger $ logError "Empty values are not allowed"
                   pure $ ExitFailure 55
                 _  -> do
                   r <- runE @'[JSONError] $ do
-                    settings' <- updateSettings [i|#{k}: #{v}\n|] settings
+                    settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
                     path <- liftIO getConfigFilePath
                     liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
-                    runLogger $ $(logDebug) $ T.pack $ show settings'
+                    runLogger $ logDebug $ T.pack $ show settings'
                     pure ()
 
                   case r of
                       VRight _ -> pure ExitSuccess
                       VLeft (V (JSONDecodeError e)) -> do
-                        runLogger $ $(logError)
-                          [i|Error decoding config: #{e}|]
+                        runLogger $ logError $ "Error decoding config: " <> T.pack e
                         pure $ ExitFailure 65
                       VLeft _ -> pure $ ExitFailure 65
 
@@ -2115,7 +2155,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                         putStr r
                         pure ExitSuccess
                       VLeft e -> do
-                        runLogger $ $(logError) $ T.pack $ prettyShow e
+                        runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 30
 
             Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
@@ -2131,9 +2171,29 @@ Make sure to clean up #{tmpdir} afterwards.|])
                         putStr r
                         pure ExitSuccess
                       VLeft e -> do
-                        runLogger $ $(logError) $ T.pack $ prettyShow e
+                        runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 30
 
+            Whereis _ WhereisBaseDir -> do
+              putStr baseDir
+              pure ExitSuccess
+
+            Whereis _ WhereisBinDir -> do
+              putStr binDir
+              pure ExitSuccess
+
+            Whereis _ WhereisCacheDir -> do
+              putStr cacheDir
+              pure ExitSuccess
+
+            Whereis _ WhereisLogsDir -> do
+              putStr logsDir
+              pure ExitSuccess
+
+            Whereis _ WhereisConfDir -> do
+              putStr confDir
+              pure ExitSuccess
+
             Upgrade uOpts force' -> do
               target <- case uOpts of
                 UpgradeInplace  -> Just <$> liftIO getExecutablePath
@@ -2148,23 +2208,22 @@ Make sure to clean up #{tmpdir} afterwards.|])
                   VRight (v', dls) -> do
                     let pretty_v = prettyVer v'
                     let vi = fromJust $ snd <$> getLatest dls GHCup
-                    runLogger $ $(logInfo)
-                      [i|Successfully upgraded GHCup to version #{pretty_v}|]
+                    runLogger $ logInfo $
+                      "Successfully upgraded GHCup to version " <> pretty_v
                     forM_ (_viPostInstall vi) $ \msg ->
-                      runLogger $ $(logInfo) msg
+                      runLogger $ logInfo msg
                     pure ExitSuccess
                   VLeft (V NoUpdate) -> do
-                    runLogger $ $(logWarn) [i|No GHCup update available|]
+                    runLogger $ logWarn "No GHCup update available"
                     pure ExitSuccess
                   VLeft e -> do
-                    runLogger $ $(logError) $ T.pack $ prettyShow e
+                    runLogger $ logError $ T.pack $ prettyShow e
                     pure $ ExitFailure 11
 
             ToolRequirements -> do
               s' <- appState
               flip runReaderT s'
-                $ runLogger
-                  (runE
+                $ (runE
                     @'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
                   $ do
                       GHCupInfo { .. } <- lift getGHCupInfo
@@ -2175,7 +2234,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                   >>= \case
                         VRight _ -> pure ExitSuccess
                         VLeft  e -> do
-                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          runLogger $ logError $ T.pack $ prettyShow e
                           pure $ ExitFailure 12
 
             ChangeLog ChangeLogOptions{..} -> do
@@ -2192,8 +2251,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
               case muri of
                 Nothing -> do
                   runLogger
-                    ($(logWarn)
-                      [i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|]
+                    (logWarn $
+                      "Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
                     )
                   pure ExitSuccess
                 Just uri -> do
@@ -2215,7 +2274,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                              Nothing
                           >>= \case
                                 Right _ -> pure ExitSuccess
-                                Left  e -> runLogger ($(logError) [i|#{e}|])
+                                Left  e -> logError (T.pack $ prettyShow e)
                                   >> pure (ExitFailure 13)
                     else putStrLn uri' >> pure ExitSuccess
 
@@ -2223,12 +2282,12 @@ Make sure to clean up #{tmpdir} afterwards.|])
               s' <- liftIO appState
               void $ liftIO $ evaluate $ force s'
               runNuke s' (do
-                   lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
-                   lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
+                   lift $ logWarn "WARNING: This will remove GHCup and all installed components from your system."
+                   lift $ logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
                    liftIO $ threadDelay 10000000  -- wait 10s
 
-                   lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
-                   lift $ $logInfo "Nuking in 3...2...1"
+                   lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
+                   lift $ logInfo "Nuking in 3...2...1"
               
                    lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
 
@@ -2239,15 +2298,15 @@ Make sure to clean up #{tmpdir} afterwards.|])
                    ) >>= \case
                             VRight leftOverFiles
                               | null leftOverFiles -> do
-                                  runLogger $ $logInfo "Nuclear Annihilation complete!"
+                                  runLogger $ logInfo "Nuclear Annihilation complete!"
                                   pure ExitSuccess
                               | otherwise -> do
-                                  runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually."
+                                  runLogger $ logError "These Files have survived Nuclear Annihilation, you may remove them manually."
                                   forM_ leftOverFiles putStrLn
                                   pure ExitSuccess
 
                             VLeft e -> do
-                              runLogger $ $(logError) $ T.pack $ prettyShow e
+                              runLogger $ logError $ T.pack $ prettyShow e
                               pure $ ExitFailure 15
             Prefetch pfCom ->
               runPrefetch (do
@@ -2278,7 +2337,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                             VRight _ -> do
                                   pure ExitSuccess
                             VLeft e -> do
-                              runLogger $ $(logError) $ T.pack $ prettyShow e
+                              runLogger $ logError $ T.pack $ prettyShow e
                               pure $ ExitFailure 15
 
 
@@ -2289,7 +2348,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
 
   pure ()
 
-fromVersion :: ( MonadLogger m
+fromVersion :: ( HasLog env
                , MonadFail m
                , MonadReader env m
                , HasGHCupInfo env
@@ -2307,7 +2366,7 @@ fromVersion :: ( MonadLogger m
                   ] m (GHCTargetVersion, Maybe VersionInfo)
 fromVersion tv = fromVersion' (toSetToolVer tv)
 
-fromVersion' :: ( MonadLogger m
+fromVersion' :: ( HasLog env
                 , MonadFail m
                 , MonadReader env m
                 , HasGHCupInfo env
@@ -2553,11 +2612,10 @@ checkForUpdates :: ( MonadReader env m
                    , HasDirs env
                    , HasPlatformReq env
                    , MonadCatch m
-                   , MonadLogger m
+                   , HasLog env
                    , MonadThrow m
                    , MonadIO m
                    , MonadFail m
-                   , MonadLogger m
                    )
                 => m ()
 checkForUpdates = do
@@ -2568,46 +2626,46 @@ checkForUpdates = do
   forM_ (getLatest dls GHCup) $ \(l, _) -> do
     (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
     when (l > ghc_ver)
-      $ $(logWarn)
-          [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
+      $ logWarn $
+          "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
 
   forM_ (getLatest dls GHC) $ \(l, _) -> do
     let mghc_ver = latestInstalled GHC
     forM mghc_ver $ \ghc_ver ->
       when (l > ghc_ver)
-        $ $(logWarn)
-            [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
+        $ logWarn $
+          "New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
 
   forM_ (getLatest dls Cabal) $ \(l, _) -> do
     let mcabal_ver = latestInstalled Cabal
     forM mcabal_ver $ \cabal_ver ->
       when (l > cabal_ver)
-        $ $(logWarn)
-            [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
+        $ logWarn $
+          "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
 
   forM_ (getLatest dls HLS) $ \(l, _) -> do
     let mhls_ver = latestInstalled HLS
     forM mhls_ver $ \hls_ver ->
       when (l > hls_ver)
-        $ $(logWarn)
-            [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
+        $ logWarn $
+          "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
 
   forM_ (getLatest dls Stack) $ \(l, _) -> do
     let mstack_ver = latestInstalled Stack
     forM mstack_ver $ \stack_ver ->
       when (l > stack_ver)
-        $ $(logWarn)
-            [i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|]
+        $ logWarn $
+          "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
 
 
 prettyDebugInfo :: DebugInfo -> String
-prettyDebugInfo DebugInfo {..} = [i|Debug Info
-==========
-GHCup base dir: #{diBaseDir}
-GHCup bin dir: #{diBinDir}
-GHCup GHC directory: #{diGHCDir}
-GHCup cache directory: #{diCacheDir}
-Architecture: #{prettyShow diArch}
-Platform: #{prettyShow diPlatform}
-Version: #{describe_result}|]
+prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
+  "==========" <> "\n" <>
+  "GHCup base dir: " <> diBaseDir <> "\n" <>
+  "GHCup bin dir: " <> diBinDir <> "\n" <>
+  "GHCup GHC directory: " <> diGHCDir <> "\n" <>
+  "GHCup cache directory: " <> diCacheDir <> "\n" <>
+  "Architecture: " <> prettyShow diArch <> "\n" <>
+  "Platform: " <> prettyShow diPlatform <> "\n" <>
+  "Version: " <> describe_result
 

cabal.ghc8107.project

@@ -8,26 +8,27 @@ package ghcup
     tests: True
     flags: +tui
 
-source-repository-package
-    type: git
-    location: https://github.com/jtdaugherty/brick.git
-    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
-
-source-repository-package
-    type: git
-    location: https://github.com/Bodigrim/tar
-    tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
-
 source-repository-package
     type: git
     location: https://github.com/bgamari/terminal-size
     tag: 34ea816bd63f75f800eedac12c6908c6f3736036
 
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/libarchive
+    tag: 8587aab78dd515928024ecd82c8f215e06db85cd
+
 constraints: http-io-streams -brotli
 
 package libarchive
   flags: -system-libarchive
 
+package aeson-pretty
+  flags: +lib-only
+
+package cabal-plan
+  flags: -exe
+
 allow-newer: base, ghc-prim, template-haskell, language-c
 
-with-compiler: ghc-8.10.5
+with-compiler: ghc-8.10.7

cabal.ghc8107.project.freeze

@@ -1,15 +1,18 @@
 active-repositories: hackage.haskell.org:merge
 constraints: any.Cabal ==3.2.1.0,
              any.HUnit ==1.6.2.0,
-             any.HsOpenSSL ==0.11.7,
+             any.HsOpenSSL ==0.11.7.1,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
+             any.HsYAML ==0.2.1.0,
+             HsYAML -exe,
+             any.HsYAML-aeson ==0.2.0.0,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
              any.StateVar ==1.2.2,
              any.aeson ==1.5.6.0,
              aeson -bytestring-builder -cffi -developer -fast,
              any.aeson-pretty ==0.8.8,
-             aeson-pretty -lib-only,
+             aeson-pretty +lib-only,
              any.alex ==3.2.6,
              alex +small_base,
              any.ansi-terminal ==0.11,
@@ -22,8 +25,7 @@ constraints: any.Cabal ==3.2.1.0,
              async -bench,
              any.attoparsec ==0.13.2.5,
              attoparsec -developer,
-             any.auto-update ==0.1.6,
-             any.base ==4.14.2.0,
+             any.base ==4.14.3.0,
              any.base-compat ==0.11.2,
              any.base-compat-batteries ==0.11.2,
              any.base-orphans ==0.8.4,
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.2.1.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
-             any.bindings-DSL ==1.0.25,
              any.blaze-builder ==0.4.2.1,
-             any.brick ==0.63,
+             any.brick ==0.64,
              brick -demos,
              any.bytestring ==0.10.12.0,
              any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
-             any.bzlib-conduit ==0.3.0.2,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
+             any.cabal-plan ==0.7.2.0,
+             cabal-plan -_ -exe -license-report,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
              any.casing ==0.1.4.1,
-             any.cereal ==0.5.8.1,
-             cereal -bytestring-builder,
              any.chs-cabal ==0.1.1.0,
              any.chs-deps ==0.1.0.0,
              chs-deps -cross,
              any.clock ==0.8.2,
              clock -llvm,
-             any.cmdargs ==0.10.21,
-             cmdargs +quotation -testprog,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
              comonad +containers +distributive +indexed-traversable,
              any.composition-prelude ==3.0.0.2,
              composition-prelude -development,
              any.concurrent-output ==1.10.12,
-             any.conduit ==1.3.4.1,
-             any.conduit-extra ==1.3.5,
-             any.conduit-zstd ==0.0.2.0,
              any.config-ini ==0.2.4.0,
              config-ini -enable-doctests,
-             any.containers ==0.6.4.1,
-             any.contravariant ==1.5.4,
+             any.containers ==0.6.5.1,
+             any.contravariant ==1.5.5,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
@@ -74,44 +69,32 @@ constraints: any.Cabal ==3.2.1.0,
              any.cryptohash-sha256 ==0.11.102.0,
              cryptohash-sha256 -exe +use-cbits,
              any.data-clist ==0.1.2.3,
-             any.data-default-class ==0.1.2.0,
-             any.data-fix ==0.3.1,
+             any.data-fix ==0.3.2,
              any.deepseq ==1.4.4.0,
-             any.digest ==0.0.1.3,
-             digest -bytestring-in-base,
              any.directory ==1.3.6.0,
              any.disk-free-space ==0.1.0.1,
              any.distributive ==0.6.2.1,
              distributive +semigroups +tagged,
              any.dlist ==1.0,
              dlist -werror,
-             any.easy-file ==0.2.2,
-             any.errors ==2.3.0,
              any.exceptions ==0.10.4,
-             any.extra ==1.7.9,
-             any.fast-logger ==3.0.5,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.generic-arbitrary ==0.1.0,
-             any.generics-sop ==0.5.1.1,
-             any.ghc-boot-th ==8.10.5,
+             any.ghc-boot-th ==8.10.7,
              any.ghc-byteorder ==4.11.0.0.10,
              any.ghc-prim ==0.6.1,
              any.happy ==1.20.0,
-             any.hashable ==1.3.2.0,
+             any.hashable ==1.3.3.0,
              hashable +integer-gmp -random-initial-seed,
-             any.haskell-src-exts ==1.23.1,
-             any.haskell-src-meta ==0.8.7,
              any.haskus-utils-data ==1.4,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.1,
-             any.hpath-filepath ==0.10.4,
-             any.hpath-posix ==0.13.3,
              any.hsc2hs ==0.68.7,
              hsc2hs -in-ghc-tree,
              any.hspec ==2.7.10,
              any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.7.10 || ==2.8.2,
+             any.hspec-discover ==2.7.10 || ==2.8.3,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.2.1.0,
              language-c -allwarnings +iecfpextension +usebytestrings,
              any.libarchive ==3.0.2.2,
              libarchive -cross -low-memory -system-libarchive,
-             any.libyaml ==0.1.2,
-             libyaml -no-unicode -system-libyaml,
-             any.lifted-base ==0.2.3.12,
              any.lzma-static ==5.2.5.4,
              any.megaparsec ==9.0.1,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
-             any.monad-control ==1.0.3,
-             any.monad-logger ==0.3.36,
-             monad-logger +template_haskell,
-             any.monad-loops ==0.4.3,
-             monad-loops +base4,
-             any.mono-traversable ==1.0.15.1,
              any.mtl ==2.2.2,
              any.network ==3.1.2.2,
              network -devel,
              any.network-uri ==2.6.4.1,
-             any.old-locale ==1.0.0.7,
-             any.old-time ==1.1.0.3,
              any.openssl-streams ==1.2.3.0,
              any.optics ==0.4,
              any.optics-core ==0.4,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optics-vl ==0.2.1,
              any.optparse-applicative ==0.16.1.0,
              optparse-applicative +process,
              any.os-release ==1.0.2,
@@ -167,8 +138,8 @@ constraints: any.Cabal ==3.2.1.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.1.0,
-             any.process ==1.6.9.0,
+             any.primitive ==0.7.2.0,
+             any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.regex-base ==0.94.0.1,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.4.2,
+             any.resourcet ==1.2.4.3,
              any.rts ==1.0.1,
              any.safe ==0.3.19,
              any.safe-exceptions ==0.1.7.2,
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.2.1.0,
              any.semigroupoids ==5.3.5,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
              any.setenv ==0.1.1.3,
-             any.sop-core ==0.5.0.1,
              any.split ==0.2.3.4,
              any.splitmix ==0.1.0.3,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
-             any.stm-chans ==3.0.0.4,
-             any.streaming-commons ==0.2.2.1,
-             streaming-commons -use-bytestring-builder,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
-             any.string-interpolate ==0.3.1.1,
-             string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
-             any.syb ==0.7.2.1,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
-             any.tar ==0.6.0.0,
              any.template-haskell ==2.16.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
              any.terminal-size ==0.3.2.1,
              any.terminfo ==0.4.1.4,
              any.text ==1.2.4.1,
-             any.text-conversions ==0.3.1,
              any.text-zipper ==0.11,
              any.tf-random ==0.5,
              any.th-abstraction ==0.4.2.0,
              any.th-compat ==0.1.2,
-             any.th-expand-syns ==0.4.8.0,
              any.th-lift ==0.8.2,
              any.th-lift-instances ==0.1.18,
-             any.th-orphans ==0.13.11,
-             any.th-reify-many ==0.1.9,
              any.these ==1.1.1.1,
              these +assoc,
              any.time ==1.9.3,
              any.time-compat ==1.9.6,
              time-compat -old-locale,
              any.transformers ==0.5.6.2,
-             any.transformers-base ==0.4.5.2,
+             any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
              any.transformers-compat ==0.7,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
-             any.typed-process ==0.2.6.0,
              any.unix ==2.7.2.2,
              any.unix-bytestring ==0.3.7.3,
              any.unix-compat ==0.5.3,
              unix-compat -old-time,
-             any.unix-time ==0.4.7,
              any.unliftio-core ==0.2.0.1,
              any.unordered-containers ==0.2.14.0,
              unordered-containers -debug,
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.2.1.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.0,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.vector-algorithms ==0.8.0.4,
-             vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
              any.versions ==5.0.0,
              any.vty ==5.33,
              any.word-wrap ==0.4.1,
              any.word8 ==0.1.3,
              any.xor ==0.0.1.0,
-             any.yaml ==0.11.5.0,
-             yaml +no-examples +no-exe,
-             any.zip ==1.7.1,
-             zip -dev -disable-bzip2 -disable-zstd,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
-             any.zlib-bindings ==0.1.1.5,
-             any.zstd ==0.1.2.0,
-             zstd +standalone
-index-state: hackage.haskell.org 2021-07-27T07:59:57Z
+             any.zlib-bindings ==0.1.1.5
+index-state: hackage.haskell.org 2021-08-29T16:24:29Z

cabal.ghc901.project

@@ -8,26 +8,27 @@ package ghcup
     tests: True
     flags: +tui
 
-source-repository-package
-    type: git
-    location: https://github.com/jtdaugherty/brick.git
-    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
-
-source-repository-package
-    type: git
-    location: https://github.com/Bodigrim/tar
-    tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
-
 source-repository-package
     type: git
     location: https://github.com/bgamari/terminal-size
     tag: 34ea816bd63f75f800eedac12c6908c6f3736036
 
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/libarchive
+    tag: 8587aab78dd515928024ecd82c8f215e06db85cd
+
 constraints: http-io-streams -brotli
 
 package libarchive
   flags: -system-libarchive
 
+package aeson-pretty
+  flags: +lib-only
+
+package cabal-plan
+  flags: -exe
+
 allow-newer: base, ghc-prim, template-haskell, language-c
 
 with-compiler: ghc-9.0.1

cabal.ghc901.project.freeze

@@ -1,15 +1,18 @@
 active-repositories: hackage.haskell.org:merge
 constraints: any.Cabal ==3.4.0.0,
              any.HUnit ==1.6.2.0,
-             any.HsOpenSSL ==0.11.7,
+             any.HsOpenSSL ==0.11.7.1,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
+             any.HsYAML ==0.2.1.0,
+             HsYAML -exe,
+             any.HsYAML-aeson ==0.2.0.0,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
              any.StateVar ==1.2.2,
              any.aeson ==1.5.6.0,
              aeson -bytestring-builder -cffi -developer -fast,
              any.aeson-pretty ==0.8.8,
-             aeson-pretty -lib-only,
+             aeson-pretty +lib-only,
              any.alex ==3.2.6,
              alex +small_base,
              any.ansi-terminal ==0.11,
@@ -22,7 +25,6 @@ constraints: any.Cabal ==3.4.0.0,
              async -bench,
              any.attoparsec ==0.13.2.5,
              attoparsec -developer,
-             any.auto-update ==0.1.6,
              any.base ==4.15.0.0,
              any.base-compat ==0.11.2,
              any.base-compat-batteries ==0.11.2,
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.4.0.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
-             any.bindings-DSL ==1.0.25,
              any.blaze-builder ==0.4.2.1,
-             any.brick ==0.63,
+             any.brick ==0.64,
              brick -demos,
              any.bytestring ==0.10.12.1,
              any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
-             any.bzlib-conduit ==0.3.0.2,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
+             any.cabal-plan ==0.7.2.0,
+             cabal-plan -_ -exe -license-report,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
              any.casing ==0.1.4.1,
-             any.cereal ==0.5.8.1,
-             cereal -bytestring-builder,
              any.chs-cabal ==0.1.1.0,
              any.chs-deps ==0.1.0.0,
              chs-deps -cross,
              any.clock ==0.8.2,
              clock -llvm,
-             any.cmdargs ==0.10.21,
-             cmdargs +quotation -testprog,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
              comonad +containers +distributive +indexed-traversable,
              any.composition-prelude ==3.0.0.2,
              composition-prelude -development,
              any.concurrent-output ==1.10.12,
-             any.conduit ==1.3.4.1,
-             any.conduit-extra ==1.3.5,
-             any.conduit-zstd ==0.0.2.0,
              any.config-ini ==0.2.4.0,
              config-ini -enable-doctests,
              any.containers ==0.6.4.1,
-             any.contravariant ==1.5.4,
+             any.contravariant ==1.5.5,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
@@ -74,45 +69,33 @@ constraints: any.Cabal ==3.4.0.0,
              any.cryptohash-sha256 ==0.11.102.0,
              cryptohash-sha256 -exe +use-cbits,
              any.data-clist ==0.1.2.3,
-             any.data-default-class ==0.1.2.0,
-             any.data-fix ==0.3.1,
+             any.data-fix ==0.3.2,
              any.deepseq ==1.4.5.0,
-             any.digest ==0.0.1.3,
-             digest -bytestring-in-base,
              any.directory ==1.3.6.1,
              any.disk-free-space ==0.1.0.1,
              any.distributive ==0.6.2.1,
              distributive +semigroups +tagged,
              any.dlist ==1.0,
              dlist -werror,
-             any.easy-file ==0.2.2,
-             any.errors ==2.3.0,
              any.exceptions ==0.10.4,
-             any.extra ==1.7.9,
-             any.fast-logger ==3.0.5,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.generic-arbitrary ==0.1.0,
-             any.generics-sop ==0.5.1.1,
              any.ghc-bignum ==1.0,
              any.ghc-boot-th ==9.0.1,
              any.ghc-byteorder ==4.11.0.0.10,
              any.ghc-prim ==0.7.0,
              any.happy ==1.20.0,
-             any.hashable ==1.3.2.0,
+             any.hashable ==1.3.3.0,
              hashable +integer-gmp -random-initial-seed,
-             any.haskell-src-exts ==1.23.1,
-             any.haskell-src-meta ==0.8.7,
              any.haskus-utils-data ==1.4,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.1,
-             any.hpath-filepath ==0.10.4,
-             any.hpath-posix ==0.13.3,
              any.hsc2hs ==0.68.7,
              hsc2hs -in-ghc-tree,
              any.hspec ==2.7.10,
              any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.7.10 || ==2.8.2,
+             any.hspec-discover ==2.7.10 || ==2.8.3,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.4.0.0,
              language-c -allwarnings +iecfpextension +usebytestrings,
              any.libarchive ==3.0.2.2,
              libarchive -cross -low-memory -system-libarchive,
-             any.libyaml ==0.1.2,
-             libyaml -no-unicode -system-libyaml,
-             any.lifted-base ==0.2.3.12,
              any.lzma-static ==5.2.5.4,
              any.megaparsec ==9.0.1,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
-             any.monad-control ==1.0.3,
-             any.monad-logger ==0.3.36,
-             monad-logger +template_haskell,
-             any.monad-loops ==0.4.3,
-             monad-loops +base4,
-             any.mono-traversable ==1.0.15.1,
              any.mtl ==2.2.2,
              any.network ==3.1.2.2,
              network -devel,
              any.network-uri ==2.6.4.1,
-             any.old-locale ==1.0.0.7,
-             any.old-time ==1.1.0.3,
              any.openssl-streams ==1.2.3.0,
              any.optics ==0.4,
              any.optics-core ==0.4,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optics-vl ==0.2.1,
              any.optparse-applicative ==0.16.1.0,
              optparse-applicative +process,
              any.os-release ==1.0.2,
@@ -167,7 +138,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.1.0,
+             any.primitive ==0.7.2.0,
              any.process ==1.6.11.0,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.regex-base ==0.94.0.1,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.4.2,
+             any.resourcet ==1.2.4.3,
              any.rts ==1.0,
              any.safe ==0.3.19,
              any.safe-exceptions ==0.1.7.2,
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.4.0.0,
              any.semigroupoids ==5.3.5,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
              any.setenv ==0.1.1.3,
-             any.sop-core ==0.5.0.1,
              any.split ==0.2.3.4,
              any.splitmix ==0.1.0.3,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.0,
-             any.stm-chans ==3.0.0.4,
-             any.streaming-commons ==0.2.2.1,
-             streaming-commons -use-bytestring-builder,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
-             any.string-interpolate ==0.3.1.1,
-             string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
-             any.syb ==0.7.2.1,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
-             any.tar ==0.6.0.0,
              any.template-haskell ==2.17.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
              any.terminal-size ==0.3.2.1,
              any.terminfo ==0.4.1.4,
              any.text ==1.2.4.1,
-             any.text-conversions ==0.3.1,
              any.text-zipper ==0.11,
              any.tf-random ==0.5,
              any.th-abstraction ==0.4.2.0,
              any.th-compat ==0.1.2,
-             any.th-expand-syns ==0.4.8.0,
              any.th-lift ==0.8.2,
              any.th-lift-instances ==0.1.18,
-             any.th-orphans ==0.13.11,
-             any.th-reify-many ==0.1.9,
              any.these ==1.1.1.1,
              these +assoc,
              any.time ==1.9.3,
              any.time-compat ==1.9.6,
              time-compat -old-locale,
              any.transformers ==0.5.6.2,
-             any.transformers-base ==0.4.5.2,
+             any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
              any.transformers-compat ==0.7,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
-             any.typed-process ==0.2.6.0,
              any.unix ==2.7.2.2,
              any.unix-bytestring ==0.3.7.3,
              any.unix-compat ==0.5.3,
              unix-compat -old-time,
-             any.unix-time ==0.4.7,
              any.unliftio-core ==0.2.0.1,
              any.unordered-containers ==0.2.14.0,
              unordered-containers -debug,
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.4.0.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.0,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.vector-algorithms ==0.8.0.4,
-             vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
              any.versions ==5.0.0,
              any.vty ==5.33,
              any.word-wrap ==0.4.1,
              any.word8 ==0.1.3,
              any.xor ==0.0.1.0,
-             any.yaml ==0.11.5.0,
-             yaml +no-examples +no-exe,
-             any.zip ==1.7.1,
-             zip -dev -disable-bzip2 -disable-zstd,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
-             any.zlib-bindings ==0.1.1.5,
-             any.zstd ==0.1.2.0,
-             zstd +standalone
-index-state: hackage.haskell.org 2021-07-27T07:59:57Z
+             any.zlib-bindings ==0.1.1.5
+index-state: hackage.haskell.org 2021-08-29T16:24:29Z

cabal.project

@@ -16,11 +16,17 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/hasufell/libarchive
-    tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
+    tag: 8587aab78dd515928024ecd82c8f215e06db85cd
 
 constraints: http-io-streams -brotli
 
 package libarchive
   flags: -system-libarchive
 
+package aeson-pretty
+  flags: +lib-only
+
+package cabal-plan
+  flags: -exe
+
 allow-newer: base, ghc-prim, template-haskell, language-c

data/build_mk/cross

@@ -0,0 +1,9 @@
+V=0
+BUILD_MAN = NO
+BUILD_SPHINX_HTML = NO
+BUILD_SPHINX_PDF = NO
+HADDOCK_DOCS = NO
+ifneq "$(BuildFlavour)" ""
+include mk/flavours/$(BuildFlavour).mk
+endif
+Stage1Only = YES

data/build_mk/default

@@ -0,0 +1,8 @@
+V=0
+BUILD_MAN = NO
+BUILD_SPHINX_HTML = NO
+BUILD_SPHINX_PDF = NO
+HADDOCK_DOCS = YES
+ifneq "$(BuildFlavour)" ""
+include mk/flavours/$(BuildFlavour).mk
+endif

data/metadata/ghcup-0.0.6.yaml

@@ -1690,7 +1690,6 @@ ghcupDownloads:
               dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
     8.10.6:
       viTags:
-      - Recommended
       - base-4.14.3.0
       viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
       viSourceDL:
@@ -1789,6 +1788,107 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.10.6/ghc-8.10.6-armv7-deb10-linux.tar.xz
               dlSubdir: ghc-8.10.6
               dlHash: d54de8306aa8b33afabf2ac94408e1f82c8e982a2a3346168c071b92bdb464c0
+    8.10.7:
+      viTags:
+      - Recommended
+      - base-4.14.3.0
+      viChangeLog: https://downloads.haskell.org/~ghc/8.10.7/docs/html/users_guide/8.10.7-notes.html
+      viSourceDL:
+        dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-src.tar.xz
+        dlSubdir: ghc-8.10.7
+        dlHash: e3eef6229ce9908dfe1ea41436befb0455fefb1932559e860ad4c606b0d03c9d
+      viPostRemove: *ghc-post-remove
+      viPreCompile: *ghc-pre-compile
+      viArch:
+        A_64:
+          Linux_Debian:
+            '( >= 9 && < 10 )': &ghc-8107-64-deb9
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb9-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: ced9870ea351af64fb48274b81a664cdb6a9266775f1598a79cbb6fdd5770a23
+            '( >= 10 && < 11 )': &ghc-8107-64-deb10
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb10-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: a13719bca87a0d3ac0c7d4157a4e60887009a7f1a8dbe95c4759ec413e086d30
+            unknown_versioning: *ghc-8107-64-deb9
+          Linux_Ubuntu:
+            unknown_versioning: &ghc-8107-64-fedora
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-fedora27-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: b6ed67049a23054a8042e65c9976d5e196e5ee4e83b29b2ee35c8a22ab1e5b73
+            '( >= 16 && < 19 )': *ghc-8107-64-deb9
+          Linux_Mint:
+            unknown_versioning: *ghc-8107-64-deb10
+          Linux_Fedora:
+            '( >= 27 && < 28 )': *ghc-8107-64-fedora
+            unknown_versioning: *ghc-8107-64-fedora
+          Linux_CentOS:
+            '( >= 7 && < 8 )': &ghc-8107-64-centos
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-centos7-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: 262a50bfb5b7c8770e0d99f54d42e5876968da7bf93e2e4d6cfe397891a36d05
+            unknown_versioning: *ghc-8107-64-centos
+          Linux_RedHat:
+            unknown_versioning: *ghc-8107-64-centos
+          Linux_Alpine:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-alpine3.10-linux-integer-simple.tar.xz
+              dlSubdir: ghc-8.10.7-x86_64-unknown-linux
+              dlHash: 16903df850ef73d5246f2ff169cbf57ecab76c2ac5acfa9928934282cfad575c
+          Linux_AmazonLinux:
+            unknown_versioning: *ghc-8107-64-centos
+          Linux_UnknownLinux:
+            unknown_versioning: *ghc-8107-64-fedora
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-apple-darwin.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: 287db0f9c338c9f53123bfa8731b0996803ee50f6ee847fe388092e5e5132047
+          FreeBSD:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-freebsd.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: 45e35d24bc700e1093efa39189e9fa01498069881aed2fa8779c011941a80da1
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: b6515b0ea3f7a6e34d92e7fcd0c1fef50d6030fe8f46883000185289a4b8ea9a
+        A_32:
+          Linux_Debian:
+            '( >= 9 && < 10 )': &ghc-8107-32-deb9
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-i386-deb9-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: fbfc1ef194f4e7a4c0da8c11cc69b17458a4b928b609b3622c97acc4acd5c5ab
+            unknown_versioning: *ghc-8107-32-deb9
+          Linux_Ubuntu:
+            unknown_versioning: *ghc-8107-32-deb9
+          Linux_Mint:
+            unknown_versioning: *ghc-8107-32-deb9
+          Linux_UnknownLinux:
+            unknown_versioning: *ghc-8107-32-deb9
+          Linux_Alpine:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/8.10.7/ghc-8.10.7-i386-alpine-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: 3110e6ee029d9d8062158b54b06f71a21b0fac87bf0e085f9be5bbcf73f99e6d
+        A_ARM64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-deb10-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: fad2417f9b295233bf8ade79c0e6140896359e87be46cb61cd1d35863d9d0e55
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-aarch64-apple-darwin.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: dc469fc3c35fd2a33a5a575ffce87f13de7b98c2d349a41002e200a56d9bba1c
+        A_ARM:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-armv7-deb10-linux.tar.xz
+              dlSubdir: ghc-8.10.7
+              dlHash: 3949c31bdf7d3b4afb765ea8246bca4ca9707c5d988d9961a244f0da100956a2
     9.0.1:
       viTags:
       - Latest

docs/RELEASING.md

@@ -0,0 +1,21 @@
+# RELEASING
+
+1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script)
+
+2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
+
+3. Add ChangeLog entry
+
+4. Add/fix downloads in `ghcup-<ver>.yaml` (under `data/metadata`), then verify with `ghcup-gen check -f ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats).
+
+5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
+
+6. Download release artifacts and upload them `downloads.haskell.org/ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
+
+7. Add ghcup release artifacts to ALL yaml files (see point 4.)
+
+8. Upload the final `ghcup-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.
+
+9. Update `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
+
+10. Update the ghcup symlinks at `downloads.haskell.org/ghcup`

ghcup.cabal

@@ -16,14 +16,19 @@ description:
 category:        System
 build-type:      Simple
 extra-doc-files:
-  CHANGELOG.md
-  config.yaml
-  ghcup-0.0.4.yaml
-  ghcup-0.0.5.yaml
-  ghcup-0.0.6.yaml
-  HACKING.md
   README.md
-  RELEASING.md
+  docs/CHANGELOG.md
+  docs/HACKING.md
+  docs/RELEASING.md
+  data/config.yaml
+  data/metadata/ghcup-0.0.4.yaml
+  data/metadata/ghcup-0.0.5.yaml
+  data/metadata/ghcup-0.0.6.yaml
+  data/metadata/ghcup-0.0.7.yaml
+
+extra-source-files:
+  data/build_mk/default
+  data/build_mk/cross
 
 source-repository head
   type:     git
@@ -103,14 +108,12 @@ library
     , deepseq               ^>=1.4.4.0
     , directory             ^>=1.3.6.0
     , disk-free-space       ^>=0.1.0.1
-    , extra                 ^>=1.7.9
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  >=3.0        && <3.2
     , libarchive            ^>=3.0.0.0
     , lzma-static           ^>=5.2.5.3
     , megaparsec            >=8.0.0      && <9.1
-    , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optics                ^>=0.4
     , os-release            ^>=1.0.0
@@ -122,7 +125,6 @@ library
     , safe-exceptions       ^>=0.1
     , split                 ^>=0.2.3.4
     , strict-base           ^>=0.4
-    , string-interpolate    >=0.2.0.0    && <0.4
     , template-haskell      >=2.7        && <2.18
     , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
@@ -134,8 +136,7 @@ library
     , vector                ^>=0.12
     , versions              >=4.0.1      && <5.1
     , word8                 ^>=0.1.3
-    , yaml                  ^>=0.11.4.0
-    , zip                   ^>=1.7.1
+    , HsYAML-aeson          ^>=0.2.0.0
     , zlib                  ^>=0.6.2.2
 
   if (flag(internal-downloader) && !os(windows))
@@ -186,9 +187,12 @@ executable ghcup
     -fwarn-incomplete-record-updates -threaded
 
   build-depends:
+    , aeson                 >=1.4      && <1.6
+    , aeson-pretty          ^>=0.8.8
     , async                 ^>=2.2.3
     , base                  >=4.13     && <5
     , bytestring            ^>=0.10
+    , cabal-plan            ^>=0.7.2
     , containers            ^>=0.6
     , deepseq               ^>=1.4
     , filepath              ^>=1.4.2.1
@@ -196,7 +200,6 @@ executable ghcup
     , haskus-utils-variant  >=3.0      && <3.2
     , libarchive            ^>=3.0.0.0
     , megaparsec            >=8.0.0    && <9.1
-    , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optparse-applicative  >=0.15.1.0 && <0.17
     , pretty                ^>=1.1.3.1
@@ -204,13 +207,12 @@ executable ghcup
     , resourcet             ^>=1.2.2
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
-    , string-interpolate    >=0.2.0.0  && <0.4
     , template-haskell      >=2.7      && <2.18
     , text                  ^>=1.2.4.0
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
     , versions              >=4.0.1    && <5.1
-    , yaml                  ^>=0.11.4.0
+    , HsYAML-aeson          ^>=0.2.0.0
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
@@ -259,7 +261,6 @@ executable ghcup-gen
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
     , libarchive            ^>=3.0.0.0
-    , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optics                ^>=0.4
     , optparse-applicative  >=0.15.1.0 && <0.17
@@ -268,11 +269,10 @@ executable ghcup-gen
     , regex-posix           ^>=0.96
     , resourcet             ^>=1.2.2
     , safe-exceptions       ^>=0.1
-    , string-interpolate    >=0.2.0.0  && <0.4
     , text                  ^>=1.2.4.0
     , transformers          ^>=0.5
     , versions              >=4.0.1    && <5.1
-    , yaml                  ^>=0.11.4.0
+    , HsYAML-aeson          ^>=0.2.0.0
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0

lib/GHCup.hs

@@ -48,7 +48,6 @@ import           Control.Monad
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
@@ -58,19 +57,18 @@ import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
 import           Data.ByteString                ( ByteString )
 import           Data.Either
 import           Data.List
-import           Data.List.Extra
 import           Data.Maybe
 import           Data.String                    ( fromString )
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Time.Clock
 import           Data.Time.Format.ISO8601
 import           Data.Versions
 import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax     ( Quasi(qAddDependentFile) )
 import           Optics
 import           Prelude                 hiding ( abs
-                                                , readFile
                                                 , writeFile
                                                 )
 import           Safe                    hiding ( at )
@@ -90,6 +88,7 @@ import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
 #if defined(IS_WINDOWS)
 import qualified System.Win32.File             as Win32
@@ -112,7 +111,7 @@ fetchToolBindist :: ( MonadFail m
                     , HasSettings env
                     , HasPlatformReq env
                     , HasGHCupInfo env
-                    , MonadLogger m
+                    , HasLog env
                     , MonadResource m
                     , MonadIO m
                     , MonadUnliftIO m
@@ -140,7 +139,7 @@ fetchGHCSrc :: ( MonadFail m
                , HasSettings env
                , HasPlatformReq env
                , HasGHCupInfo env
-               , MonadLogger m
+               , HasLog env
                , MonadResource m
                , MonadIO m
                , MonadUnliftIO m
@@ -177,7 +176,7 @@ installGHCBindist :: ( MonadFail m
                      , HasDirs env
                      , HasSettings env
                      , HasPlatformReq env
-                     , MonadLogger m
+                     , HasLog env
                      , MonadResource m
                      , MonadIO m
                      , MonadUnliftIO m
@@ -202,7 +201,7 @@ installGHCBindist :: ( MonadFail m
 installGHCBindist dlinfo ver isoFilepath = do
   let tver = mkTVer ver
 
-  lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
+  lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
 
   case isoFilepath of
     -- we only care for already installed errors in regular (non-isolated) installs
@@ -219,7 +218,7 @@ installGHCBindist dlinfo ver isoFilepath = do
   
   case isoFilepath of
     Just isoDir -> do                        -- isolated install
-      lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
+      lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
       liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
     Nothing -> do                            -- regular install
       liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
@@ -233,9 +232,9 @@ installGHCBindist dlinfo ver isoFilepath = do
     case catMaybes r of
       [] -> pure ()
       _ -> do
-        lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker"
-        lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
-        lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
+        lift $ logWarn $ "CC/LD environment variable is set. This will change the compiler/linker"
+         <> "\n" <> "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
+         <> "\n" <> "environments). If you encounter problems, unset CC and LD and reinstall."
 
 
 -- | Install a packed GHC distribution. This only deals with unpacking and the GHC
@@ -247,7 +246,7 @@ installPackedGHC :: ( MonadMask m
                     , HasPlatformReq env
                     , HasSettings env
                     , MonadThrow m
-                    , MonadLogger m
+                    , HasLog env
                     , MonadIO m
                     , MonadUnliftIO m
                     )
@@ -305,7 +304,7 @@ installUnpackedGHC :: ( MonadReader env m
                       , HasDirs env
                       , HasSettings env
                       , MonadThrow m
-                      , MonadLogger m
+                      , HasLog env
                       , MonadIO m
                       , MonadUnliftIO m
                       , MonadMask m
@@ -316,7 +315,7 @@ installUnpackedGHC :: ( MonadReader env m
                    -> Excepts '[ProcessError] m ()
 installUnpackedGHC path inst ver = do
 #if defined(IS_WINDOWS)
-  lift $ $(logInfo) "Installing GHC (this may take a while)"
+  lift $ logInfo "Installing GHC (this may take a while)"
   -- Windows bindists are relocatable and don't need
   -- to run configure.
   -- We also must make sure to preserve mtime to not confuse ghc-pkg.
@@ -333,7 +332,7 @@ installUnpackedGHC path inst ver = do
        | otherwise
        = []
 
-  lift $ $(logInfo) "Installing GHC (this may take a while)"
+  lift $ logInfo "Installing GHC (this may take a while)"
   lEM $ execLogged "sh"
                    ("./configure" : ("--prefix=" <> inst) 
                     : alpineArgs
@@ -359,7 +358,7 @@ installGHCBin :: ( MonadFail m
                  , HasGHCupInfo env
                  , HasDirs env
                  , HasSettings env
-                 , MonadLogger m
+                 , HasLog env
                  , MonadResource m
                  , MonadIO m
                  , MonadUnliftIO m
@@ -393,7 +392,7 @@ installCabalBindist :: ( MonadMask m
                        , HasPlatformReq env
                        , HasDirs env
                        , HasSettings env
-                       , MonadLogger m
+                       , HasLog env
                        , MonadResource m
                        , MonadIO m
                        , MonadUnliftIO m
@@ -417,7 +416,7 @@ installCabalBindist :: ( MonadMask m
                          m
                          ()
 installCabalBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
+  lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
@@ -448,7 +447,7 @@ installCabalBindist dlinfo ver isoFilepath = do
 
   case isoFilepath of
     Just isoDir -> do             -- isolated install
-      lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
+      lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
       liftE $ installCabalUnpacked workdir isoDir Nothing
 
     Nothing -> do                 -- regular install
@@ -460,19 +459,22 @@ installCabalBindist dlinfo ver isoFilepath = do
       when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
 
 -- | Install an unpacked cabal distribution.
-installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
+installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
               -> Maybe Version -- ^ Nothing for isolated install
               -> Excepts '[CopyError, FileAlreadyExistsError] m ()
 installCabalUnpacked path inst mver' = do
-  lift $ $(logInfo) "Installing cabal"
+  lift $ logInfo "Installing cabal"
   let cabalFile = "cabal"
   liftIO $ createDirRecursive' inst
   let destFileName = cabalFile
         <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
         <> exeExt
   let destPath = inst </> destFileName
+
+  liftE $ throwIfFileAlreadyExists destPath
+    
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> cabalFile <> exeExt)
     destPath
@@ -488,7 +490,7 @@ installCabalBin :: ( MonadMask m
                    , HasGHCupInfo env
                    , HasDirs env
                    , HasSettings env
-                   , MonadLogger m
+                   , HasLog env
                    , MonadResource m
                    , MonadIO m
                    , MonadUnliftIO m
@@ -523,7 +525,7 @@ installHLSBindist :: ( MonadMask m
                      , HasPlatformReq env
                      , HasDirs env
                      , HasSettings env
-                     , MonadLogger m
+                     , HasLog env
                      , MonadResource m
                      , MonadIO m
                      , MonadUnliftIO m
@@ -542,11 +544,12 @@ installHLSBindist :: ( MonadMask m
                         , UnknownArchive
                         , TarDirDoesNotExist
                         , ArchiveResult
+                        , FileAlreadyExistsError
                         ]
                        m
                        ()
 installHLSBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
+  lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
@@ -572,7 +575,7 @@ installHLSBindist dlinfo ver isoFilepath = do
 
   case isoFilepath of
     Just isoDir -> do
-      lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
+      lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
       liftE $ installHLSUnpacked workdir isoDir Nothing
 
     Nothing -> do
@@ -585,13 +588,13 @@ installHLSBindist dlinfo ver isoFilepath = do
 
 
 -- | Install an unpacked hls distribution.
-installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
+installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
               -> Maybe Version -- ^ Nothing for isolated install
-              -> Excepts '[CopyError] m ()
+              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
 installHLSUnpacked path inst mver' = do
-  lift $ $(logInfo) "Installing HLS"
+  lift $ logInfo "Installing HLS"
   liftIO $ createDirRecursive' inst
 
   -- install haskell-language-server-<ghcver>
@@ -605,20 +608,32 @@ installHLSUnpacked path inst mver' = do
     let toF = dropSuffix exeExt f
               <> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
               <> exeExt
+
+    let srcPath = path </> f
+    let destPath = inst </> toF
+
+    liftE $ throwIfFileAlreadyExists destPath
+      
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-      (path </> f)
-      (inst </> toF)
-    lift $ chmod_755 (inst </> toF)
+      srcPath
+      destPath
+    lift $ chmod_755 destPath
 
   -- install haskell-language-server-wrapper
   let wrapper = "haskell-language-server-wrapper"
       toF = wrapper
             <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
             <> exeExt
+      srcWrapperPath = path </> wrapper <> exeExt
+      destWrapperPath = inst </> toF
+
+  liftE $ throwIfFileAlreadyExists destWrapperPath
+      
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
-    (path </> wrapper <> exeExt)
-    (inst </> toF)
-  lift $ chmod_755 (inst </> toF)
+    srcWrapperPath
+    destWrapperPath
+    
+  lift $ chmod_755 destWrapperPath
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -629,7 +644,7 @@ installHLSBin :: ( MonadMask m
                  , HasGHCupInfo env
                  , HasDirs env
                  , HasSettings env
-                 , MonadLogger m
+                 , HasLog env
                  , MonadResource m
                  , MonadIO m
                  , MonadUnliftIO m
@@ -647,6 +662,7 @@ installHLSBin :: ( MonadMask m
                     , UnknownArchive
                     , TarDirDoesNotExist
                     , ArchiveResult
+                    , FileAlreadyExistsError
                     ]
                    m
                    ()
@@ -665,7 +681,7 @@ installStackBin :: ( MonadMask m
                    , HasSettings env
                    , HasPlatformReq env
                    , HasGHCupInfo env
-                   , MonadLogger m
+                   , HasLog env
                    , MonadResource m
                    , MonadIO m
                    , MonadUnliftIO m
@@ -683,6 +699,7 @@ installStackBin :: ( MonadMask m
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , ArchiveResult
+                      , FileAlreadyExistsError
                       ]
                      m
                      ()
@@ -699,7 +716,7 @@ installStackBindist :: ( MonadMask m
                        , HasPlatformReq env
                        , HasDirs env
                        , HasSettings env
-                       , MonadLogger m
+                       , HasLog env
                        , MonadResource m
                        , MonadIO m
                        , MonadUnliftIO m
@@ -718,11 +735,12 @@ installStackBindist :: ( MonadMask m
                           , UnknownArchive
                           , TarDirDoesNotExist
                           , ArchiveResult
+                          , FileAlreadyExistsError
                           ]
                          m
                          ()
 installStackBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
+  lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
@@ -747,7 +765,7 @@ installStackBindist dlinfo ver isoFilepath = do
 
   case isoFilepath of
     Just isoDir -> do                 -- isolated install
-      lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
+      lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
       liftE $ installStackUnpacked workdir isoDir Nothing
     Nothing -> do                     -- regular install
       liftE $ installStackUnpacked workdir binDir (Just ver)
@@ -759,19 +777,22 @@ installStackBindist dlinfo ver isoFilepath = do
 
 
 -- | Install an unpacked stack distribution.
-installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
+installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
               -> Maybe Version -- ^ Nothing for isolated installs
-              -> Excepts '[CopyError] m ()
+              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
 installStackUnpacked path inst mver' = do
-  lift $ $(logInfo) "Installing stack"
+  lift $ logInfo "Installing stack"
   let stackFile = "stack"
   liftIO $ createDirRecursive' inst
   let destFileName = stackFile
                      <> maybe "" (("-" <>) .  T.unpack . prettyVer) mver'
                      <> exeExt
-  let destPath = inst </> destFileName
+      destPath = inst </> destFileName
+
+  liftE $ throwIfFileAlreadyExists destPath
+      
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> stackFile <> exeExt)
     destPath
@@ -795,7 +816,7 @@ installStackUnpacked path inst mver' = do
 -- for 'SetGHCOnly' constructor.
 setGHC :: ( MonadReader env m
           , HasDirs env
-          , MonadLogger m
+          , HasLog env
           , MonadThrow m
           , MonadFail m
           , MonadIO m
@@ -829,7 +850,7 @@ setGHC ver sghc = do
       SetGHCOnly -> pure $ Just file
       SetGHC_XY  -> do
         handle
-            (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+            (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
           $ do 
             (mj, mi) <- getMajorMinorV (_tvVersion ver)
             let major' = intToText mj <> "." <> intToText mi
@@ -854,7 +875,7 @@ setGHC ver sghc = do
   symlinkShareDir :: ( MonadReader env m
                      , HasDirs env
                      , MonadIO m
-                     , MonadLogger m
+                     , HasLog env
                      , MonadCatch m
                      , MonadMask m
                      )
@@ -871,9 +892,9 @@ setGHC ver sghc = do
         whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
           let fullF   = destdir </> sharedir
           let targetF = "." </> "ghc" </> ver' </> sharedir
-          $(logDebug) [i|rm -f #{fullF}|]
+          logDebug $ "rm -f " <> T.pack fullF
           hideError doesNotExistErrorType $ rmDirectoryLink fullF
-          $(logDebug) [i|ln -s #{targetF} #{fullF}|]
+          logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
           liftIO
 #if defined(IS_WINDOWS)
             -- On windows we need to be more permissive
@@ -891,7 +912,7 @@ setGHC ver sghc = do
 setCabal :: ( MonadMask m
             , MonadReader env m
             , HasDirs env
-            , MonadLogger m
+            , HasLog env
             , MonadThrow m
             , MonadFail m
             , MonadIO m
@@ -923,7 +944,7 @@ setCabal ver = do
 setHLS :: ( MonadCatch m
           , MonadReader env m
           , HasDirs env
-          , MonadLogger m
+          , HasLog env
           , MonadThrow m
           , MonadFail m
           , MonadIO m
@@ -939,7 +960,7 @@ setHLS ver = do
   -- selected version, so we could end up with stray or incorrect symlinks.
   oldSyms <- lift hlsSymlinks
   forM_ oldSyms $ \f -> do
-    lift $ $(logDebug) [i|rm #{binDir </> f}|]
+    lift $ logDebug $ "rm " <> T.pack (binDir </> f)
     lift $ rmLink (binDir </> f)
 
   -- set haskell-language-server-<ghcver> symlinks
@@ -964,7 +985,7 @@ setHLS ver = do
 setStack :: ( MonadMask m
             , MonadReader env m
             , HasDirs env
-            , MonadLogger m
+            , HasLog env
             , MonadThrow m
             , MonadFail m
             , MonadIO m
@@ -1027,9 +1048,9 @@ availableToolVersions av tool = view
 -- | List all versions from the download info, as well as stray
 -- versions.
 listVersions :: ( MonadCatch m
-                , MonadLogger m
+                , HasLog env
                 , MonadThrow m
-                , MonadLogger m
+                , HasLog env
                 , MonadIO m
                 , MonadReader env m
                 , HasDirs env
@@ -1085,7 +1106,7 @@ listVersions lt' criteria = do
                , MonadReader env m
                , HasDirs env
                , MonadThrow m
-               , MonadLogger m
+               , HasLog env
                , MonadIO m
                )
             => Map.Map Version VersionInfo
@@ -1125,15 +1146,15 @@ listVersions lt' criteria = do
           , ..
           }
       Left e -> do
-        $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+        logWarn
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayCabals :: ( MonadReader env m
                  , HasDirs env
                  , MonadCatch m
                  , MonadThrow m
-                 , MonadLogger m
+                 , HasLog env
                  , MonadIO m
                  )
             => Map.Map Version VersionInfo
@@ -1160,15 +1181,15 @@ listVersions lt' criteria = do
               , ..
               }
       Left e -> do
-        $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+        logWarn
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayHLS :: ( MonadReader env m
               , HasDirs env
               , MonadCatch m
               , MonadThrow m
-              , MonadLogger m
+              , HasLog env
               , MonadIO m)
            => Map.Map Version VersionInfo
            -> Maybe Version
@@ -1194,15 +1215,15 @@ listVersions lt' criteria = do
               , ..
               }
       Left e -> do
-        $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+        logWarn
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayStacks :: ( MonadReader env m
                  , HasDirs env
                  , MonadCatch m
                  , MonadThrow m
-                 , MonadLogger m
+                 , HasLog env
                  , MonadIO m
                  )
               => Map.Map Version VersionInfo
@@ -1229,8 +1250,8 @@ listVersions lt' criteria = do
               , ..
               }
       Left e -> do
-        $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+        logWarn
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
@@ -1254,7 +1275,7 @@ listVersions lt' criteria = do
                                            }
 
   -- NOTE: this are not cross ones, because no bindists
-  toListResult :: ( MonadLogger m
+  toListResult :: ( HasLog env
                   , MonadReader env m
                   , HasDirs env
                   , HasGHCupInfo env
@@ -1356,7 +1377,7 @@ listVersions lt' criteria = do
 rmGHCVer :: ( MonadReader env m
             , HasDirs env
             , MonadThrow m
-            , MonadLogger m
+            , HasLog env
             , MonadIO m
             , MonadFail m
             , MonadCatch m
@@ -1373,23 +1394,23 @@ rmGHCVer ver = do
 
   -- this isn't atomic, order matters
   when isSetGHC $ do
-    lift $ $(logInfo) [i|Removing ghc symlinks|]
+    lift $ logInfo "Removing ghc symlinks"
     liftE $ rmPlain (_tvTarget ver)
 
-  lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
+  lift $ logInfo "Removing ghc-x.y.z symlinks"
   liftE $ rmMinorSymlinks ver
 
-  lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
+  lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
   -- first remove
   handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
   -- then fix them (e.g. with an earlier version)
 
-  lift $ $(logInfo) [i|Removing directory recursively: #{dir}|]
+  lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
   lift $ recyclePathForcibly dir
 
   v' <-
     handle
-      (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+      (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
     $ fmap Just
     $ getMajorMinorV (_tvVersion ver)
   forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
@@ -1406,7 +1427,7 @@ rmCabalVer :: ( MonadMask m
               , MonadReader env m
               , HasDirs env
               , MonadThrow m
-              , MonadLogger m
+              , HasLog env
               , MonadIO m
               , MonadFail m
               , MonadCatch m
@@ -1437,7 +1458,7 @@ rmHLSVer :: ( MonadMask m
             , MonadReader env m
             , HasDirs env
             , MonadThrow m
-            , MonadLogger m
+            , HasLog env
             , MonadIO m
             , MonadFail m
             , MonadCatch m
@@ -1460,7 +1481,7 @@ rmHLSVer ver = do
     oldSyms <- lift hlsSymlinks
     forM_ oldSyms $ \f -> do
       let fullF = binDir </> f
-      lift $ $(logDebug) [i|rm #{fullF}|]
+      lift $ logDebug $ "rm " <> T.pack fullF
       lift $ rmLink fullF
     -- set latest hls
     hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -1475,7 +1496,7 @@ rmStackVer :: ( MonadMask m
               , MonadReader env m
               , HasDirs env
               , MonadThrow m
-              , MonadLogger m
+              , HasLog env
               , MonadIO m
               , MonadFail m
               , MonadCatch m
@@ -1505,7 +1526,7 @@ rmGhcup :: ( MonadReader env m
            , HasDirs env
            , MonadIO m
            , MonadCatch m
-           , MonadLogger m
+           , HasLog env
            , MonadMask m
            , MonadUnliftIO m
            )
@@ -1530,7 +1551,7 @@ rmGhcup = do
 
   let areEqualPaths = equalFilePath p1 p2
 
-  unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
+  unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
 
 #if defined(IS_WINDOWS)
   -- since it doesn't seem possible to delete a running exe on windows
@@ -1546,7 +1567,7 @@ rmGhcup = do
 
   where
     handlePathNotPresent fp _err = do
-      $logDebug $ "Error: The path does not exist, " <> T.pack fp
+      logDebug $ "Error: The path does not exist, " <> T.pack fp
       pure fp
 
     nonStandardInstallLocationMsg path = T.pack $
@@ -1556,7 +1577,7 @@ rmGhcup = do
 
 rmTool :: ( MonadReader env m
           , HasDirs env
-          , MonadLogger m
+          , HasLog env
           , MonadFail m
           , MonadMask m
           , MonadUnliftIO m)
@@ -1576,7 +1597,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
 rmGhcupDirs :: ( MonadReader env m
                , HasDirs env
                , MonadIO m
-               , MonadLogger m
+               , HasLog env
                , MonadCatch m
                , MonadMask m )
             => m [FilePath]
@@ -1603,7 +1624,7 @@ rmGhcupDirs = do
   handleRm $ rmBinDir binDir
   handleRm $ rmDir recycleDir
 #if defined(IS_WINDOWS)
-  $logInfo [i|removing #{(baseDir </> "msys64")}|]
+  logInfo $ "removing " <> T.pack (baseDir </> "msys64")
   handleRm $ rmPathForcibly (baseDir </> "msys64")
 #endif
 
@@ -1614,27 +1635,27 @@ rmGhcupDirs = do
   hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
 
   where
-    handleRm :: (MonadCatch m, MonadLogger m)  => m () -> m ()
-    handleRm = handleIO (\e -> $logDebug [i|Part of the cleanup action failed with error: #{displayException e}
-continuing regardless...|])
+    handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m)  => m () -> m ()
+    handleRm = handleIO (\e -> logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
+                                <> "continuing regardless...")
 
-    rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
+    rmEnvFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmEnvFile enFilePath = do
-      $logInfo "Removing Ghcup Environment File"
+      logInfo "Removing Ghcup Environment File"
       hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
 
-    rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
+    rmConfFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmConfFile confFilePath = do
-      $logInfo "removing Ghcup Config File"
+      logInfo "removing Ghcup Config File"
       hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
 
-    rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
+    rmDir :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmDir dir =
       -- 'getDirectoryContentsRecursive' is lazy IO. In case
       -- an error leaks through, we catch it here as well,
       -- althought 'deleteFile' should already handle it.
       hideErrorDef [doesNotExistErrorType] () $ do
-        $logInfo [i|removing #{dir}|]
+        logInfo $ "removing " <> T.pack dir
         contents <- liftIO $ getDirectoryContentsRecursive dir
         forM_ contents (deleteFile . (dir </>))
 
@@ -1707,7 +1728,7 @@ getDebugInfo :: ( Alternative m
                 , MonadFail m
                 , MonadReader env m
                 , HasDirs env
-                , MonadLogger m
+                , HasLog env
                 , MonadCatch m
                 , MonadIO m
                 )
@@ -1743,7 +1764,7 @@ compileGHC :: ( MonadMask m
               , HasSettings env
               , MonadThrow m
               , MonadResource m
-              , MonadLogger m
+              , HasLog env
               , MonadIO m
               , MonadUnliftIO m
               , MonadFail m
@@ -1783,7 +1804,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
       Left tver -> do
-        lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
+        lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
         dlInfo <-
@@ -1808,7 +1829,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
         tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
-          lift $ $(logInfo) [i|Fetching git repo #{rep} at ref #{ref} (this may take a while)|]
+          lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
           lEM $ git [ "init" ]
           lEM $ git [ "remote"
                     , "add"
@@ -1835,7 +1856,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
             ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
 
         liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
-        lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|]
+        lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
 
         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
     -- the version that's installed may differ from the
@@ -1847,10 +1868,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     when alreadyInstalled $ do
       case isolateDir of
         Just isoDir ->
-          lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
+          lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
         Nothing ->
-          lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
-      lift $ $(logWarn)
+          lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
+      lift $ logWarn
         "...waiting for 10 seconds before continuing, you can still abort..."
       liftIO $ threadDelay 10000000 -- give the user a sec to intervene
 
@@ -1877,7 +1898,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
       Nothing ->
         -- only remove old ghc in regular installs
         when alreadyInstalled $ do
-          lift $ $(logInfo) [i|Deleting existing installation|]
+          lift $ logInfo "Deleting existing installation"
           liftE $ rmGHCVer tver
           
       _ -> pure ()
@@ -1902,26 +1923,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     pure tver
 
  where
-  defaultConf = case targetGhc of
-    Left (GHCTargetVersion (Just _) _) -> [s|
-V=0
-BUILD_MAN = NO
-BUILD_SPHINX_HTML = NO
-BUILD_SPHINX_PDF = NO
-HADDOCK_DOCS = NO
-ifneq "$(BuildFlavour)" ""
-include mk/flavours/$(BuildFlavour).mk
-endif
-Stage1Only = YES|]
-    _ -> [s|
-V=0
-BUILD_MAN = NO
-BUILD_SPHINX_HTML = NO
-BUILD_SPHINX_PDF = NO
-HADDOCK_DOCS = YES
-ifneq "$(BuildFlavour)" ""
-include mk/flavours/$(BuildFlavour).mk
-endif|]
+  defaultConf = 
+    let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
+        default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
+    in case targetGhc of
+         Left (GHCTargetVersion (Just _) _) -> cross_mk
+         _ -> default_mk
 
   compileHadrianBindist :: ( MonadReader env m
                            , HasDirs env
@@ -1929,7 +1936,7 @@ endif|]
                            , HasPlatformReq env
                            , MonadThrow m
                            , MonadCatch m
-                           , MonadLogger m
+                           , HasLog env
                            , MonadIO m
                            , MonadFail m
                            )
@@ -1952,11 +1959,11 @@ endif|]
 
     liftE $ configureBindist bghc tver workdir ghcdir
 
-    lift $ $(logInfo) [i|Building (this may take a while)...|]
+    lift $ logInfo "Building (this may take a while)..."
     hadrian_build <- liftE $ findHadrianFile workdir
     lEM $ execLogged hadrian_build
-                          ( maybe [] (\j  -> [[i|-j#{j}|]]         ) jobs
-                         ++ maybe [] (\bf -> [[i|--flavour=#{bf}|]]) buildFlavour
+                          ( maybe [] (\j  -> ["-j" <> show j]         ) jobs
+                         ++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
                          ++ ["binary-dist"]
                           )
                           (Just workdir) "ghc-make" Nothing
@@ -1991,7 +1998,7 @@ endif|]
                         , HasPlatformReq env
                         , MonadThrow m
                         , MonadCatch m
-                        , MonadLogger m
+                        , HasLog env
                         , MonadIO m
                         , MonadFail m
                         )
@@ -2018,19 +2025,19 @@ endif|]
         (FileDoesNotExistError bc)
         (liftIO $ copyFile bc (build_mk workdir))
       Nothing ->
-        liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
+        liftIO $ T.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
 
     liftE $ checkBuildConfig (build_mk workdir)
 
-    lift $ $(logInfo) [i|Building (this may take a while)...|]
+    lift $ logInfo "Building (this may take a while)..."
     lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
 
     if | isCross tver -> do
-          lift $ $(logInfo) [i|Installing cross toolchain...|]
+          lift $ logInfo "Installing cross toolchain..."
           lEM $ make ["install"] (Just workdir)
           pure Nothing
        | otherwise -> do
-          lift $ $(logInfo) [i|Creating bindist...|]
+          lift $ logInfo "Creating bindist..."
           lEM $ make ["binary-dist"] (Just workdir)
           [tar] <- liftIO $ findFiles
             workdir
@@ -2049,7 +2056,7 @@ endif|]
                  , MonadIO m
                  , MonadThrow m
                  , MonadCatch m
-                 , MonadLogger m
+                 , HasLog env
                  )
               => GHCTargetVersion
               -> FilePath           -- ^ tar file
@@ -2071,14 +2078,23 @@ endif|]
       . SHA256.hashlazy
       $ c
     cTime <- liftIO getCurrentTime
-    let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|]
+    let tarName = makeValid ("ghc-"
+                            <> T.unpack (tVerToText tver)
+                            <> "-"
+                            <> pfReqToString pfreq
+                            <> "-"
+                            <> iso8601Show cTime
+                            <> "-"
+                            <> T.unpack cDigest
+                            <> ".tar"
+                            <> takeExtension tar)
     let tarPath = cacheDir </> tarName
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
                                                              tarPath
-    lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
+    lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
     pure tarPath
 
-  checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
+  checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
                    => FilePath
                    -> Excepts
                         '[FileDoesNotExistError, InvalidBuildConfig]
@@ -2100,13 +2116,12 @@ endif|]
       _ -> pure ()
 
     forM_ buildFlavour $ \bf ->
-      when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do
-        lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|]
+      when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
+        lift $ logWarn $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
         liftIO $ threadDelay 5000000
 
   addBuildFlavourToConf bc = case buildFlavour of
-    Just bf -> [i|BuildFlavour = #{bf}
-|] <> [i|#{bc}|]
+    Just bf -> "BuildFlavour = " <> T.pack bf <> "\n" <> bc
     Nothing -> bc
 
   isCross :: GHCTargetVersion -> Bool
@@ -2119,7 +2134,7 @@ endif|]
                       , HasPlatformReq env
                       , MonadThrow m
                       , MonadCatch m
-                      , MonadLogger m
+                      , HasLog env
                       , MonadIO m
                       , MonadFail m
                       )
@@ -2138,7 +2153,7 @@ endif|]
                         m
                         ()
   configureBindist bghc tver workdir ghcdir = do
-    lift $ $(logInfo) [s|configuring build|]
+    lift $ logInfo [s|configuring build|]
     
     forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
 
@@ -2202,7 +2217,7 @@ upgradeGHCup :: ( MonadMask m
                 , HasGHCupInfo env
                 , HasSettings env
                 , MonadCatch m
-                , MonadLogger m
+                , HasLog env
                 , MonadThrow m
                 , MonadResource m
                 , MonadIO m
@@ -2224,7 +2239,7 @@ upgradeGHCup mtarget force' = do
   Dirs {..} <- lift getDirs
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
-  lift $ $(logInfo) [i|Upgrading GHCup...|]
+  lift $ logInfo "Upgrading GHCup..."
   let latestVer = fromJust $ fst <$> getLatest dls GHCup
   when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
   dli   <- liftE $ getDownloadInfo GHCup latestVer
@@ -2233,20 +2248,28 @@ upgradeGHCup mtarget force' = do
   p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
   let destDir = takeDirectory destFile
       destFile = fromMaybe (binDir </> fn) mtarget
-  lift $ $(logDebug) [i|mkdir -p #{destDir}|]
+  lift $ logDebug $ "mkdir -p " <> T.pack destDir
   liftIO $ createDirRecursive' destDir
-  lift $ $(logDebug) [i|rm -f #{destFile}|]
+  lift $ logDebug $ "rm -f " <> T.pack destFile
   lift $ hideError NoSuchThing $ recycleFile destFile
-  lift $ $(logDebug) [i|cp #{p} #{destFile}|]
+  lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
                                                            destFile
   lift $ chmod_755 destFile
 
   liftIO (isInPath destFile) >>= \b -> unless b $
-    lift $ $(logWarn) [i|"#{takeFileName destFile}" is not in PATH! You have to add it in order to use ghcup.|]
+    lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
   liftIO (isShadowed destFile) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{pa}". The upgrade will not be in effect, unless you remove "#{pa}" or make sure "#{destDir}" comes before "#{takeFileName pa}" in PATH.|]
+    Just pa -> lift $ logWarn $ "ghcup is shadowed by "
+      <> T.pack pa
+      <> ". The upgrade will not be in effect, unless you remove "
+      <> T.pack pa
+      <> " or make sure "
+      <> T.pack destDir
+      <> " comes before "
+      <> T.pack (takeFileName pa)
+      <> " in PATH."
 
   pure latestVer
 
@@ -2262,7 +2285,7 @@ upgradeGHCup mtarget force' = do
 -- both installing from source and bindist.
 postGHCInstall :: ( MonadReader env m
                   , HasDirs env
-                  , MonadLogger m
+                  , HasLog env
                   , MonadThrow m
                   , MonadFail m
                   , MonadIO m
@@ -2278,7 +2301,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
   -- Create ghc-x.y symlinks. This may not be the current
   -- version, create it regardless.
   v' <-
-    handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+    handle (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
     $ fmap Just
     $ getMajorMinorV _tvVersion
   forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
@@ -2294,7 +2317,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
 --   * for ghcup, this reports the location of the currently running executable
 whereIsTool :: ( MonadReader env m
                , HasDirs env
-               , MonadLogger m
+               , HasLog env
                , MonadThrow m
                , MonadFail m
                , MonadIO m
@@ -2332,3 +2355,10 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
       liftIO $ canonicalizePath currentRunningExecPath
 
 
+throwIfFileAlreadyExists :: ( MonadIO m ) =>
+                            FilePath ->
+                            Excepts '[FileAlreadyExistsError] m ()
+
+throwIfFileAlreadyExists fp = whenM (checkFileAlreadyExists fp)
+                                (throwE $ FileAlreadyExistsError fp)
+

lib/GHCup/Download.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 
@@ -34,8 +31,8 @@ import           GHCup.Download.Utils
 #endif
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
+import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
 import           GHCup.Utils.Prelude
@@ -47,7 +44,6 @@ import           Control.Monad
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
@@ -57,9 +53,8 @@ import           Data.ByteString                ( ByteString )
 #if defined(INTERNAL_DOWNLOADER)
 import           Data.CaseInsensitive           ( mk )
 #endif
-import           Data.List.Extra
 import           Data.Maybe
-import           Data.String.Interpolate
+import           Data.List
 import           Data.Time.Clock
 import           Data.Time.Clock.POSIX
 import           Data.Versions
@@ -73,6 +68,7 @@ import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
                                                 )
+import           Safe
 import           System.Directory
 import           System.Environment
 import           System.Exit
@@ -90,7 +86,7 @@ import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
-import qualified Data.Yaml                     as Y
+import qualified Data.YAML.Aeson               as Y
 
 
 
@@ -112,7 +108,7 @@ getDownloadsF :: ( FromJSONKey Tool
                  , HasDirs env
                  , MonadIO m
                  , MonadCatch m
-                 , MonadLogger m
+                 , HasLog env
                  , MonadThrow m
                  , MonadFail m
                  , MonadMask m
@@ -165,7 +161,7 @@ getBase :: ( MonadReader env m
            , MonadFail m
            , MonadIO m
            , MonadCatch m
-           , MonadLogger m
+           , HasLog env
            , MonadMask m
            )
         => URI
@@ -187,28 +183,27 @@ getBase uri = do
 
   -- if we didn't get a filepath from the download, use the cached yaml
   actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
-  lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|]
+  yamlContents <- liftIO $ L.readFile actualYaml
+  lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
 
   liftE
     . onE_ (onError actualYaml)
-    . lEM' @_ @_ @'[JSONError] JSONDecodeError
-    . fmap (first (\e -> [i|#{displayException e}
-Consider removing "#{actualYaml}" manually.|]))
-    . liftIO
-    . Y.decodeFileEither
-    $ actualYaml
+    . lE' @_ @_ @'[JSONError] JSONDecodeError
+    . first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
+    . Y.decode1
+    $ yamlContents
  where
   -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
   -- may re-download and succeed.
-  onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
+  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
   onError fp = do
     let efp = etagsFile fp
-    handleIO (\e -> $(logWarn) [i|Couldn't remove file #{efp}, error was: #{displayException e}|])
+    handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
       (hideError doesNotExistErrorType $ rmFile efp)
     liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
   warnCache s = do
-    lift $ $(logWarn) [i|Could not get download info, trying cached version (this may not be recent!)|]
-    lift $ $(logDebug) [i|Error was: #{s}|]
+    lift $ logWarn "Could not get download info, trying cached version (this may not be recent!)"
+    lift $ logDebug $ "Error was: " <> T.pack s
 
   -- First check if the json file is in the ~/.ghcup/cache dir
   -- and check it's access time. If it has been accessed within the
@@ -222,7 +217,7 @@ Consider removing "#{actualYaml}" manually.|]))
              , MonadCatch m1
              , MonadIO m1
              , MonadFail m1
-             , MonadLogger m1
+             , HasLog env1
              , MonadMask m1
              )
           => URI
@@ -313,7 +308,7 @@ download :: ( MonadReader env m
             , HasDirs env
             , MonadMask m
             , MonadThrow m
-            , MonadLogger m
+            , HasLog env
             , MonadIO m
             )
          => URI
@@ -327,7 +322,7 @@ download uri eDigest dest mfn etags
   | scheme == "http"  = dl
   | scheme == "file"  = do
       let destFile' = T.unpack . decUTF8Safe $ path
-      lift $ $(logDebug) [i|using local file: #{destFile'}|]
+      lift $ logDebug $ "using local file: " <> T.pack destFile'
       forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
@@ -336,7 +331,7 @@ download uri eDigest dest mfn etags
   scheme = view (uriSchemeL' % schemeBSL') uri
   dl = do
     destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
-    lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
+    lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
 
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
@@ -359,10 +354,10 @@ download uri eDigest dest mfn etags
                       dh <- liftIO $ emptySystemTempFile "curl-header"
                       flip finally (try @_ @SomeException $ rmFile dh) $
                         flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
-                          metag <- readETag destFile
+                          metag <- lift $ readETag destFile
                           liftE $ lEM @_ @'[ProcessError] $ exec "curl"
                               (o' ++ (if etags then ["--dump-header", dh] else [])
-                                  ++ maybe [] (\t -> ["-H", [i|If-None-Match: #{t}|]]) metag
+                                  ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
                                   ++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
                           headers <- liftIO $ T.readFile dh
 
@@ -371,14 +366,14 @@ download uri eDigest dest mfn etags
                           case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
                             Just (http':sc:_)
                               | sc == "304"
-                              , T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|]
+                              , T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
                               | T.pack "HTTP" `T.isPrefixOf` http' -> do
-                                  $logDebug [i|Status code was #{sc}, overwriting|]
+                                  lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
                                   liftIO $ copyFile (destFile <.> "tmp") destFile
                             _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
                               :: V '[MalformedHeaders]))
 
-                          writeEtags destFile (parseEtags headers)
+                          lift $ writeEtags destFile (parseEtags headers)
                     else
                       liftE $ lEM @_ @'[ProcessError] $ exec "curl" 
                         (o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
@@ -388,20 +383,20 @@ download uri eDigest dest mfn etags
                     o' <- liftIO getWgetOpts
                     if etags
                       then do
-                        metag <- readETag destFile
-                        let opts = o' ++ maybe [] (\t -> ["--header", [i|If-None-Match: #{t}|]]) metag
+                        metag <- lift $ readETag destFile
+                        let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
                                       ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
                         CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
                         case _exitCode of
                           ExitSuccess -> do
                             liftIO $ copyFile destFileTemp destFile
-                            writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+                            lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
                           ExitFailure i'
                             | i' == 8
                             , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
                                      -> do
-                                          $logDebug "Not modified, skipping download"
-                                          writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+                                          lift $ logDebug "Not modified, skipping download"
+                                          lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
                             | otherwise -> throwE (NonZeroExit i' "wget" opts)
                       else do
                         let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
@@ -412,14 +407,14 @@ download uri eDigest dest mfn etags
                   (https, host, fullPath, port) <- liftE $ uriToQuadruple uri
                   if etags
                     then do
-                      metag <- readETag destFile
+                      metag <- lift $ readETag destFile
                       let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
                                                                          , E.encodeUtf8 etag)]) metag
                       liftE
                         $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
                         $ do
                           r <- downloadToFile https host fullPath port destFile addHeaders
-                          writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
+                          lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
                     else void $ liftE $ catchE @HTTPNotModified
                                         @'[DownloadFailed]
                                    (\e@(HTTPNotModified _) ->
@@ -445,33 +440,33 @@ download uri eDigest dest mfn etags
   path = view pathL' uri
   uri' = decUTF8Safe (serializeURIRef' uri)
 
-  parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
+  parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
   parseEtags stderr = do
     let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
     case T.words <$> mEtag of
       (Just []) -> do
-        $logDebug "Couldn't parse etags, no input: "
+        logDebug "Couldn't parse etags, no input: "
         pure Nothing
       (Just [_, etag']) -> do
-        $logDebug [i|Parsed etag: #{etag'}|]
+        logDebug $ "Parsed etag: " <> etag'
         pure (Just etag')
       (Just xs) -> do
-        $logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
+        logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
         pure Nothing
       Nothing -> do
-        $logDebug "No etags header found"
+        logDebug "No etags header found"
         pure Nothing
 
-  writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
+  writeEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
   writeEtags destFile getTags = do
     getTags >>= \case
       Just t -> do
-        $logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]
+        logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
         liftIO $ T.writeFile (etagsFile destFile) t
       Nothing ->
-        $logDebug [i|No etags files written|]
+        logDebug "No etags files written"
 
-  readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
+  readETag :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
   readETag fp = do
     e <- liftIO $ doesFileExist fp
     if e
@@ -479,13 +474,13 @@ download uri eDigest dest mfn etags
       rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
       case rE of
         (Right et) -> do
-          $logDebug [i|Read etag: #{et}|]
+          logDebug $ "Read etag: " <> et
           pure (Just et)
         (Left _) -> do
-          $logDebug [i|Etag file doesn't exist (yet)|]
+          logDebug "Etag file doesn't exist (yet)"
           pure Nothing
     else do
-      $logDebug [i|Skipping and deleting etags file because destination file #{fp} doesn't exist|]
+      logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist"
       liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
       pure Nothing
 
@@ -498,7 +493,7 @@ downloadCached :: ( MonadReader env m
                   , MonadMask m
                   , MonadResource m
                   , MonadThrow m
-                  , MonadLogger m
+                  , HasLog env
                   , MonadIO m
                   , MonadUnliftIO m
                   )
@@ -519,7 +514,7 @@ downloadCached' :: ( MonadReader env m
                    , HasSettings env
                    , MonadMask m
                    , MonadThrow m
-                   , MonadLogger m
+                   , HasLog env
                    , MonadIO m
                    , MonadUnliftIO m
                    )
@@ -553,7 +548,7 @@ checkDigest :: ( MonadReader env m
                , HasSettings env
                , MonadIO m
                , MonadThrow m
-               , MonadLogger m
+               , HasLog env
                )
             => T.Text     -- ^ the hash
             -> FilePath
@@ -563,7 +558,7 @@ checkDigest eDigest file = do
   let verify = not noVerify
   when verify $ do
     let p' = takeFileName file
-    lift $ $(logInfo) [i|verifying digest of: #{p'}|]
+    lift $ logInfo $ "verifying digest of: " <> T.pack p'
     c <- liftIO $ L.readFile file
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
     when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

lib/GHCup/Errors.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE FlexibleInstances           #-}
 
@@ -25,7 +24,6 @@ import           Codec.Archive
 import           Control.Exception.Safe
 import           Data.ByteString                ( ByteString )
 import           Data.CaseInsensitive           ( CI )
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant
@@ -34,6 +32,7 @@ import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           URI.ByteString
 
 import qualified Data.Map.Strict               as M
+import qualified Data.Text                     as T
 
 
 
@@ -51,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
   pPrint (NoCompatiblePlatform str') =
     text ("Could not find a compatible platform. Got: " ++ str')
 
--- | Unable to find a download for the requested versio/distro.
+-- | Unable to find a download for the requested version/distro.
 data NoDownload = NoDownload
   deriving Show
 
@@ -88,7 +87,7 @@ data UnknownArchive = UnknownArchive FilePath
 
 instance Pretty UnknownArchive where
   pPrint (UnknownArchive file) =
-    text [i|The archive format is unknown. We don't know how to extract the file "#{file}"|]
+    text $ "The archive format is unknown. We don't know how to extract the file " <> file
 
 -- | The scheme is not supported (such as ftp).
 data UnsupportedScheme = UnsupportedScheme
@@ -111,7 +110,7 @@ data TagNotFound = TagNotFound Tag Tool
 
 instance Pretty TagNotFound where
   pPrint (TagNotFound tag tool) =
-    text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
+    text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
 
 -- | Unable to find the next version of a tool (the one after the currently
 -- set one).
@@ -120,7 +119,7 @@ data NextVerNotFound = NextVerNotFound Tool
 
 instance Pretty NextVerNotFound where
   pPrint (NextVerNotFound tool) =
-    text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|]
+    text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
 
 -- | The tool (such as GHC) is already installed with that version.
 data AlreadyInstalled = AlreadyInstalled Tool Version
@@ -128,14 +127,14 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
 
 instance Pretty AlreadyInstalled where
   pPrint (AlreadyInstalled tool ver') =
-    text [i|#{tool}-#{prettyShow ver'} is already installed|]
+    pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
 
 -- | The Directory is supposed to be empty, but wasn't.
 data DirNotEmpty = DirNotEmpty {path :: FilePath}
 
 instance Pretty DirNotEmpty where
   pPrint (DirNotEmpty path) = do
-    text [i|The directory was expected to be empty, but isn't: #{path}|]
+    text $ "The directory was expected to be empty, but isn't: " <> path
 
 -- | The tool is not installed. Some operations rely on a tool
 -- to be installed (such as setting the current GHC version).
@@ -144,7 +143,7 @@ data NotInstalled = NotInstalled Tool GHCTargetVersion
 
 instance Pretty NotInstalled where
   pPrint (NotInstalled tool ver) =
-    text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
+    text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
 
 -- | An executable was expected to be in PATH, but was not found.
 data NotFoundInPATH = NotFoundInPATH FilePath
@@ -152,7 +151,7 @@ data NotFoundInPATH = NotFoundInPATH FilePath
 
 instance Pretty NotFoundInPATH where
   pPrint (NotFoundInPATH exe) =
-    text [i|The exe "#{exe}" was not found in PATH.|]
+    text $ "The exe " <> exe <> " was not found in PATH."
 
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
@@ -160,7 +159,7 @@ data JSONError = JSONDecodeError String
 
 instance Pretty JSONError where
   pPrint (JSONDecodeError err) =
-    text [i|JSON decoding failed with: #{err}|]
+    text $ "JSON decoding failed with: " <> err
 
 -- | A file that is supposed to exist does not exist
 -- (e.g. when we use file scheme to "download" something).
@@ -169,7 +168,7 @@ data FileDoesNotExistError = FileDoesNotExistError FilePath
 
 instance Pretty FileDoesNotExistError where
   pPrint (FileDoesNotExistError file) =
-    text [i|File "#{file}" does not exist.|]
+    text $ "File " <> file <> " does not exist."
 
 -- | The file already exists
 -- (e.g. when we use isolated installs with the same path).
@@ -179,7 +178,7 @@ data FileAlreadyExistsError = FileAlreadyExistsError FilePath
 
 instance Pretty FileAlreadyExistsError where
   pPrint (FileAlreadyExistsError file) =
-    text [i|File "#{file}" Already exists.|]
+    text $ "File " <> file <> " Already exists."
 
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
@@ -194,7 +193,7 @@ data DigestError = DigestError Text Text
 
 instance Pretty DigestError where
   pPrint (DigestError currentDigest expectedDigest) =
-    text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
+    text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
 
 -- | Unexpected HTTP status.
 data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
@@ -202,7 +201,7 @@ data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
 
 instance Pretty HTTPStatusError where
   pPrint (HTTPStatusError status _) =
-    text [i|Unexpected HTTP status: #{status}|]
+    text "Unexpected HTTP status:" <+> pPrint status
 
 -- | Malformed headers.
 data MalformedHeaders = MalformedHeaders Text
@@ -210,7 +209,7 @@ data MalformedHeaders = MalformedHeaders Text
 
 instance Pretty MalformedHeaders where
   pPrint (MalformedHeaders h) =
-    text [i|Headers are malformed: #{h}|]
+    text "Headers are malformed: " <+> pPrint h
 
 -- | Unexpected HTTP status.
 data HTTPNotModified = HTTPNotModified Text
@@ -218,7 +217,7 @@ data HTTPNotModified = HTTPNotModified Text
 
 instance Pretty HTTPNotModified where
   pPrint (HTTPNotModified etag) =
-    text [i|Remote resource not modifed, etag was: #{etag}|]
+    text "Remote resource not modifed, etag was:" <+> pPrint etag
 
 -- | The 'Location' header was expected during a 3xx redirect, but not found.
 data NoLocationHeader = NoLocationHeader
@@ -226,7 +225,7 @@ data NoLocationHeader = NoLocationHeader
 
 instance Pretty NoLocationHeader where
   pPrint NoLocationHeader =
-    text [i|The 'Location' header was expected during a 3xx redirect, but not found.|]
+    text "The 'Location' header was expected during a 3xx redirect, but not found."
 
 -- | Too many redirects.
 data TooManyRedirs = TooManyRedirs
@@ -234,7 +233,7 @@ data TooManyRedirs = TooManyRedirs
 
 instance Pretty TooManyRedirs where
   pPrint TooManyRedirs =
-    text [i|Too many redirections.|]
+    text "Too many redirections."
 
 -- | A patch could not be applied.
 data PatchFailed = PatchFailed
@@ -242,7 +241,7 @@ data PatchFailed = PatchFailed
 
 instance Pretty PatchFailed where
   pPrint PatchFailed =
-    text [i|A patch could not be applied.|]
+    text "A patch could not be applied."
 
 -- | The tool requirements could not be found.
 data NoToolRequirements = NoToolRequirements
@@ -250,35 +249,35 @@ data NoToolRequirements = NoToolRequirements
 
 instance Pretty NoToolRequirements where
   pPrint NoToolRequirements =
-    text [i|The Tool requirements could not be found.|]
+    text "The Tool requirements could not be found."
 
 data InvalidBuildConfig = InvalidBuildConfig Text
   deriving Show
 
 instance Pretty InvalidBuildConfig where
   pPrint (InvalidBuildConfig reason) =
-    text [i|The build config is invalid. Reason was: #{reason}|]
+    text "The build config is invalid. Reason was:" <+> pPrint reason
 
 data NoToolVersionSet = NoToolVersionSet Tool
   deriving Show
 
 instance Pretty NoToolVersionSet where
   pPrint (NoToolVersionSet tool) =
-    text [i|No version is set for tool "#{tool}".|]
+    text "No version is set for tool" <+> pPrint tool <+> text "."
 
 data NoNetwork = NoNetwork
   deriving Show
 
 instance Pretty NoNetwork where
   pPrint NoNetwork =
-    text [i|A download was required or requested, but '--offline' was specified.|]
+    text "A download was required or requested, but '--offline' was specified."
 
 data HadrianNotFound = HadrianNotFound
   deriving Show
 
 instance Pretty HadrianNotFound where
   pPrint HadrianNotFound =
-    text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|]
+    text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
 
 
     -------------------------
@@ -300,17 +299,17 @@ data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FileP
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
-    text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason
+    text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
 
 deriving instance Show BuildFailed
 
 
 -- | Setting the current GHC version failed.
-data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
+data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
-    text [i|Setting the current GHC version failed: #{reason}|]
+    text "Setting the current GHC version failed:" <+> pPrint reason
 
 deriving instance Show GHCupSetError
 
@@ -326,7 +325,7 @@ data ParseError = ParseError String
 
 instance Pretty ParseError where
   pPrint (ParseError reason) =
-    text [i|Parsing failed: #{reason}|]
+    text "Parsing failed:" <+> pPrint reason
 
 instance Exception ParseError
 
@@ -336,7 +335,7 @@ data UnexpectedListLength = UnexpectedListLength String
 
 instance Pretty UnexpectedListLength where
   pPrint (UnexpectedListLength reason) =
-    text [i|List length unexpected: #{reason}|]
+    text "List length unexpected:" <+> pPrint reason
 
 instance Exception UnexpectedListLength
 
@@ -345,7 +344,7 @@ data NoUrlBase = NoUrlBase Text
 
 instance Pretty NoUrlBase where
   pPrint (NoUrlBase url) =
-    text [i|Couldn't get a base filename from url #{url}|]
+    text "Couldn't get a base filename from url" <+> pPrint url
 
 instance Exception NoUrlBase
 
@@ -370,21 +369,21 @@ instance
 
 instance Pretty URIParseError where
   pPrint (MalformedScheme reason) =
-    text [i|Failed to parse URI. Malformed scheme: #{reason}|]
+    text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
   pPrint MalformedUserInfo =
-    text [i|Failed to parse URI. Malformed user info.|]
+    text "Failed to parse URI. Malformed user info."
   pPrint MalformedQuery =
-    text [i|Failed to parse URI. Malformed query.|]
+    text "Failed to parse URI. Malformed query."
   pPrint MalformedFragment =
-    text [i|Failed to parse URI. Malformed fragment.|]
+    text "Failed to parse URI. Malformed fragment."
   pPrint MalformedHost =
-    text [i|Failed to parse URI. Malformed host.|]
+    text "Failed to parse URI. Malformed host."
   pPrint MalformedPort =
-    text [i|Failed to parse URI. Malformed port.|]
+    text "Failed to parse URI. Malformed port."
   pPrint MalformedPath =
-    text [i|Failed to parse URI. Malformed path.|]
+    text "Failed to parse URI. Malformed path."
   pPrint (OtherError err) =
-    text [i|Failed to parse URI: #{err}|]
+    text "Failed to parse URI:" <+> pPrint err
 
 instance Pretty ArchiveResult where
   pPrint ArchiveFatal = text "Archive result: fatal"
@@ -393,3 +392,6 @@ instance Pretty ArchiveResult where
   pPrint ArchiveRetry = text "Archive result: retry"
   pPrint ArchiveOk = text "Archive result: Ok"
   pPrint ArchiveEOF = text "Archive result: EOF"
+
+instance Pretty T.Text where
+  pPrint = text . T.unpack

lib/GHCup/Platform.hs

@@ -20,6 +20,7 @@ module GHCup.Platform where
 
 import           GHCup.Errors
 import           GHCup.Types
+import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.File
 import           GHCup.Utils.Prelude
@@ -28,12 +29,10 @@ import           GHCup.Utils.String.QQ
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
@@ -58,7 +57,7 @@ import qualified Data.Text.IO                  as T
 
 
 -- | Get the full platform request, consisting of architecture, distro, ...
-platformRequest :: (Alternative m, MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
+platformRequest :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
                 => Excepts
                      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
                      m
@@ -83,7 +82,7 @@ getArchitecture = case arch of
   what          -> Left (NoCompatibleArch what)
 
 
-getPlatform :: (Alternative m, MonadLogger m, MonadCatch m, MonadIO m, MonadFail m)
+getPlatform :: (Alternative m, MonadReader env m, HasLog env, MonadCatch m, MonadIO m, MonadFail m)
             => Excepts
                  '[NoCompatiblePlatform, DistroNotFound]
                  m
@@ -108,7 +107,7 @@ getPlatform = do
       pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
     "mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
     what -> throwE $ NoCompatiblePlatform what
-  lift $ $(logDebug) [i|Identified Platform as: #{prettyShow pfr}|]
+  lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
   pure pfr
  where
   getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
@@ -139,12 +138,11 @@ getLinuxDistro = do
         | hasWord name ["exherbo"] -> Exherbo
         | hasWord name ["gentoo"]  -> Gentoo
         | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
+        | hasWord name ["solus"]   -> Solus
         | otherwise                -> UnknownLinux
   pure (distro, parsedVer)
  where
-  hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
-                            False
-                            matches
+  hasWord t = any (\x -> match (regex x) (T.unpack t))
    where
     regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
 

lib/GHCup/Types.hs

@@ -25,21 +25,17 @@ module GHCup.Types
   )
   where
 
-import           Control.Applicative
 import           Control.DeepSeq                ( NFData, rnf )
-import           Control.Monad.Logger
 import           Data.Map.Strict                ( Map )
 import           Data.List.NonEmpty             ( NonEmpty (..) )
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           Haskus.Utils.Variant.Excepts
 import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
 #if defined(BRICK)
 import           Graphics.Vty                   ( Key(..) )
 #endif
 
-import qualified Control.Monad.Trans.Class     as Trans
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
 
@@ -115,6 +111,13 @@ data Tool = GHC
           | Stack
   deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
 
+instance Pretty Tool where
+  pPrint GHC = text "ghc"
+  pPrint Cabal = text "cabal"
+  pPrint GHCup = text "ghcup"
+  pPrint HLS = text "hls"
+  pPrint Stack = text "stack"
+
 instance NFData Tool
 
 data GlobalTool = ShimGen
@@ -145,7 +148,7 @@ data Tag = Latest
          | Recommended
          | Prerelease
          | Base PVP
-         | Old                -- ^ old version are hidden by default in TUI
+         | Old                -- ^ old versions are hidden by default in TUI
          | UnknownTag String  -- ^ used for upwardscompat
          deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
 
@@ -220,6 +223,7 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
+                 | Solus
                  -- rolling
                  | Gentoo
                  | Exherbo
@@ -233,12 +237,13 @@ instance NFData LinuxDistro
 distroToString :: LinuxDistro -> String
 distroToString Debian = "debian"
 distroToString Ubuntu = "ubuntu"
-distroToString Mint= "mint"
+distroToString Mint = "mint"
 distroToString Fedora = "fedora"
 distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
+distroToString Solus = "solus"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -387,6 +392,7 @@ data AppState = AppState
   , keyBindings :: KeyBindings
   , ghcupInfo :: GHCupInfo
   , pfreq :: PlatformRequest
+  , loggerConfig :: LoggerConfig
   } deriving (Show, GHC.Generic)
 
 instance NFData AppState
@@ -395,6 +401,7 @@ data LeanAppState = LeanAppState
   { settings :: Settings
   , dirs :: Dirs
   , keyBindings :: KeyBindings
+  , loggerConfig :: LoggerConfig
   } deriving (Show, GHC.Generic)
 
 instance NFData LeanAppState
@@ -546,14 +553,25 @@ instance Pretty Versioning where
 instance Pretty Version where
   pPrint = text . T.unpack . prettyVer
 
+instance Show (a -> b) where
+  show _ = "<function>"
 
-instance (Monad m, Alternative m) => Alternative (LoggingT m) where
-    empty   = Trans.lift empty
-    {-# INLINE empty #-}
-    m <|> n = LoggingT $ \ r -> runLoggingT m r <|> runLoggingT n r
-    {-# INLINE (<|>) #-}
+instance Show (IO ()) where
+  show _ = "<io>"
 
 
-instance MonadLogger m => MonadLogger (Excepts e m) where
-  monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
+data LogLevel = Warn
+              | Info
+              | Debug
+              | Error
+  deriving (Eq, Ord, Show)
 
+data LoggerConfig = LoggerConfig
+  { lcPrintDebug :: Bool                  -- ^ whether to print debug in colorOutter
+  , colorOutter  :: T.Text -> IO () -- ^ how to write the color output
+  , rawOutter    :: T.Text -> IO () -- ^ how to write the full raw output
+  }
+  deriving Show
+
+instance NFData LoggerConfig where
+  rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug

lib/GHCup/Types/JSON.hs

@@ -42,7 +42,7 @@ import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
 
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit

lib/GHCup/Types/Optics.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE OverloadedStrings   #-}
 
 {-|
 Module      : GHCup.Types.Optics
@@ -21,9 +22,13 @@ module GHCup.Types.Optics where
 import           GHCup.Types
 
 import           Control.Monad.Reader
-import           Data.ByteString                ( ByteString )
+import           Data.ByteString         ( ByteString )
+import           Data.Text               ( Text )
 import           Optics
 import           URI.ByteString
+import           System.Console.Pretty
+
+import qualified Data.Text                     as T
 
 makePrisms ''Tool
 makePrisms ''Architecture
@@ -87,13 +92,15 @@ getLeanAppState :: ( MonadReader env m
                    , LabelOptic' "settings"    A_Lens env Settings
                    , LabelOptic' "dirs"        A_Lens env Dirs
                    , LabelOptic' "keyBindings" A_Lens env KeyBindings
+                   , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
                    )
                 => m LeanAppState
 getLeanAppState = do
   s <- gets @"settings"
   d <- gets @"dirs"
   k <- gets @"keyBindings"
-  pure (LeanAppState s d k)
+  l <- gets @"loggerConfig"
+  pure (LeanAppState s d k l)
 
 
 getSettings :: ( MonadReader env m
@@ -110,6 +117,87 @@ getDirs :: ( MonadReader env m
 getDirs = gets @"dirs"
 
 
+logInfo :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+logInfo = logInternal Info
+
+logWarn :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+logWarn = logInternal Warn
+
+logDebug :: ( MonadReader env m
+            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+            , MonadIO m
+            )
+         => Text
+         -> m ()
+logDebug = logInternal Debug
+
+logError :: ( MonadReader env m
+            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+            , MonadIO m
+            )
+         => Text
+         -> m ()
+logError = logInternal Error
+
+
+logInternal :: ( MonadReader env m
+               , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+               , MonadIO m
+               ) => LogLevel
+                 -> Text
+                 -> m ()
+logInternal logLevel msg = do
+  LoggerConfig {..} <- gets @"loggerConfig"
+  let style' = case logLevel of
+        Debug   -> style Bold . color Blue
+        Info    -> style Bold . color Green
+        Warn    -> style Bold . color Yellow
+        Error   -> style Bold . color Red
+  let l = case logLevel of
+        Debug   -> style' "[ Debug ]"
+        Info    -> style' "[ Info  ]"
+        Warn    -> style' "[ Warn  ]"
+        Error   -> style' "[ Error ]"
+  let strs = T.split (== '\n') msg
+  let out = case strs of
+              [] -> T.empty
+              (x:xs) -> 
+                  foldr (\a b -> a <> "\n" <> b) mempty
+                . ((l <> " " <> x) :)
+                . fmap (\line' -> style' "[ ...   ] " <> line' )
+                $ xs
+
+  when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
+    $ liftIO $ colorOutter out
+
+  -- raw output
+  let lr = case logLevel of
+        Debug   -> "Debug:"
+        Info    -> "Info:"
+        Warn    -> "Warn:"
+        Error   -> "Error:"
+  let outr = lr <> " " <> msg <> "\n"
+  liftIO $ rawOutter outr
+
+
+
+getLogCleanup :: ( MonadReader env m
+                 , LabelOptic' "logCleanup" A_Lens env (IO ())
+                 )
+              => m (IO ())
+getLogCleanup = gets @"logCleanup"
+
+
 getKeyBindings :: ( MonadReader env m
                   , LabelOptic' "keyBindings" A_Lens env KeyBindings
                   )
@@ -136,6 +224,7 @@ type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
 type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
 type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
 type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
+type HasLog env = (LabelOptic' "loggerConfig" A_Lens env LoggerConfig)
 
 
 getCache :: (MonadReader env m, HasSettings env) => m Bool

lib/GHCup/Utils.hs

@@ -40,14 +40,12 @@ import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 
 import           Codec.Archive           hiding ( Directory )
-import           Codec.Archive.Zip
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
@@ -59,10 +57,8 @@ import           Data.ByteString                ( ByteString )
 import           Data.Either
 import           Data.Foldable
 import           Data.List
-import           Data.List.Extra
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           GHC.IO.Exception
@@ -116,7 +112,7 @@ ghcLinkDestination tool ver = do
 rmMinorSymlinks :: ( MonadReader env m
                    , HasDirs env
                    , MonadIO m
-                   , MonadLogger m
+                   , HasLog env
                    , MonadThrow m
                    , MonadFail m
                    , MonadMask m
@@ -130,14 +126,14 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
   forM_ files $ \f -> do
     let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
     let fullF = binDir </> f_xyz
-    lift $ $(logDebug) [i|rm -f #{fullF}|]
+    lift $ logDebug ("rm -f " <> T.pack fullF)
     lift $ hideError doesNotExistErrorType $ rmLink fullF
 
 
 -- | Removes the set ghc version for the given target, if any.
 rmPlain :: ( MonadReader env m
            , HasDirs env
-           , MonadLogger m
+           , HasLog env
            , MonadThrow m
            , MonadFail m
            , MonadIO m
@@ -152,11 +148,11 @@ rmPlain target = do
     files <- liftE $ ghcToolFiles tv
     forM_ files $ \f -> do
       let fullF = binDir </> f <> exeExt
-      lift $ $(logDebug) [i|rm -f #{fullF}|]
+      lift $ logDebug ("rm -f " <> T.pack fullF)
       lift $ hideError doesNotExistErrorType $ rmLink fullF
     -- old ghcup
     let hdc_file = binDir </> "haddock-ghc" <> exeExt
-    lift $ $(logDebug) [i|rm -f #{hdc_file}|]
+    lift $ logDebug ("rm -f " <> T.pack hdc_file)
     lift $ hideError doesNotExistErrorType $ rmLink hdc_file
 
 
@@ -164,7 +160,7 @@ rmPlain target = do
 rmMajorSymlinks :: ( MonadReader env m
                    , HasDirs env
                    , MonadIO m
-                   , MonadLogger m
+                   , HasLog env
                    , MonadThrow m
                    , MonadFail m
                    , MonadMask m
@@ -180,7 +176,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
   forM_ files $ \f -> do
     let f_xy = f <> "-" <> T.unpack v' <> exeExt
     let fullF = binDir </> f_xy
-    lift $ $(logDebug) [i|rm -f #{fullF}|]
+    lift $ logDebug ("rm -f " <> T.pack fullF)
     lift $ hideError doesNotExistErrorType $ rmLink fullF
 
 
@@ -252,9 +248,9 @@ getInstalledGHCs = do
 
 
 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
-getInstalledCabals :: ( MonadLogger m
-                      , MonadReader env m
+getInstalledCabals :: ( MonadReader env m
                       , HasDirs env
+                      , HasLog env
                       , MonadIO m
                       , MonadCatch m
                       )
@@ -272,14 +268,14 @@ getInstalledCabals = do
 
 
 -- | Whether the given cabal version is installed.
-cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
+cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 cabalInstalled ver = do
   vers <- fmap rights getInstalledCabals
   pure $ elem ver vers
 
 
 -- Return the currently set cabal version, if any.
-cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 cabalSet = do
   Dirs {..}  <- getDirs
   let cabalbin = binDir </> "cabal" <> exeExt
@@ -296,7 +292,11 @@ cabalSet = do
         case linkVersion =<< link of
           Right v -> pure $ Just v
           Left err -> do
-            $(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|]
+            logWarn $ "Failed to parse cabal symlink target with: "
+              <> T.pack (displayException err)
+              <> ". The symlink "
+              <> T.pack cabalbin
+              <> " needs to point to valid cabal binary, such as 'cabal-3.4.0.0'."
             pure Nothing
  where
   -- We try to be extra permissive with link destination parsing,
@@ -363,7 +363,7 @@ getInstalledStacks = do
 
 -- Return the currently set stack version, if any.
 -- TODO: there's a lot of code duplication here :>
-stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
+stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, HasLog env) => m (Maybe Version)
 stackSet = do
   Dirs {..}  <- getDirs
   let stackBin = binDir </> "stack" <> exeExt
@@ -380,7 +380,11 @@ stackSet = do
         case linkVersion =<< link of
           Right v -> pure $ Just v
           Left err -> do
-            $(logWarn) [i|Failed to parse stack symlink target with: "#{err}". The symlink #{stackBin} needs to point to valid stack binary, such as 'stack-2.7.1'.|]
+            logWarn $ "Failed to parse stack symlink target with: "
+              <> T.pack (displayException err)
+              <> ". The symlink "
+              <> T.pack stackBin
+              <> " needs to point to valid stack binary, such as 'stack-2.7.1'."
             pure Nothing
  where
   linkVersion :: MonadThrow m => FilePath -> m Version
@@ -594,7 +598,7 @@ getLatestGHCFor major' minor' dls =
 
 
 -- | Unpack an archive to a temporary directory and return that path.
-unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
+unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
             => FilePath       -- ^ destination dir
             -> FilePath       -- ^ archive path
             -> Excepts '[UnknownArchive
@@ -602,7 +606,7 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
                         ] m ()
 unpackToDir dfp av = do
   let fn = takeFileName av
-  lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|]
+  lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
 
   let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
       untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
@@ -621,12 +625,11 @@ unpackToDir dfp av = do
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (untar . BZip.decompress =<< rf av)
     | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
-    | ".zip" `isSuffixOf` fn ->
-      withArchive av (unpackInto dfp)
+    | ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
     | otherwise -> throwE $ UnknownArchive fn
 
 
-getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
+getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
                 => FilePath       -- ^ archive path
                 -> Excepts '[UnknownArchive
                             , ArchiveResult
@@ -651,14 +654,11 @@ getArchiveFiles av = do
     | ".tar.bz2" `isSuffixOf` fn ->
       liftE (entries . BZip.decompress =<< rf av)
     | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
-    | ".zip" `isSuffixOf` fn ->
-      withArchive av $ do
-        entries' <- getEntries
-        pure $ fmap unEntrySelector $ Map.keys entries'
+    | ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
     | otherwise -> throwE $ UnknownArchive fn
 
 
-intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
+intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
            => FilePath       -- ^ unpacked tar dir
            -> TarDir         -- ^ how to descend
            -> Excepts '[TarDirDoesNotExist] m FilePath
@@ -786,14 +786,19 @@ makeOut args workdir = do
 
 -- | Try to apply patches in order. Fails with 'PatchFailed'
 -- on first failure.
-applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
+applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
              => FilePath   -- ^ dir containing patches
              -> FilePath   -- ^ dir to apply patches in
              -> Excepts '[PatchFailed] m ()
 applyPatches pdir ddir = do
-  patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
+  patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles
+      pdir
+      (makeRegexOpts compExtended
+                     execBlank
+                     ([s|.+\.(patch|diff)$|] :: ByteString)
+      )
   forM_ (sort patches) $ \patch' -> do
-    lift $ $(logInfo) [i|Applying patch #{patch'}|]
+    lift $ logInfo $ "Applying patch " <> T.pack patch'
     fmap (either (const Nothing) Just)
          (exec
            "patch"
@@ -834,7 +839,7 @@ runBuildAction :: ( Pretty (V e)
                   , HasSettings env
                   , MonadIO m
                   , MonadMask m
-                  , MonadLogger m
+                  , HasLog env
                   , MonadUnliftIO m
                   )
                => FilePath        -- ^ build directory (cleaned up depending on Settings)
@@ -862,10 +867,10 @@ runBuildAction bdir instdir action = do
 
 -- | Remove a build directory, ignoring if it doesn't exist and gracefully
 -- printing other errors without crashing.
-rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
+rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
 rmBDir dir = withRunInIO (\run -> run $
-           liftIO $ handleIO (\e -> run $ $(logWarn)
-               [i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
+           liftIO $ handleIO (\e -> run $ logWarn $
+               "Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
            $ hideError doesNotExistErrorType
            $ rmPathForcibly dir)
 
@@ -977,7 +982,7 @@ rmLink = hideError doesNotExistErrorType . recycleFile
 -- On windows, this requires that 'ensureGlobalTools' was run beforehand.
 createLink :: ( MonadMask m
               , MonadThrow m
-              , MonadLogger m
+              , HasLog env
               , MonadIO m
               , MonadReader env m
               , HasDirs env
@@ -999,24 +1004,24 @@ createLink link exe = do
       fullLink = takeDirectory exe </> link
       shimContents = "path = " <> fullLink
 
-  $(logDebug) [i|rm -f #{exe}|]
+  logDebug $ "rm -f " <> T.pack exe
   rmLink exe
 
-  $(logDebug) [i|ln -s #{fullLink} #{exe}|]
+  logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
   liftIO $ copyFile shimGen exe
   liftIO $ writeFile shim shimContents
 #else
-  $(logDebug) [i|rm -f #{exe}|]
+  logDebug $ "rm -f " <> T.pack exe
   hideError doesNotExistErrorType $ recycleFile exe
 
-  $(logDebug) [i|ln -s #{link} #{exe}|]
+  logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
   liftIO $ createFileLink link exe
 #endif
 
 
 ensureGlobalTools :: ( MonadMask m
                      , MonadThrow m
-                     , MonadLogger m
+                     , HasLog env
                      , MonadIO m
                      , MonadReader env m
                      , HasDirs env
@@ -1034,8 +1039,8 @@ ensureGlobalTools = do
     $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
   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}|]
+      lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
+      lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
       lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
       liftE @'[DigestError , DownloadFailed] $ dl
     ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)

lib/GHCup/Utils/Dirs.hs

@@ -2,9 +2,7 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ViewPatterns          #-}
-{-# LANGUAGE TemplateHaskell       #-}
 
 {-|
 Module      : GHCup.Utils.Dirs
@@ -45,12 +43,10 @@ import           GHCup.Utils.Prelude
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Unlift
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource hiding (throwM)
 import           Data.Bifunctor
 import           Data.Maybe
-import           Data.String.Interpolate
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -62,7 +58,7 @@ import           System.IO.Temp
 
 import qualified Data.ByteString               as BS
 import qualified Data.Text                     as T
-import qualified Data.Yaml                     as Y
+import qualified Data.YAML.Aeson               as Y
 import qualified Text.Megaparsec               as MP
 import Control.Concurrent (threadDelay)
 
@@ -225,7 +221,7 @@ ghcupConfigFile = do
   contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
   case contents of
       Nothing -> pure defaultUserSettings
-      Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'
+      Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
 
 
     -------------------------
@@ -262,7 +258,7 @@ parseGHCupGHCDir (T.pack -> fp) =
 mkGhcupTmpDir :: ( MonadReader env m
                  , HasDirs env
                  , MonadUnliftIO m
-                 , MonadLogger m
+                 , HasLog env
                  , MonadCatch m
                  , MonadThrow m
                  , MonadMask m
@@ -274,15 +270,21 @@ mkGhcupTmpDir = do
   let minSpace = 5000 -- a rough guess, aight?
   space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
   when (maybe False (toBytes minSpace >) space) $ do
-    $(logWarn) [i|Possibly insufficient disk space on #{tmpdir}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
-    $(logWarn)
+    logWarn ("Possibly insufficient disk space on "
+      <> T.pack tmpdir
+      <> ". At least "
+      <> T.pack (show minSpace)
+      <> " MB are recommended, but only "
+      <> toMB (fromJust space)
+      <> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
+    logWarn
       "...waiting for 10 seconds before continuing anyway, you can still abort..."
     liftIO $ threadDelay 10000000 -- give the user a sec to intervene
 
   liftIO $ createTempDirectory tmpdir "ghcup"
  where
   toBytes mb = mb * 1024 * 1024
-  toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
+  toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
   truncate' :: Double -> Int -> Double
   truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
       where t = 10^n
@@ -290,8 +292,9 @@ mkGhcupTmpDir = do
 
 withGHCupTmpDir :: ( MonadReader env m
                    , HasDirs env
+                   , HasLog env
+                   , HasSettings env
                    , MonadUnliftIO m
-                   , MonadLogger m
                    , MonadCatch m
                    , MonadResource m
                    , MonadThrow m
@@ -304,7 +307,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
         (run mkGhcupTmpDir)
         (\fp ->
             handleIO (\e -> run
-                $ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|])
+                $ logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
             . rmPathForcibly
             $ fp))
 
@@ -336,9 +339,10 @@ relativeSymlink p1 p2 =
 
 cleanupTrash :: ( MonadIO m
                 , MonadMask m
-                , MonadLogger m
                 , MonadReader env m
+                , HasLog env
                 , HasDirs env
+                , HasSettings env
                 )
              => m ()
 cleanupTrash = do
@@ -347,8 +351,8 @@ cleanupTrash = do
   if null contents
   then pure ()
   else do
-    $(logWarn) [i|Removing leftover files in #{recycleDir}|]
+    logWarn ("Removing leftover files in " <> T.pack recycleDir)
     forM_ contents (\fp -> handleIO (\e ->
-        $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]
+        logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
       ) $ liftIO $ removePathForcibly (recycleDir </> fp))
 

lib/GHCup/Utils/File/Common.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TemplateHaskell   #-}
@@ -8,10 +7,8 @@ module GHCup.Utils.File.Common where
 
 import           GHCup.Utils.Prelude
 
-import           Control.Monad.Extra
 import           Control.Monad.Reader
 import           Data.Maybe
-import           Data.String.Interpolate
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
 import           System.Directory
@@ -31,13 +28,13 @@ data ProcessError = NonZeroExit Int FilePath [String]
 
 instance Pretty ProcessError where
   pPrint (NonZeroExit e exe args) =
-    text [i|Process "#{exe}" with arguments #{args} failed with exit code #{e}.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
   pPrint (PTerminated exe args) =
-    text [i|Process "#{exe}" with arguments #{args} terminated.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
   pPrint (PStopped exe args) =
-    text [i|Process "#{exe}" with arguments #{args} stopped.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
   pPrint (NoSuchPid exe args) =
-    text [i|Could not find PID for process running "#{exe}" with arguments #{args}.|]
+    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 
 data CapturedProcess = CapturedProcess
   { _exitCode :: ExitCode
@@ -104,3 +101,6 @@ findFiles path regex = do
   contents <- listDirectory path
   pure $ filter (match regex) contents
 
+
+checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
+checkFileAlreadyExists fp = liftIO $ doesFileExist fp

lib/GHCup/Utils/File/Posix.hs

@@ -1,8 +1,5 @@
-{-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE ViewPatterns      #-}
 
 {-|
 Module      : GHCup.Utils.File.Posix
@@ -28,14 +25,12 @@ import           Control.Concurrent.Async
 import           Control.Exception              ( evaluate )
 import           Control.Exception.Safe
 import           Control.Monad
-import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.State.Strict
 import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.IORef
 import           Data.Sequence                  ( Seq, (|>) )
-import           Data.String.Interpolate
 import           Data.List
 import           Data.Word8
 import           GHC.IO.Exception
@@ -132,7 +127,7 @@ execLogged exe args chdir lfile env = do
       pure e
 
   tee :: Fd -> Fd -> IO ()
-  tee fileFd fdIn = readTilEOF lineAction fdIn
+  tee fileFd = readTilEOF lineAction
 
    where
     lineAction :: ByteString -> IO ()
@@ -351,7 +346,7 @@ toProcessError exe args mps = case mps of
 
 
 
-chmod_755 :: (MonadLogger m, MonadIO m) => FilePath -> m ()
+chmod_755 :: (MonadReader env m, HasLog env, MonadIO m) => FilePath -> m ()
 chmod_755 fp = do
   let exe_mode =
           nullFileMode
@@ -362,7 +357,7 @@ chmod_755 fp = do
             `unionFileModes` groupReadMode
             `unionFileModes` otherExecuteMode
             `unionFileModes` otherReadMode
-  $(logDebug) [i|chmod 755 #{fp}|]
+  logDebug ("chmod 755 " <> T.pack fp)
   liftIO $ setFileMode fp exe_mode
 
 

lib/GHCup/Utils/Logger.hs

@@ -22,11 +22,8 @@ import           GHCup.Utils.String.QQ
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Control.Monad.Logger
 import           Control.Monad.Reader
-import           Data.Char               ( ord )
 import           Prelude                 hiding ( appendFile )
-import           System.Console.Pretty
 import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
@@ -35,53 +32,6 @@ import qualified Data.ByteString               as B
 import GHCup.Utils.Prelude
 
 
-data LoggerConfig = LoggerConfig
-  { lcPrintDebug :: Bool                  -- ^ whether to print debug in colorOutter
-  , colorOutter  :: B.ByteString -> IO () -- ^ how to write the color output
-  , rawOutter    :: B.ByteString -> IO () -- ^ how to write the full raw output
-  }
-
-
-myLoggerT :: LoggerConfig -> LoggingT m a -> m a
-myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
- where
-  mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
-  mylogger _ _ level str' = do
-    -- color output
-    let style' = case level of
-          LevelDebug   -> style Bold . color Blue
-          LevelInfo    -> style Bold . color Green
-          LevelWarn    -> style Bold . color Yellow
-          LevelError   -> style Bold . color Red
-          LevelOther _ -> id
-    let l = case level of
-          LevelDebug   -> toLogStr (style' "[ Debug ]")
-          LevelInfo    -> toLogStr (style' "[ Info  ]")
-          LevelWarn    -> toLogStr (style' "[ Warn  ]")
-          LevelError   -> toLogStr (style' "[ Error ]")
-          LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
-    let strs = fmap toLogStr . B.split (fromIntegral $ ord '\n') . fromLogStr $ str'
-    let out = case strs of
-                [] -> B.empty
-                (x:xs) -> fromLogStr
-                  . foldr (\a b -> a <> toLogStr "\n" <> b) mempty
-                  . ((l <> toLogStr " " <> x) :)
-                  . fmap (\line' -> toLogStr (style' "[ ...   ] ") <> line' )
-                  $ xs
-
-    when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
-      $ colorOutter out
-
-    -- raw output
-    let lr = case level of
-          LevelDebug   -> toLogStr "Debug:"
-          LevelInfo    -> toLogStr "Info:"
-          LevelWarn    -> toLogStr "Warn:"
-          LevelError   -> toLogStr "Error:"
-          LevelOther t -> toLogStr t <> toLogStr ":"
-    let outr = fromLogStr (lr <> toLogStr " " <> str' <> toLogStr "\n")
-    rawOutter outr
-
 
 initGHCupFileLogging :: ( MonadReader env m
                         , HasDirs env

lib/GHCup/Utils/Prelude.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 {-|
 Module      : GHCup.Utils.Prelude
@@ -30,10 +29,10 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
-import           Control.Monad.Logger
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.List                      ( nub, intercalate )
+import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf )
+import           Data.Maybe
 import           Data.Foldable
 import           Data.String
 import           Data.Text                      ( Text )
@@ -75,8 +74,9 @@ import qualified System.Win32.File             as Win32
 -- >>> import Data.ByteString.Internal (c2w, w2c)
 -- >>> import Test.QuickCheck
 -- >>> import Data.Word8
--- >>> import Data.Word8
 -- >>> import qualified Data.Text as T
+-- >>> import qualified Data.Char as C
+-- >>> import Data.List
 -- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
 
 
@@ -174,8 +174,12 @@ lEM' :: forall e' e es a m
 lEM' f em = lift em >>= lE . first f
 
 -- for some obscure reason... this won't type-check if we move it to a different module
-catchWarn :: forall es m . (Pretty (V es), MonadLogger m, Monad m) => Excepts es m () -> Excepts '[] m ()
-catchWarn = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
+catchWarn :: forall es m env . ( Pretty (V es)
+                             , MonadReader env m
+                             , HasLog env
+                             , MonadIO m
+                             , Monad m) => Excepts es m () -> Excepts '[] m ()
+catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyShow $ v))
 
 fromEither :: Either a b -> VEither '[a] b
 fromEither = either (VLeft . V) VRight
@@ -520,7 +524,7 @@ forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
 forFold = \t -> (`traverseFold` t)
 
 
--- | Strip @\\r@ and @\\n@ from 'ByteString's
+-- | Strip @\\r@ and @\\n@ from 'String's
 --
 -- >>> stripNewline "foo\n\n\n"
 -- "foo"
@@ -532,13 +536,10 @@ forFold = \t -> (`traverseFold` t)
 -- prop> \t -> stripNewline (t <> "\n") === stripNewline t
 -- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
 stripNewline :: String -> String
-stripNewline s
-  | null s               = []
-  | head s `elem` "\n\r" = stripNewline (tail s)
-  | otherwise            = head s : stripNewline (tail s)
+stripNewline = filter (`notElem` "\n\r")
 
 
--- | Strip @\\r@ and @\\n@ from 'ByteString's
+-- | Strip @\\r@ and @\\n@ from 'Text's
 --
 -- >>> stripNewline' "foo\n\n\n"
 -- "foo"
@@ -550,10 +551,7 @@ stripNewline s
 -- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
 -- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
 stripNewline' :: T.Text -> T.Text
-stripNewline' s
-  | T.null s               = mempty
-  | T.head s `elem` "\n\r" = stripNewline' (T.tail s)
-  | otherwise              = T.singleton (T.head s) <> stripNewline' (T.tail s)
+stripNewline' = T.filter (`notElem` "\n\r")
 
 
 -- | Is the word8 a newline?
@@ -587,3 +585,117 @@ splitOnPVP c s = case Split.splitOn c s of
     | otherwise -> def
  where
   def = (s, "")
+
+
+
+-- | Like 'find', but where the test can be monadic.
+--
+-- >>> findM (Just . C.isUpper) "teST"
+-- Just (Just 'S')
+-- >>> findM (Just . C.isUpper) "test"
+-- Just Nothing
+-- >>> findM (Just . const True) ["x",undefined]
+-- Just (Just "x")
+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
+findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
+
+
+-- | Drops the given suffix from a list.
+--   It returns the original sequence if the sequence doesn't end with the given suffix.
+--
+-- >>> dropSuffix "!" "Hello World!"
+-- "Hello World"
+-- >>> dropSuffix "!" "Hello World!!"
+-- "Hello World!"
+-- >>> dropSuffix "!" "Hello World."
+-- "Hello World."
+dropSuffix :: Eq a => [a] -> [a] -> [a]
+dropSuffix a b = fromMaybe b $ stripSuffix a b
+
+-- | Return the prefix of the second list if its suffix
+--   matches the entire first list.
+--
+-- >>> stripSuffix "bar" "foobar"
+-- Just "foo"
+-- >>> stripSuffix ""    "baz"
+-- Just "baz"
+-- >>> stripSuffix "foo" "quux"
+-- Nothing
+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
+stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b)
+
+
+-- | Drops the given prefix from a list.
+--   It returns the original sequence if the sequence doesn't start with the given prefix.
+--
+-- >>> dropPrefix "Mr. " "Mr. Men"
+-- "Men"
+-- >>> dropPrefix "Mr. " "Dr. Men"
+-- "Dr. Men"
+dropPrefix :: Eq a => [a] -> [a] -> [a]
+dropPrefix a b = fromMaybe b $ stripPrefix a b
+
+
+
+-- | Break a list into pieces separated by the first
+-- list argument, consuming the delimiter. An empty delimiter is
+-- invalid, and will cause an error to be raised.
+--
+-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
+-- ["a","b","d","e"]
+-- >>> splitOn "aaa"  "aaaXaaaXaaaXaaa"
+-- ["","X","X","X",""]
+-- >>> splitOn "x"    "x"
+-- ["",""]
+-- >>> splitOn "x"    ""
+-- [""]
+--
+-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x
+-- prop> \c x -> splitOn [c] x                           == split (==c) x
+splitOn :: Eq a => [a] -> [a] -> [[a]]
+splitOn [] _ = error "splitOn, needle may not be empty"
+splitOn _ [] = [[]]
+splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
+    where (a,b) = breakOn needle haystack
+
+
+-- | Splits a list into components delimited by separators,
+-- where the predicate returns True for a separator element.  The
+-- resulting components do not contain the separators.  Two adjacent
+-- separators result in an empty component in the output.
+--
+-- >>> split (== 'a') "aabbaca"
+-- ["","","bb","c",""]
+-- >>> split (== 'a') ""
+-- [""]
+-- >>> split (== ':') "::xyz:abc::123::"
+-- ["","","xyz","abc","","123","",""]
+-- >>> split (== ',') "my,list,here"
+-- ["my","list","here"]
+split :: (a -> Bool) -> [a] -> [[a]]
+split _ [] = [[]]
+split f (x:xs)
+  | f x = [] : split f xs
+  | y:ys <- split f xs = (x:y) : ys
+  | otherwise = [[]]
+
+
+-- | Find the first instance of @needle@ in @haystack@.
+-- The first element of the returned tuple
+-- is the prefix of @haystack@ before @needle@ is matched.  The second
+-- is the remainder of @haystack@, starting with the match.
+-- If you want the remainder /without/ the match, use 'stripInfix'.
+--
+-- >>> breakOn "::" "a::b::c"
+-- ("a","::b::c")
+-- >>> breakOn "/" "foobar"
+-- ("foobar","")
+--
+-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
+breakOn :: Eq a => [a] -> [a] -> ([a], [a])
+breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
+breakOn _ [] = ([], [])
+breakOn needle (x:xs) = first (x:) $ breakOn needle xs
+
+
+

lib/GHCup/Utils/String/QQ.hs

@@ -44,15 +44,14 @@ import           Language.Haskell.TH.Quote
 -- The pattern portion is undefined.
 s :: QuasiQuoter
 s = QuasiQuoter
-  (\s' -> case and $ fmap isAscii s' of
+  (\s' -> case all isAscii s' of
     True  -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
     False -> fail "Not ascii"
   )
-  (error "Cannot use q as a pattern")
-  (error "Cannot use q as a type")
-  (error "Cannot use q as a dec")
+  (error "Cannot use s as a pattern")
+  (error "Cannot use s as a type")
+  (error "Cannot use s as a dec")
  where
   removeCRs = filter (/= '\r')
   trimLeadingNewline ('\n' : xs) = xs
   trimLeadingNewline xs          = xs
-

lib/GHCup/Version.hs

@@ -24,8 +24,11 @@ import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
 
 -- | This reflects the API version of the YAML.
+--
+-- Note that when updating this, CI requires that the file exsists AND the same file exists at
+-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
 ghcupURL :: URI
-ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP

scripts/bootstrap/bootstrap-haskell

@@ -3,6 +3,7 @@
 # Main settings:
 #   * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
 #   * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
+#   * BOOTSTRAP_HASKELL_MINIMAL - any nonzero value to only install ghcup
 #   * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
 #   * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
 #   * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
@@ -371,6 +372,13 @@ adjust_bashrc() {
 								echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
 							fi
 							;;
+						MSYS*|MINGW*)
+							if [ ! -e "${HOME}/.bash_profile" ] ; then
+								echo '# generated by ghcup' > "${HOME}/.bash_profile"
+								echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
+								echo 'test -f ~/.bashrc && . ~/.bashrc' >> "${HOME}/.bash_profile"
+							fi
+							;;
 					esac
 					break ;;
 
@@ -591,10 +599,12 @@ ask_bashrc
 ask_bashrc_answer=$?
 ask_cabal_config_init
 ask_cabal_config_init_answer=$?
-ask_hls
-ask_hls_answer=$?
-ask_stack
-ask_stack_answer=$?
+if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
+	ask_hls
+	ask_hls_answer=$?
+	ask_stack
+	ask_stack_answer=$?
+fi
 
 edo mkdir -p "${GHCUP_BIN}"
 
@@ -620,14 +630,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
     read -r answer </dev/tty
 fi
 
-eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
+	eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
 
-eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
-eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+	eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+	eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
 
-do_cabal_config_init $ask_cabal_config_init_answer
+	do_cabal_config_init $ask_cabal_config_init_answer
 
-edo cabal new-update
+	edo cabal new-update
+else # don't install ghc and cabal
+	case "${plat}" in
+			MSYS*|MINGW*)
+				# need to bootstrap cabal to initialize config on windows
+				# we'll remove it afterwards
+				tmp_dir="$(mktemp -d)"
+				eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+				PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
+				rm "${tmp_dir}/cabal"
+				unset tmp_dir
+				;;
+			*)
+				;;
+	esac
+fi
 
 case $ask_hls_answer in
 	1)

scripts/bootstrap/bootstrap-haskell.ps1

@@ -15,24 +15,26 @@
 param (
     # Run an interactive installation
     [switch]$Interactive,
-    # Specify the install root (default: 'C:\')
-    [string]$InstallDir,
-    # Instead of installing a new MSys2, use an existing installation
-    [string]$ExistingMsys2Dir,
-    # Specify the cabal root directory (default: '$InstallDir\cabal')
-    [string]$CabalDir,
-    # Overwrite (or rather backup) a previous install
-    [switch]$Overwrite,
-    # Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
-    [string]$BootstrapUrl,
+    # Do minimal installation of ghcup and msys2 only
+    [switch]$Minimal,
     # Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
     [switch]$InBash,
+    # Overwrite (or rather backup) a previous install
+    [switch]$Overwrite,
+    # Skip adjusting cabal.config with mingw paths
+    [switch]$NoAdjustCabalConfig,
     # Whether to install stack as well
     [switch]$InstallStack,
     # Whether to install hls as well
     [switch]$InstallHLS,
-    # Skip adjusting cabal.config with mingw paths
-    [switch]$NoAdjustCabalConfig
+    # Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
+    [string]$InstallDir,
+    # Instead of installing a new MSys2, use an existing installation
+    [string]$BootstrapUrl,
+    # Specify the install root (default: 'C:\')
+    [string]$ExistingMsys2Dir,
+    # Specify the cabal root directory (default: '$InstallDir\cabal')
+    [string]$CabalDir
 )
 
 $Silent = !$Interactive
@@ -180,7 +182,7 @@ elevated command prompt:
 
 if ($GhcupBasePrefixEnv) {
   $defaultGhcupBasePrefix = $GhcupBasePrefixEnv
-} else {
+} elseif (!($InstallDir)) {
   $partitions = Get-CimInstance win32_logicaldisk
   $defaultGhcupBasePrefix = $null
   foreach ($p in $partitions){
@@ -209,10 +211,10 @@ if ($Silent -and !($InstallDir)) {
   $GhcupBasePrefix = $defaultGhcupBasePrefix
 } elseif ($InstallDir) {
   if (!(Test-Path -LiteralPath ('{0}' -f $InstallDir) -IsValid)) {
-    Print-Msg -color Red -msg "Not a valid directory!"
+    Print-Msg -color Red -msg "Not a valid directory! (InstallDir)"
     Exit 1
   } elseif (!(Split-Path -IsAbsolute -Path "$InstallDir")) {
-    Print-Msg -color Red -msg "Non-absolute Path specified!"
+    Print-Msg -color Red -msg "Non-absolute Path specified! (InstallDir)"
     Exit 1
   } else {
     $GhcupBasePrefix = $InstallDir
@@ -243,7 +245,20 @@ $null = [Environment]::SetEnvironmentVariable("GHCUP_INSTALL_BASE_PREFIX", $Ghcu
 
 
 $GhcupDir = ('{0}\ghcup' -f $GhcupBasePrefix)
-$MsysDir = ('{0}\msys64' -f $GhcupDir)
+if ($ExistingMsys2Dir) {
+  if (!(Test-Path -LiteralPath ('{0}' -f $ExistingMsys2Dir) -IsValid)) {
+    Print-Msg -color Red -msg "Not a valid directory! (ExistingMsys2Dir)"
+    Exit 1
+  } elseif (!(Split-Path -IsAbsolute -Path "$ExistingMsys2Dir")) {
+    Print-Msg -color Red -msg "Non-absolute Path specified! (ExistingMsys2Dir)"
+    Exit 1
+  } else {
+	$MsysDir = $ExistingMsys2Dir
+  }
+} else {
+	$MsysDir = ('{0}\msys64' -f $GhcupDir)
+}
+
 $Bash = ('{0}\usr\bin\bash' -f $MsysDir)
 if (!($BootstrapUrl)) {
   $BootstrapUrl = 'https://www.haskell.org/ghcup/sh/bootstrap-haskell'
@@ -398,6 +413,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 
     Print-Msg -msg 'Setting default home directory...'
     Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
+
   } elseif ($msys2Decision -eq 1) {
     Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
     while ($true) {
@@ -529,10 +545,14 @@ if (!($NoAdjustCabalConfig)) {
   $AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
 }
 
+if ($Minimal) {
+  $MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
+}
+
 if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
-  Exec "$Bash" '-lc' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
+  Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
 } else {
-  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
+  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
 }
 
 

stack.yaml

@@ -4,11 +4,11 @@ packages:
   - .
 
 extra-deps:
-  - git: https://github.com/hasufell/text-conversions.git
-    commit: 9abf0e5e5664a3178367597c32db19880477a53c
+  - git: https://github.com/bgamari/terminal-size
+    commit: 34ea816bd63f75f800eedac12c6908c6f3736036
 
-  - git: https://github.com/Bodigrim/tar
-    commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
+  - git: https://github.com/hasufell/libarchive
+    commit: 8587aab78dd515928024ecd82c8f215e06db85cd
 
   - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
   - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
@@ -29,7 +29,6 @@ extra-deps:
   - hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
   - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
   - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
-  - libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
   - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
   - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
   - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
@@ -43,7 +42,6 @@ extra-deps:
   - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
   - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
   - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
-  - zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
 
 flags:
   http-io-streams:
@@ -55,6 +53,12 @@ flags:
   regex-posix:
     _regex-posix-clib: true
 
+  aeson-pretty:
+    lib-only: true
+
+  cabal-plan:
+    exe: false
+
 ghc-options:
   "$locals": -O2
   streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

test/GHCup/ArbitraryTypes.hs

@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
     ---------------------
 
 instance Arbitrary Scheme where
-  arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ]
+  arbitrary = elements [ Scheme "http", Scheme "https" ]
 
 instance Arbitrary Host where
   arbitrary = genericArbitrary

test/GHCup/Types/JSONSpec.hs

@@ -13,4 +13,5 @@ import           Test.Hspec
 
 spec :: Spec
 spec = do
-  roundtripAndGoldenSpecs (Proxy @GHCupInfo)
+  roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName "test/golden" }) (Proxy @GHCupInfo)
+