diff --git a/cabal.project b/cabal.project index e9e9738..37d7aec 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ constraints: http-io-streams -brotli, any.aeson >= 2.0.1.0 package libarchive - flags: -system-libarchive + flags: +system-libarchive package aeson-pretty flags: +lib-only diff --git a/lib/GHCup/Cabal.hs b/lib/GHCup/Cabal.hs index 75dbeb0..9854889 100644 --- a/lib/GHCup/Cabal.hs +++ b/lib/GHCup/Cabal.hs @@ -177,7 +177,7 @@ installCabalBin :: ( MonadMask m , MonadUnliftIO m , MonadFail m ) - => Version + => VersionRev -> InstallDir -> Bool -- force install -> Excepts @@ -198,7 +198,7 @@ installCabalBin :: ( MonadMask m () installCabalBin ver installDir forceInstall = do dlinfo <- liftE $ getDownloadInfo Cabal ver - installCabalBindist dlinfo ver installDir forceInstall + installCabalBindist dlinfo (vVersion ver) installDir forceInstall ----------------- diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 3fc06da..205557f 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -277,20 +277,19 @@ getDownloadInfo :: ( MonadReader env m , HasGHCupInfo env ) => Tool - -> Version + -> VersionRev -- ^ tool version -> Excepts '[NoDownload] m DownloadInfo -getDownloadInfo t v = do +getDownloadInfo t (VersionRev v vr) = do (PlatformRequest a p mv) <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let distro_preview f g = let platformVersionSpec = - -- TODO - preview (ix t % ix v % viDownload % ix 0 % viArch % ix a % ix (f p)) dls + preview (ix t % ix v % viDownload % ix vr % viArch % ix a % ix (f p)) dls mv' = g mv in fmap snd . find diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index af86df4..fd62dde 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -78,6 +78,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Encoding as E import qualified Text.Megaparsec as MP +import qualified Data.Map.Strict as M data GHCVer v = SourceDist v @@ -105,7 +106,7 @@ testGHCVer :: ( MonadFail m , MonadIO m , MonadUnliftIO m ) - => Version + => VersionRev -> [T.Text] -> Excepts '[ DigestError @@ -120,12 +121,11 @@ testGHCVer :: ( MonadFail m ] m () -testGHCVer ver addMakeArgs = do +testGHCVer (VersionRev ver vr) addMakeArgs = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo dlInfo <- - -- TODO - preview (ix GHC % ix ver % viDownload % ix 0 % viTestDL % _Just) dls + preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls ?? NoDownload liftE $ testGHCBindist dlInfo ver addMakeArgs @@ -244,7 +244,7 @@ fetchGHCSrc :: ( MonadFail m , MonadIO m , MonadUnliftIO m ) - => Version + => VersionRev -> Maybe FilePath -> Excepts '[ DigestError @@ -255,11 +255,10 @@ fetchGHCSrc :: ( MonadFail m ] m FilePath -fetchGHCSrc v mfp = do +fetchGHCSrc (VersionRev v vr) mfp = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo dlInfo <- - -- TODO - preview (ix GHC % ix v % viDownload % ix 0 % viSourceDL % _Just) dls + preview (ix GHC % ix v % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls ?? NoDownload liftE $ downloadCached' dlInfo Nothing mfp @@ -806,8 +805,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr -- download source tarball dlInfo <- - -- TODO - preview (ix GHC % ix (tver ^. tvVersion) % viDownload % ix 0 % viSourceDL % _Just) dls + preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls ?? NoDownload dl <- liftE $ downloadCached dlInfo Nothing diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index d47d133..69876d5 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -368,8 +368,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda -- download source tarball dlInfo <- - -- TODO - preview (ix HLS % ix tver % viDownload % ix 0 % viSourceDL % _Just) dls + preview (ix HLS % ix tver % viDownload % _last % viSourceDL % _Just) dls ?? NoDownload dl <- liftE $ downloadCached dlInfo Nothing diff --git a/lib/GHCup/Prelude/MegaParsec.hs b/lib/GHCup/Prelude/MegaParsec.hs index 2f8d06b..e2adff1 100644 --- a/lib/GHCup/Prelude/MegaParsec.hs +++ b/lib/GHCup/Prelude/MegaParsec.hs @@ -28,6 +28,8 @@ import System.FilePath import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Text.Megaparsec as MP +import Data.Char (digitToInt) +import Data.Data (Proxy(..)) choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a @@ -86,7 +88,33 @@ ghcTargetVerP = <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-") <|> ((\ _ x -> x) Nothing <$> mempty) ) - <*> (version' <* MP.eof) + <*> version' + where + verP' :: MP.Parsec Void Text Text + verP' = do + v <- version' + let startsWithDigists = + and + . take 3 + . concatMap + (map + (\case + (Digits _) -> True + (Str _) -> False + ) . NE.toList) + . NE.toList + $ _vChunks v + if startsWithDigists && isNothing (_vEpoch v) + then pure $ prettyVer v + else fail "Oh" + +ghcTargetVerRevP :: MP.Parsec Void Text GHCTargetVersionRev +ghcTargetVerRevP = + (\x y -> GHCTargetVersionRev x y) + <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-") + <|> ((\ _ x -> x) Nothing <$> mempty) + ) + <*> versionRevP where verP' :: MP.Parsec Void Text Text verP' = do @@ -122,3 +150,44 @@ verP suffix = do pathSep :: MP.Parsec Void Text Char pathSep = MP.oneOf pathSeparators + +versionRevP :: MP.Parsec Void Text VersionRev +versionRevP = MP.label "versionRev" $ + MP.try (parseUntil (MP.try (MP.chunk "-r")) >>= versionWithRev) <|> ((`VersionRev` 0) <$> version') + where + versionWithRev ver = do + rest <- MP.getInput + MP.setInput ver + v <- version' + MP.setInput rest + _ <- MP.chunk "-r" + rev <- parseInt + pure $ VersionRev v rev + + digit = MP.oneOf ['0'..'9'] MP. "digit" + parseInt :: MP.Parsec Void Text Int + parseInt = MP.label "parseInt" $ do + i <- MP.tokensToChunk (Proxy :: Proxy Text) <$> some digit + pure $ numberValue 10 $ T.unpack i + + numberValue :: Int -> String -> Int + numberValue base = foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0 + +userVersionRevP :: MP.Parsec Void Text UserVersionRev +userVersionRevP = MP.label "userVersionRev" $ + ((\(VersionRev v r) -> UserVersionRev v (Just r)) <$> MP.try versionRevP) <|> ((`UserVersionRev` Nothing) <$> version') + + +-- | Read a @VersionRev@ from a String. +-- +-- - 3.3.2 -> VersionRev { vVersion = 3.3.3, vRev = 0 } +-- - 2.3.4-r3 -> VersionRev { vVersion = 2.3.4, vRev = 3 } +versionRev :: Text -> Either (MP.ParseErrorBundle Text Void) VersionRev +versionRev = MP.parse versionRevP "" + +-- | Read a @UserVersionRev@ from a String. +-- +-- - 3.3.2 -> UserVersionRev { vVersion = 3.3.3, vRev = Nothing } +-- - 2.3.4-r3 -> UserVersionRev { vVersion = 2.3.4, vRev = Just 3 } +userVersionRev :: Text -> Either (MP.ParseErrorBundle Text Void) UserVersionRev +userVersionRev = MP.parse userVersionRevP "" diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index 52aebb8..fb28a4b 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -181,6 +181,30 @@ fromVersionInfoLegacy VersionInfoLegacy{..} = , ..} +-- | A version with a revision, denoting bindist 'versions' that are purely distribution specific. +-- +-- The revision starts at 0. +data VersionRev = VersionRev { vVersion :: Version, vRev :: Int } + deriving (Ord, Eq, GHC.Generic, Show) + +showVersionRev :: VersionRev -> Text +showVersionRev (VersionRev v 0) = prettyVer v +showVersionRev (VersionRev v r) = prettyVer v <> "-r" <> T.pack (show r) + +-- | Similar to @VersionRev@, except that revision is optional. The absence of a revision has +-- a particular meaning: +-- +-- * for install/prefetch: we want the latest available revision +-- * for compile: it depends +-- * for rm/set/unset/whereis/changelog: we want the revision that is installed (there can be only one) +-- +-- Translating @UserVersionRev@ to @VersionRev@ requires context of the GHCup metadata, +-- installed versions and the to be executed command. +data UserVersionRev = UserVersionRev { uvVersion :: Version, uvRev :: Maybe Int } + deriving (Ord, Eq, GHC.Generic, Show) + + + -- | A tag. These are currently attached to a version of a tool. data Tag = Latest | Recommended @@ -617,12 +641,6 @@ data GHCTargetVersion = GHCTargetVersion } deriving (Ord, Eq, Show) -data GitBranch = GitBranch - { ref :: String - , repo :: Maybe String - } - deriving (Ord, Eq, Show) - mkTVer :: Version -> GHCTargetVersion mkTVer = GHCTargetVersion Nothing @@ -630,10 +648,30 @@ tVerToText :: GHCTargetVersion -> Text tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v' tVerToText (GHCTargetVersion Nothing v') = prettyVer v' +-- | A GHC identified by the target platform triple +-- and the version. +data GHCTargetVersionRev = GHCTargetVersionRev + { _tvTargetRev :: Maybe Text + , _tvVersionRev :: VersionRev + } + deriving (Ord, Eq, Show) + +mkTVerRev :: VersionRev -> GHCTargetVersionRev +mkTVerRev = GHCTargetVersionRev Nothing + +tVerRevToText :: GHCTargetVersionRev -> Text +tVerRevToText (GHCTargetVersionRev (Just t) v') = t <> "-" <> showVersionRev v' +tVerRevToText (GHCTargetVersionRev Nothing v') = showVersionRev v' + -- | Assembles a path of the form: - instance Pretty GHCTargetVersion where pPrint = text . T.unpack . tVerToText +data GitBranch = GitBranch + { ref :: String + , repo :: Maybe String + } + deriving (Ord, Eq, Show) -- | A comparator and a version. data VersionCmp = VR_gt Versioning diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 266d707..86885cf 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -160,7 +160,7 @@ rmMinorGHCSymlinks :: ( MonadReader env m rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do Dirs {..} <- lift getDirs - files <- liftE $ ghcToolFiles tv + files <- liftE $ ghcToolFiles tv forM_ files $ \f -> do let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt let fullF = binDir f_xyz @@ -181,7 +181,7 @@ rmPlainGHC :: ( MonadReader env m -> Excepts '[NotInstalled] m () rmPlainGHC target = do Dirs {..} <- lift getDirs - mtv <- lift $ ghcSet target + mtv <- lift $ ghcSet target forM_ mtv $ \tv -> do files <- liftE $ ghcToolFiles tv forM_ files $ \f -> do @@ -228,7 +228,7 @@ rmMinorHLSSymlinks :: ( MonadReader env m , MonadFail m , MonadMask m ) - => Version + => VersionRev -> Excepts '[NotInstalled] m () rmMinorHLSSymlinks ver = do Dirs {..} <- lift getDirs @@ -281,7 +281,7 @@ rmPlainHLS = do ----------------------------------- --- | Whether the given GHC versin is installed. +-- | Whether the given GHC version is installed. ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool ghcInstalled ver = do ghcdir <- ghcupGHCDir ver @@ -299,7 +299,7 @@ ghcSrcInstalled ver = do ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) => Maybe Text -- ^ the target of the GHC version, if any -- (e.g. armv7-unknown-linux-gnueabihf) - -> m (Maybe GHCTargetVersion) + -> m (Maybe GHCTargetVersionRev) ghcSet mtarget = do Dirs {..} <- getDirs let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget @@ -311,7 +311,7 @@ ghcSet mtarget = do link <- liftIO $ getLinkTarget ghcBin Just <$> ghcLinkVersion link where - ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion + ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t where parser = @@ -321,7 +321,7 @@ ghcSet mtarget = do r <- parseUntil1 pathSep rest <- MP.getInput MP.setInput r - x <- ghcTargetVerP + x <- ghcTargetVerRevP MP.setInput rest pure x ) @@ -347,13 +347,13 @@ getInstalledCabals :: ( MonadReader env m , MonadIO m , MonadCatch m ) - => m [Either FilePath Version] + => m [Either FilePath VersionRev] getInstalledCabals = do Dirs {..} <- getDirs bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles binDir (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString)) - vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of + vs <- forM bins $ \f -> case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of Just (Right r) -> pure $ Right r Just (Left _) -> pure $ Left f Nothing -> pure $ Left f @@ -361,14 +361,14 @@ getInstalledCabals = do -- | Whether the given cabal version is installed. -cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool +cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool cabalInstalled ver = do vers <- fmap rights getInstalledCabals pure $ elem ver vers -- Return the currently set cabal version, if any. -cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) +cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev) cabalSet = do Dirs {..} <- getDirs let cabalbin = binDir "cabal" <> exeExt @@ -395,7 +395,7 @@ cabalSet = do -- We try to be extra permissive with link destination parsing, -- because of: -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119 - linkVersion :: MonadThrow m => FilePath -> m Version + linkVersion :: MonadThrow m => FilePath -> m VersionRev linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt parser @@ -403,7 +403,7 @@ cabalSet = do <|> MP.try (stripRelativePath *> cabalParse) <|> cabalParse -- parses the version of "cabal-3.2.0.0" -> "3.2.0.0" - cabalParse = MP.chunk "cabal-" *> version' + cabalParse = MP.chunk "cabal-" *> versionRevP -- parses any path component ending with path separator, -- e.g. "foo/" stripPathComponet = parseUntil1 pathSep *> MP.some pathSep @@ -420,7 +420,7 @@ cabalSet = do -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@, -- as well as @~\/.ghcup\/hls\/<\hlsver\>@ getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) - => m [Either FilePath Version] + => m [Either FilePath VersionRev] getInstalledHLSs = do Dirs {..} <- getDirs bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles @@ -431,7 +431,7 @@ getInstalledHLSs = do ) legacy <- forM bins $ \f -> case - version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f) + versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f) of Just (Right r) -> pure $ Right r Just (Left _) -> pure $ Left f @@ -448,7 +448,7 @@ getInstalledHLSs = do -- | Get all installed stacks, by matching on -- @~\/.ghcup\/bin/stack-<\stackver\>@. getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) - => m [Either FilePath Version] + => m [Either FilePath VersionRev] getInstalledStacks = do Dirs {..} <- getDirs bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles @@ -458,7 +458,7 @@ getInstalledStacks = do ([s|^stack-.*$|] :: ByteString) ) forM bins $ \f -> - case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of + case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of Just (Right r) -> pure $ Right r Just (Left _) -> pure $ Left f Nothing -> pure $ Left f @@ -509,13 +509,13 @@ stackSet = do stripRelativePath = MP.many (MP.try stripPathComponet) -- | Whether the given Stack version is installed. -stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool +stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool stackInstalled ver = do vers <- fmap rights getInstalledStacks pure $ elem ver vers -- | Whether the given HLS version is installed. -hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool +hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool hlsInstalled ver = do vers <- fmap rights getInstalledHLSs pure $ elem ver vers @@ -527,7 +527,7 @@ isLegacyHLS ver = do -- Return the currently set hls version, if any. -hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) +hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev) hlsSet = do Dirs {..} <- getDirs let hlsBin = binDir "haskell-language-server-wrapper" <> exeExt @@ -540,7 +540,7 @@ hlsSet = do link <- liftIO $ getLinkTarget hlsBin Just <$> linkVersion link where - linkVersion :: MonadThrow m => FilePath -> m Version + linkVersion :: MonadThrow m => FilePath -> m VersionRev linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt where parser @@ -548,7 +548,7 @@ hlsSet = do <|> MP.try (stripRelativePath *> cabalParse) <|> cabalParse -- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0" - cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version' + cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP -- parses any path component ending with path separator, -- e.g. "foo/" stripPathComponet = parseUntil1 pathSep *> MP.some pathSep @@ -567,7 +567,7 @@ hlsGHCVersions :: ( MonadReader env m , MonadThrow m , MonadCatch m ) - => m [Version] + => m [VersionRev] hlsGHCVersions = do h <- hlsSet fromMaybe [] <$> forM h hlsGHCVersions' @@ -579,12 +579,12 @@ hlsGHCVersions' :: ( MonadReader env m , MonadThrow m , MonadCatch m ) - => Version - -> m [Version] + => VersionRev + -> m [VersionRev] hlsGHCVersions' v' = do bins <- hlsServerBinaries v' Nothing let vers = fmap - (version + (versionRev . T.pack . fromJust . stripPrefix "haskell-language-server-" @@ -597,10 +597,10 @@ hlsGHCVersions' v' = do -- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any. hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m) - => Version + => VersionRev -> Maybe Version -- ^ optional GHC version -> m [FilePath] -hlsServerBinaries ver mghcVer = do +hlsServerBinaries (VersionRev ver rv) mghcVer = do Dirs {..} <- getDirs liftIO $ handleIO (\_ -> pure []) $ findFiles binDir @@ -611,6 +611,7 @@ hlsServerBinaries ver mghcVer = do <> maybe [s|.*|] escapeVerRex mghcVer <> [s|~|] <> escapeVerRex ver + <> E.encodeUtf8 (T.pack ("-r" <> show rv)) <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString ) @@ -657,16 +658,20 @@ hlsInternalServerLibs ver ghcVer = do -- | Get the wrapper binary for an hls version, if any. hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) - => Version + => VersionRev -> m (Maybe FilePath) -hlsWrapperBinary ver = do +hlsWrapperBinary (VersionRev ver rv) = do Dirs {..} <- getDirs wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles binDir (makeRegexOpts compExtended execBlank - ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString + ([s|^haskell-language-server-wrapper-|] + <> escapeVerRex ver + <> E.encodeUtf8 (T.pack ("-r" <> show rv)) + <> E.encodeUtf8 (T.pack exeExt) + <> [s|$|] :: ByteString ) ) case wrapper of @@ -677,7 +682,7 @@ hlsWrapperBinary ver = do -- | Get all binaries for an hls version, if any. -hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath] +hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath] hlsAllBinaries ver = do hls <- hlsServerBinaries ver Nothing wrapper <- hlsWrapperBinary ver @@ -930,7 +935,7 @@ ghcInternalBinDir ver = do -- -- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m) - => GHCTargetVersion + => GHCTargetVersionRev -> Excepts '[NotInstalled] m [FilePath] ghcToolFiles ver = do bindir <- ghcInternalBinDir ver @@ -1288,7 +1293,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m => m () warnAboutHlsCompatibility = do supportedGHC <- hlsGHCVersions - currentGHC <- fmap _tvVersion <$> ghcSet Nothing + currentGHC <- fmap _tvVersionRev <$> ghcSet Nothing currentHLS <- hlsSet case (currentGHC, currentHLS) of diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs index 8c55422..cdac7af 100644 --- a/lib/GHCup/Utils/Dirs.hs +++ b/lib/GHCup/Utils/Dirs.hs @@ -417,9 +417,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion parseGHCupGHCDir (T.pack -> fp) = throwEither $ MP.parse ghcTargetVerP "" fp -parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version +parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev parseGHCupHLSDir (T.pack -> fp) = - throwEither $ MP.parse version' "" fp + throwEither $ versionRev fp -- TODO: inlined from GHCup.Prelude throwEither :: (Exception a, MonadThrow m) => Either a b -> m b