Overhaul metadata merging and add 'ghcup config add-release-channel URI'

app/ghcup/GHCup/OptParse.hs

@@ -98,7 +98,7 @@ data Command
 #ifndef DISABLE_UPGRADE
   | Upgrade UpgradeOpts Bool
 #endif
-  | ToolRequirements ToolReqOpts
+  | ToolRequirements
   | ChangeLog ChangeLogOptions
   | Nuke
 #if defined(BRICK)
@@ -113,8 +113,8 @@ data Command
 opts :: Parser Options
 opts =
   Options
-    <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
+    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
-    <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
+    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
     <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
     <*> optional
           (option
@@ -127,7 +127,7 @@ opts =
             <> completer fileUri
             )
           )
-    <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
+    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
     <*> optional (option
           (eitherReader keepOnParser)
           (  long "keep"
@@ -153,7 +153,7 @@ opts =
 #endif
           <> hidden
           ))
-    <*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.")
+    <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
     <*> optional (option
           (eitherReader gpgParser)
           (  long "gpg"
@@ -289,8 +289,8 @@ com =
               ((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
           <> command
                "tool-requirements"
-               (   ToolRequirements
+               (   (\_ -> ToolRequirements)
-               <$> info (toolReqP <**> helper)
+               <$> info helper
                         (progDesc "Show the requirements for ghc/cabal")
                )
           <> command

app/ghcup/GHCup/OptParse/Common.hs

@@ -138,7 +138,7 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 -- the help is shown only for --no-recursive.
 invertableSwitch
     :: String              -- ^ long option
-    -> Maybe Char          -- ^ short option for the non-default option
+    -> Char                -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier
     -> Parser (Maybe Bool)
@@ -149,14 +149,14 @@ invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shorto
 -- | Allows providing option modifiers for both --foo and --no-foo.
 invertableSwitch'
     :: String              -- ^ long option (eg "foo")
-    -> Maybe Char          -- ^ short option for the non-default option
+    -> Char                -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier for --foo
     -> Mod FlagFields Bool -- ^ option modifier for --no-foo
     -> Parser (Maybe Bool)
 invertableSwitch' longopt shortopt defv enmod dismod = optional
-    ( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt)
+    ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
-    <|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty)
+    <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
     )
   where
     nolongopt = "no-" ++ longopt

app/ghcup/GHCup/OptParse/Compile.hs

@@ -234,7 +234,12 @@ ghcCompileOpts =
             )
           )
     <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
-    <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
+    <*> flag
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
     <*> optional
           (option
             (eitherReader
@@ -295,7 +300,12 @@ hlsCompileOpts =
               <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
-    <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
+    <*> flag
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
     <*> optional
           (option
             (eitherReader

app/ghcup/GHCup/OptParse/Config.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
 
 module GHCup.OptParse.Config where
 
@@ -17,6 +18,7 @@ import           GHCup.Utils
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.Logger
 import           GHCup.Utils.String.QQ
+import           GHCup.OptParse.Common
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -27,10 +29,11 @@ import           Control.Monad.Trans.Resource
 import           Data.Functor
 import           Data.Maybe
 import           Haskus.Utils.Variant.Excepts
-import           Options.Applicative     hiding ( style )
+import           Options.Applicative     hiding ( style, ParseError )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
+import           URI.ByteString          hiding ( uriParser )
 
 import qualified Data.Text                     as T
 import qualified Data.ByteString.UTF8          as UTF8
@@ -49,6 +52,7 @@ data ConfigCommand
   = ShowConfig
   | SetConfig String (Maybe String)
   | InitConfig
+  | AddReleaseChannel URI
 
 
 
@@ -62,6 +66,7 @@ configP = subparser
       (  command "init" initP
       <> command "set"  setP -- [set] KEY VALUE at help lhs
       <> command "show" showP
+      <> command "add-release-channel" addP
       )
     <|> argsP -- add show for a single option
     <|> pure ShowConfig
@@ -70,6 +75,8 @@ 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 <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
+    (progDesc "Add a release channel from a URI")
 
 
 
@@ -114,23 +121,18 @@ formatConfig :: UserSettings -> String
 formatConfig = UTF8.toString . Y.encode
 
 
-updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
+updateSettings :: UserSettings -> Settings -> Settings
-updateSettings config' settings = do
+updateSettings UserSettings{..} Settings{..} =
-  settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
+   let cache'      = fromMaybe cache uCache
-  pure $ mergeConf settings' settings
+       metaCache'  = fromMaybe metaCache uMetaCache
-  where
+       noVerify'   = fromMaybe noVerify uNoVerify
-   mergeConf :: UserSettings -> Settings -> Settings
+       keepDirs'   = fromMaybe keepDirs uKeepDirs
-   mergeConf UserSettings{..} Settings{..} =
+       downloader' = fromMaybe downloader uDownloader
-     let cache'      = fromMaybe cache uCache
+       verbose'    = fromMaybe verbose uVerbose
-         metaCache'  = fromMaybe metaCache uMetaCache
+       urlSource'  = fromMaybe urlSource uUrlSource
-         noVerify'   = fromMaybe noVerify uNoVerify
+       noNetwork'  = fromMaybe noNetwork uNoNetwork
-         keepDirs'   = fromMaybe keepDirs uKeepDirs
+       gpgSetting' = fromMaybe gpgSetting uGPGSetting
-         downloader' = fromMaybe downloader uDownloader
+   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
-         verbose'    = fromMaybe verbose uVerbose
-         urlSource'  = fromMaybe urlSource uUrlSource
-         noNetwork'  = fromMaybe noNetwork uNoNetwork
-         gpgSetting' = fromMaybe gpgSetting uGPGSetting
-     in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
 
 
 
@@ -140,7 +142,7 @@ updateSettings config' settings = do
 
 
 
-config :: ( Monad m
+config :: forall m. ( Monad m
           , MonadMask m
           , MonadUnliftIO m
           , MonadFail m
@@ -161,27 +163,42 @@ config configCommand settings keybindings runLogger = case configCommand of
     liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
     pure ExitSuccess
 
-  (SetConfig k (Just v)) ->
+  (SetConfig k mv) -> do
-    case v of
+    r <- runE @'[JSONError, ParseError] $ do
-      "" -> do
+      case mv of
-        runLogger $ logError "Empty values are not allowed"
+        Just "" ->
-        pure $ ExitFailure 55
+          throwE $ ParseError "Empty values are not allowed"
-      _  -> doConfig (k <> ": " <> v <> "\n")
+        Nothing -> do
+          usersettings <- decodeSettings k
+          lift $ doConfig usersettings
+          pure ()
+        Just v -> do
+          usersettings <- decodeSettings (k <> ": " <> v <> "\n")
+          lift $ doConfig usersettings
+          pure ()
+    case r of
+      VRight _ -> pure ExitSuccess
+      VLeft (V (JSONDecodeError e)) -> do
+        runLogger $ logError $ "Error decoding config: " <> T.pack e
+        pure $ ExitFailure 65
+      VLeft _ -> pure $ ExitFailure 65
 
-  (SetConfig json Nothing) -> doConfig json
+  AddReleaseChannel uri -> do
+    case urlSource settings of
+      AddSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      _ -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
+        pure ExitSuccess
 
  where
-  doConfig val = do
+  doConfig :: MonadIO m => UserSettings -> m ()
-    r <- runE @'[JSONError] $ do
+  doConfig usersettings = do
-      settings' <- updateSettings (UTF8.fromString val) settings
+    let settings' = updateSettings usersettings settings
-      path <- liftIO getConfigFilePath
+    path <- liftIO getConfigFilePath
-      liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
+    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
-      lift $ runLogger $ logDebug $ T.pack $ show settings'
+    runLogger $ logDebug $ T.pack $ show settings'
-      pure ()
+    pure ()
 
-    case r of
+  decodeSettings = lE' (JSONDecodeError . displayException) . Y.decodeEither' . UTF8.fromString
-        VRight _ -> pure ExitSuccess
-        VLeft (V (JSONDecodeError e)) -> do
-          runLogger $ logError $ "Error decoding config: " <> T.pack e
-          pure $ ExitFailure 65
-        VLeft _ -> pure $ ExitFailure 65

app/ghcup/GHCup/OptParse/Install.hs

@@ -197,8 +197,12 @@ installOpts tool =
             )
         <|> pure (Nothing, Nothing)
         )
-    <*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault
+    <*> flag
-      (help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install"))
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
     <*> optional
           (option
            (eitherReader isolateParser)
@@ -211,11 +215,6 @@ installOpts tool =
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install")
- where
-  setDefault = case tool of
-    Nothing  -> False
-    Just GHC -> False
-    Just _   -> True
           
 
 
@@ -398,7 +397,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                      isolateDir
                      forceInstall
                    )
-                   $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
+                   $ when instSet $ void $ setGHC v SetGHCOnly Nothing
          pure vi
        Just uri -> do
          runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
@@ -409,7 +408,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                        isolateDir
                        forceInstall
                      )
-                     $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
+                     $ when instSet $ void $ setGHC v SetGHCOnly Nothing
            pure vi
       )
         >>= \case
@@ -469,7 +468,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                     v
                                     isolateDir
                                     forceInstall
-                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
+                                  ) $ when instSet $ void $ setCabal v
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -479,7 +478,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                       v
                                       isolateDir
                                       forceInstall
-                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
+                                    ) $ when instSet $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -520,7 +519,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                     v
                                     isolateDir
                                     forceInstall
-                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
+                                  ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -531,7 +530,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                       v
                                       isolateDir
                                       forceInstall
-                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
+                                    ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -580,7 +579,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                      v
                                      isolateDir
                                      forceInstall
-                                   ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
+                                   ) $ when instSet $ void $ setStack v
           pure vi
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -590,7 +589,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                        v
                                        isolateDir
                                        forceInstall
-                                     ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
+                                     ) $ when instSet $ void $ setStack v
             pure vi
       )
       >>= \case

