Show note for versions that don't have a bindist
This commit is contained in:
parent
6c95218daf
commit
85054d9c76
@ -23,6 +23,7 @@ import GHCup.Utils.MegaParsec
|
|||||||
import GHCup.Utils.Prelude
|
import GHCup.Utils.Prelude
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
|
|
||||||
|
import Control.Exception.Safe
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
@ -53,7 +54,7 @@ import System.Console.Pretty
|
|||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO hiding ( appendFile )
|
import System.IO hiding ( appendFile )
|
||||||
import Text.Read
|
import Text.Read hiding ( lift )
|
||||||
import Text.Layout.Table
|
import Text.Layout.Table
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
@ -917,7 +918,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, TagNotFound
|
, TagNotFound
|
||||||
]
|
]
|
||||||
|
|
||||||
let runListGHC = runE @'[] . runLogger
|
let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||||
|
|
||||||
let runRmGHC =
|
let runRmGHC =
|
||||||
runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
||||||
@ -1000,7 +1001,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
runLogger
|
runLogger
|
||||||
($(logError) [i|Error fetching download info: #{e}|])
|
($(logError) [i|Error fetching download info: #{e}|])
|
||||||
exitWith (ExitFailure 2)
|
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 "," $ (fmap printTag $ sort lTag)
|
||||||
, intercalate ","
|
, intercalate ","
|
||||||
$ (if fromSrc then [color' Blue "compiled"] else mempty)
|
$ (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
|
lr
|
||||||
@ -1367,28 +1376,34 @@ printListResult raw lr = do
|
|||||||
True -> flip const
|
True -> flip const
|
||||||
False -> color
|
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
|
=> GHCupDownloads
|
||||||
-> m ()
|
-> Excepts
|
||||||
|
'[ NoCompatiblePlatform
|
||||||
|
, NoCompatibleArch
|
||||||
|
, DistroNotFound
|
||||||
|
]
|
||||||
|
m
|
||||||
|
()
|
||||||
checkForUpdates dls = do
|
checkForUpdates dls = do
|
||||||
forM_ (getLatest dls GHCup) $ \l -> do
|
forM_ (getLatest dls GHCup) $ \l -> do
|
||||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||||
when (l > ghc_ver)
|
when (l > ghc_ver)
|
||||||
$ $(logWarn)
|
$ lift $ $(logWarn)
|
||||||
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
||||||
|
|
||||||
forM_ (getLatest dls GHC) $ \l -> do
|
forM_ (getLatest dls GHC) $ \l -> do
|
||||||
mghc_ver <- latestInstalled GHC
|
mghc_ver <- latestInstalled GHC
|
||||||
forM mghc_ver $ \ghc_ver ->
|
forM mghc_ver $ \ghc_ver ->
|
||||||
when (l > ghc_ver)
|
when (l > ghc_ver)
|
||||||
$ $(logWarn)
|
$ lift $ $(logWarn)
|
||||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
||||||
|
|
||||||
forM_ (getLatest dls Cabal) $ \l -> do
|
forM_ (getLatest dls Cabal) $ \l -> do
|
||||||
mcabal_ver <- latestInstalled Cabal
|
mcabal_ver <- latestInstalled Cabal
|
||||||
forM mcabal_ver $ \cabal_ver ->
|
forM mcabal_ver $ \cabal_ver ->
|
||||||
when (l > cabal_ver)
|
when (l > cabal_ver)
|
||||||
$ $(logWarn)
|
$ lift $ $(logWarn)
|
||||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
||||||
|
|
||||||
where
|
where
|
||||||
|
@ -327,6 +327,7 @@ executable ghcup
|
|||||||
, pretty-terminal
|
, pretty-terminal
|
||||||
, resourcet
|
, resourcet
|
||||||
, safe
|
, safe
|
||||||
|
, safe-exceptions
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
, table-layout
|
||||||
, template-haskell
|
, template-haskell
|
||||||
|
33
lib/GHCup.hs
33
lib/GHCup.hs
@ -357,6 +357,7 @@ data ListResult = ListResult
|
|||||||
, lSet :: Bool -- ^ currently active version
|
, lSet :: Bool -- ^ currently active version
|
||||||
, fromSrc :: Bool -- ^ compiled from source
|
, fromSrc :: Bool -- ^ compiled from source
|
||||||
, lStray :: Bool -- ^ not in download info
|
, lStray :: Bool -- ^ not in download info
|
||||||
|
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
@ -369,21 +370,34 @@ availableToolVersions av tool = view
|
|||||||
|
|
||||||
-- | List all versions from the download info, as well as stray
|
-- | List all versions from the download info, as well as stray
|
||||||
-- versions.
|
-- versions.
|
||||||
listVersions :: (MonadThrow m, MonadLogger m, MonadIO m)
|
listVersions :: ( MonadCatch m
|
||||||
|
, MonadLogger m
|
||||||
|
, MonadThrow m
|
||||||
|
, MonadLogger m
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
=> GHCupDownloads
|
=> GHCupDownloads
|
||||||
-> Maybe Tool
|
-> Maybe Tool
|
||||||
-> Maybe ListCriteria
|
-> Maybe ListCriteria
|
||||||
-> m [ListResult]
|
-> Excepts
|
||||||
listVersions av lt criteria = case lt of
|
'[ NoCompatiblePlatform
|
||||||
|
, NoCompatibleArch
|
||||||
|
, DistroNotFound
|
||||||
|
]
|
||||||
|
m
|
||||||
|
[ListResult]
|
||||||
|
listVersions av lt criteria = do
|
||||||
|
pfreq <- platformRequest
|
||||||
|
case lt of
|
||||||
Just t -> do
|
Just t -> do
|
||||||
-- get versions from GHCupDownloads
|
-- get versions from GHCupDownloads
|
||||||
let avTools = availableToolVersions av t
|
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
|
case t of
|
||||||
-- append stray GHCs
|
-- append stray GHCs
|
||||||
GHC -> do
|
GHC -> do
|
||||||
slr <- strayGHCs avTools
|
slr <- lift $ strayGHCs avTools
|
||||||
pure $ (sort (slr ++ lr))
|
pure $ (sort (slr ++ lr))
|
||||||
_ -> pure lr
|
_ -> pure lr
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
@ -412,6 +426,7 @@ listVersions av lt criteria = case lt of
|
|||||||
, lTag = []
|
, lTag = []
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = maybe True (const False) (Map.lookup _tvVersion avTools)
|
, lStray = maybe True (const False) (Map.lookup _tvVersion avTools)
|
||||||
|
, lNoBindist = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Right tver@GHCTargetVersion{ .. } -> do
|
Right tver@GHCTargetVersion{ .. } -> do
|
||||||
@ -424,6 +439,7 @@ listVersions av lt criteria = case lt of
|
|||||||
, lTag = []
|
, lTag = []
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
||||||
|
, lNoBindist = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@ -432,15 +448,17 @@ listVersions av lt criteria = case lt of
|
|||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
-- NOTE: this are not cross ones, because no bindists
|
-- NOTE: this are not cross ones, because no bindists
|
||||||
toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
|
toListResult :: PlatformRequest -> Tool -> (Version, [Tag]) -> IO ListResult
|
||||||
toListResult t (v, tags) = case t of
|
toListResult pfreq t (v, tags) = case t of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
|
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
|
||||||
let tver = mkTVer v
|
let tver = mkTVer v
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
||||||
lInstalled <- ghcInstalled tver
|
lInstalled <- ghcInstalled tver
|
||||||
fromSrc <- ghcSrcInstalled tver
|
fromSrc <- ghcSrcInstalled tver
|
||||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
|
let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av
|
||||||
lSet <- fmap (maybe False (== v)) $ cabalSet
|
lSet <- fmap (maybe False (== v)) $ cabalSet
|
||||||
lInstalled <- cabalInstalled v
|
lInstalled <- cabalInstalled v
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
@ -460,6 +478,7 @@ listVersions av lt criteria = case lt of
|
|||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
, fromSrc = False
|
||||||
, lStray = False
|
, lStray = False
|
||||||
|
, lNoBindist = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user