Fix error messages and overhaul pretty printing

Fixes #115

CHANGELOG.md

@@ -1,7 +1,10 @@
 # Revision history for ghcup
 
-## 0.1.13 -- ????-??-??
+## 0.1.13 -- 2021-02-26
 
+* Support ARMv7/AARCH64
+* Add command line completions for installed and available versions wrt [MR #70](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/70)
+* Allow to cycle through set tools wrt [#114](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/114)
 * Fix item selection with unavailable versions wrt [#107](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/107)
 * Allow for dynamic post-install, post-remove and pre-compile msgs wrt [MR #68](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/68)
 * Alert user if upgraded ghcup is shadowed by old ghcup wrt [#111](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/111)

app/ghcup-gen/Validate.hs

@@ -32,6 +32,7 @@ import           Optics
 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
@@ -83,7 +84,7 @@ validate dls = do
  where
   checkHasRequiredPlatforms t v tags arch pspecs = do
     let v' = prettyVer v
-        arch' = prettyArch arch
+        arch' = prettyShow arch
     when (not $ any (== Linux UnknownLinux) pspecs) $ do
       lift $ $(logError)
         [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
@@ -99,7 +100,7 @@ validate dls = do
     -- (although it could be static)
     when (not $ any (== Linux Alpine) pspecs) $
       case t of
-        GHCup -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
+        GHCup | arch `elem` [A_64, A_32] -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{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
         GHC | Latest `elem` tags || Recommended `elem` tags

app/ghcup/BrickMain.hs

@@ -48,6 +48,7 @@ import           Prelude                 hiding ( appendFile )
 import           System.Environment
 import           System.Exit
 import           System.IO.Unsafe
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
 import qualified GHCup.Types                   as GT
@@ -445,12 +446,8 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
               runLogger $ $(logInfo) msg
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
-          VLeft (V (BuildFailed _ e)) ->
-            pure $ Left [i|Build failed with #{e}|]
-          VLeft (V NoDownload) ->
-            pure $ Left [i|No available version for #{prettyVer lVer}|]
           VLeft (V NoUpdate) -> pure $ Right ()
-          VLeft e -> pure $ Left [i|#{e}
+          VLeft e -> pure $ Left [i|#{prettyShow e}
 Also check the logs in ~/.ghcup/logs|]
 
 
@@ -474,7 +471,7 @@ set' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight _ -> pure $ Right ()
-          VLeft  e -> pure $ Left [i|#{e}|]
+          VLeft  e -> pure $ Left (prettyShow e)
 
 
 del' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -500,7 +497,7 @@ del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
               runLogger $ $(logInfo) msg
             pure $ Right ()
           VRight _ -> pure $ Right ()
-          VLeft  e -> pure $ Left [i|#{e}|]
+          VLeft  e -> pure $ Left (prettyShow e)
 
 
 changelog' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -515,7 +512,7 @@ changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
             FreeBSD -> "xdg-open"
       exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
         Right _ -> pure $ Right ()
-        Left  e -> pure $ Left [i|#{e}|]
+        Left  e -> pure $ Left $ prettyShow e
 
 
 settings' :: IORef AppState
@@ -595,7 +592,7 @@ getDownloads' = do
 
   case r of
     VRight a -> pure $ Right a
-    VLeft  e -> pure $ Left [i|#{e}|]
+    VLeft  e -> pure $ Left (prettyShow e)
 
 
 getAppData :: Maybe GHCupDownloads

app/ghcup/Main.hs

@@ -44,7 +44,7 @@ import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
 import           Data.Functor
-import           Data.List                      ( intercalate, sort )
+import           Data.List                      ( intercalate, nub, sort, sortBy )
 import           Data.List.NonEmpty             (NonEmpty ((:|)))
 import           Data.Maybe
 import           Data.String.Interpolate
@@ -66,10 +66,12 @@ import           System.Environment
 import           System.Exit
 import           System.IO               hiding ( appendFile )
 import           Text.Read               hiding ( lift )
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.UTF8          as UTF8
+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
@@ -112,9 +114,14 @@ data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
                  | ToolTag Tag
 
 prettyToolVer :: ToolVersion -> String
-prettyToolVer (ToolVersion v') = T.unpack $ prettyTVer v'
+prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
 prettyToolVer (ToolTag t) = show t
 
+toSetToolVer :: Maybe ToolVersion -> SetToolVersion
+toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
+toSetToolVer (Just (ToolTag t')) = SetToolTag t'
+toSetToolVer Nothing = SetRecommended
+
 
 data InstallCommand = InstallGHC InstallOptions
                     | InstallCabal InstallOptions
@@ -131,8 +138,14 @@ data SetCommand = SetGHC SetOptions
                 | SetCabal SetOptions
                 | SetHLS SetOptions
 
+-- a superset of ToolVersion
+data SetToolVersion = SetToolVersion GHCTargetVersion
+                    | SetToolTag Tag
+                    | SetRecommended
+                    | SetNext
+
 data SetOptions = SetOptions
-  { sToolVer :: Maybe ToolVersion
+  { sToolVer :: SetToolVersion
   }
 
 data ListOptions = ListOptions
@@ -192,10 +205,10 @@ data ChangeLogOptions = ChangeLogOptions
 -- by default. For example:
 --
 -- > invertableSwitch "recursive" True (help "do not recurse into directories")
--- 
+--
--- This example makes --recursive enabled by default, so 
+-- This example makes --recursive enabled by default, so
 -- the help is shown only for --no-recursive.
-invertableSwitch 
+invertableSwitch
     :: String              -- ^ long option
     -> Char                -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
@@ -363,7 +376,7 @@ com =
           (  command
               "install-cabal"
               ((info
-                 ((InstallCabalLegacy <$> installOpts) <**> helper)
+                 ((InstallCabalLegacy <$> installOpts (Just Cabal)) <**> helper)
                  (  progDesc "Install or update cabal"
                  <> footerDoc (Just $ text installCabalFooter)
                  )
@@ -413,7 +426,7 @@ installParser =
           "ghc"
           (   InstallGHC
           <$> (info
-                (installOpts <**> helper)
+                (installOpts (Just GHC) <**> helper)
                 (  progDesc "Install GHC"
                 <> footerDoc (Just $ text installGHCFooter)
                 )
@@ -423,7 +436,7 @@ installParser =
            "cabal"
            (   InstallCabal
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just Cabal) <**> helper)
                  (  progDesc "Install Cabal"
                  <> footerDoc (Just $ text installCabalFooter)
                  )
@@ -433,7 +446,7 @@ installParser =
            "hls"
            (   InstallHLS
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just HLS) <**> helper)
                  (  progDesc "Install haskell-languge-server"
                  <> footerDoc (Just $ text installHLSFooter)
                  )
@@ -441,7 +454,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts)
+    <|> (Right <$> installOpts Nothing)
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -472,8 +485,8 @@ Examples:
   ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
 
 
-installOpts :: Parser InstallOptions
+installOpts :: Maybe Tool -> Parser InstallOptions
-installOpts =
+installOpts tool =
   (\p (u, v) b -> InstallOptions v p u b)
     <$> (optional
           (option
@@ -495,9 +508,9 @@ installOpts =
                     )
                   )
                 )
-            <*> (Just <$> toolVersionArgument)
+            <*> (Just <$> toolVersionArgument Nothing tool)
             )
-        <|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
+        <|> (pure (Nothing, Nothing))
         )
     <*> flag
           False
@@ -514,7 +527,7 @@ setParser =
           "ghc"
           (   SetGHC
           <$> (info
-                (setOpts <**> helper)
+                (setOpts (Just GHC) <**> helper)
                 (  progDesc "Set GHC version"
                 <> footerDoc (Just $ text setGHCFooter)
                 )
@@ -524,7 +537,7 @@ setParser =
            "cabal"
            (   SetCabal
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just Cabal) <**> helper)
                  (  progDesc "Set Cabal version"
                  <> footerDoc (Just $ text setCabalFooter)
                  )
@@ -534,7 +547,7 @@ setParser =
            "hls"
            (   SetHLS
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just HLS) <**> helper)
                  (  progDesc "Set haskell-language-server version"
                  <> footerDoc (Just $ text setHLSFooter)
                  )
@@ -542,7 +555,7 @@ setParser =
            )
       )
     )
-    <|> (Right <$> setOpts)
+    <|> (Right <$> setOpts Nothing)
  where
   setGHCFooter :: String
   setGHCFooter = [s|Discussion:
@@ -559,8 +572,10 @@ setParser =
     Sets the the current haskell-language-server version.|]
 
 
-setOpts :: Parser SetOptions
+setOpts :: Maybe Tool -> Parser SetOptions
-setOpts = SetOptions <$> optional toolVersionArgument
+setOpts tool = SetOptions <$>
+    (fromMaybe SetRecommended <$>
+      optional (setVersionArgument (Just ListInstalled) tool))
 
 listOpts :: Parser ListOptions
 listOpts =
@@ -592,29 +607,29 @@ rmParser =
   (Left <$> subparser
       (  command
           "ghc"
-          (RmGHC <$> (info (rmOpts <**> helper) (progDesc "Remove GHC version")))
+          (RmGHC <$> (info (rmOpts (Just GHC) <**> helper) (progDesc "Remove GHC version")))
       <> command
            "cabal"
            (   RmCabal
-           <$> (info (versionParser' <**> helper)
+           <$> (info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
                      (progDesc "Remove Cabal version")
                )
            )
       <> command
            "hls"
            (   RmHLS
-           <$> (info (versionParser' <**> helper)
+           <$> (info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
                      (progDesc "Remove haskell-language-server version")
                )
            )
       )
     )
-    <|> (Right <$> rmOpts)
+    <|> (Right <$> rmOpts Nothing)
 
 
 
-rmOpts :: Parser RmOptions
+rmOpts :: Maybe Tool -> Parser RmOptions
-rmOpts = RmOptions <$> versionArgument
+rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
 
 
 changelogP :: Parser ChangeLogOptions
@@ -636,7 +651,7 @@ changelogP =
             )
           )
         )
-    <*> optional toolVersionArgument
+    <*> optional (toolVersionArgument Nothing Nothing)
 
 compileP :: Parser CompileCommand
 compileP = subparser
@@ -765,13 +780,85 @@ toolVersionParser = verP' <|> toolP
           )
 
 -- | same as toolVersionParser, except as an argument.
-toolVersionArgument :: Parser ToolVersion
+toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionArgument =
+toolVersionArgument criteria tool =
-  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
+  argument (eitherReader toolVersionEither)
+    (metavar "VERSION|TAG"
+    <> completer (tagCompleter (fromMaybe GHC tool) [])
+    <> foldMap (completer . versionCompleter criteria) tool)
 
 
-versionArgument :: Parser GHCTargetVersion
+setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
-versionArgument = argument (eitherReader tVersionEither) (metavar "VERSION")
+setVersionArgument criteria tool =
+  argument (eitherReader setEither)
+    (metavar "VERSION|TAG|next"
+    <> completer (tagCompleter (fromMaybe GHC tool) ["next"])
+    <> foldMap (completer . versionCompleter criteria) tool)
+ where
+  setEither s' =
+        parseSet s'
+    <|> bimap id SetToolTag (tagEither s')
+    <|> bimap id SetToolVersion (tVersionEither s')
+  parseSet s' = case fmap toLower s' of
+                  "next" -> Right SetNext
+                  other  -> Left [i|Unknown tag/version #{other}|]
+
+
+versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
+versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
+
+
+tagCompleter :: Tool -> [String] -> Completer
+tagCompleter tool add = listIOCompleter $ do
+  let loggerConfig = LoggerConfig
+        { lcPrintDebug = False
+        , colorOutter  = mempty
+        , rawOutter    = mempty
+        }
+
+      runLogger = myLoggerT loggerConfig
+
+  dirs <- getDirs
+  let simpleSettings = Settings False False Never Curl False GHCupURL
+      simpleAppState = AppState simpleSettings dirs defaultKeyBindings
+      runEnv = runLogger . flip runReaderT simpleAppState
+
+  mGhcUpInfo <- runEnv . runE $ readFromCache
+
+  case mGhcUpInfo of
+    VRight dls -> do
+      let allTags = filter (\t -> t /= Old)
+            $ join
+            $ M.elems
+            $ availableToolVersions (_ghcupDownloads dls) tool
+      pure $ nub $ (add ++) $ fmap tagToString allTags
+    VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
+
+
+versionCompleter :: Maybe ListCriteria -> Tool -> Completer
+versionCompleter criteria tool = listIOCompleter $ do
+  let loggerConfig = LoggerConfig
+        { lcPrintDebug = False
+        , colorOutter  = mempty
+        , rawOutter    = mempty
+        }
+
+      runLogger = myLoggerT loggerConfig
+
+  mpFreq <- runLogger . runE $ platformRequest
+
+  forFold mpFreq $ \pfreq -> do
+    dirs <- getDirs
+    let simpleSettings = Settings False False Never Curl False GHCupURL
+        simpleAppState = AppState simpleSettings dirs defaultKeyBindings
+        runEnv = runLogger . flip runReaderT simpleAppState
+
+    mGhcUpInfo <- runEnv . runE $ readFromCache
+
+    forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do
+      installedVersions <- runEnv $ listVersions dls (Just tool) criteria pfreq
+      return $ T.unpack . prettyVer . lVer <$> installedVersions
+
 
 versionParser :: Parser GHCTargetVersion
 versionParser = option
@@ -779,10 +866,10 @@ versionParser = option
   (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
   )
 
-versionParser' :: Parser Version
+versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
-versionParser' = argument
+versionParser' criteria tool = argument
-  (eitherReader (bimap show id . version . T.pack))
+  (eitherReader (first show . version . T.pack))
-  (metavar "VERSION")
+  (metavar "VERSION"  <> foldMap (completer . versionCompleter criteria) tool)
 
 
 tagEither :: String -> Either String Tag
@@ -792,7 +879,7 @@ tagEither s' = case fmap toLower s' of
   ('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}|])
+  other         -> Left [i|Unknown tag #{other}|]
 
 
 tVersionEither :: String -> Either String GHCTargetVersion
@@ -1045,6 +1132,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , DigestError
                       , DownloadFailed
                       , TarDirDoesNotExist
+                      , NextVerNotFound
+                      , NoToolVersionSet
                       ]
 
           let runInstTool = runInstTool' appstate
@@ -1058,6 +1147,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let
@@ -1068,6 +1159,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   @'[ NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let
@@ -1078,6 +1171,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   @'[ NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let runListGHC = runLogger . flip runReaderT appstate
@@ -1137,7 +1232,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     VRight r -> pure r
                     VLeft e -> do
                       runLogger
-                        ($(logError) [i|Error determining Platform: #{e}|])
+                        ($(logError) $ T.pack $ prettyShow e)
                       exitWith (ExitFailure 2)
 
 
@@ -1152,7 +1247,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     VRight r -> pure r
                     VLeft  e -> do
                       runLogger
-                        ($(logError) [i|Error fetching download info: #{e}|])
+                        ($(logError) $ T.pack $ prettyShow e)
                       exitWith (ExitFailure 2)
 
           case optCommand of
@@ -1191,23 +1286,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             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|]
                             pure ExitSuccess
-                          VLeft (V (BuildFailed tmpdir e)) -> do
+                          VLeft err@(V (BuildFailed tmpdir _)) -> do
                             case keepDirs settings of
-                              Never -> runLogger ($(logError) [i|Build failed with #{e}|])
+                              Never -> runLogger ($(logError) $ T.pack $ prettyShow err)
-                              _ -> runLogger ($(logError) [i|Build failed with #{e}
+                              _ -> runLogger ($(logError) [i|#{prettyShow err}
     Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
     Make sure to clean up #{tmpdir} afterwards.|])
                             pure $ ExitFailure 3
-                          VLeft (V NoDownload) -> do
-
-                            runLogger $ do
-                              case instVer of
-                                Just iver -> $(logError) [i|No available GHC version for #{prettyToolVer iver}|]
-                                Nothing -> $(logError) [i|No available recommended GHC version|]
-                            pure $ ExitFailure 3
                           VLeft e -> do
                             runLogger $ do
-                              $(logError) [i|#{e}|]
+                              $(logError) $ T.pack $ prettyShow e
                               $(logError) [i|Also check the logs in #{logsDir}|]
                             pure $ ExitFailure 3
 
@@ -1236,16 +1324,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           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|]
                           pure ExitSuccess
-                        VLeft (V NoDownload) -> do
-
-                          runLogger $ do
-                            case instVer of
-                              Just iver -> $(logError) [i|No available Cabal version for #{prettyToolVer iver}|]
-                              Nothing -> $(logError) [i|No available recommended Cabal version|]
-                          pure $ ExitFailure 4
                         VLeft e -> do
                           runLogger $ do
-                            $(logError) [i|#{e}|]
+                            $(logError) $ T.pack $ prettyShow e
                             $(logError) [i|Also check the logs in #{logsDir}|]
                           pure $ ExitFailure 4
 
@@ -1273,23 +1354,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           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|]
                           pure ExitSuccess
-                        VLeft (V NoDownload) -> do
-
-                          runLogger $ do
-                            case instVer of
-                              Just iver -> $(logError) [i|No available HLS version for #{prettyToolVer iver}|]
-                              Nothing -> $(logError) [i|No available recommended HLS version|]
-                          pure $ ExitFailure 4
                         VLeft e -> do
                           runLogger $ do
-                            $(logError) [i|#{e}|]
+                            $(logError) $ T.pack $ prettyShow e
                             $(logError) [i|Also check the logs in #{logsDir}|]
                           pure $ ExitFailure 4
 
 
           let setGHC' SetOptions{..} =
                 (runSetGHC $ do
-                    v <- liftE $ fst <$> fromVersion dls sToolVer GHC
+                    v <- liftE $ fst <$> fromVersion' dls sToolVer GHC
                     liftE $ setGHC v SetGHCOnly
                   )
                   >>= \case
@@ -1299,29 +1373,39 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                                 [i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
                           pure ExitSuccess
                         VLeft e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 5
 
           let setCabal' SetOptions{..} =
                 (runSetCabal $ do
-                    v <- liftE $ fst <$> fromVersion dls sToolVer Cabal
+                    v <- liftE $ fst <$> fromVersion' dls sToolVer Cabal
                     liftE $ setCabal (_tvVersion v)
+                    pure v
                   )
                   >>= \case
-                        VRight _ -> pure ExitSuccess
+                        VRight (GHCTargetVersion{..}) -> do
+                          runLogger
+                            $ $(logInfo)
+                                [i|Cabal #{prettyVer _tvVersion} successfully set as default version|]
+                          pure ExitSuccess
                         VLeft  e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
           let setHLS' SetOptions{..} =
                 (runSetHLS $ do
-                    v <- liftE $ fst <$> fromVersion dls sToolVer HLS
+                    v <- liftE $ fst <$> fromVersion' dls sToolVer HLS
                     liftE $ setHLS (_tvVersion v)
+                    pure v
                   )
                   >>= \case
-                        VRight _ -> pure ExitSuccess
+                        VRight (GHCTargetVersion{..}) -> do
+                          runLogger
+                            $ $(logInfo)
+                                [i|HLS #{prettyVer _tvVersion} successfully set as default version|]
+                          pure ExitSuccess
                         VLeft  e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
           let rmGHC' RmOptions{..} =
@@ -1338,7 +1422,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 7
 
           let rmCabal' tv =
@@ -1355,7 +1439,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
           let rmHLS' tv =
@@ -1372,7 +1456,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft  e -> do
-                          runLogger ($(logError) [i|#{e}|])
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
 
@@ -1419,7 +1503,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         putStrLn $ prettyDebugInfo dinfo
                         pure ExitSuccess
                       VLeft e -> do
-                        runLogger ($(logError) [i|#{e}|])
+                        runLogger $ $(logError) $ T.pack $ prettyShow e
                         pure $ ExitFailure 8
 
             Compile (CompileGHC GHCCompileOptions {..}) ->
@@ -1454,16 +1538,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         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|]
                         pure ExitSuccess
-                      VLeft (V (BuildFailed tmpdir e)) -> do
+                      VLeft err@(V (BuildFailed tmpdir _)) -> do
                         case keepDirs settings of
-                          Never -> runLogger ($(logError) [i|Build failed with #{e}
+                          Never -> runLogger $ $(logError) $ T.pack $ prettyShow err
-Check the logs at #{logsDir}|])
+                          _ -> runLogger ($(logError) [i|#{prettyShow err}
-                          _ -> runLogger ($(logError) [i|Build failed with #{e}
 Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
 Make sure to clean up #{tmpdir} afterwards.|])
                         pure $ ExitFailure 9
                       VLeft e -> do
-                        runLogger ($(logError) [i|#{e}|])
+                        runLogger $ $(logError) $ T.pack $ prettyShow e
                         pure $ ExitFailure 9
 
             Upgrade (uOpts) force -> do
@@ -1488,7 +1571,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                   runLogger $ $(logWarn) [i|No GHCup update available|]
                   pure ExitSuccess
                 VLeft e -> do
-                  runLogger ($(logError) [i|#{e}|])
+                  runLogger $ $(logError) $ T.pack $ prettyShow e
                   pure $ ExitFailure 11
 
             ToolRequirements ->
@@ -1505,10 +1588,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                 >>= \case
                       VRight _ -> pure ExitSuccess
                       VLeft  e -> do
-                        runLogger
+                        runLogger $ $(logError) $ T.pack $ prettyShow e
-                          ($(logError)
-                            [i|Error getting tool requirements: #{e}|]
-                          )
                         pure $ ExitFailure 12
 
             ChangeLog (ChangeLogOptions {..}) -> do
@@ -1553,16 +1633,22 @@ Make sure to clean up #{tmpdir} afterwards.|])
             ef@(ExitFailure _) -> exitWith ef
   pure ()
 
-
+fromVersion :: (MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
-fromVersion :: Monad m
             => GHCupDownloads
             -> Maybe ToolVersion
             -> Tool
-            -> Excepts '[TagNotFound, VerNotFound] m (GHCTargetVersion, VersionInfo)
+            -> Excepts '[TagNotFound, VerNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, VersionInfo)
-fromVersion av Nothing tool =
+fromVersion av tv tool = fromVersion' av (toSetToolVer tv) tool
+
+fromVersion' :: (MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
+             => GHCupDownloads
+             -> SetToolVersion
+             -> Tool
+             -> Excepts '[TagNotFound, VerNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, VersionInfo)
+fromVersion' av SetRecommended tool =
   (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool
     ?? TagNotFound Recommended tool
-fromVersion av (Just (ToolVersion v)) tool = do
+fromVersion' av (SetToolVersion v) tool = do
   vi <- getVersionInfo (_tvVersion v) tool av ?? VerNotFound (_tvVersion v) tool
   case pvp $ prettyVer (_tvVersion v) of
     Left _ -> pure (v, vi)
@@ -1571,13 +1657,48 @@ fromVersion av (Just (ToolVersion v)) tool = do
         Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', vi')
         Nothing -> pure (v, vi)
     Right _ -> pure (v, vi)
-fromVersion av (Just (ToolTag Latest)) tool =
+fromVersion' av  (SetToolTag Latest) tool =
   (\(x, y) -> (mkTVer x, y)) <$> getLatest av tool ?? TagNotFound Latest tool
-fromVersion av (Just (ToolTag Recommended)) tool =
+fromVersion' av (SetToolTag Recommended) tool =
   (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool ?? TagNotFound Recommended tool
-fromVersion av (Just (ToolTag (Base pvp''))) GHC =
+fromVersion' av (SetToolTag (Base pvp'')) GHC =
   (\(x, y) -> (mkTVer x, y)) <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC
-fromVersion _ (Just (ToolTag t')) tool =
+fromVersion' av SetNext tool = do
+  next <- case tool of
+    GHC -> do
+      set <- fmap _tvVersion $ ghcSet Nothing !? NoToolVersionSet tool
+      ghcs <- rights <$> lift getInstalledGHCs
+      (headMay
+        . tail
+        . dropWhile (\GHCTargetVersion {..} -> _tvVersion /= set)
+        . cycle
+        . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
+        . filter (\GHCTargetVersion {..} -> _tvTarget == Nothing)
+        $ ghcs) ?? NoToolVersionSet tool
+    Cabal -> do
+      set <- cabalSet !? NoToolVersionSet tool
+      cabals <- rights <$> lift getInstalledCabals
+      (fmap (GHCTargetVersion Nothing)
+        . headMay
+        . tail
+        . dropWhile (/= set)
+        . cycle
+        . sort
+        $ cabals) ?? NoToolVersionSet tool
+    HLS -> do
+      set <- hlsSet !? NoToolVersionSet tool
+      hlses <- rights <$> lift getInstalledHLSs
+      (fmap (GHCTargetVersion Nothing)
+        . headMay
+        . tail
+        . dropWhile (/= set)
+        . cycle
+        . sort
+        $ hlses) ?? NoToolVersionSet tool
+    GHCup -> fail "GHCup cannot be set"
+  vi <- getVersionInfo (_tvVersion next) tool av ?? VerNotFound (_tvVersion next) tool
+  pure (next, vi)
+fromVersion' _ (SetToolTag t') tool =
   throwE $ TagNotFound t' tool
 
 
@@ -1781,7 +1902,7 @@ GHCup base dir: #{toFilePath diBaseDir}
 GHCup bin dir: #{toFilePath diBinDir}
 GHCup GHC directory: #{toFilePath diGHCDir}
 GHCup cache directory: #{toFilePath diCacheDir}
-Architecture: #{prettyArch diArch}
+Architecture: #{prettyShow diArch}
-Platform: #{prettyPlatform diPlatform}
+Platform: #{prettyShow diPlatform}
 Version: #{describe_result}|]
 

bootstrap-haskell

@@ -69,7 +69,7 @@ _done() {
 download_ghcup() {
 	_plat="$(uname -s)"
 	_arch=$(uname -m)
-	_ghver="0.1.12"
+	_ghver="0.1.13"
 	_base_url="https://downloads.haskell.org/~ghcup"
 
     case "${_plat}" in
@@ -89,6 +89,12 @@ download_ghcup() {
 				i*86)
 					_url=${_base_url}/${_ghver}/i386-linux-ghcup-${_ghver}
 					;;
+				armv7*)
+					_url=${_base_url}/${_ghver}/armv7-linux-ghcup-${_ghver}
+					;;
+				aarch64|arm64|armv8l)
+					_url=${_base_url}/${_ghver}/aarch64-linux-ghcup-${_ghver}
+					;;
 				*) die "Unknown architecture: ${_arch}"
 					;;
 			esac

ghcup-0.0.4.yaml

@@ -138,6 +138,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz
         dlSubdir: ghc-7.10.3
         dlHash: cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef
+      viPostRemove: &ghc-post-remove "After removing GHC you might also want to clean up your cabal store at: ~/.cabal/store/ghc-<ghcver>"
       viArch:
         A_64:
           Linux_Debian:
@@ -201,6 +202,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz
         dlSubdir: ghc-8.0.2
         dlHash: 11625453e1d0686b3fa6739988f70ecac836cadc30b9f0c8b49ef9091d6118b1
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -259,6 +261,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz
         dlSubdir: ghc-8.2.2
         dlHash: bb8ec3634aa132d09faa270bbd604b82dfa61f04855655af6f9d14a9eedc05fc
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -326,6 +329,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz
         dlSubdir: ghc-8.4.1
         dlHash: 39ae2f25192408f355693e5a3c8b6ff613ddb7c4da998fdf26210143a61839d2
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -375,6 +379,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz
         dlSubdir: ghc-8.4.2
         dlHash: 01cc32f24a06bf3b2428351b6d7fec791e82d042426d29ad9e5a245b35f0047b
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -429,6 +434,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz
         dlSubdir: ghc-8.4.3
         dlHash: ae47afda985830de8811243255aa3744dfb9207cb980af74393298b2b62160d6
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -477,6 +483,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz
         dlSubdir: ghc-8.4.4
         dlHash: 11117735a58e507c481c09f3f39ae5a314e9fbf49fc3109528f99ea7959004b2
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -550,6 +557,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz
         dlSubdir: ghc-8.6.1
         dlHash: 2c25c26d1e5c47c7cbb2a1d8e6456524033e7a71409184dd3125e3fc5a3c7036
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -604,6 +612,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz
         dlSubdir: ghc-8.6.2
         dlHash: caaa819d21280ecde90a4773143dee188711e9ff175a27cfbaee56eb851d76d5
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -649,6 +658,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz
         dlSubdir: ghc-8.6.3
         dlHash: 9f9e37b7971935d88ba80426c36af14b1e0b3ec1d9c860f44a4391771bc07f23
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -712,6 +722,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz
         dlSubdir: ghc-8.6.4
         dlHash: 5b5d07e4463203a433c3ed3df461ba6cce11b6d2b9b264db31f3429075d0303a
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -760,6 +771,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz
         dlSubdir: ghc-8.6.5
         dlHash: 4d4aa1e96f4001b934ac6193ab09af5d6172f41f5a5d39d8e43393b9aafee361
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -839,6 +851,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz
         dlSubdir: ghc-8.8.1
         dlHash: 908a83d9b814da74585de9d39687189e6260ec3848131f9d9236cab8a123721a
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -897,6 +910,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz
         dlSubdir: ghc-8.8.2
         dlHash: 01cea54d90686b97bcc9960b108beaffccd4336dee930dcf9beaf52b1f370a0b
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -955,6 +969,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz
         dlSubdir: ghc-8.8.3
         dlHash: e0dcc0aaf3e234c5978f29e6df62947e97720ab404ec0158343df211c5480f89
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1023,6 +1038,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-src.tar.xz
         dlSubdir: ghc-8.8.4
         dlHash: f0505e38b2235ff9f1090b51f44d6c8efd371068e5a6bb42a2a6d8b67b5ffc2d
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1096,6 +1112,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz
         dlSubdir: ghc-8.10.1
         dlHash: 4e3b07f83a266b3198310f19f71e371ebce97c769b14f0d688f4cbf2a2a1edf5
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1185,6 +1202,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-src.tar.xz
         dlSubdir: ghc-8.10.2
         dlHash: 9c573a4621a78723950617c223559bdc325ea6a3409264aedf68f05510b0880b
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1273,6 +1291,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-src.tar.xz
         dlSubdir: ghc-8.10.3
         dlHash: ccdc8319549028a708d7163e2967382677b1a5a379ff94d948195b5cf46eb931
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1362,6 +1381,8 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-src.tar.xz
         dlSubdir: ghc-8.10.4
         dlHash: 52af871b4e08550257d720c2944ac85727d0b948407cef1bebfe7508c224910e
+      viPostRemove: *ghc-post-remove
+      viPreCompile: "If you have autoconf >= 2.70 you'll need this patch https://gitlab.haskell.org/ghc/ghc/-/snippets/2040 (see the --patchdir option)"
       viArch:
         A_64:
           Linux_Debian:
@@ -1451,6 +1472,7 @@ ghcupDownloads:
         dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-src.tar.xz
         dlSubdir: ghc-9.0.1
         dlHash: a5230314e4065f9fcc371dfe519748fd85c825b279abf72a24e09b83578a35f9
+      viPostRemove: *ghc-post-remove
       viArch:
         A_64:
           Linux_Debian:
@@ -1671,7 +1693,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
   GHCup:
-    0.1.12:
+    0.1.13:
       viTags:
       - Recommended
       - Latest
@@ -1681,31 +1703,42 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-linux-ghcup-0.1.12
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/x86_64-linux-ghcup-0.1.13
-              dlHash: 83088569ddf2d35df494f440dedd9c8eb2a53276d665f7de731f6554986c2ddb
+              dlHash: 674266bb9fa85bbafd3c620c68fae4b3cc62507bd6ad9b116603e860bdee1f5a
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-apple-darwin-ghcup-0.1.12
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/x86_64-apple-darwin-ghcup-0.1.13
-              dlHash: 1336efb0851e1ed267838f97f6c36cbceb5363ad0ae359f04f1bc43d0c5f2cef
+              dlHash: 5e45cb0b69cd8ee4f7793b84042d4bd121609fa59531ef760fc98fa10c466e4d
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-portbld-freebsd-ghcup-0.1.12
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/x86_64-portbld-freebsd-ghcup-0.1.13
-              dlHash: a72123e972a53d667574c7d276a81842701a07fce2b434e4d856e561c34772fe
+              dlHash: 79ce3143a100b60b5294fa831abf091b9699e0bf3addb6c9956de706fc954902
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.12/i386-linux-ghcup-0.1.12
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/i386-linux-ghcup-0.1.13
-              dlHash: 4bc79a272dfcd16143f08d9f8e33f2fef66dc53f3a0659bdab56ac3cbecf9e84
+              dlHash: 4d7646027215b29384f1409399f66bd348421de8a6d53e47ae47c3b465e18fb0
           Linux_Alpine:
             unknown_versioning: *ghcup-32
+        A_ARM64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/aarch64-linux-ghcup-0.1.13
+              dlHash: c60be7ca13454a9ea5cfe1aacd57809a01605c9533f40a433543d443ac16e439
+        A_ARM:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.13/armv7-linux-ghcup-0.1.13
+              dlHash: d0d047dce694a43ce2872c28ad05b22541c43d6e222eed172b9f909f5dbadb8c
   HLS:
     1.0.0:
       viTags:
         - Recommended
         - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#100
+      viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
       viArch:
         A_64:
           Linux_UnknownLinux:

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.12
+version:            0.1.13
 synopsis:           ghc toolchain installer as an exe/library
 description:
   A rewrite of the shell script ghcup, for providing
@@ -150,6 +150,9 @@ common optparse-applicative
 common parsec
   build-depends: parsec >=3.1
 
+common pretty
+  build-depends: pretty >=1.1.3.1
+
 common pretty-terminal
   build-depends: pretty-terminal >=0.1.0.0
 
@@ -288,6 +291,7 @@ library
     , optics
     , optics-vl
     , parsec
+    , pretty
     , pretty-terminal
     , regex-posix
     , resourcet
@@ -336,11 +340,13 @@ library
     GHCup.Utils.Version.QQ
     GHCup.Version
 
+  other-modules:
+    Paths_ghcup
+
   default-extensions:
     Strict
     StrictData
 
-  -- other-modules:
   -- other-extensions:
   hs-source-dirs:  lib
 
@@ -375,6 +381,7 @@ executable ghcup
     , monad-logger
     , mtl
     , optparse-applicative
+    , pretty
     , pretty-terminal
     , resourcet
     , safe
@@ -430,6 +437,7 @@ executable ghcup-gen
     , mtl
     , optics
     , optparse-applicative
+    , pretty
     , pretty-terminal
     , regex-posix
     , resourcet

lib/GHCup.hs

@@ -525,7 +525,7 @@ setGHC ver sghc = do
   let verBS = verToBS (_tvVersion ver)
   ghcdir                        <- lift $ ghcupGHCDir ver
 
-  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
+  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC ver))
 
   -- symlink destination
   AppState { dirs = Dirs {..} } <- lift ask
@@ -605,7 +605,7 @@ setCabal ver = do
 
   whenM (liftIO $ fmap not $ doesFileExist (binDir </> targetFile))
     $ throwE
-    $ NotInstalled Cabal (prettyVer ver)
+    $ NotInstalled Cabal (GHCTargetVersion Nothing ver)
 
   let cabalbin = binDir </> [rel|cabal|]
 
@@ -647,7 +647,7 @@ setHLS ver = do
 
   -- set haskell-language-server-<ghcver> symlinks
   bins <- lift $ hlsServerBinaries ver
-  when (bins == []) $ throwE $ NotInstalled HLS (prettyVer ver)
+  when (bins == []) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
 
   forM_ bins $ \f -> do
     let destL = toFilePath f
@@ -929,7 +929,7 @@ rmGHCVer :: ( MonadReader AppState m
 rmGHCVer ver = do
   isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
 
-  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
+  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC ver))
   dir <- lift $ ghcupGHCDir ver
 
   -- this isn't atomic, order matters
@@ -970,7 +970,7 @@ rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, M
            => Version
            -> Excepts '[NotInstalled] m ()
 rmCabalVer ver = do
-  whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (prettyVer ver))
+  whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (GHCTargetVersion Nothing ver))
 
   cSet      <- lift $ cabalSet
 
@@ -993,7 +993,7 @@ rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, Mon
          => Version
          -> Excepts '[NotInstalled] m ()
 rmHLSVer ver = do
-  whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (prettyVer ver))
+  whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
 
   isHlsSet      <- lift $ hlsSet
 
@@ -1240,7 +1240,7 @@ Stage1Only = YES|]
       $ c
     tarName <-
       parseRel
-        [i|ghc-#{prettyTVer tver}-#{prettyPfReq pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
+        [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
     let tarPath = cacheDir </> tarName
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
                                                              tarPath

lib/GHCup/Download.hs

@@ -137,30 +137,8 @@ getDownloadsF urlSource = do
       bsExt <- reThrowAll DownloadFailed $ downloadBS uri
       ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt)
       pure (mergeGhcupInfo base ext)
- where
-  readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
-                => Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-  readFromCache = do
-    AppState {dirs = Dirs {..}} <- lift ask
-    lift $ $(logWarn)
-      [i|Could not get download info, trying cached version (this may not be recent!)|]
-    let path = view pathL' ghcupURL
-    yaml_file <- (cacheDir </>) <$> urlBaseName path
-    bs        <-
-      handleIO' NoSuchThing
-                (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
-      $ liftIO
-      $ readFile yaml_file
-    lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
 
-  getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
+    where
-          => Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
-  getBase =
-    handleIO (\_ -> readFromCache)
-    $ catchE @_ @'[JSONError, FileDoesNotExistError]
-        (\(DownloadFailed _) -> readFromCache)
-    $ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
-      >>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
 
   mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
                  -> GHCupInfo -- ^ extension overwriting the base
@@ -172,6 +150,32 @@ getDownloadsF urlSource = do
                            ) base
     in GHCupInfo tr new
 
+
+readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
+              => Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
+readFromCache = do
+  AppState {dirs = Dirs {..}} <- lift ask
+  lift $ $(logWarn)
+    [i|Could not get download info, trying cached version (this may not be recent!)|]
+  let path = view pathL' ghcupURL
+  yaml_file <- (cacheDir </>) <$> urlBaseName path
+  bs        <-
+    handleIO' NoSuchThing
+              (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
+    $ liftIO
+    $ readFile yaml_file
+  lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
+
+
+getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
+        => Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
+getBase =
+  handleIO (\_ -> readFromCache)
+  $ catchE @_ @'[JSONError, FileDoesNotExistError]
+      (\(DownloadFailed _) -> readFromCache)
+  $ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
+    >>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
+    where
   -- First check if the json file is in the ~/.ghcup/cache dir
   -- and check it's access time. If it has been accessed within the
   -- last 5 minutes, just reuse it.
@@ -209,8 +213,8 @@ getDownloadsF urlSource = do
       then do
         accessTime <-
           PF.accessTimeHiRes
-            <$> (liftIO $ PF.getFileStatus (toFilePath json_file))
+            <$> liftIO (PF.getFileStatus (toFilePath json_file))
-        currentTime <- liftIO $ getPOSIXTime
+        currentTime <- liftIO getPOSIXTime
 
         -- access time won't work on most linuxes, but we can try regardless
         if (currentTime - accessTime) > 300

lib/GHCup/Errors.hs

@@ -1,7 +1,13 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TypeOperators           #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleInstances           #-}
 
 {-|
 Module      : GHCup.Errors
@@ -15,13 +21,21 @@ Portability : POSIX
 module GHCup.Errors where
 
 import           GHCup.Types
+import           GHCup.Utils.Prelude
 
+#if !defined(TAR)
+import           Codec.Archive
+#endif
 import           Control.Exception.Safe
 import           Data.ByteString                ( ByteString )
+import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           Haskus.Utils.Variant
 import           HPath
+import           Haskus.Utils.Variant
+import           Text.PrettyPrint
+import           Text.PrettyPrint.HughesPJClass
+import           URI.ByteString
 
 
 
@@ -35,101 +49,211 @@ import           HPath
 data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got
   deriving Show
 
+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.
 data NoDownload = NoDownload
   deriving Show
 
+instance Pretty NoDownload where
+  pPrint NoDownload =
+    text "Unable to find a download for the requested version/distro."
+
 -- | No update available or necessary.
 data NoUpdate = NoUpdate
   deriving Show
 
+instance Pretty NoUpdate where
+  pPrint NoUpdate = text "No update available or necessary."
+
 -- | The Architecture is unknown and unsupported.
 data NoCompatibleArch = NoCompatibleArch String
   deriving Show
 
+instance Pretty NoCompatibleArch where
+  pPrint (NoCompatibleArch arch) =
+    text ("The Architecture is unknown or unsupported. Got: " ++ arch)
+
 -- | Unable to figure out the distribution of the host.
 data DistroNotFound = DistroNotFound
   deriving Show
 
+instance Pretty DistroNotFound where
+  pPrint DistroNotFound =
+    text "Unable to figure out the distribution of the host."
+
 -- | The archive format is unknown. We don't know how to extract it.
 data UnknownArchive = UnknownArchive ByteString
   deriving Show
 
+instance Pretty UnknownArchive where
+  pPrint (UnknownArchive file) =
+    text [i|The archive format is unknown. We don't know how to extract the file "#{decUTF8Safe file}"|]
+
 -- | The scheme is not supported (such as ftp).
 data UnsupportedScheme = UnsupportedScheme
   deriving Show
 
+instance Pretty UnsupportedScheme where
+  pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
+
 -- | Unable to copy a file.
 data CopyError = CopyError String
   deriving Show
 
+instance Pretty CopyError where
+  pPrint (CopyError reason) =
+    text ("Unable to copy a file. Reason was: " ++ reason)
+
 -- | Unable to find a tag of a tool.
 data TagNotFound = TagNotFound Tag Tool
   deriving Show
 
+instance Pretty TagNotFound where
+  pPrint (TagNotFound tag tool) =
+    text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
+
 -- | Unable to find a version of a tool.
 data VerNotFound = VerNotFound Version Tool
   deriving Show
 
+instance Pretty VerNotFound where
+  pPrint (VerNotFound ver' tool) =
+    text [i|Unable to find version "#{prettyShow ver'}" of tool "#{tool}"|]
+
+-- | Unable to find the next version of a tool (the one after the currently
+-- set one).
+data NextVerNotFound = NextVerNotFound Tool
+  deriving Show
+
+instance Pretty NextVerNotFound where
+  pPrint (NextVerNotFound tool) =
+    text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|]
+
 -- | The tool (such as GHC) is already installed with that version.
 data AlreadyInstalled = AlreadyInstalled Tool Version
   deriving Show
 
+instance Pretty AlreadyInstalled where
+  pPrint (AlreadyInstalled tool ver') =
+    text [i|#{tool}-#{prettyShow ver'} is already installed|]
+
 -- | The tool is not installed. Some operations rely on a tool
 -- to be installed (such as setting the current GHC version).
-data NotInstalled = NotInstalled Tool Text
+data NotInstalled = NotInstalled Tool GHCTargetVersion
   deriving Show
 
+instance Pretty NotInstalled where
+  pPrint (NotInstalled tool ver) =
+    text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
+
 -- | An executable was expected to be in PATH, but was not found.
 data NotFoundInPATH = NotFoundInPATH (Path Rel)
   deriving Show
 
+instance Pretty NotFoundInPATH where
+  pPrint (NotFoundInPATH exe) =
+    text [i|The exe "#{decUTF8Safe . toFilePath $ exe}" was not found in PATH.|]
+
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
   deriving Show
 
+instance Pretty JSONError where
+  pPrint (JSONDecodeError err) =
+    text [i|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).
 data FileDoesNotExistError = FileDoesNotExistError ByteString
   deriving Show
 
+instance Pretty FileDoesNotExistError where
+  pPrint (FileDoesNotExistError file) =
+    text [i|File "#{decUTF8Safe file}" does not exist.|]
+
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
 
+instance Pretty TarDirDoesNotExist where
+  pPrint (TarDirDoesNotExist dir) =
+    text "Tar directory does not exist:" <+> pPrint dir
+
 -- | File digest verification failed.
 data DigestError = DigestError Text Text
   deriving Show
 
+instance Pretty DigestError where
+  pPrint (DigestError currentDigest expectedDigest) =
+    text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
+
 -- | Unexpected HTTP status.
 data HTTPStatusError = HTTPStatusError Int
   deriving Show
 
+instance Pretty HTTPStatusError where
+  pPrint (HTTPStatusError status) =
+    text [i|Unexpected HTTP status: #{status}|]
+
 -- | The 'Location' header was expected during a 3xx redirect, but not found.
 data NoLocationHeader = NoLocationHeader
   deriving Show
 
+instance Pretty NoLocationHeader where
+  pPrint NoLocationHeader =
+    text [i|The 'Location' header was expected during a 3xx redirect, but not found.|]
+
 -- | Too many redirects.
 data TooManyRedirs = TooManyRedirs
   deriving Show
 
+instance Pretty TooManyRedirs where
+  pPrint TooManyRedirs =
+    text [i|Too many redirections.|]
+
 -- | A patch could not be applied.
 data PatchFailed = PatchFailed
   deriving Show
 
+instance Pretty PatchFailed where
+  pPrint PatchFailed =
+    text [i|A patch could not be applied.|]
+
 -- | The tool requirements could not be found.
 data NoToolRequirements = NoToolRequirements
   deriving Show
 
+instance Pretty NoToolRequirements where
+  pPrint NoToolRequirements =
+    text [i|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}|]
+
+data NoToolVersionSet = NoToolVersionSet Tool
+  deriving Show
+
+instance Pretty NoToolVersionSet where
+  pPrint (NoToolVersionSet tool) =
+    text [i|No version is set for tool "#{tool}".|]
+
 
     -------------------------
     --[ High-level errors ]--
     -------------------------
 
 -- | A download failed. The underlying error is encapsulated.
-data DownloadFailed = forall es . Show (V es) => DownloadFailed (V es)
+data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs))
+
+instance Pretty DownloadFailed where
+  pPrint (DownloadFailed reason) =
+    text "Download failed:" <+> pPrint reason
 
 deriving instance Show DownloadFailed
 
@@ -137,12 +261,20 @@ deriving instance Show DownloadFailed
 -- | A build failed.
 data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es)
 
+instance Pretty BuildFailed where
+  pPrint (BuildFailed path reason) =
+    text [i|BuildFailed failed in dir "#{decUTF8Safe . toFilePath $ path}": #{reason}|]
+
 deriving instance Show BuildFailed
 
 
 -- | Setting the current GHC version failed.
 data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
 
+instance Pretty GHCupSetError where
+  pPrint (GHCupSetError reason) =
+    text [i|Setting the current GHC version failed: #{reason}|]
+
 deriving instance Show GHCupSetError
 
 
@@ -155,11 +287,65 @@ deriving instance Show GHCupSetError
 data ParseError = ParseError String
   deriving Show
 
+instance Pretty ParseError where
+  pPrint (ParseError reason) =
+    text [i|Parsing failed: #{reason}|]
+
 instance Exception ParseError
 
 
 data UnexpectedListLength = UnexpectedListLength String
   deriving Show
 
+instance Pretty UnexpectedListLength where
+  pPrint (UnexpectedListLength reason) =
+    text [i|List length unexpected: #{reason}|]
+
 instance Exception UnexpectedListLength
 
+
+
+    ------------------------
+    --[ orphan instances ]--
+    ------------------------
+
+instance Pretty (V '[]) where
+   {-# INLINABLE pPrint #-}
+   pPrint _ = undefined
+
+instance
+   ( Pretty x
+   , Pretty (V xs)
+   ) => Pretty (V (x ': xs))
+   where
+      pPrint v = case popVariantHead v of
+         Right x -> pPrint x
+         Left xs -> pPrint xs
+
+instance Pretty URIParseError where
+  pPrint (MalformedScheme reason) =
+    text [i|Failed to parse URI. Malformed scheme: #{reason}|]
+  pPrint MalformedUserInfo =
+    text [i|Failed to parse URI. Malformed user info.|]
+  pPrint MalformedQuery =
+    text [i|Failed to parse URI. Malformed query.|]
+  pPrint MalformedFragment =
+    text [i|Failed to parse URI. Malformed fragment.|]
+  pPrint MalformedHost =
+    text [i|Failed to parse URI. Malformed host.|]
+  pPrint MalformedPort =
+    text [i|Failed to parse URI. Malformed port.|]
+  pPrint MalformedPath =
+    text [i|Failed to parse URI. Malformed path.|]
+  pPrint (OtherError err) =
+    text [i|Failed to parse URI: #{err}|]
+
+#if !defined(TAR)
+instance Pretty ArchiveResult where
+  pPrint ArchiveFatal = text "Archive result: fatal"
+  pPrint ArchiveFailed = text "Archive result: failed"
+  pPrint ArchiveWarn = text "Archive result: warning"
+  pPrint ArchiveRetry = text "Archive result: retry"
+  pPrint ArchiveOk = text "Archive result: Ok"
+  pPrint ArchiveEOF = text "Archive result: EOF"
+#endif

lib/GHCup/Types.hs

@@ -1,6 +1,8 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes           #-}
 
 {-|
 Module      : GHCup.Types
@@ -15,12 +17,16 @@ module GHCup.Types where
 
 import           Data.Map.Strict                ( Map )
 import           Data.List.NonEmpty             ( NonEmpty (..) )
+import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           HPath
+import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
 
 import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as E
+import qualified Data.Text.Encoding.Error      as E
 import qualified GHC.Generics                  as GHC
 import qualified Graphics.Vty                  as Vty
 
@@ -106,6 +112,21 @@ data Tag = Latest
          | UnknownTag String  -- ^ used for upwardscompat
          deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
 
+tagToString :: Tag -> String
+tagToString Recommended        = "recommended"
+tagToString Latest             = "latest"
+tagToString Prerelease         = "prerelease"
+tagToString (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
+tagToString (UnknownTag t    ) = t
+tagToString Old                = ""
+
+instance Pretty Tag where
+  pPrint Recommended        = text "recommended"
+  pPrint Latest             = text "latest"
+  pPrint Prerelease         = text "prerelease"
+  pPrint (Base       pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
+  pPrint (UnknownTag t    ) = text t
+  pPrint Old                = mempty
 
 data Architecture = A_64
                   | A_32
@@ -117,15 +138,18 @@ data Architecture = A_64
                   | A_ARM64
   deriving (Eq, GHC.Generic, Ord, Show)
 
-prettyArch :: Architecture -> String
+archToString :: Architecture -> String
-prettyArch A_64 = "x86_64"
+archToString A_64 = "x86_64"
-prettyArch A_32 = "i386"
+archToString A_32 = "i386"
-prettyArch A_PowerPC = "powerpc"
+archToString A_PowerPC = "powerpc"
-prettyArch A_PowerPC64 = "powerpc64"
+archToString A_PowerPC64 = "powerpc64"
-prettyArch A_Sparc = "sparc"
+archToString A_Sparc = "sparc"
-prettyArch A_Sparc64 = "sparc64"
+archToString A_Sparc64 = "sparc64"
-prettyArch A_ARM = "arm"
+archToString A_ARM = "arm"
-prettyArch A_ARM64 = "aarch64"
+archToString A_ARM64 = "aarch64"
+
+instance Pretty Architecture where
+  pPrint = text . archToString
 
 data Platform = Linux LinuxDistro
               -- ^ must exit
@@ -134,10 +158,13 @@ data Platform = Linux LinuxDistro
               | FreeBSD
   deriving (Eq, GHC.Generic, Ord, Show)
 
-prettyPlatfrom :: Platform -> String
+platformToString :: Platform -> String
-prettyPlatfrom (Linux distro) = "linux-" ++ prettyDistro distro
+platformToString (Linux distro) = "linux-" ++ distroToString distro
-prettyPlatfrom Darwin = "darwin"
+platformToString Darwin = "darwin"
-prettyPlatfrom FreeBSD = "freebsd"
+platformToString FreeBSD = "freebsd"
+
+instance Pretty Platform where
+  pPrint = text . platformToString
 
 data LinuxDistro = Debian
                  | Ubuntu
@@ -155,18 +182,21 @@ data LinuxDistro = Debian
                  -- ^ must exit
   deriving (Eq, GHC.Generic, Ord, Show)
 
-prettyDistro :: LinuxDistro -> String
+distroToString :: LinuxDistro -> String
-prettyDistro Debian = "debian"
+distroToString Debian = "debian"
-prettyDistro Ubuntu = "ubuntu"
+distroToString Ubuntu = "ubuntu"
-prettyDistro Mint= "mint"
+distroToString Mint= "mint"
-prettyDistro Fedora = "fedora"
+distroToString Fedora = "fedora"
-prettyDistro CentOS = "centos"
+distroToString CentOS = "centos"
-prettyDistro RedHat = "redhat"
+distroToString RedHat = "redhat"
-prettyDistro Alpine = "alpine"
+distroToString Alpine = "alpine"
-prettyDistro AmazonLinux = "amazon"
+distroToString AmazonLinux = "amazon"
-prettyDistro Gentoo = "gentoo"
+distroToString Gentoo = "gentoo"
-prettyDistro Exherbo = "exherbo"
+distroToString Exherbo = "exherbo"
-prettyDistro UnknownLinux = "unknown"
+distroToString UnknownLinux = "unknown"
+
+instance Pretty LinuxDistro where
+  pPrint = text . distroToString
 
 
 -- | An encapsulation of a download. This can be used
@@ -191,6 +221,10 @@ data TarDir = RealDir (Path Rel)
             | RegexDir String     -- ^ will be compiled to regex, the first match will "win"
             deriving (Eq, Ord, GHC.Generic, Show)
 
+instance Pretty TarDir where
+  pPrint (RealDir path) = text [i|#{E.decodeUtf8With E.lenientDecode . toFilePath $ path}|]
+  pPrint (RegexDir regex) = text regex
+
 
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
@@ -310,12 +344,15 @@ data PlatformResult = PlatformResult
   }
   deriving (Eq, Show)
 
-prettyPlatform :: PlatformResult -> String
+platResToString :: PlatformResult -> String
-prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
+platResToString PlatformResult { _platform = plat, _distroVersion = Just v' }
   = show plat <> ", " <> T.unpack (prettyV v')
-prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
+platResToString PlatformResult { _platform = plat, _distroVersion = Nothing }
   = show plat
 
+instance Pretty PlatformResult where
+  pPrint = text . platResToString
+
 data PlatformRequest = PlatformRequest
   { _rArch     :: Architecture
   , _rPlatform :: Platform
@@ -323,14 +360,17 @@ data PlatformRequest = PlatformRequest
   }
   deriving (Eq, Show)
 
-prettyPfReq :: PlatformRequest -> String
+pfReqToString :: PlatformRequest -> String
-prettyPfReq (PlatformRequest arch plat ver) =
+pfReqToString (PlatformRequest arch plat ver) =
-  prettyArch arch ++ "-" ++ prettyPlatfrom plat ++ pver
+  archToString arch ++ "-" ++ platformToString plat ++ pver
  where
   pver = case ver of
            Just v' -> "-" ++ (T.unpack $ prettyV v')
            Nothing -> ""
 
+instance Pretty PlatformRequest where
+  pPrint = text . pfReqToString
+
 -- | A GHC identified by the target platform triple
 -- and the version.
 data GHCTargetVersion = GHCTargetVersion
@@ -343,11 +383,13 @@ data GHCTargetVersion = GHCTargetVersion
 mkTVer :: Version -> GHCTargetVersion
 mkTVer = GHCTargetVersion Nothing
 
+tVerToText :: GHCTargetVersion -> Text
+tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
+tVerToText (GHCTargetVersion Nothing  v') = prettyVer v'
 
 -- | Assembles a path of the form: <target-triple>-<version>
-prettyTVer :: GHCTargetVersion -> Text
+instance Pretty GHCTargetVersion where
-prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
+  pPrint = text . T.unpack . tVerToText
-prettyTVer (GHCTargetVersion Nothing  v') = prettyVer v'
 
 
 -- | A comparator and a version.
@@ -365,3 +407,9 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
                   | OrRange (NonEmpty VersionCmp) VersionRange
   deriving (Eq, GHC.Generic, Ord, Show)
 
+
+instance Pretty Versioning where
+  pPrint = text . T.unpack . prettyV
+
+instance Pretty Version where
+  pPrint = text . T.unpack . prettyVer

lib/GHCup/Utils.hs

@@ -650,7 +650,7 @@ ghcToolFiles ver = do
 
   -- fail if ghc is not installed
   whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
-        (throwE (NotInstalled GHC (prettyTVer ver)))
+        (throwE (NotInstalled GHC ver))
 
   files    <- liftIO $ getDirsFiles' bindir
   -- figure out the <ver> suffix, because this might not be `Version` for
@@ -808,3 +808,12 @@ getVersionInfo v' tool dls =
     % _head
     )
     dls
+
+
+-- Gathering monoidal values
+traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
+traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
+
+-- | Gathering monoidal values
+forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
+forFold = \t -> \f -> traverseFold f t

lib/GHCup/Utils/Dirs.hs

@@ -185,9 +185,9 @@ getDirs = do
 ghcupConfigFile :: (MonadIO m)
                 => Excepts '[JSONError] m UserSettings
 ghcupConfigFile = do
-  confDir <- liftIO $ ghcupConfigDir
+  confDir <- liftIO ghcupConfigDir
   let file = confDir </> [rel|config.yaml|]
-  bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ fmap Just $ readFile file 
+  bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> readFile file
   case bs of
       Nothing -> pure defaultUserSettings
       Just bs' -> lE' JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict $ bs'
@@ -214,7 +214,7 @@ ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
             -> m (Path Abs)
 ghcupGHCDir ver = do
   ghcbasedir    <- ghcupGHCBaseDir
-  verdir        <- parseRel $ E.encodeUtf8 (prettyTVer ver)
+  verdir        <- parseRel $ E.encodeUtf8 (tVerToText ver)
   pure (ghcbasedir </> verdir)
 
 

lib/GHCup/Utils/File.hs

@@ -43,7 +43,7 @@ import           GHC.IO.Exception
 import           HPath
 import           HPath.IO                hiding ( hideError )
 import           Optics                  hiding ((<|), (|>))
-import           System.Console.Pretty
+import           System.Console.Pretty   hiding ( Pretty )
 import           System.Console.Regions
 import           System.IO.Error
 import           System.Posix.Directory.ByteString
@@ -55,6 +55,7 @@ import "unix"    System.Posix.IO.ByteString
                                          hiding ( openFd )
 import           System.Posix.Process           ( ProcessStatus(..) )
 import           System.Posix.Types
+import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 
 
@@ -79,6 +80,15 @@ data ProcessError = NonZeroExit Int ByteString [ByteString]
                   | NoSuchPid ByteString [ByteString]
                   deriving Show
 
+instance Pretty ProcessError where
+  pPrint (NonZeroExit e exe args) =
+    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} failed with exit code #{e}.|]
+  pPrint (PTerminated exe args) =
+    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} terminated.|]
+  pPrint (PStopped exe args) =
+    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} stopped.|]
+  pPrint (NoSuchPid exe args) =
+    text [i|Could not find PID for process running "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args}.|]
 
 data CapturedProcess = CapturedProcess
   { _exitCode :: ExitCode

lib/GHCup/Version.hs

@@ -12,13 +12,15 @@ Portability : POSIX
 -}
 module GHCup.Version where
 
-import           GHCup.Utils.Version.QQ
 import           GHCup.Types
+import           Paths_ghcup (version)
 
-import           Data.Versions
+import           Data.Version (Version(versionBranch))
+import           Data.Versions hiding (version)
 import           URI.ByteString
 import           URI.ByteString.QQ
 
+import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
 
 -- | This reflects the API version of the YAML.
@@ -27,7 +29,7 @@ ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.4.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP
-ghcUpVer = [pver|0.1.12|]
+ghcUpVer = PVP . NE.fromList . fmap fromIntegral $ versionBranch version
 
 -- | ghcup version as numeric string.
 numericVer :: String

www/ghcup.js

@@ -149,7 +149,17 @@ function fill_in_bug_report_values() {
 }
 
 function copyToClipboard() {
-  const text = document.getElementsByClassName("ghcup-command").item(0).innerText;
+  const text = document.getElementById("ghcup-command-normal").innerText;
+  const el = document.createElement('textarea');
+  el.value = text;
+  document.body.appendChild(el);
+  el.select();
+  document.execCommand('copy');
+  document.body.removeChild(el);
+}
+
+function copyToClipboardSilicon() {
+  const text = document.getElementById("ghcup-command-silicon").innerText;
   const el = document.createElement('textarea');
   el.value = text;
   document.body.appendChild(el);

www/index.html

@@ -33,9 +33,9 @@
       <div id="platform-instructions-mac" class="instructions" style="display: none;">
         <p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		<p>On Intel:</p>
-		<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
+		<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-normal">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
         <p>On Apple Silicon:</p>
-		<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
+		<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-silicon">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
         <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
       </div>
 
@@ -108,7 +108,7 @@
           in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		  <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
           <p>For macOS on Apple Silicon, run this instead:</p>
-          <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
+          <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
           <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
         </div>
 
@@ -155,7 +155,7 @@
           in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		  <pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre>
           <p>For macOS on Apple Silicon, run this instead:</p>
-          <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
+          <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
           <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
         </div>