Honour NO_COLOR in bootstrap scrips, fixes #248

.gitlab-ci.yml

@@ -49,6 +49,7 @@ variables:
     OS: "LINUX"
     ARCH: "ARM"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+  retry: 2
 
 .linux:aarch64:
   image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
@@ -75,7 +76,7 @@ variables:
     ARCH: "ARM64"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
 
-.freebsd:
+.freebsd13:
   tags:
     - x86_64-freebsd13
   variables:
@@ -83,6 +84,14 @@ variables:
     ARCH: "64"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
 
+.freebsd12:
+  tags:
+    - x86_64-freebsd
+  variables:
+    OS: "FREEBSD"
+    ARCH: "64"
+    CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+
 .windows:
   tags:
     - new-x86_64-windows
@@ -90,6 +99,7 @@ variables:
     OS: "WINDOWS"
     ARCH: "64"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+  retry: 2
 
 .root_cleanup:
   after_script:
@@ -99,7 +109,7 @@ variables:
   script:
     - bash ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.7"
+    JSON_VERSION: "0.0.6"
   artifacts:
     expire_in: 2 week
     paths:
@@ -173,10 +183,18 @@ variables:
     runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
     runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
 
-.test_ghcup_version:freebsd:
+.test_ghcup_version:freebsd12:
   extends:
     - .test_ghcup_version
-    - .freebsd
+    - .freebsd12
+    - .root_cleanup
+  before_script:
+    - ./.gitlab/before_script/freebsd/install_deps.sh
+
+.test_ghcup_version:freebsd13:
+  extends:
+    - .test_ghcup_version
+    - .freebsd13
     - .root_cleanup
   before_script:
     - ./.gitlab/before_script/freebsd/install_deps.sh
@@ -207,7 +225,7 @@ variables:
   only:
     - tags
   variables:
-    JSON_VERSION: "0.0.7"
+    JSON_VERSION: "0.0.6"
 
 ######## stack test ########
 
@@ -263,6 +281,23 @@ test:linux:
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
+test:linux:hls:
+  stage: test
+  extends:
+    - .test_ghcup_version
+    - .debian
+  variables:
+    GHC_VERSION: "8.10.7"
+    HLS_TARGET_VERSION: "1.4.0"
+    CABAL_VERSION: "3.6.0.0"
+  needs: []
+  when: manual
+  allow_failure: true
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps.sh
+  script:
+    - ./.gitlab/script/ghcup_hls.sh
+
 test:linux:cross-armv7:
   stage: test
   extends:
@@ -355,9 +390,19 @@ test:mac:aarch64:
 
 ######## freebsd test ########
 
-test:freebsd:
+test:freebsd12:
   stage: test
-  extends: .test_ghcup_version:freebsd
+  extends: .test_ghcup_version:freebsd12
+  variables:
+    GHC_VERSION: "8.10.4"
+    CABAL_VERSION: "3.4.0.0"
+  allow_failure: true # freebsd runners are unreliable
+  when: manual
+  needs: []
+
+test:freebsd13:
+  stage: test
+  extends: .test_ghcup_version:freebsd13
   variables:
     GHC_VERSION: "8.10.4"
     CABAL_VERSION: "3.4.0.0"
@@ -491,11 +536,26 @@ release:darwin:aarch64:
 
 ######## freebsd release ########
 
-release:freebsd:
+release:freebsd12:
   stage: release
-  needs: ["test:freebsd"]
+  needs: ["test:freebsd12"]
   extends:
-    - .freebsd
+    - .freebsd12
+    - .release_ghcup
+    - .root_cleanup
+  before_script:
+    - ./.gitlab/before_script/freebsd/install_deps.sh
+  variables:
+    ARTIFACT: "x86_64-portbld-freebsd-ghcup"
+    GHC_VERSION: "8.10.6"
+    CABAL_VERSION: "3.4.0.0"
+  allow_failure: true
+
+release:freebsd13:
+  stage: release
+  needs: ["test:freebsd13"]
+  extends:
+    - .freebsd13
     - .release_ghcup
     - .root_cleanup
   before_script:

.gitlab/script/ghcup_hls.sh

