Show note for versions that don't have a bindist

This commit is contained in:
Julian Ospald 2020-05-15 21:53:45 +02:00
parent 6c95218daf
commit 85054d9c76
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 64 additions and 29 deletions

View File

@ -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

View File

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

View File

@ -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,21 +370,34 @@ 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
-> 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 t)
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult pfreq t)
case t of
-- append stray GHCs
GHC -> do
slr <- strayGHCs avTools
slr <- lift $ strayGHCs avTools
pure $ (sort (slr ++ lr))
_ -> pure lr
Nothing -> do
@ -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
, ..
}