Add command line completions for installed and available versions.

When running `ghcup set ghc` and pressing tab, one should be able to
autocomplete the currently installed GHCs we have available.

Add an optparse applicative completer for install, rm, and set commands
which shows tags and versions. For installation, all are shown; while
for remove and set, only those installed are.

app/ghcup/Main.hs

@@ -192,10 +192,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 +363,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 +413,7 @@ installParser =
           "ghc"
           (   InstallGHC
           <$> (info
-                (installOpts <**> helper)
+                (installOpts (Just GHC) <**> helper)
                 (  progDesc "Install GHC"
                 <> footerDoc (Just $ text installGHCFooter)
                 )
@@ -423,7 +423,7 @@ installParser =
            "cabal"
            (   InstallCabal
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just Cabal) <**> helper)
                  (  progDesc "Install Cabal"
                  <> footerDoc (Just $ text installCabalFooter)
                  )
@@ -433,7 +433,7 @@ installParser =
            "hls"
            (   InstallHLS
            <$> (info
-                 (installOpts <**> helper)
+                 (installOpts (Just HLS) <**> helper)
                  (  progDesc "Install haskell-languge-server"
                  <> footerDoc (Just $ text installHLSFooter)
                  )
@@ -441,7 +441,7 @@ installParser =
            )
       )
     )
-    <|> (Right <$> installOpts)
+    <|> (Right <$> installOpts Nothing)
  where
   installHLSFooter :: String
   installHLSFooter = [s|Discussion:
@@ -472,8 +472,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 +495,9 @@ installOpts =
                     )
                   )
                 )
-            <*> (Just <$> toolVersionArgument)
+            <*> (Just <$> toolVersionArgument Nothing tool)
             )
-        <|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
+        <|> (pure (Nothing, Nothing))
         )
     <*> flag
           False
@@ -514,7 +514,7 @@ setParser =
           "ghc"
           (   SetGHC
           <$> (info
-                (setOpts <**> helper)
+                (setOpts (Just GHC) <**> helper)
                 (  progDesc "Set GHC version"
                 <> footerDoc (Just $ text setGHCFooter)
                 )
@@ -524,7 +524,7 @@ setParser =
            "cabal"
            (   SetCabal
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just Cabal) <**> helper)
                  (  progDesc "Set Cabal version"
                  <> footerDoc (Just $ text setCabalFooter)
                  )
@@ -534,7 +534,7 @@ setParser =
            "hls"
            (   SetHLS
            <$> (info
-                 (setOpts <**> helper)
+                 (setOpts (Just HLS) <**> helper)
                  (  progDesc "Set haskell-language-server version"
                  <> footerDoc (Just $ text setHLSFooter)
                  )
@@ -542,7 +542,7 @@ setParser =
            )
       )
     )
-    <|> (Right <$> setOpts)
+    <|> (Right <$> setOpts Nothing)
  where
   setGHCFooter :: String
   setGHCFooter = [s|Discussion:
@@ -559,8 +559,8 @@ setParser =
     Sets the the current haskell-language-server version.|]
 
 
-setOpts :: Parser SetOptions
+setOpts :: Maybe Tool -> Parser SetOptions
-setOpts = SetOptions <$> optional toolVersionArgument
+setOpts tool = SetOptions <$> optional (toolVersionArgument (Just ListInstalled) tool)
 
 listOpts :: Parser ListOptions
 listOpts =
@@ -592,7 +592,7 @@ 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
@@ -609,12 +609,12 @@ rmParser =
            )
       )
     )
-    <|> (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 +636,7 @@ changelogP =
             )
           )
         )
-    <*> optional toolVersionArgument
+    <*> optional (toolVersionArgument Nothing Nothing)
 
 compileP :: Parser CompileCommand
 compileP = subparser
@@ -765,13 +765,63 @@ toolVersionParser = verP' <|> toolP
           )
 
 -- | same as toolVersionParser, except as an argument.
-toolVersionArgument :: Parser ToolVersion
+toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionArgument =
+toolVersionArgument criterial tool =
-  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
+  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criterial) tool)
 
 
-versionArgument :: Parser GHCTargetVersion
+versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
-versionArgument = argument (eitherReader tVersionEither) (metavar "VERSION")
+versionArgument criterial tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criterial) tool)
+
+
+tagCompleter :: Completer
+tagCompleter =
+  listCompleter [
+    "recommended", "latest"
+  ]
+
+
+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 $
+          getDownloadsF $
+            urlSource simpleSettings
+
+      forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do
+        installedVersions <-
+          runEnv $
+            listVersions dls (Just tool) criteria pfreq
+
+        return $
+          T.unpack . prettyVer . lVer <$> installedVersions
+
 
 versionParser :: Parser GHCTargetVersion
 versionParser = option

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 = flip traverseFold