app/ghcup/GHCup/OptParse/List.hs

@@ -143,7 +143,7 @@ printListResult no_color raw lr = do
             )
         $ lr
   let cols =
-        foldr (\xs ys -> zipWith (:) xs ys) (cycle [[]]) rows
+        foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows
       lengths = fmap (maximum . fmap strWidth) cols
       padded  = fmap (\xs -> zipWith padTo xs lengths) rows
 

app/ghcup/GHCup/OptParse/Run.hs

@@ -35,6 +35,7 @@ import           Prelude                 hiding ( appendFile )
 import           System.Directory
 import           System.FilePath
 import           System.Environment
+import           System.IO.Temp
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
@@ -216,20 +217,16 @@ run :: forall m.
    -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
-run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
+run RunOptions{..} runAppState leanAppstate runLogger = do
-   toolchain <- Excepts resolveToolchain
    tmp <- case runBinDir of
-     Just bindir -> do
+     Just bdir -> do
-       liftIO $ createDirRecursive' bindir
+       liftIO $ createDirRecursive' bdir
-       liftIO $ canonicalizePath bindir
+       liftIO $ canonicalizePath bdir
-     Nothing -> do
+     Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
-       d <- liftIO $ predictableTmpDir toolchain
+   r <- do
-       liftIO $ createDirRecursive' d
+     addToolsToDir tmp
-       liftIO $ canonicalizePath d
+   case r of
-   Excepts $ installToolChain toolchain tmp
+     VRight _ -> do
-   pure tmp
-   ) >>= \case
-     VRight tmp -> do
        case runCOMMAND of
          [] -> do
            liftIO $ putStr tmp
