Add "ghcup set ghc next" tag wrt #114

Only lookup user configuration before doing a search; implement version completion for Cabal and HLS removal

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
@@ -70,6 +70,7 @@ 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
@@ -115,6 +116,11 @@ prettyToolVer :: ToolVersion -> String
 prettyToolVer (ToolVersion v') = T.unpack $ prettyTVer 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 +137,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 +204,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 +375,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 +425,7 @@ installParser =
           "ghc"
           (   InstallGHC
           <$> (info
-                (installOpts <**> helper)
+                (installOpts (Just GHC) <**> helper)
                 (  progDesc "Install GHC"
                 <> footerDoc (Just $ text installGHCFooter)
                 )
@@ -423,7 +435,7 @@ installParser =
            "cabal"
            (   InstallCabal
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just Cabal) <**> helper)
                  (  progDesc "Install Cabal"
                  <> footerDoc (Just $ text installCabalFooter)
                  )
@@ -433,7 +445,7 @@ installParser =
            "hls"
            (   InstallHLS
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just HLS) <**> helper)
                  (  progDesc "Install haskell-languge-server"
                  <> footerDoc (Just $ text installHLSFooter)
                  )
@@ -441,7 +453,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts)
+    <|> (Right <$> installOpts Nothing)
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -472,8 +484,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 =
+installOpts :: Maybe Tool -> Parser InstallOptions
+installOpts tool =
   (\p (u, v) b -> InstallOptions v p u b)
     <$> (optional
           (option
@@ -495,9 +507,9 @@ installOpts =
                     )
                   )
                 )
-            <*> (Just <$> toolVersionArgument)
+            <*> (Just <$> toolVersionArgument Nothing tool)
             )
-        <|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
+        <|> (pure (Nothing, Nothing))
         )
     <*> flag
           False
@@ -514,7 +526,7 @@ setParser =
           "ghc"
           (   SetGHC
           <$> (info
-                (setOpts <**> helper)
+                (setOpts (Just GHC) <**> helper)
                 (  progDesc "Set GHC version"
                 <> footerDoc (Just $ text setGHCFooter)
                 )
@@ -524,7 +536,7 @@ setParser =
            "cabal"
            (   SetCabal
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just Cabal) <**> helper)
                  (  progDesc "Set Cabal version"
                  <> footerDoc (Just $ text setCabalFooter)
                  )
@@ -534,7 +546,7 @@ setParser =
            "hls"
            (   SetHLS
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just HLS) <**> helper)
                  (  progDesc "Set haskell-language-server version"
                  <> footerDoc (Just $ text setHLSFooter)
                  )
@@ -542,7 +554,7 @@ setParser =
            )
       )
     )
-    <|> (Right <$> setOpts)
+    <|> (Right <$> setOpts Nothing)
  where
   setGHCFooter :: String
   setGHCFooter = [s|Discussion:
@@ -559,8 +571,10 @@ setParser =
     Sets the the current haskell-language-server version.|]
 
 
-setOpts :: Parser SetOptions
-setOpts = SetOptions <$> optional toolVersionArgument
+setOpts :: Maybe Tool -> Parser SetOptions
+setOpts tool = SetOptions <$>
+    (fromMaybe SetRecommended <$>
+      optional (setVersionArgument (Just ListInstalled) tool))
 
 listOpts :: Parser ListOptions
 listOpts =
@@ -592,29 +606,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 = RmOptions <$> versionArgument
+rmOpts :: Maybe Tool -> Parser RmOptions
+rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
 
 
 changelogP :: Parser ChangeLogOptions
@@ -636,7 +650,7 @@ changelogP =
             )
           )
         )
-    <*> optional toolVersionArgument
+    <*> optional (toolVersionArgument Nothing Nothing)
 
 compileP :: Parser CompileCommand
 compileP = subparser
@@ -765,13 +779,85 @@ toolVersionParser = verP' <|> toolP
           )
 
 -- | same as toolVersionParser, except as an argument.
-toolVersionArgument :: Parser ToolVersion
-toolVersionArgument =
-  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
+toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
+toolVersionArgument criteria tool =
+  argument (eitherReader toolVersionEither)
+    (metavar "VERSION|TAG"
+    <> completer (tagCompleter (fromMaybe GHC tool) [])
+    <> foldMap (completer . versionCompleter criteria) tool)
 
 
-versionArgument :: Parser GHCTargetVersion
-versionArgument = argument (eitherReader tVersionEither) (metavar "VERSION")
+setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
+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 prettyTag 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 +865,10 @@ versionParser = option
   (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
   )
 
