Support aliases in 'config add-release-channel' and '--url-source'

Add the URIs of known release channels in code, and allow choosing them
via aliases.

lib-opt/GHCup/OptParse.hs

@@ -53,7 +53,7 @@ import           GHCup.OptParse.ToolRequirements
 import           GHCup.OptParse.Nuke
 
 import           GHCup.Types
-import           GHCup.Utils.Parsers (gpgParser, downloaderParser, keepOnParser, platformParser, parseUrlSource)
+import           GHCup.Utils.Parsers (gpgParser, downloaderParser, keepOnParser, platformParser, parseUrlSourceWithChannelAlias)
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -140,10 +140,10 @@ opts =
       )
     <*> optional
           (option
-            (eitherReader parseUrlSource)
+            (eitherReader parseUrlSourceWithChannelAlias)
             (  short 's'
             <> long "url-source"
-            <> metavar "URL_SOURCE"
+            <> metavar "<URL_SOURCE|main|cross|prereleases|vanilla>"
             <> help "Alternative ghcup download info"
             <> internal
             <> completer urlSourceCompleter

lib-opt/GHCup/OptParse/Common.hs

@@ -148,7 +148,7 @@ urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
 
 urlSourceCompleter' :: [String] -> String -> IO [String]
 urlSourceCompleter' add str' = do
-  let static = ["GHCupURL", "StackSetupURL"]
+  let static = ["GHCupURL", "StackSetupURL", "main", "cross", "prereleases", "vanilla"]
   file <- fileUri' add str'
   pure $ static ++ file
 

lib-opt/GHCup/OptParse/Config.hs

@@ -14,7 +14,7 @@ module GHCup.OptParse.Config where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils
-import           GHCup.Utils.Parsers (parseNewUrlSource)
+import           GHCup.Utils.Parsers (parseNewUrlSourceWithChannelAlias)
 import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
@@ -75,8 +75,9 @@ configP = subparser
   showP = info (pure ShowConfig) (progDesc "Show current config (default)")
   setP  = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
   argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
-  addP  = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter))
-    (progDesc "Add a release channel, e.g. from a URI")
+  addP  = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing")
+                <*> argument (eitherReader parseNewUrlSourceWithChannelAlias) (metavar "<URL_SOURCE|main|cross|prereleases|vanilla>" <> completer urlSourceCompleter))
+    (progDesc "Add a release channel, e.g. from a URI or using alias")
 
 
 
@@ -96,8 +97,10 @@ configFooter = [s|Examples:
   ghcup config init
 
   # set <key> <value> configuration pair
-  ghcup config set <key> <value>|]
+  ghcup config set <key> <value>
 
+  # add a release channel
+  ghcup config add-release-channel prereleases|]
 
 configSetFooter :: String
 configSetFooter = [s|Examples:

lib/GHCup/Types.hs

@@ -394,6 +394,13 @@ data NewURLSource = NewGHCupURL
 
 instance NFData NewURLSource
 
+-- | Alias for ease of URLSource selection
+data ChannelAlias = MainChannel
+                  | CrossChannel
+                  | PrereleasesChannel
+                  | VanillaChannel
+                  deriving (Eq, GHC.Generic, Show)
+
 fromURLSource :: URLSource -> [NewURLSource]
 fromURLSource GHCupURL              = [NewGHCupURL]
 fromURLSource StackSetupURL         = [NewStackSetupURL]

lib/GHCup/Utils/Parsers.hs

@@ -393,6 +393,24 @@ parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
 parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
             <|> (fmap NewURI . first show . parseURI .UTF8.fromString $ s')
 
+parseChannelAlias :: String -> Either String ChannelAlias
+parseChannelAlias "main" = pure MainChannel
+parseChannelAlias "cross" = pure CrossChannel
+parseChannelAlias "prereleases" = pure PrereleasesChannel
+parseChannelAlias "vanilla" = pure VanillaChannel
+parseChannelAlias _ = Left "Please enter a valid channel alias <main|cross|prereleases|vanilla>"
+
+parseUrlSourceWithChannelAlias :: String -> Either String URLSource
+parseUrlSourceWithChannelAlias s' = (fmap toURLSource . parseChannelAlias $ s')
+  <|> parseUrlSource s'
+  where toURLSource MainChannel = GHCupURL
+        toURLSource alias = (OwnSource . (:[]) . Right) (channelURL alias)
+
+parseNewUrlSourceWithChannelAlias :: String -> Either String NewURLSource
+parseNewUrlSourceWithChannelAlias s' = (fmap toNewURLSource . parseChannelAlias $ s')
+  <|> parseNewUrlSource s'
+  where toNewURLSource MainChannel = NewGHCupURL
+        toNewURLSource alias = NewURI (channelURL alias)
 
 #if MIN_VERSION_transformers(0,6,0)
 instance Alternative (Either [a]) where

lib/GHCup/Version.hs

@@ -86,3 +86,10 @@ versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
 
 pvpFromList :: [Int] -> V.PVP
 pvpFromList = V.PVP . NE.fromList . fmap fromIntegral
+
+channelURL :: ChannelAlias -> URI
+channelURL = \case
+  MainChannel -> ghcupURL
+  CrossChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml|]
+  PrereleasesChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml|]
+  VanillaChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-vanilla-0.0.8.yaml|]

test/optparse-test/ConfigTest.hs

@@ -32,6 +32,18 @@ checkList =
   , ("config add-release-channel StackSetupURL"
     , AddReleaseChannel False NewStackSetupURL
     )
+  , ("config add-release-channel main"
+    , AddReleaseChannel False NewGHCupURL
+    )
+  , ("config add-release-channel cross"
+    , AddReleaseChannel False (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml|])
+    )
+  , ("config add-release-channel prereleases"
+    , AddReleaseChannel False (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml|])
+    )
+  , ("config add-release-channel vanilla"
+    , AddReleaseChannel False (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-vanilla-0.0.8.yaml|])
+    )
   , ("config set cache true", SetConfig "cache" (Just "true"))
   ]