@@ -256,78 +253,70 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
    isToolTag _           = False
 
    -- TODO: doesn't work for cross
-   resolveToolchain
+   addToolsToDir tmp
      | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-         ghcVer <- forM runGHCVer $ \ver -> do
+         forM_ runGHCVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) GHC
-           pure v
+           installTool GHC v
-         cabalVer <- forM runCabalVer $ \ver -> do
+           setTool GHC v tmp
+         forM_ runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           pure v
+           installTool Cabal v
-         hlsVer <- forM runHLSVer $ \ver -> do
+           setTool Cabal v tmp
+         forM_ runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           pure v
+           installTool HLS v
-         stackVer <- forM runStackVer $ \ver -> do
+           setTool HLS v tmp
+         forM_ runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           pure v
+           installTool Stack v
-         pure Toolchain{..}
+           setTool Stack v tmp
      | otherwise = runLeanRUN leanAppstate $ do
-         ghcVer <- case runGHCVer of
+         case runGHCVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool GHC v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         cabalVer <- case runCabalVer of
+         case runCabalVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool Cabal v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         hlsVer <- case runHLSVer of
+         case runHLSVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool HLS v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         stackVer <- case runStackVer of
+         case runStackVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool Stack v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         pure Toolchain{..}
 
-   installToolChain Toolchain{..} tmp
+   installTool tool v = do
-     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
+      isInstalled <- checkIfToolInstalled' tool v
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+      case tool of
-           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+        GHC -> do
-           case mt of
+          unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-             Just (GHC, v) -> do
+            (_tvVersion v)
-               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+            Nothing
-                 (_tvVersion v)
+            False
-                 Nothing
+        Cabal -> do
-                 False
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-               setTool GHC v tmp
+            (_tvVersion v)
-             Just (Cabal, v) -> do
+            Nothing
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+            False
-                 (_tvVersion v)
+        Stack -> do
-                 Nothing
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-                 False
+            (_tvVersion v)
-               setTool Cabal v tmp
+            Nothing
-             Just (Stack, v) -> do
+            False
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+        HLS -> do
-                 (_tvVersion v)
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-                 Nothing
+            (_tvVersion v)
-                 False
+            Nothing
-               setTool Stack v tmp
+            False
-             Just (HLS, v) -> do
+        GHCup -> pure ()
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-                 (_tvVersion v)
-                 Nothing
-                 False
-               setTool HLS v tmp
-             _ -> pure ()
-     | otherwise = runLeanRUN leanAppstate $ do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
-           case mt of
-             Just (GHC, v)   -> setTool GHC v tmp
-             Just (Cabal, v) -> setTool Cabal v tmp
-             Just (Stack, v) -> setTool Stack v tmp
-             Just (HLS, v)   -> setTool HLS v tmp
-             _ -> pure ()
 
    setTool tool v tmp =
       case tool of
