From 3baf25425121e06ff8f3a738734a7f39a315f209 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Thu, 25 Feb 2021 16:13:00 +0100
Subject: [PATCH] Improve tag completer

---
 app/ghcup/Main.hs  | 38 +++++++++++++++++++++++++++++++-------
 lib/GHCup/Types.hs |  7 +++++++
 2 files changed, 38 insertions(+), 7 deletions(-)

diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 09a3cf1..50daa10 100644
--- a/app/ghcup/Main.hs
+++ b/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 )
 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
@@ -767,18 +768,41 @@ toolVersionParser = verP' <|> toolP
 -- | same as toolVersionParser, except as an argument.
 toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
 toolVersionArgument criteria tool =
-  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criteria) tool)
+  argument (eitherReader toolVersionEither)
+    (metavar "VERSION|TAG"
+    <> completer (tagCompleter (fromMaybe GHC tool))
+    <> foldMap (completer . versionCompleter criteria) tool)
 
 
 versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
 versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
 
 
-tagCompleter :: Completer
-tagCompleter =
-  listCompleter [
-    "recommended", "latest"
-  ]
+tagCompleter :: Tool -> Completer
+tagCompleter tool = 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 $ fmap prettyTag allTags
+    VLeft _ -> pure  ["recommended", "latest"]
 
 
 versionCompleter :: Maybe ListCriteria -> Tool -> Completer
diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs
index 9d0250d..f53833d 100644
--- a/lib/GHCup/Types.hs
+++ b/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