-versionParser' :: Parser Version
-versionParser' = argument
-  (eitherReader (bimap show id . version . T.pack))
-  (metavar "VERSION")
+versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
+versionParser' criteria tool = argument
+  (eitherReader (first show . version . T.pack))
+  (metavar "VERSION"  <> foldMap (completer . versionCompleter criteria) tool)
 
 
 tagEither :: String -> Either String Tag
@@ -792,7 +878,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 +1131,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , DigestError
                       , DownloadFailed
                       , TarDirDoesNotExist
+                      , NextVerNotFound
+                      , NoToolVersionSet
                       ]
 
           let runInstTool = runInstTool' appstate
@@ -1058,6 +1146,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let
@@ -1068,6 +1158,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   @'[ NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let
@@ -1078,6 +1170,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   @'[ NotInstalled
                     , TagNotFound
                     , VerNotFound
+                    , NextVerNotFound
+                    , NoToolVersionSet
                     ]
 
           let runListGHC = runLogger . flip runReaderT appstate
@@ -1289,7 +1383,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           let setGHC' SetOptions{..} =
                 (runSetGHC $ do
-                    v <- liftE $ fst <$> fromVersion dls sToolVer GHC
+                    v <- liftE $ fst <$> fromVersion' dls sToolVer GHC
                     liftE $ setGHC v SetGHCOnly
                   )
                   >>= \case
@@ -1304,22 +1398,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
           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}|])
                           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}|])
                           pure $ ExitFailure 14
@@ -1553,16 +1657,22 @@ Make sure to clean up #{tmpdir} afterwards.|])
             ef@(ExitFailure _) -> exitWith ef
   pure ()
 
-
-fromVersion :: Monad m
+fromVersion :: (MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)
             => GHCupDownloads
             -> Maybe ToolVersion
             -> Tool
-            -> Excepts '[TagNotFound, VerNotFound] m (GHCTargetVersion, VersionInfo)
-fromVersion av Nothing tool =
+            -> Excepts '[TagNotFound, VerNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, VersionInfo)
+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 +1681,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
 
 

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

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
@@ -336,11 +336,13 @@ library
     GHCup.Utils.Version.QQ
     GHCup.Version
 
+  other-modules:
+    Paths_ghcup
+
   default-extensions:
     Strict
     StrictData
 
-  -- other-modules:
   -- other-extensions:
   hs-source-dirs:  lib
 

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)
-          => 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
 
   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))
-        currentTime <- liftIO $ getPOSIXTime
+            <$> liftIO (PF.getFileStatus (toFilePath json_file))
+        currentTime <- liftIO getPOSIXTime
 
         -- access time won't work on most linuxes, but we can try regardless
         if (currentTime - accessTime) > 300

lib/GHCup/Errors.hs

@@ -71,6 +71,11 @@ data TagNotFound = TagNotFound Tag Tool
 data VerNotFound = VerNotFound Version Tool
   deriving Show
 
+-- | Unable to find the next version of a tool (the one after the currently
+-- set one).
+data NextVerNotFound = NextVerNotFound Tool
+  deriving Show
+
 -- | The tool (such as GHC) is already installed with that version.
 data AlreadyInstalled = AlreadyInstalled Tool Version
   deriving Show
@@ -122,6 +127,9 @@ data NoToolRequirements = NoToolRequirements
 
 data InvalidBuildConfig = InvalidBuildConfig Text
   deriving Show
+ 
+data NoToolVersionSet = NoToolVersionSet Tool
+  deriving Show
 
 
     -------------------------

lib/GHCup/Types.hs

@@ -106,6 +106,13 @@ data Tag = Latest
          | UnknownTag String  -- ^ used for upwardscompat
          deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
 
+prettyTag :: Tag -> String
+prettyTag Recommended        = "recommended"
+prettyTag Latest             = "latest"
+prettyTag Prerelease         = "prerelease"
+prettyTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
+prettyTag (UnknownTag t    ) = t
+prettyTag Old                = ""
 
 data Architecture = A_64
                   | A_32

lib/GHCup/Utils.hs

@@ -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'

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>