@@ -371,31 +360,3 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
         envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
     liftIO $ setEnv pathVar newPath
     return envWithNewPath
-
-   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
-     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
-   predictableTmpDir Toolchain{..} = do
-      tmp <- getTemporaryDirectory
-      pure $ tmp
-        </> ("ghcup-" <> intercalate "_"
-              (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
-              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
-              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
-              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
-              )
-            )
-
-
-
-    -------------------------
-    --[ Other local types ]--
-    -------------------------
-
-
-
-data Toolchain = Toolchain
-  { ghcVer     :: Maybe GHCTargetVersion
-  , cabalVer   :: Maybe GHCTargetVersion
-  , hlsVer     :: Maybe GHCTargetVersion
-  , stackVer   :: Maybe GHCTargetVersion
-  }

app/ghcup/GHCup/OptParse/ToolRequirements.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE QuasiQuotes #-}
 
 module GHCup.OptParse.ToolRequirements where
 
@@ -12,7 +11,6 @@ module GHCup.OptParse.ToolRequirements where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -36,41 +34,6 @@ import System.IO
 
 
 
-    ---------------
-    --[ Options ]--
-    ---------------
-
-
-data ToolReqOpts = ToolReqOpts
-  { tlrRaw :: Bool
-  }
-
-
-
-
-    ---------------
-    --[ Parsers ]--
-    ---------------
-
-          
-toolReqP :: Parser ToolReqOpts
-toolReqP =
-  ToolReqOpts
-    <$> switch (short 'r' <> long "raw-format" <> help "machine-parsable format")
-
-
-
-
-    --------------
-    --[ Footer ]--
-    --------------
-
-
-toolReqFooter :: String
-toolReqFooter = [s|Discussion:
-  Print tool requirements on the current platform.
-  If you want to pass this to your package manage, use '--raw-format'.|]
-
 
 
     ---------------------------
@@ -103,17 +66,14 @@ toolRequirements :: ( Monad m
                     , MonadFail m
                     , Alternative m
                     )
