hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

WIP

Browse Source
This commit is contained in:
Julian Ospald 2023-03-11 21:40:47 +08:00
parent e0222b4007
commit ff60744cc6
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
9 changed files with 170 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cabal.project
View File

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

4
lib/GHCup/Cabal.hs
View File

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

7
lib/GHCup/Download.hs
View File

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

18
lib/GHCup/GHC.hs
View File

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

3
lib/GHCup/HLS.hs
View File

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

71
lib/GHCup/Prelude/MegaParsec.hs
View File

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

50
lib/GHCup/Types.hs
View File

@ -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: <target-triple>-<version>
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

73
lib/GHCup/Utils.hs
View File

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

4
lib/GHCup/Utils/Dirs.hs
View File

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