Allow to install X.Y versions
This commit is contained in:
parent
4ed5e21b7f
commit
13acce07d4
@ -33,6 +33,7 @@ import Data.Char
|
|||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.List ( intercalate, sort )
|
import Data.List ( intercalate, sort )
|
||||||
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
@ -92,6 +93,10 @@ data Command
|
|||||||
data ToolVersion = ToolVersion Version
|
data ToolVersion = ToolVersion Version
|
||||||
| ToolTag Tag
|
| ToolTag Tag
|
||||||
|
|
||||||
|
prettyToolVer :: ToolVersion -> String
|
||||||
|
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
||||||
|
prettyToolVer (ToolTag t) = show t
|
||||||
|
|
||||||
|
|
||||||
data InstallOptions = InstallOptions
|
data InstallOptions = InstallOptions
|
||||||
{ instVer :: Maybe ToolVersion
|
{ instVer :: Maybe ToolVersion
|
||||||
@ -788,6 +793,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
|
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
|
||||||
)
|
)
|
||||||
pure $ ExitFailure 3
|
pure $ ExitFailure 3
|
||||||
|
VLeft (V NoDownload) -> do
|
||||||
|
|
||||||
|
runLogger $ do
|
||||||
|
case instVer of
|
||||||
|
Just iver -> $(logError) [i|No available GHC version for #{prettyToolVer iver}|]
|
||||||
|
Nothing -> $(logError) [i|No available recommended GHC version|]
|
||||||
|
pure $ ExitFailure 3
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) [i|#{e}|]
|
$(logError) [i|#{e}|]
|
||||||
@ -806,6 +818,13 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
|
|||||||
runLogger $ $(logWarn)
|
runLogger $ $(logWarn)
|
||||||
[i|Cabal ver #{prettyVer v} already installed|]
|
[i|Cabal ver #{prettyVer v} already installed|]
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
VLeft (V NoDownload) -> do
|
||||||
|
|
||||||
|
runLogger $ do
|
||||||
|
case instVer of
|
||||||
|
Just iver -> $(logError) [i|No available Cabal version for #{prettyToolVer iver}|]
|
||||||
|
Nothing -> $(logError) [i|No available recommended Cabal version|]
|
||||||
|
pure $ ExitFailure 4
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ do
|
runLogger $ do
|
||||||
$(logError) [i|#{e}|]
|
$(logError) [i|#{e}|]
|
||||||
@ -999,7 +1018,14 @@ fromVersion :: Monad m
|
|||||||
-> Excepts '[TagNotFound] m Version
|
-> Excepts '[TagNotFound] m Version
|
||||||
fromVersion av Nothing tool =
|
fromVersion av Nothing tool =
|
||||||
getRecommended av tool ?? TagNotFound Recommended tool
|
getRecommended av tool ?? TagNotFound Recommended tool
|
||||||
fromVersion _ (Just (ToolVersion v)) _ = pure v
|
fromVersion av (Just (ToolVersion v)) _ = do
|
||||||
|
case pvp $ prettyVer v of
|
||||||
|
Left _ -> pure v
|
||||||
|
Right (PVP (major' :|[minor'])) ->
|
||||||
|
case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of
|
||||||
|
Just v' -> pure v'
|
||||||
|
Nothing -> pure v
|
||||||
|
Right _ -> pure v
|
||||||
fromVersion av (Just (ToolTag Latest)) tool =
|
fromVersion av (Just (ToolTag Latest)) tool =
|
||||||
getLatest av tool ?? TagNotFound Latest tool
|
getLatest av tool ?? TagNotFound Latest tool
|
||||||
fromVersion av (Just (ToolTag Recommended)) tool =
|
fromVersion av (Just (ToolTag Recommended)) tool =
|
||||||
|
@ -222,6 +222,23 @@ getGHCForMajor major' minor' = do
|
|||||||
$ semvers
|
$ semvers
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get the latest available ghc for X.Y major version.
|
||||||
|
getLatestGHCFor :: Int -- ^ major version component
|
||||||
|
-> Int -- ^ minor version component
|
||||||
|
-> GHCupDownloads
|
||||||
|
-> Maybe Version
|
||||||
|
getLatestGHCFor major' minor' dls = do
|
||||||
|
join . fmap
|
||||||
|
(lastMay . filter
|
||||||
|
(\v -> case semver $ prettyVer v of
|
||||||
|
Right SemVer{..} -> fromIntegral _svMajor == major' && fromIntegral _svMinor == minor'
|
||||||
|
Left _ -> False
|
||||||
|
)
|
||||||
|
)
|
||||||
|
. preview (ix GHC % to Map.keys) $ dls
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
Loading…
Reference in New Issue
Block a user