-                 => ToolReqOpts
+                 => (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
-                 -> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
                  -> (ReaderT LeanAppState m () -> m ())
                  -> m ExitCode
-toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements runAppState (do
+toolRequirements runAppState runLogger = runToolRequirements runAppState (do
     GHCupInfo { .. } <- lift getGHCupInfo
     platform' <- liftE getPlatform
-    req       <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
+    req      <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
-    if tlrRaw
+    liftIO $ T.hPutStr stdout (prettyRequirements req)
-    then liftIO $ T.hPutStr stdout (rawRequirements req)
-    else liftIO $ T.hPutStr stdout (prettyRequirements req)
   )
     >>= \case
           VRight _ -> pure ExitSuccess

app/ghcup/Main.hs

@@ -82,7 +82,7 @@ toSettings options = do
          keepDirs    = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
          downloader  = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
          keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
-         urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
+         urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
      in (Settings {..}, keyBindings)
@@ -228,7 +228,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   Nuke -> pure ()
                   Whereis _ _ -> pure ()
                   DInfo -> pure ()
-                  ToolRequirements _ -> pure ()
+                  ToolRequirements -> pure ()
                   ChangeLog _ -> pure ()
                   UnSet _ -> pure ()
 #if defined(BRICK)
@@ -308,7 +308,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 #ifndef DISABLE_UPGRADE
             Upgrade uOpts force'     -> upgrade uOpts force' dirs runAppState runLogger
 #endif
-            ToolRequirements topts   -> toolRequirements topts runAppState runLogger
+            ToolRequirements         -> toolRequirements runAppState runLogger
             ChangeLog changelogOpts  -> changelog changelogOpts runAppState runLogger
             Nuke                     -> nuke appState runLogger
             Prefetch pfCom           -> prefetch pfCom runAppState runLogger

cabal.ghc8107.project.freeze

@@ -10,8 +10,8 @@ constraints: any.Cabal ==3.6.2.0,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.3.0,
+             any.aeson ==2.0.2.0,
-             aeson -cffi +ordered-keymap,
+             aeson -bytestring-builder -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.14.4,
+             any.attoparsec ==0.13.2.5,
              attoparsec -developer,
              any.base ==4.14.3.0,
              any.base-compat ==0.12.1,
              any.base-compat-batteries ==0.12.1,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.2.1.0,
+             any.base64-bytestring ==1.1.0.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -69,7 +69,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.2,
+             any.data-clist ==0.1.2.3,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.4.0,
              any.directory ==1.3.6.0,
@@ -82,14 +82,10 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.2.0,
+             any.generic-arbitrary ==0.1.0,
-             any.ghc ==8.10.7,
-             any.ghc-boot ==8.10.7,
              any.ghc-boot-th ==8.10.7,
              any.ghc-byteorder ==4.11.0.0.10,
-             any.ghc-heap ==8.10.7,
              any.ghc-prim ==0.6.1,
-             any.ghci ==8.10.7,
              any.happy ==1.20.0,
              any.hashable ==1.4.0.2,
              hashable +containers +integer-gmp -random-initial-seed,
@@ -97,12 +93,11 @@ constraints: any.Cabal ==3.6.2.0,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
-             any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.9.4,
+             any.hspec ==2.7.10,
-             any.hspec-core ==2.9.4,
+             any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.9.4,
+             any.hspec-discover ==2.7.10,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -123,7 +118,7 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.2.0,
+             any.megaparsec ==9.0.1,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
@@ -139,7 +134,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.17.0.0,
+             any.optparse-applicative ==0.16.1.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -178,14 +173,13 @@ constraints: any.Cabal ==3.6.2.0,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
-             any.streamly ==0.8.2,
+             any.streamly ==0.8.1.1,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
-             any.tagsoup ==0.14.8,
              any.template-haskell ==2.16.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
@@ -217,7 +211,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.17.0,
+             any.unordered-containers ==0.2.16.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -225,15 +219,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.3,
+             any.versions ==5.0.2,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.1,
+             any.xor ==0.0.1.0,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-03-15T16:43:02Z
+index-state: hackage.haskell.org 2022-02-15T12:16:42Z

cabal.ghc902.project.freeze

@@ -10,8 +10,8 @@ constraints: any.Cabal ==3.6.2.0,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.0.3.0,
+             any.aeson ==2.0.2.0,
-             aeson -cffi +ordered-keymap,
+             aeson -bytestring-builder -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
@@ -25,14 +25,14 @@ constraints: any.Cabal ==3.6.2.0,
              async -bench,
              any.atomic-primops ==0.8.4,
              atomic-primops -debug,
-             any.attoparsec ==0.14.4,
+             any.attoparsec ==0.13.2.5,
              attoparsec -developer,
              any.base ==4.15.1.0,
              any.base-compat ==0.12.1,
              any.base-compat-batteries ==0.12.1,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.2.1.0,
+             any.base64-bytestring ==1.1.0.0,
              any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
@@ -69,7 +69,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.2,
+             any.data-clist ==0.1.2.3,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.5.0,
              any.directory ==1.3.6.2,
@@ -82,15 +82,11 @@ constraints: any.Cabal ==3.6.2.0,
              any.filepath ==1.4.2.1,
              any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.2.0,
+             any.generic-arbitrary ==0.1.0,
-             any.ghc ==9.0.2,
              any.ghc-bignum ==1.1,
-             any.ghc-boot ==9.0.2,
              any.ghc-boot-th ==9.0.2,
              any.ghc-byteorder ==4.11.0.0.10,
-             any.ghc-heap ==9.0.2,
              any.ghc-prim ==0.7.0,
-             any.ghci ==9.0.2,
              any.happy ==1.20.0,
              any.hashable ==1.4.0.2,
              hashable +containers +integer-gmp -random-initial-seed,
@@ -98,12 +94,11 @@ constraints: any.Cabal ==3.6.2.0,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
-             any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.9.4,
+             any.hspec ==2.7.10,
-             any.hspec-core ==2.9.4,
+             any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.9.4,
+             any.hspec-discover ==2.7.10,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -123,7 +118,7 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.2.0,
+             any.megaparsec ==9.0.1,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
@@ -139,7 +134,7 @@ constraints: any.Cabal ==3.6.2.0,
              optics-core -explicit-generic-labels,
              any.optics-extra ==0.4,
              any.optics-th ==0.4,
-             any.optparse-applicative ==0.17.0.0,
+             any.optparse-applicative ==0.16.1.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
              os-release -devel,
@@ -178,14 +173,13 @@ constraints: any.Cabal ==3.6.2.0,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.0,
-             any.streamly ==0.8.2,
+             any.streamly ==0.8.1.1,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
-             any.tagsoup ==0.14.8,
              any.template-haskell ==2.17.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
@@ -217,7 +211,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.17.0,
+             any.unordered-containers ==0.2.16.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -225,15 +219,15 @@ constraints: any.Cabal ==3.6.2.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.3,
+             any.versions ==5.0.2,
              any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
-             any.xor ==0.0.1.1,
+             any.xor ==0.0.1.0,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
              any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-03-15T16:43:02Z
+index-state: hackage.haskell.org 2022-02-15T12:16:42Z

data/config.yaml

@@ -48,12 +48,16 @@ url-source:
 
   ## Example 1: Read download info from this location instead
   ## Accepts file/http/https scheme
+  ## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
+  ## which case they are merged right-biased (overwriting duplicate versions).
   # OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
 
-  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
+  ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
+  ## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
   # AddSource:
     # Left:
-      # toolRequirements: {} # this is ignored
+      # globalTools: {}
+      # toolRequirements: {}
       # ghcupDownloads:
         # GHC:
           # 9.10.2:
@@ -66,6 +70,8 @@ url-source:
                     # dlSubdir: ghc-7.10.3
                     # dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
 
-  ## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
+  ## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
+  ## versions).
   # AddSource:
-    # Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
+    # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

lib/GHCup.hs

@@ -468,6 +468,10 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                 -- regular install
       liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
 
+      -- create symlink if this is the latest version for regular installs
+      cVers <- lift $ fmap rights getInstalledCabals
+      let lInstCabal = headMay . reverse . sort $ cVers
+      when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
       
 -- | Install an unpacked cabal distribution.Symbol
 installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
@@ -622,6 +626,7 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
         liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
         liftE $ setHLS ver SetHLS_XYZ Nothing
 
+  liftE $ installHLSPostInst isoFilepath ver
 
 isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
                    -> IO Bool
@@ -691,6 +696,19 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
   lift $ chmod_755 destWrapperPath
 
 
+installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
+                   => Maybe FilePath
+                   -> Version
+                   -> Excepts '[NotInstalled] m ()
+installHLSPostInst isoFilepath ver = 
+  case isoFilepath of
+    Just _ -> pure ()
+    Nothing -> do
+      -- create symlink if this is the latest version in a regular install
+      hlsVers <- lift $ fmap rights getInstalledHLSs
+      let lInstHLS = headMay . reverse . sort $ hlsVers
+      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing
+
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -898,6 +916,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
           liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
     )
 
+  liftE $ installHLSPostInst isolateDir installVer
+
   pure installVer
 
 
@@ -1014,6 +1034,11 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                     -- regular install
       liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
 
+      -- create symlink if this is the latest version and a regular install
+      sVers <- lift $ fmap rights getInstalledStacks
+      let lInstStack = headMay . reverse . sort $ sVers
+      when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
+
 
 -- | Install an unpacked stack distribution.
 installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)