@@ -0,0 +1,51 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+CI_PROJECT_DIR=$(pwd)
+
+ecabal() {
+	cabal "$@"
+}
+
+eghcup() {
+	ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
+}
+
+git describe --always
+
+### build
+
+ecabal update
+
+ecabal build -w ghc-${GHC_VERSION}
+cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
+
+### cleanup
+
+rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+
+### manual cli based testing
+
+eghcup --numeric-version
+
+eghcup install ghc ${GHC_VERSION}
+eghcup set ghc ${GHC_VERSION}
+eghcup install cabal ${CABAL_VERSION}
+
+cabal --version
+
+eghcup debug-info
+
+eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
+
+[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
+
+# nuke
+eghcup nuke
+[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
+

app/ghcup-gen/Main.hs

@@ -11,21 +11,23 @@
 module Main where
 
 import           GHCup.Types
-import           GHCup.Types.Optics
 import           GHCup.Errors
 import           GHCup.Platform
 import           GHCup.Utils.Dirs
+import           GHCup.Utils.Logger
 import           GHCup.Types.JSON               ( )
 
 import           Control.Monad.Trans.Reader     ( runReaderT )
 import           Control.Monad.IO.Class
 import           Data.Char                      ( toLower )
+import           Data.Maybe
 #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.Environment
 import           System.Exit
 import           System.IO                      ( stderr )
 import           Text.Regex.Posix
@@ -114,9 +116,11 @@ com = subparser
 
 main :: IO ()
 main = do
-  let loggerConfig = LoggerConfig { lcPrintDebug = True
+  no_color <- isJust <$> lookupEnv "NO_COLOR"
-                                  , colorOutter  = T.hPutStr stderr
+  let loggerConfig = LoggerConfig { lcPrintDebug  = True
-                                  , rawOutter    = \_ -> pure ()
+                                  , consoleOutter = T.hPutStr stderr
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = not no_color
                                   }
   dirs <- liftIO getAllDirs
   let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings loggerConfig

app/ghcup-gen/Validate.hs

@@ -15,6 +15,7 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Version.QQ
 
 import           Codec.Archive

app/ghcup/BrickMain.hs

@@ -13,9 +13,9 @@ 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.Logger
 import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
 
@@ -537,9 +537,10 @@ settings' :: IORef AppState
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO $ do
   dirs <- getAllDirs
-  let loggerConfig = LoggerConfig { lcPrintDebug = False
+  let loggerConfig = LoggerConfig { lcPrintDebug  = False
-                                  , colorOutter  = \_ -> pure ()
+                                  , consoleOutter = \_ -> pure ()
-                                  , rawOutter    = \_ -> pure ()
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = True
                                   }
   newIORef $ AppState (Settings { cache      = True
                                 , noVerify   = False

app/ghcup/Main.hs

@@ -187,6 +187,7 @@ data RmOptions = RmOptions
 
 
 data CompileCommand = CompileGHC GHCCompileOptions
+                    | CompileHLS HLSCompileOptions
 
 data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
 
@@ -205,6 +206,18 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
+data HLSCompileOptions = HLSCompileOptions
+  { targetHLS    :: Either Version GitBranch
+  , jobs         :: Maybe Int
+  , setCompile   :: Bool
+  , ovewrwiteVer :: Maybe Version
+  , isolateDir   :: Maybe FilePath
+  , cabalProject :: Maybe FilePath
+  , cabalProjectLocal :: Maybe FilePath
+  , patchDir     :: Maybe FilePath
+  , targetGHCs   :: [ToolVersion]
+  }
+
 data UpgradeOpts = UpgradeInplace
                  | UpgradeAt FilePath
                  | UpgradeGHCupDir
@@ -895,6 +908,15 @@ compileP = subparser
             <> footerDoc (Just $ text compileFooter)
             )
       )
+  <>  command
+      "hls"
+      (   CompileHLS
+      <$> info
+            (hlsCompileOpts <**> helper)
+            (  progDesc "Compile HLS from source"
+            <> footerDoc (Just $ text compileHLSFooter)
+            )
+      )
   )
  where
   compileFooter = [s|Discussion:
@@ -919,6 +941,14 @@ Examples:
   # build cross compiler
   ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
 
+  compileHLSFooter = [s|Discussion:
+  Compiles and installs the specified HLS version.
+  The last argument is a list of GHC versions to compile for.
+  These need to be available in PATH prior to compilation.
+
+Examples:
+  ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
+
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -1188,6 +1218,78 @@ ghcCompileOpts =
             )
            )
 
+hlsCompileOpts :: Parser HLSCompileOptions
+hlsCompileOpts =
+  HLSCompileOptions
+    <$> ((Left <$> option
+          (eitherReader
+            (first (const "Not a valid version") . version . T.pack)
+          )
+          (short 'v' <> long "version" <> metavar "VERSION" <> help
+            "The tool version to compile"
+          )
+          ) <|>
+          (Right <$> (GitBranch <$> option
+          str
+          (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
+            "The git commit/branch/ref to build from"
+          ) <*>
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          )))
+    <*> optional
+          (option
+            (eitherReader (readEither @Int))
+            (short 'j' <> long "jobs" <> metavar "JOBS" <> help
+              "How many jobs to use for make"
+            )
+          )
+    <*> flag
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
+    <*> optional
+          (option
+            (eitherReader
+              (first (const "Not a valid version") . version . T.pack)
+            )
+            (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
+              "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader isolateParser)
+            (  short 'i'
+            <> long "isolate"
+            <> metavar "DIR"
+            <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            )
+           )
+    <*> optional
+          (option
+            str
+            (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
+              "If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader absolutePathParser)
+            (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
+              "Absolute path to a cabal.project.local to be used for the build. Will be copied over."
+            )
+          )
+    <*> optional
+          (option
+            (eitherReader absolutePathParser)
+            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
+            )
+          )
+    <*> some (toolVersionArgument Nothing (Just GHC))
+
 
 toolVersionParser :: Parser ToolVersion
 toolVersionParser = verP' <|> toolP
@@ -1203,9 +1305,13 @@ toolVersionParser = verP' <|> toolP
 toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
 toolVersionArgument criteria tool =
   argument (eitherReader toolVersionEither)
-    (metavar "VERSION|TAG"
+    (metavar (mv tool)
     <> completer (tagCompleter (fromMaybe GHC tool) [])
     <> foldMap (completer . versionCompleter criteria) tool)
+ where
+  mv (Just GHC) = "GHC_VERSION|TAG"
+  mv (Just HLS) = "HLS_VERSION|TAG"
+  mv _          = "VERSION|TAG"
 
 
 setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
@@ -1232,9 +1338,10 @@ tagCompleter :: Tool -> [String] -> Completer
 tagCompleter tool add = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
-        { lcPrintDebug = False
+        { lcPrintDebug   = False
-        , colorOutter  = mempty
+        , consoleOutter  = mempty
-        , rawOutter    = mempty
+        , fileOutter     = mempty
+        , fancyColors    = False
         }
   let appState = LeanAppState
         (Settings True False Never Curl False GHCupURL True GPGNone)
@@ -1258,9 +1365,10 @@ versionCompleter :: Maybe ListCriteria -> Tool -> Completer
 versionCompleter criteria tool = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
-        { lcPrintDebug = False
+        { lcPrintDebug   = False
-        , colorOutter  = mempty
+        , consoleOutter  = mempty
-        , rawOutter    = mempty
+        , fileOutter     = mempty
+        , fancyColors    = False
         }
   let settings = Settings True False Never Curl False GHCupURL True GPGNone
   let leanAppState = LeanAppState
@@ -1414,6 +1522,11 @@ isolateParser f = case isValid f of
               True -> Right $ normalise f
               False -> Left "Please enter a valid filepath for isolate dir."
 
+absolutePathParser :: FilePath -> Either String FilePath
+absolutePathParser f = case isValid f && isAbsolute f of
+              True -> Right $ normalise f
+              False -> Left "Please enter a valid absolute filepath."
+
 toSettings :: Options -> IO (Settings, KeyBindings)
 toSettings options = do
   userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -1577,17 +1690,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           -- logger interpreter
           logfile <- flip runReaderT dirs initGHCupFileLogging
+          no_color <- isJust <$> lookupEnv "NO_COLOR"
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
-                , colorOutter  = T.hPutStr stderr
+                , consoleOutter  = T.hPutStr stderr
-                , rawOutter    =
+                , fileOutter    =
                     case optCommand of
                       Nuke -> \_ -> pure ()
                       _ -> T.appendFile logfile
+                , fancyColors = not no_color
                 }
           let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
           let runLogger = flip runReaderT leanAppstate
-          let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
+          let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { consoleOutter = \_ -> pure () } } :: LeanAppState)
 
 
           -------------------------
@@ -1789,6 +1904,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , ArchiveResult
                       ]
 
+          let runCompileHLS =
+                  runAppState
+                  . runResourceT
+                  . runE
+                    @'[ AlreadyInstalled
+                      , BuildFailed
+                      , DigestError
+                      , GPGError
+                      , DownloadFailed
+                      , GHCupSetError
+                      , NoDownload
+                      , NotFoundInPATH
+                      , PatchFailed
+                      , UnknownArchive
+                      , TarDirDoesNotExist
+                      , TagNotFound
+                      , NextVerNotFound
+                      , NoToolVersionSet
+                      , NotInstalled
+                      , DirNotEmpty
+                      , ArchiveResult
+                      ]
+
           let
             runLeanWhereIs =
                 -- Don't use runLeanAppState here, which is disabled on windows.
@@ -2202,7 +2340,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             List ListOptions {..} ->
               runListGHC (do
                   l <- listVersions loTool lCriteria
-                  liftIO $ printListResult lRawFormat l
+                  liftIO $ printListResult no_color lRawFormat l
                   pure ExitSuccess
                 )
 
@@ -2224,6 +2362,53 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         runLogger $ logError $ T.pack $ prettyShow e
                         pure $ ExitFailure 8
 
+            Compile (CompileHLS HLSCompileOptions { .. }) -> do
+              runCompileHLS (do
+                case targetHLS of
+                  Left targetVer -> do
+                    GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+                    let vi = getVersionInfo targetVer HLS dls
+                    forM_ (_viPreCompile =<< vi) $ \msg -> do
+                      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 ()
+                ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
+                targetVer <- liftE $ compileHLS
+                            targetHLS
+                            ghcs
+                            jobs
+                            ovewrwiteVer
+                            isolateDir
+                            cabalProject
+                            cabalProjectLocal
+                            patchDir
+                GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+                let vi = getVersionInfo targetVer HLS dls
+                when setCompile $ void $ liftE $
+                  setHLS targetVer
+                pure (vi, targetVer)
+                )
+                >>= \case
+                      VRight (vi, tv) -> do
+                        runLogger $ logInfo
+                          "HLS successfully compiled and installed"
+                        forM_ (_viPostInstall =<< vi) $ \msg ->
+                          runLogger $ logInfo msg
+                        putStr (T.unpack $ prettyVer tv)
+                        pure ExitSuccess
+                      VLeft err@(V (BuildFailed tmpdir _)) -> do
+                        case keepDirs settings of
+                          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
+                        pure $ ExitFailure 9
             Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
               runLogger $ logError "Hadrian cross compile support is not yet implemented!"
               pure $ ExitFailure 9
@@ -2626,9 +2811,8 @@ fromVersion' (SetToolTag t') tool =
   throwE $ TagNotFound t' tool
 
 
-printListResult :: Bool -> [ListResult] -> IO ()
+printListResult :: Bool -> Bool -> [ListResult] -> IO ()
-printListResult raw lr = do
+printListResult no_color raw lr = do
-  no_color <- isJust <$> lookupEnv "NO_COLOR"
 
   let
     color | raw || no_color = flip const

data/metadata/ghcup-0.0.6.yaml

@@ -2269,7 +2269,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
               dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
   GHCup:
-    0.1.16.2:
+    0.1.17:
       viTags:
       - Recommended
       - Latest
@@ -2279,43 +2279,43 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-linux-ghcup-0.1.17
-              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
+              dlHash: 1eaa33af4180f97edf02822d6d711ce618d9828fe9ebbf042d198fe6c1c9d153
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-apple-darwin-ghcup-0.1.17
-              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
+              dlHash: a3d4ed12f8631c0537d8d9531cc5518bc6f90edcee3326e5d4e0efb72c8dfc6f
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-portbld-freebsd-ghcup-0.1.17
-              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
+              dlHash: 83012de837773f3aa26182c607c2da85ee6ff3b0092becb78907700f407a27fb
           Windows:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-mingw64-ghcup-0.1.17.exe
-              dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948
+              dlHash: 40bda6050c800fa69af51d2e668426ca73b4179214bfeef329b795484991d258
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/i386-linux-ghcup-0.1.17
-              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
+              dlHash: d0f887b13a2c7a11477dc54cb90b446ef0ebe1d2a6bfbf60ccd4b37fc5de70cc
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/aarch64-linux-ghcup-0.1.17
-              dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
+              dlHash: be67cf8800ae305c5ba210b645f4fce8751763f3eac3db399f6efca145b7ab38
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/aarch64-apple-darwin-ghcup-0.1.17
-              dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
+              dlHash: b1be8c55838bd0d972e42b02b71bdf47fbbf67be1456e0de2d7d346620538539
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17/armv7-linux-ghcup-0.1.17
-              dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
+              dlHash: fe54ded2fafff4f8d82e511229f257f4c3b87b14c796f9b5b0ea35c359c26cb0
   HLS:
     1.1.0:
       viTags:
@@ -2388,6 +2388,10 @@ ghcupDownloads:
         - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
       viPostInstall: *hls-post-install
+      viSourceDL:
+        dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
+        dlSubdir: haskell-language-server-1.4.0
+        dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
       viArch:
         A_64:
           Linux_UnknownLinux:

docs/CHANGELOG.md

@@ -1,5 +1,19 @@
 # Revision history for ghcup
 
+## 0.1.17 -- 2021-09-20
+
+* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
+* Implement compiling HLS from source wrt [#201](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/201)
+* Implement experimental GPG verification of the metadata file (see README) wrt [#263](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/236)
+* Add `ghcup unset` command wrt [#145](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/145)
+* Add `ghcup whereis bindir` etc wrt [#221](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/221)
+* Greatly reduce dependency footprint wrt [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/212)
+* Add `ghcup --plan-json`
+* Improve `--patchdir` option for GHC compilation wrt [#226](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/226)
+* Try to improve logging and failure modes, especially during downloads
+* Add descriptive warnings when HLS and GHC versions are incompatible
+* Improve curl header parsing wrt [#213](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/213)
+
 ## 0.1.16.2 -- 2021-08-12
 
 * Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            ghcup
-version:         0.1.16.2
+version:         0.1.17
 license:         LGPL-3.0-only
 license-file:    LICENSE
 copyright:       Julian Ospald 2020
@@ -24,7 +24,6 @@ extra-doc-files:
   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
@@ -100,6 +99,7 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            ^>=0.10
+    , Cabal
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , concurrent-output     ^>=1.10.11

lib/GHCup.hs

@@ -34,6 +34,7 @@ import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
 import           GHCup.Utils
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 import           GHCup.Utils.Version.QQ
@@ -63,6 +64,11 @@ import           Data.Text                      ( Text )
 import           Data.Time.Clock
 import           Data.Time.Format.ISO8601
 import           Data.Versions
+import           Distribution.Types.Version   hiding ( Version )
+import           Distribution.Types.PackageId
+import           Distribution.Types.PackageDescription
+import           Distribution.Types.GenericPackageDescription
+import           Distribution.PackageDescription.Parsec
 import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Language.Haskell.TH
@@ -83,6 +89,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
 
 import qualified Crypto.Hash.SHA256            as SHA256
+import qualified Data.List.NonEmpty            as NE
 import qualified Data.ByteString.Base16        as B16
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
@@ -264,6 +271,7 @@ installPackedGHC :: ( MonadMask m
                     , HasLog env
                     , MonadIO m
                     , MonadUnliftIO m
+                    , MonadFail m
                     )
                  => FilePath          -- ^ Path to the packed GHC bindist
                  -> Maybe TarDir      -- ^ Subdir of the archive
@@ -621,10 +629,7 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do
       liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version in a regular install
+  liftE $ installHLSPostInst isoFilepath ver
-      hlsVers <- lift $ fmap rights getInstalledHLSs
-      let lInstHLS = headMay . reverse . sort $ hlsVers
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
 
 
 -- | Install an unpacked hls distribution.
@@ -678,6 +683,21 @@ installHLSUnpacked path inst mver' forceInstall = do
     
   lift $ chmod_755 destWrapperPath
 
+
+installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
+                   => Maybe FilePath
+                   -> Version
+                   -> Excepts '[NotInstalled] m ()
+installHLSPostInst isoFilepath ver = 
+  case isoFilepath of
+    Just _ -> pure ()
+    Nothing -> do
+      -- create symlink if this is the latest version in a regular install
+      hlsVers <- lift $ fmap rights getInstalledHLSs
+      let lInstHLS = headMay . reverse . sort $ hlsVers
+      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
+
+
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
 installHLSBin :: ( MonadMask m
@@ -716,6 +736,171 @@ installHLSBin ver isoFilepath forceInstall = do
   installHLSBindist dlinfo ver isoFilepath forceInstall
 
 
+compileHLS :: ( MonadMask m
+              , MonadCatch m
+              , MonadReader env m
+              , HasDirs env
+              , HasSettings env
+              , HasPlatformReq env
+              , HasGHCupInfo env
+              , HasLog env
+              , MonadResource m
+              , MonadIO m
+              , MonadUnliftIO m
+              , MonadFail m
+              )
+           => Either Version GitBranch
+           -> [Version]
+           -> Maybe Int
+           -> Maybe Version
+           -> Maybe FilePath
+           -> Maybe FilePath
+           -> Maybe FilePath
+           -> Maybe FilePath
+           -> Excepts '[ NoDownload
+                       , GPGError
+                       , DownloadFailed
+                       , DigestError
+                       , UnknownArchive
+                       , TarDirDoesNotExist
+                       , ArchiveResult
+                       , BuildFailed
+                       , NotInstalled
+                       ] m Version
+compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do
+  PlatformRequest { .. } <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+  Dirs { .. } <- lift getDirs
+
+  (workdir, tver) <- case targetHLS of
+    -- unpack from version tarball
+    Left tver -> do
+      lift $ logDebug $ "Requested to compile: " <> prettyVer tver
+
+      -- download source tarball
+      dlInfo <-
+        preview (ix HLS % ix tver % viSourceDL % _Just) dls
+          ?? NoDownload
+      dl <- liftE $ downloadCached dlInfo Nothing
+
+      -- unpack
+      tmpUnpack <- lift mkGhcupTmpDir
+      liftE $ unpackToDir tmpUnpack dl
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
+
+      workdir <- maybe (pure tmpUnpack)
+                       (liftE . intoSubdir tmpUnpack)
+                       (view dlSubdir dlInfo)
+
+      pure (workdir, tver)
+
+    -- clone from git
+    Right GitBranch{..} -> do
+      tmpUnpack <- lift mkGhcupTmpDir
+      let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
+      tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+        let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
+        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"
+                  , "origin"
+                  , fromString rep ]
+
+        let fetch_args = 
+                  [ "fetch"
+                  , "--depth"
+                  , "1"
+                  , "--quiet"
+                  , "origin"
+                  , fromString ref ]
+        lEM $ git fetch_args
+
+        lEM $ git [ "checkout", "FETCH_HEAD" ]
+        (Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (tmpUnpack </> "haskell-language-server.cabal"))
+        pure . (\c -> Version Nothing c [] Nothing)
+          . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
+          . versionNumbers
+          . pkgVersion
+          . package
+          . packageDescription
+          $ gpd
+
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
+      lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
+
+      pure (tmpUnpack, tver)
+
+  -- the version that's installed may differ from the
+  -- compiled version, so the user can overwrite it
+  let installVer = fromMaybe tver ov
+
+  liftE $ runBuildAction
+    workdir
+    Nothing
+    (reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
+      let installDir = workdir </> "out"
+      liftIO $ createDirRecursive' installDir
+
+      -- apply patches
+      forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
+
+      -- set up project files
+      cp <- case cabalProject of
+        Just cp
+          | isAbsolute cp -> do
+              handleIO (throwE . CopyError . show) $ liftIO $ copyFile cp (workdir </> "cabal.project")
+              pure "cabal.project"
+          | otherwise -> pure (takeFileName cp)
+        Nothing -> pure "cabal.project"
+      forM_ cabalProjectLocal $ \cpl -> handleIO (throwE . CopyError . show) $ liftIO $ copyFile cpl (workdir </> cp <.> "local")
+
+      artifacts <- forM (sort ghcs) $ \ghc -> do
+        let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
+        liftIO $ createDirRecursive' installDir
+        lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
+        liftE $ lEM @_ @'[ProcessError] $
+          execLogged "cabal" ( [ "v2-install"
+                               , "-w"
+                               , "ghc-" <> T.unpack (prettyVer ghc)
+                               , "--install-method=copy"
+                               ] ++
+                               maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
+                               [ "--overwrite-policy=always"
+                               , "--disable-profiling"
+                               , "--disable-tests"
+                               , "--enable-split-sections"
+                               , "--enable-executable-stripping"
+                               , "--enable-executable-static"
+                               , "--installdir=" <> ghcInstallDir
+                               , "--project-file=" <> cp
+                               , "exe:haskell-language-server"
+                               , "exe:haskell-language-server-wrapper"]
+                             )
+          (Just workdir) "cabal" Nothing
+        pure ghcInstallDir
+
+      forM_ artifacts $ \artifact -> do
+        liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
+          (installDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
+        liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
+          (installDir </> "haskell-language-server-wrapper" <.> exeExt)
+        liftIO $ rmPathForcibly artifact
+
+      case isolateDir of
+        Just isoDir -> do
+          lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
+          liftE $ installHLSUnpacked installDir isoDir Nothing True
+        Nothing -> do
+          liftE $ installHLSUnpacked installDir binDir (Just installVer) True
+    )
+
+  liftE $ installHLSPostInst isolateDir installVer
+
+  pure installVer
+
+
+
 -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
 -- creates a default @stack -> stack-x.y.z.q@ symlink for
 -- the latest installed version.

lib/GHCup/Download.hs

@@ -35,6 +35,7 @@ import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Version
 
@@ -636,7 +637,7 @@ checkDigest eDigest file = do
     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)
+    when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
 
 
 -- | Get additional curl args from env. This is an undocumented option.

lib/GHCup/Errors.hs

@@ -188,12 +188,14 @@ instance Pretty TarDirDoesNotExist where
     text "Tar directory does not exist:" <+> pPrint dir
 
 -- | File digest verification failed.
-data DigestError = DigestError Text Text
+data DigestError = DigestError FilePath Text Text
   deriving Show
 
 instance Pretty DigestError where
-  pPrint (DigestError currentDigest expectedDigest) =
+  pPrint (DigestError fp currentDigest expectedDigest) =
-    text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
+    text "Digest error for" <+> text (fp <> ": expected")
+      <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
+      "\nConsider removing the file in case it's cached and try again."
 
 -- | File digest verification failed.
 data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)

lib/GHCup/Platform.hs

@@ -23,6 +23,7 @@ import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 
@@ -138,7 +139,6 @@ 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

lib/GHCup/Types.hs

@@ -223,7 +223,6 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
-                 | Solus
                  -- rolling
                  | Gentoo
                  | Exherbo
@@ -243,7 +242,6 @@ distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
-distroToString Solus = "solus"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -578,11 +576,12 @@ data LogLevel = Warn
   deriving (Eq, Ord, Show)
 
 data LoggerConfig = LoggerConfig
-  { lcPrintDebug :: Bool                  -- ^ whether to print debug in colorOutter
+  { lcPrintDebug   :: Bool            -- ^ whether to print debug in colorOutter
-  , colorOutter  :: T.Text -> IO () -- ^ how to write the color output
+  , consoleOutter  :: T.Text -> IO () -- ^ how to write the console output
-  , rawOutter    :: T.Text -> IO () -- ^ how to write the full raw output
+  , fileOutter     :: T.Text -> IO () -- ^ how to write the file output
+  , fancyColors    :: Bool
   }
   deriving Show
 
 instance NFData LoggerConfig where
-  rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug
+  rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)

lib/GHCup/Types/JSON.hs

@@ -24,6 +24,8 @@ module GHCup.Types.JSON where
 import           GHCup.Types
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger             () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
+                                                   -- This is due to the boot file.
 
 import           Control.Applicative            ( (<|>) )
 import           Data.Aeson

lib/GHCup/Types/Optics.hs

@@ -23,12 +23,9 @@ import           GHCup.Types
 
 import           Control.Monad.Reader
 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
@@ -117,80 +114,6 @@ 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 ())
                  )

lib/GHCup/Utils.hs

@@ -35,6 +35,7 @@ import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
@@ -842,6 +843,8 @@ runBuildAction :: ( Pretty (V e)
                   , MonadMask m
                   , HasLog env
                   , MonadUnliftIO m
+                  , MonadFail m
+                  , MonadCatch m
                   )
                => FilePath        -- ^ build directory (cleaned up depending on Settings)
                -> Maybe FilePath  -- ^ dir to *always* clean up on exception
@@ -1039,7 +1042,7 @@ ensureGlobalTools = do
   shimDownload <- liftE $ lE @_ @'[NoDownload]
     $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
   let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
-  void $ (\(DigestError _ _) -> do
+  void $ (\(DigestError _ _ _) -> do
       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")

lib/GHCup/Utils/Dirs.hs

@@ -38,6 +38,7 @@ import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
 import           GHCup.Utils.MegaParsec
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 
 import           Control.Exception.Safe

lib/GHCup/Utils/File/Common.hs-boot

@@ -0,0 +1,5 @@
+module GHCup.Utils.File.Common where
+
+import           Text.Regex.Posix
+
+findFiles :: FilePath -> Regex -> IO [FilePath]

lib/GHCup/Utils/File/Posix.hs

@@ -17,6 +17,7 @@ module GHCup.Utils.File.Posix where
 
 import           GHCup.Utils.File.Common
 import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger
 import           GHCup.Types
 import           GHCup.Types.Optics
 

lib/GHCup/Utils/Logger.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE QuasiQuotes      #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE OverloadedStrings   #-}
 
 {-|
 Module      : GHCup.Utils.Logger
@@ -16,21 +18,97 @@ module GHCup.Utils.Logger where
 
 import           GHCup.Types
 import           GHCup.Types.Optics
-import           GHCup.Utils.File
+import {-# SOURCE #-} GHCup.Utils.File.Common
 import           GHCup.Utils.String.QQ
 
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
+import           Data.Text               ( Text )
+import           Optics
 import           Prelude                 hiding ( appendFile )
+import           System.Console.Pretty
 import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
 
 import qualified Data.ByteString               as B
 import GHCup.Utils.Prelude
+import qualified Data.Text                     as T
 
+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 color' c = if fancyColors then color c else id
+  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 $ consoleOutter out
+
+  -- raw output
+  let lr = case logLevel of
+        Debug   -> "Debug:"
+        Info    -> "Info:"
+        Warn    -> "Warn:"
+        Error   -> "Error:"
+  let outr = lr <> " " <> msg <> "\n"
+  liftIO $ fileOutter outr
 
 
 initGHCupFileLogging :: ( MonadReader env m

lib/GHCup/Utils/Logger.hs-boot

@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes      #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+module GHCup.Utils.Logger where
+
+import           GHCup.Types
+
+import           Control.Monad.IO.Class
+import           Control.Monad.Reader
+import           Data.Text               ( Text )
+import           Optics
+
+logWarn :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+

lib/GHCup/Utils/Prelude.hs

@@ -23,6 +23,7 @@ module GHCup.Utils.Prelude where
 import           GHCup.Types
 #endif
 import           GHCup.Types.Optics
+import {-# SOURCE #-} GHCup.Utils.Logger
 
 import           Control.Applicative
 import           Control.Exception.Safe

lib/GHCup/Version.hs

@@ -28,7 +28,7 @@ import qualified Data.Text                     as T
 -- 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.7.yaml|]
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP

scripts/bootstrap/bootstrap-haskell

@@ -21,7 +21,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.16.2"
+ghver="0.1.17"
 base_url="https://downloads.haskell.org/~ghcup"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -52,41 +52,57 @@ esac
 
 
 die() {
-    (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
+    if [ -n "${NO_COLOR}" ] ; then
+        (>&2 printf "%s\\n" "$1")
+    else
+        (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
+    fi
     exit 2
 }
 
 warn() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;35m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;35m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;35m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;35m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 yellow() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;33m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;33m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;33m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;33m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 green() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;32m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;32m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;32m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;32m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 edo() {