Compare commits
2 Commits
| Author | SHA1 | Date |
|---|---|---|
 Julian Ospald
|
ff60744cc6 | |
|
Julian Ospald
|
e0222b4007
|
|
|
@ -11,7 +11,6 @@ module BrickMain where
|
|||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.OptParse.Common (logGHCPostRm)
|
||||
|
|
@ -20,6 +19,7 @@ import GHCup.Prelude.File
|
|||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
|
|
@ -53,6 +53,7 @@ import System.Exit
|
|||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString
|
||||
import Optics ( view )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as B
|
||||
|
|
@ -477,7 +478,7 @@ install' _ (_, ListResult {..}) = do
|
|||
)
|
||||
>>= \case
|
||||
VRight (vi, Dirs{..}, Just ce) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
|
|
@ -489,7 +490,7 @@ install' _ (_, ListResult {..}) = do
|
|||
_ -> pure ()
|
||||
pure $ Right ()
|
||||
VRight (vi, _, _) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
|
|
@ -564,7 +565,7 @@ del' _ (_, ListResult {..}) = do
|
|||
>>= \case
|
||||
VRight vi -> do
|
||||
logGHCPostRm (mkTVer lVer)
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
forM_ (view viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyHFError e)
|
||||
|
|
|
|||
|
|
@ -57,6 +57,7 @@ import System.Process ( readProcess )
|
|||
import System.FilePath
|
||||
import Text.HTML.TagSoup hiding ( Tag )
|
||||
import URI.ByteString
|
||||
import Optics ( view )
|
||||
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import qualified Data.Map.Strict as M
|
||||
|
|
@ -451,7 +452,7 @@ tagCompleter tool add = listIOCompleter $ do
|
|||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
$ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
||||
|
||||
|
|
|
|||
|
|
@ -16,11 +16,11 @@ import qualified GHCup.GHC as GHC
|
|||
import qualified GHCup.HLS as HLS
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.String.QQ
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Types.Optics
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
|
|
@ -36,6 +36,7 @@ import Data.Versions ( Version, prettyVer, version, p
|
|||
import qualified Data.Versions as V
|
||||
import Data.Text ( Text )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
|
@ -511,7 +512,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||
HLS.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
forM_ (view viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
|
|
@ -539,7 +540,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||
VRight (vi, tv) -> do
|
||||
runLogger $ logInfo
|
||||
"HLS successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
liftIO $ putStr (T.unpack $ prettyVer tv)
|
||||
pure ExitSuccess
|
||||
|
|
@ -563,7 +564,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||
GHC.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
forM_ (view viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
|
|
@ -593,7 +594,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||
VRight (vi, tv) -> do
|
||||
runLogger $ logInfo
|
||||
"GHC successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
liftIO $ putStr (T.unpack $ tVerToText tv)
|
||||
pure ExitSuccess
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@ import GHCup.Utils.Dirs
|
|||
import GHCup.Prelude
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.String.QQ
|
||||
import GHCup.Types.Optics
|
||||
|
||||
import Codec.Archive
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
|
|
@ -36,6 +37,7 @@ import Data.Maybe
|
|||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Optics
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
|
@ -345,7 +347,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "GHC installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
|
||||
|
|
@ -413,7 +415,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "Cabal installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
|
|
@ -463,7 +465,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "HLS installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
|
|
@ -512,7 +514,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "Stack installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
|
@ -34,6 +33,7 @@ import Haskus.Utils.Variant.Excepts
|
|||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Optics
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
|
|
@ -227,5 +227,5 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||
pure $ ExitFailure 15
|
||||
|
||||
postRmLog vi =
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
forM_ (view viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@ import Haskus.Utils.Variant.Excepts
|
|||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Optics ( view )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
|
|
@ -144,7 +145,7 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
|
|||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ logInfo $
|
||||
"Successfully upgraded GHCup to version " <> pretty_v
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
forM_ (view viPostInstall vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -258,6 +258,7 @@ executable ghcup
|
|||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -277,19 +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 =
|
||||
preview (ix t % ix v % 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
|
||||
|
|
|
|||
|
|
@ -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,11 +121,11 @@ testGHCVer :: ( MonadFail m
|
|||
]
|
||||
m
|
||||
()
|
||||
testGHCVer ver addMakeArgs = do
|
||||
testGHCVer (VersionRev ver vr) addMakeArgs = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix ver % 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
|
||||
|
|
@ -243,7 +244,7 @@ fetchGHCSrc :: ( MonadFail m
|
|||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
=> VersionRev
|
||||
-> Maybe FilePath
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
|
|
@ -254,10 +255,10 @@ fetchGHCSrc :: ( MonadFail m
|
|||
]
|
||||
m
|
||||
FilePath
|
||||
fetchGHCSrc v mfp = do
|
||||
fetchGHCSrc (VersionRev v vr) mfp = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix v % 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
|
||||
|
||||
|
|
@ -804,7 +805,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||
|
||||
-- download source tarball
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
|
||||
preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -368,7 +368,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||
|
||||
-- download source tarball
|
||||
dlInfo <-
|
||||
preview (ix HLS % ix tver % viSourceDL % _Just) dls
|
||||
preview (ix HLS % ix tver % viDownload % _last % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -308,7 +308,7 @@ listVersions lt' criteria = do
|
|||
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
||||
in if | Map.member currentVer av -> Nothing
|
||||
| otherwise -> Just $ ListResult { lVer = currentVer
|
||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||
, lTag = maybe (if isOld then [Old] else []) (view viTags) listVer
|
||||
, lCross = Nothing
|
||||
, lTool = GHCup
|
||||
, fromSrc = False
|
||||
|
|
@ -337,7 +337,8 @@ listVersions lt' criteria = do
|
|||
-> [Either FilePath Version]
|
||||
-> (Version, VersionInfo)
|
||||
-> m ListResult
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
|
||||
let tags = view viTags vi
|
||||
case t of
|
||||
GHC -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
||||
|
|
|
|||
|
|
@ -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 ""
|
||||
|
|
|
|||
|
|
@ -44,6 +44,8 @@ import Graphics.Vty ( Key(..) )
|
|||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
|
||||
|
||||
#if !defined(BRICK)
|
||||
|
|
@ -135,6 +137,19 @@ instance NFData GlobalTool
|
|||
-- | All necessary information of a tool version, including
|
||||
-- source download and per-architecture downloads.
|
||||
data VersionInfo = VersionInfo
|
||||
{ _viTags :: [Tag] -- ^ version specific tag
|
||||
, _viChangeLog :: Maybe URI
|
||||
, _viDownload :: Map Int VersionDownload
|
||||
-- informative messages
|
||||
, _viPostInstall :: Maybe Text
|
||||
, _viPostRemove :: Maybe Text
|
||||
, _viPreCompile :: Maybe Text
|
||||
}
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
instance NFData VersionInfo
|
||||
|
||||
data VersionInfoLegacy = VersionInfoLegacy
|
||||
{ _viTags :: [Tag] -- ^ version specific tag
|
||||
, _viChangeLog :: Maybe URI
|
||||
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||
|
|
@ -147,7 +162,47 @@ data VersionInfo = VersionInfo
|
|||
}
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
instance NFData VersionInfo
|
||||
data VersionDownload = VersionDownload
|
||||
{ _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
||||
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
|
||||
|
||||
}
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
instance NFData VersionDownload
|
||||
|
||||
fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
|
||||
fromVersionInfoLegacy VersionInfoLegacy{..} =
|
||||
VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
|
||||
, _viTestDL = _viTestDL
|
||||
, _viArch = _viArch
|
||||
}
|
||||
, ..}
|
||||
|
||||
|
||||
-- | 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.
|
||||
|
|
@ -586,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
|
||||
|
||||
|
|
@ -599,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
|
||||
|
|
|
|||
|
|
@ -320,11 +320,18 @@ instance FromJSONKey (Maybe VersionRange) where
|
|||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
||||
|
||||
|
||||
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
|
||||
|
||||
instance FromJSON VersionInfo where
|
||||
parseJSON v = parseLegacy v <|> parseNew v
|
||||
where
|
||||
parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
|
||||
parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ makeLenses ''PlatformResult
|
|||
makeLenses ''DownloadInfo
|
||||
makeLenses ''Tag
|
||||
makeLenses ''VersionInfo
|
||||
makeLenses ''VersionDownload
|
||||
|
||||
makeLenses ''GHCTargetVersion
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -781,6 +786,9 @@ getLatestToolFor tool pvpIn dls = do
|
|||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
||||
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
|
||||
|
||||
-- type ToolVersionSpec = Map Version ToolRevisionSpec
|
||||
-- type ToolRevisionSpec = Map Int VersionInfo
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -927,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
|
||||
|
|
@ -1285,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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -147,6 +147,10 @@ instance Arbitrary Architecture where
|
|||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary VersionDownload where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary VersionInfo where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue