Show note for versions that don't have a bindist

app/ghcup/Main.hs

@@ -23,6 +23,7 @@ import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 import           GHCup.Version
 
+import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -53,7 +54,7 @@ import           System.Console.Pretty
 import           System.Environment
 import           System.Exit
 import           System.IO               hiding ( appendFile )
-import           Text.Read
+import           Text.Read               hiding ( lift )
 import           Text.Layout.Table
 import           URI.ByteString
 
@@ -917,7 +918,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     , TagNotFound
                     ]
 
-          let runListGHC = runE @'[] . runLogger
+          let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
 
           let runRmGHC =
                 runLogger . flip runReaderT settings . runE @'[NotInstalled]
@@ -1000,7 +1001,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       runLogger
                         ($(logError) [i|Error fetching download info: #{e}|])
                       exitWith (ExitFailure 2)
-          runLogger $ checkForUpdates dls
+          (runLogger
+              . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ checkForUpdates dls
+              )
+              >>= \case
+                    VRight _ -> pure ()
+                    VLeft  e -> do
+                      runLogger
+                        ($(logError) [i|Error checking for upgrades: #{e}|])
 
 
           -----------------------
@@ -1353,7 +1361,8 @@ printListResult raw lr = do
                        , intercalate "," $ (fmap printTag $ sort lTag)
                        , intercalate ","
                        $  (if fromSrc then [color' Blue "compiled"] else mempty)
-                       ++ (if lStray then [color' Blue "stray"] else mempty)
+                       ++ (if lStray then [color' Yellow "stray"] else mempty)
+                       ++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
                        ]
             )
             lr
@@ -1367,28 +1376,34 @@ printListResult raw lr = do
     True  -> flip const
     False -> color
 
-checkForUpdates :: (MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
+checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
                 => GHCupDownloads
-                -> m ()
+                -> Excepts
+                     '[ NoCompatiblePlatform
+                      , NoCompatibleArch
+                      , DistroNotFound
+                      ]
+                     m
+                     ()
 checkForUpdates dls = do
   forM_ (getLatest dls GHCup) $ \l -> do
     (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
     when (l > ghc_ver)
-      $ $(logWarn)
+      $ lift $ $(logWarn)
           [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
 
   forM_ (getLatest dls GHC) $ \l -> do
     mghc_ver <- latestInstalled GHC
     forM mghc_ver $ \ghc_ver ->
       when (l > ghc_ver)
-        $ $(logWarn)
+        $ lift $ $(logWarn)
             [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
 
   forM_ (getLatest dls Cabal) $ \l -> do
     mcabal_ver <- latestInstalled Cabal
     forM mcabal_ver $ \cabal_ver ->
       when (l > cabal_ver)
-        $ $(logWarn)
+        $ lift $ $(logWarn)
             [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
 
  where

ghcup.cabal

@@ -327,6 +327,7 @@ executable ghcup
     , pretty-terminal
     , resourcet
     , safe
+    , safe-exceptions
     , string-interpolate
     , table-layout
     , template-haskell

lib/GHCup.hs

@@ -357,6 +357,7 @@ data ListResult = ListResult
   , lSet       :: Bool -- ^ currently active version
   , fromSrc    :: Bool -- ^ compiled from source
   , lStray     :: Bool -- ^ not in download info
+  , lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
   }
   deriving (Eq, Ord, Show)
 
@@ -369,28 +370,41 @@ availableToolVersions av tool = view
 
 -- | List all versions from the download info, as well as stray
 -- versions.
-listVersions :: (MonadThrow m, MonadLogger m, MonadIO m)
+listVersions :: ( MonadCatch m
+                , MonadLogger m
+                , MonadThrow m
+                , MonadLogger m
+                , MonadIO m
+                )
              => GHCupDownloads
              -> Maybe Tool
              -> Maybe ListCriteria
-             -> m [ListResult]
-listVersions av lt criteria = case lt of
-  Just t -> do
-    -- get versions from GHCupDownloads
-    let avTools = availableToolVersions av t
-    lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult t)
+             -> Excepts
+                  '[ NoCompatiblePlatform
+                   , NoCompatibleArch
+                   , DistroNotFound
+                   ]
+                  m
+                  [ListResult]
+listVersions av lt criteria = do
+  pfreq <- platformRequest
+  case lt of
+    Just t -> do
+      -- get versions from GHCupDownloads
+      let avTools = availableToolVersions av t
+      lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult pfreq t)
 
-    case t of
-      -- append stray GHCs
-      GHC -> do
-        slr <- strayGHCs avTools
-        pure $ (sort (slr ++ lr))
-      _ -> pure lr
-  Nothing -> do
-    ghcvers   <- listVersions av (Just GHC) criteria
-    cabalvers <- listVersions av (Just Cabal) criteria
-    ghcupvers <- listVersions av (Just GHCup) criteria
-    pure (ghcvers <> cabalvers <> ghcupvers)
+      case t of
+        -- append stray GHCs
+        GHC -> do
+          slr <- lift $ strayGHCs avTools
+          pure $ (sort (slr ++ lr))
+        _ -> pure lr
+    Nothing -> do
+      ghcvers   <- listVersions av (Just GHC) criteria
+      cabalvers <- listVersions av (Just Cabal) criteria
+      ghcupvers <- listVersions av (Just GHCup) criteria
+      pure (ghcvers <> cabalvers <> ghcupvers)
 
  where
   strayGHCs :: (MonadThrow m, MonadLogger m, MonadIO m)
@@ -412,6 +426,7 @@ listVersions av lt criteria = case lt of
               , lTag       = []
               , lInstalled = True
               , lStray     = maybe True (const False) (Map.lookup _tvVersion avTools)
+              , lNoBindist = False
               , ..
               }
       Right tver@GHCTargetVersion{ .. } -> do
@@ -424,6 +439,7 @@ listVersions av lt criteria = case lt of
           , lTag       = []
           , lInstalled = True
           , lStray     = True -- NOTE: cross currently cannot be installed via bindist
+          , lNoBindist = False
           , ..
           }
       Left e -> do
@@ -432,15 +448,17 @@ listVersions av lt criteria = case lt of
         pure Nothing
 
   -- NOTE: this are not cross ones, because no bindists
-  toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
-  toListResult t (v, tags) = case t of
+  toListResult :: PlatformRequest -> Tool -> (Version, [Tag]) -> IO ListResult
+  toListResult pfreq t (v, tags) = case t of
     GHC -> do
+      let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
       let tver = mkTVer v
       lSet       <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
       lInstalled <- ghcInstalled tver
       fromSrc    <- ghcSrcInstalled tver
       pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
     Cabal -> do
+      let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av
       lSet <- fmap (maybe False (== v)) $ cabalSet
       lInstalled <- cabalInstalled v
       pure ListResult { lVer    = v
@@ -460,6 +478,7 @@ listVersions av lt criteria = case lt of
                       , lTool   = t
                       , fromSrc = False
                       , lStray  = False
+                      , lNoBindist = False
                       , ..
                       }