lib/GHCup/Download.hs

@@ -121,28 +121,25 @@ getDownloadsF = do
   Settings { urlSource } <- lift getSettings
   case urlSource of
     GHCupURL -> liftE $ getBase ghcupURL
-    (OwnSource url) -> liftE $ getBase url
+    (OwnSource exts) -> do
+      ext  <- liftE $ mapM (either pure getBase) exts
+      mergeGhcupInfo ext
     (OwnSpec av) -> pure av
-    (AddSource (Left ext)) -> do
+    (AddSource exts) -> do
       base <- liftE $ getBase ghcupURL
-      pure (mergeGhcupInfo base ext)
+      ext  <- liftE $ mapM (either pure getBase) exts
-    (AddSource (Right uri)) -> do
+      mergeGhcupInfo (base:ext)
-      base <- liftE $ getBase ghcupURL
-      ext  <- liftE $ getBase uri
-      pure (mergeGhcupInfo base ext)
 
-    where
+ where
-
+  mergeGhcupInfo :: MonadFail m
-  mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
+                 => [GHCupInfo]
-                 -> GHCupInfo -- ^ extension overwriting the base
+                 -> m GHCupInfo
-                 -> GHCupInfo
+  mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
-  mergeGhcupInfo (GHCupInfo tr base base2) (GHCupInfo _ ext ext2) =
+  mergeGhcupInfo xs@(GHCupInfo{}: _) =
-    let newDownloads = M.mapWithKey (\k a -> case M.lookup k ext of
+    let newDownloads   = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads   <$> xs)
-                                        Just a' -> M.union a' a
+        newGlobalTools = M.unionsWith (\_ a2 -> a2              ) (_globalTools      <$> xs)
-                                        Nothing -> a
+        newToolReqs    = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
-                                    ) base
+    in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
-        newGlobalTools = M.union base2 ext2
-    in GHCupInfo tr newDownloads newGlobalTools
 
 
 yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath

lib/GHCup/Requirements.hs

@@ -67,9 +67,3 @@ prettyRequirements Requirements {..} =
         else ""
       n = if not . T.null $ _notes then "\n  Note: " <> _notes else ""
   in  "System requirements " <> d <> n
-
-rawRequirements :: Requirements -> T.Text
-rawRequirements Requirements {..} =
-  if not . null $ _distroPKGs
-  then T.intercalate " " _distroPKGs
-  else ""

lib/GHCup/Types.hs

@@ -286,9 +286,9 @@ instance Pretty TarDir where
 
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
-               | OwnSource URI
+               | OwnSource [Either GHCupInfo URI] -- ^ complete source list
                | OwnSpec GHCupInfo
-               | AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
+               | AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
                deriving (GHC.Generic, Show)
 
 instance NFData URLSource

lib/GHCup/Types/JSON.hs

@@ -79,6 +79,38 @@ instance FromJSON Tag where
 instance ToJSON URI where
   toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
 
+instance FromJSON URLSource where
+  parseJSON v =
+        parseGHCupURL v
+    <|> parseOwnSourceLegacy v
+    <|> parseOwnSourceNew1 v
+    <|> parseOwnSourceNew2 v
+    <|> parseOwnSpec v
+    <|> legacyParseAddSource v
+    <|> newParseAddSource v
+   where
+    parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
+      r :: URI <- o .: "OwnSource"
+      pure (OwnSource [Right r])
+    parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
+      r :: [URI] <- o .: "OwnSource"
+      pure (OwnSource (fmap Right r))
+    parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "OwnSource"
+      pure (OwnSource r)
+    parseOwnSpec = withObject "URLSource" $ \o -> do
+      r :: GHCupInfo <- o .: "OwnSpec"
+      pure (OwnSpec r)
+    parseGHCupURL = withObject "URLSource" $ \o -> do
+      _ :: [Value] <- o .: "GHCupURL"
+      pure GHCupURL
+    legacyParseAddSource = withObject "URLSource" $ \o -> do
+      r :: Either GHCupInfo URI <- o .: "AddSource"
+      pure (AddSource [r])
+    newParseAddSource = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "AddSource"
+      pure (AddSource r)
+
 instance FromJSON URI where
   parseJSON = withText "URL" $ \t ->
     case parseURI strictURIParserOptions (encodeUtf8 t) of
@@ -314,7 +346,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
-deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
+deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings