ghcup 0.1.40.0 → 0.1.50.0
raw patch · 41 files changed
+746/−252 lines, 41 filesdep +yaml-streamlydep ~generic-arbitraryPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: yaml-streamly
Dependency ranges changed: generic-arbitrary
API changes (from Hackage documentation)
- GHCup.Types: [$sel:diBaseDir:DebugInfo] :: DebugInfo -> FilePath
- GHCup.Types: [$sel:diBinDir:DebugInfo] :: DebugInfo -> FilePath
- GHCup.Types: [$sel:diCacheDir:DebugInfo] :: DebugInfo -> FilePath
- GHCup.Types: [$sel:diGHCDir:DebugInfo] :: DebugInfo -> FilePath
+ GHCup.Errors: data () => URIParseError
+ GHCup.Prelude.MegaParsec: ghcVersionFromPath :: Parsec Void Text GHCTargetVersion
+ GHCup.Types: DefaultChannel :: ChannelAlias
+ GHCup.Types: GLax :: GuessMode
+ GHCup.Types: GLaxWithInstalled :: GuessMode
+ GHCup.Types: GStrict :: GuessMode
+ GHCup.Types: StackChannel :: ChannelAlias
+ GHCup.Types: [$sel:diChannels:DebugInfo] :: DebugInfo -> [(ChannelAlias, URI)]
+ GHCup.Types: [$sel:diDirs:DebugInfo] :: DebugInfo -> Dirs
+ GHCup.Types: [$sel:diShimGenURL:DebugInfo] :: DebugInfo -> URI
+ GHCup.Types: [$sel:guessVersion:Settings] :: Settings -> Bool
+ GHCup.Types: [$sel:uGuessVersion:UserSettings] :: UserSettings -> Maybe Bool
+ GHCup.Types: data GuessMode
+ GHCup.Types: instance GHC.Classes.Eq GHCup.Types.GuessMode
+ GHCup.Types: instance GHC.Show.Show GHCup.Types.GuessMode
+ GHCup.Utils.Parsers: guessFullVersion :: (HasLog env, MonadFail m, MonadReader env m, HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) => GHCupDownloads -> GHCTargetVersion -> Tool -> GuessMode -> m (GHCTargetVersion, Maybe VersionInfo)
+ GHCup.Utils.Parsers: instance GHC.Base.Alternative (Data.Either.Either [a])
+ GHCup.Utils.URI: parseURIP :: Parser (URIRef Absolute)
- GHCup: compileGHC :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadThrow m, MonadResource m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m) => GHCVer -> Maybe Text -> Maybe [VersionPattern] -> Either Version FilePath -> Maybe (Either Version FilePath) -> Maybe Int -> Maybe FilePath -> Maybe (Either FilePath [URI]) -> [Text] -> Maybe String -> Maybe BuildSystem -> InstallDir -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError, BuildFailed, UninstallFailed, MergeFileTreeError] m GHCTargetVersion
+ GHCup: compileGHC :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadThrow m, MonadResource m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m) => GHCVer -> Maybe Text -> Maybe [VersionPattern] -> Either Version FilePath -> Maybe (Either Version FilePath) -> Maybe Int -> Maybe FilePath -> Maybe (Either FilePath [URI]) -> [Text] -> Maybe String -> Maybe BuildSystem -> InstallDir -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError, BuildFailed, UninstallFailed, MergeFileTreeError, URIParseError] m GHCTargetVersion
- GHCup: compileHLS :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => HLSVer -> [Version] -> Maybe Int -> Maybe [VersionPattern] -> InstallDir -> Maybe (Either FilePath URI) -> Maybe URI -> Bool -> Maybe (Either FilePath [URI]) -> [Text] -> Excepts '[NoDownload, GPGError, DownloadFailed, DigestError, ContentLengthError, UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed, NotInstalled] m Version
+ GHCup: compileHLS :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => HLSVer -> [Version] -> Maybe Int -> Maybe [VersionPattern] -> InstallDir -> Maybe (Either FilePath URI) -> Maybe URI -> Bool -> Maybe (Either FilePath [URI]) -> [Text] -> Excepts '[NoDownload, GPGError, DownloadFailed, DigestError, ContentLengthError, UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed, NotInstalled, URIParseError] m Version
- GHCup: fetchGHCSrc :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload] m FilePath
+ GHCup: fetchGHCSrc :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, URIParseError] m FilePath
- GHCup: fetchToolBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Tool -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload] m FilePath
+ GHCup: fetchToolBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Tool -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, URIParseError] m FilePath
- GHCup: installGHCBin :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, Alternative m) => GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, NoCompatiblePlatform, ParseError, UnsupportedSetupCombo, DistroNotFound, NoCompatibleArch] m ()
+ GHCup: installGHCBin :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, Alternative m) => GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, NoCompatiblePlatform, ParseError, UnsupportedSetupCombo, DistroNotFound, NoCompatibleArch, URIParseError] m ()
- GHCup: installGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError] m ()
+ GHCup: installGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup: installHLSBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError] m ()
+ GHCup: installHLSBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup: installHLSBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError] m ()
+ GHCup: installHLSBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup: installPackedGHC :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m, MonadResource m) => FilePath -> Maybe TarDir -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Excepts '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, MergeFileTreeError] m ()
+ GHCup: installPackedGHC :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m, MonadResource m) => FilePath -> Maybe TarDir -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Text -> Excepts '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, MergeFileTreeError] m ()
- GHCup: installUnpackedGHC :: (MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) => GHCupPath -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Excepts '[ProcessError, MergeFileTreeError] m ()
+ GHCup: installUnpackedGHC :: (MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) => GHCupPath -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Text -> Excepts '[ProcessError, MergeFileTreeError] m ()
- GHCup: testGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed] m ()
+ GHCup: testGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed, URIParseError] m ()
- GHCup: testGHCVer :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed] m ()
+ GHCup: testGHCVer :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed, URIParseError] m ()
- GHCup: upgradeGHCup :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadCatch m, HasLog env, MonadThrow m, MonadFail m, MonadResource m, MonadIO m, MonadUnliftIO m) => Maybe FilePath -> Bool -> Bool -> Excepts '[CopyError, DigestError, ContentLengthError, GPGError, GPGError, DownloadFailed, NoDownload, NoUpdate, ToolShadowed] m Version
+ GHCup: upgradeGHCup :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadCatch m, HasLog env, MonadThrow m, MonadFail m, MonadResource m, MonadIO m, MonadUnliftIO m) => Maybe FilePath -> Bool -> Bool -> Excepts '[CopyError, DigestError, ContentLengthError, GPGError, GPGError, DownloadFailed, NoDownload, NoUpdate, ToolShadowed, URIParseError] m Version
- GHCup: upgradeGHCup' :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadCatch m, HasLog env, MonadThrow m, MonadFail m, MonadResource m, MonadIO m, MonadUnliftIO m) => Maybe FilePath -> Bool -> Bool -> Version -> Excepts '[CopyError, DigestError, ContentLengthError, GPGError, GPGError, DownloadFailed, NoDownload, NoUpdate, ToolShadowed] m Version
+ GHCup: upgradeGHCup' :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadCatch m, HasLog env, MonadThrow m, MonadFail m, MonadResource m, MonadIO m, MonadUnliftIO m) => Maybe FilePath -> Bool -> Bool -> Version -> Excepts '[CopyError, DigestError, ContentLengthError, GPGError, GPGError, DownloadFailed, NoDownload, NoUpdate, ToolShadowed, URIParseError] m Version
- GHCup.Cabal: installCabalBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError] m ()
+ GHCup.Cabal: installCabalBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, URIParseError] m ()
- GHCup.Cabal: installCabalBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError] m ()
+ GHCup.Cabal: installCabalBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, URIParseError] m ()
- GHCup.Download: downloadCached :: (MonadReader env m, HasDirs env, HasSettings env, MonadMask m, MonadResource m, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) => DownloadInfo -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
+ GHCup.Download: downloadCached :: (MonadReader env m, HasDirs env, HasSettings env, MonadMask m, MonadResource m, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) => DownloadInfo -> Maybe FilePath -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
- GHCup.Download: downloadCached' :: (MonadReader env m, HasDirs env, HasSettings env, MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) => DownloadInfo -> Maybe FilePath -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
+ GHCup.Download: downloadCached' :: (MonadReader env m, HasDirs env, HasSettings env, MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) => DownloadInfo -> Maybe FilePath -> Maybe FilePath -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
- GHCup.Errors: DigestMissing :: URI -> DigestMissing
+ GHCup.Errors: DigestMissing :: Text -> DigestMissing
- GHCup.GHC: compileGHC :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadThrow m, MonadResource m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m) => GHCVer -> Maybe Text -> Maybe [VersionPattern] -> Either Version FilePath -> Maybe (Either Version FilePath) -> Maybe Int -> Maybe FilePath -> Maybe (Either FilePath [URI]) -> [Text] -> Maybe String -> Maybe BuildSystem -> InstallDir -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError, BuildFailed, UninstallFailed, MergeFileTreeError] m GHCTargetVersion
+ GHCup.GHC: compileGHC :: (MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env, HasGHCupInfo env, HasSettings env, MonadThrow m, MonadResource m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m) => GHCVer -> Maybe Text -> Maybe [VersionPattern] -> Either Version FilePath -> Maybe (Either Version FilePath) -> Maybe Int -> Maybe FilePath -> Maybe (Either FilePath [URI]) -> [Text] -> Maybe String -> Maybe BuildSystem -> InstallDir -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError, BuildFailed, UninstallFailed, MergeFileTreeError, URIParseError] m GHCTargetVersion
- GHCup.GHC: fetchGHCSrc :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload] m FilePath
+ GHCup.GHC: fetchGHCSrc :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> Maybe FilePath -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, URIParseError] m FilePath
- GHCup.GHC: installGHCBin :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, Alternative m) => GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, NoCompatiblePlatform, ParseError, UnsupportedSetupCombo, DistroNotFound, NoCompatibleArch] m ()
+ GHCup.GHC: installGHCBin :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, Alternative m) => GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, NoCompatiblePlatform, ParseError, UnsupportedSetupCombo, DistroNotFound, NoCompatibleArch, URIParseError] m ()
- GHCup.GHC: installGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError] m ()
+ GHCup.GHC: installGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> InstallDir -> Bool -> [Text] -> Text -> Excepts '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup.GHC: installPackedGHC :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m, MonadResource m) => FilePath -> Maybe TarDir -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Excepts '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, MergeFileTreeError] m ()
+ GHCup.GHC: installPackedGHC :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadFail m, MonadResource m) => FilePath -> Maybe TarDir -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Text -> Excepts '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError, MergeFileTreeError] m ()
- GHCup.GHC: installUnpackedGHC :: (MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) => GHCupPath -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Excepts '[ProcessError, MergeFileTreeError] m ()
+ GHCup.GHC: installUnpackedGHC :: (MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) => GHCupPath -> InstallDirResolved -> GHCTargetVersion -> Bool -> [Text] -> Text -> Excepts '[ProcessError, MergeFileTreeError] m ()
- GHCup.GHC: testGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed] m ()
+ GHCup.GHC: testGHCBindist :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => DownloadInfo -> GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed, URIParseError] m ()
- GHCup.GHC: testGHCVer :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed] m ()
+ GHCup.GHC: testGHCVer :: (MonadFail m, MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) => GHCTargetVersion -> [Text] -> Excepts '[DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive, TestFailed, URIParseError] m ()
- GHCup.HLS: compileHLS :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => HLSVer -> [Version] -> Maybe Int -> Maybe [VersionPattern] -> InstallDir -> Maybe (Either FilePath URI) -> Maybe URI -> Bool -> Maybe (Either FilePath [URI]) -> [Text] -> Excepts '[NoDownload, GPGError, DownloadFailed, DigestError, ContentLengthError, UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed, NotInstalled] m Version
+ GHCup.HLS: compileHLS :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => HLSVer -> [Version] -> Maybe Int -> Maybe [VersionPattern] -> InstallDir -> Maybe (Either FilePath URI) -> Maybe URI -> Bool -> Maybe (Either FilePath [URI]) -> [Text] -> Excepts '[NoDownload, GPGError, DownloadFailed, DigestError, ContentLengthError, UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed, NotInstalled, URIParseError] m Version
- GHCup.HLS: installHLSBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError] m ()
+ GHCup.HLS: installHLSBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup.HLS: installHLSBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError] m ()
+ GHCup.HLS: installHLSBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError, URIParseError] m ()
- GHCup.Stack: installStackBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError] m ()
+ GHCup.Stack: installStackBin :: (MonadMask m, MonadCatch m, MonadReader env m, HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, URIParseError] m ()
- GHCup.Stack: installStackBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError] m ()
+ GHCup.Stack: installStackBindist :: (MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env, HasDirs env, HasSettings env, HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) => DownloadInfo -> Version -> InstallDir -> Bool -> Excepts '[AlreadyInstalled, CopyError, DigestError, ContentLengthError, GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError, URIParseError] m ()
- GHCup.Types: DebugInfo :: FilePath -> FilePath -> FilePath -> FilePath -> Architecture -> PlatformResult -> DebugInfo
+ GHCup.Types: DebugInfo :: Dirs -> Architecture -> PlatformResult -> [(ChannelAlias, URI)] -> URI -> DebugInfo
- GHCup.Types: DownloadInfo :: URI -> Maybe TarDir -> Text -> Maybe Integer -> Maybe FilePath -> Maybe [Tag] -> DownloadInfo
+ GHCup.Types: DownloadInfo :: Text -> Maybe TarDir -> Text -> Maybe Integer -> Maybe FilePath -> Maybe [Tag] -> DownloadInfo
- GHCup.Types: Settings :: Bool -> Integer -> MetaMode -> Bool -> KeepDirs -> Downloader -> Bool -> [NewURLSource] -> Bool -> GPGSetting -> Bool -> Maybe PlatformRequest -> DownloadMirrors -> [String] -> PagerConfig -> Settings
+ GHCup.Types: Settings :: Bool -> Integer -> MetaMode -> Bool -> KeepDirs -> Downloader -> Bool -> [NewURLSource] -> Bool -> GPGSetting -> Bool -> Maybe PlatformRequest -> DownloadMirrors -> [String] -> PagerConfig -> Bool -> Settings
- GHCup.Types: UserSettings :: Maybe Bool -> Maybe Integer -> Maybe MetaMode -> Maybe Bool -> Maybe Bool -> Maybe KeepDirs -> Maybe Downloader -> Maybe UserKeyBindings -> Maybe URLSource -> Maybe Bool -> Maybe GPGSetting -> Maybe PlatformRequest -> Maybe DownloadMirrors -> Maybe [String] -> Maybe PagerConfig -> UserSettings
+ GHCup.Types: UserSettings :: Maybe Bool -> Maybe Integer -> Maybe MetaMode -> Maybe Bool -> Maybe Bool -> Maybe KeepDirs -> Maybe Downloader -> Maybe UserKeyBindings -> Maybe URLSource -> Maybe Bool -> Maybe GPGSetting -> Maybe PlatformRequest -> Maybe DownloadMirrors -> Maybe [String] -> Maybe PagerConfig -> Maybe Bool -> UserSettings
- GHCup.Types: [$sel:_dlUri:DownloadInfo] :: DownloadInfo -> URI
+ GHCup.Types: [$sel:_dlUri:DownloadInfo] :: DownloadInfo -> Text
- GHCup.Types.Optics: dlUri :: Lens' DownloadInfo URI
+ GHCup.Types.Optics: dlUri :: Lens' DownloadInfo Text
- GHCup.Utils: ensureShimGen :: (MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadReader env m, HasDirs env, HasSettings env, HasGHCupInfo env, MonadUnliftIO m, MonadFail m) => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
+ GHCup.Utils: ensureShimGen :: (MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadReader env m, HasDirs env, HasSettings env, HasGHCupInfo env, MonadUnliftIO m, MonadFail m) => Excepts '[URIParseError, GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
- GHCup.Utils.Parsers: fromVersion :: (HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env, HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) => Maybe ToolVersion -> Tool -> Excepts '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
+ GHCup.Utils.Parsers: fromVersion :: (HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env, HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) => Maybe ToolVersion -> GuessMode -> Tool -> Excepts '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
- GHCup.Utils.Parsers: fromVersion' :: (HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env, HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) => SetToolVersion -> Tool -> Excepts '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
+ GHCup.Utils.Parsers: fromVersion' :: (HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env, HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) => SetToolVersion -> GuessMode -> Tool -> Excepts '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo)
- GHCup.Utils.URI: parseURI' :: Parser (URIRef Absolute)
+ GHCup.Utils.URI: parseURI' :: Text -> Either URIParseError (URIRef Absolute)
Files
- CHANGELOG.md +10/−0
- README.md +1/−0
- app/ghcup/Main.hs +6/−5
- ghcup.cabal +53/−40
- lib-opt/GHCup/OptParse.hs +3/−1
- lib-opt/GHCup/OptParse/Compile.hs +16/−2
- lib-opt/GHCup/OptParse/Config.hs +2/−1
- lib-opt/GHCup/OptParse/DInfo.hs +31/−9
- lib-opt/GHCup/OptParse/Install.hs +25/−12
- lib-opt/GHCup/OptParse/Prefetch.hs +10/−5
- lib-opt/GHCup/OptParse/Rm.hs +8/−7
- lib-opt/GHCup/OptParse/Run.hs +11/−5
- lib-opt/GHCup/OptParse/Set.hs +8/−5
- lib-opt/GHCup/OptParse/Test.hs +7/−3
- lib-opt/GHCup/OptParse/Upgrade.hs +1/−0
- lib-opt/GHCup/OptParse/Whereis.hs +5/−2
- lib-tui/GHCup/Brick/Actions.hs +53/−11
- lib-tui/GHCup/Brick/Common.hs +4/−1
- lib-tui/GHCup/Brick/Widgets/Menu.hs +11/−6
- lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs +8/−1
- lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs +7/−0
- lib/GHCup.hs +8/−6
- lib/GHCup/Cabal.hs +2/−0
- lib/GHCup/Download.hs +10/−8
- lib/GHCup/Errors.hs +3/−5
- lib/GHCup/GHC.hs +22/−10
- lib/GHCup/HLS.hs +3/−0
- lib/GHCup/List.hs +16/−14
- lib/GHCup/Prelude/MegaParsec.hs +14/−1
- lib/GHCup/Stack.hs +2/−0
- lib/GHCup/Types.hs +25/−10
- lib/GHCup/Types/JSON.hs +10/−17
- lib/GHCup/Utils.hs +5/−22
- lib/GHCup/Utils/Parsers.hs +103/−32
- lib/GHCup/Utils/URI.hs +10/−3
- lib/GHCup/Version.hs +2/−0
- scripts/bootstrap/bootstrap-haskell +161/−5
- test/ghcup-test/GHCup/ParserSpec.hs +60/−0
- test/optparse-test/CompileTest.hs +1/−0
- test/optparse-test/ConfigTest.hs +6/−0
- test/optparse-test/InstallTest.hs +3/−3
CHANGELOG.md view
@@ -1,5 +1,15 @@ # Revision history for ghcup +## 0.1.50.0 -- 2025-03-23++* Fix logic when guessing incomplete PVP versions, fixes [#1243](https://github.com/haskell/ghcup-hs/pull/1243)+* Speed up metadata parsing significantly wrt [#1213](https://github.com/haskell/ghcup-hs/issues/1213)+* Implement "install targets", fixes [#1210](https://github.com/haskell/ghcup-hs/issues/1210)+* Add `default` channel alias wrt [#1196](https://github.com/haskell/ghcup-hs/pull/1196)+* Print post rm messages in TUI wrt [#1202](https://github.com/haskell/ghcup-hs/pull/1202)+* Print pre install messages in TUI wrt [#1241](https://github.com/haskell/ghcup-hs/issues/1241)+* Fix handling of 'ghc' subdir in parser for obtaining set ghc version wrt [#1215](https://github.com/haskell/ghcup-hs/issues/1215)+ ## 0.1.40.0 -- 2025-01-01 ### New features
README.md view
@@ -15,4 +15,5 @@ * [the metadata YAML files](https://github.com/haskell/ghcup-metadata) * [homepage and documentation](https://github.com/haskell/ghcup-www) * [docker images](https://github.com/haskell/ghcup-docker)+* [github action](https://github.com/haskell/ghcup-setup)
app/ghcup/Main.hs view
@@ -98,6 +98,7 @@ pager = case fromMaybe (fromMaybe (Types.pager defaultSettings) uPager) (flip PagerConfig Nothing <$> optPager) of PagerConfig b Nothing -> PagerConfig b pagerCmd x -> x+ guessVersion = fromMaybe (fromMaybe (Types.guessVersion defaultSettings) uGuessVersion) optGuessVersion in (Settings {..}, keyBindings) #if defined(INTERNAL_DOWNLOADER) defaultDownloader = Internal@@ -310,7 +311,7 @@ Install installCommand -> install installCommand settings appState runLogger InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) settings appState runLogger Test testCommand -> test testCommand settings appState runLogger- Set setCommand -> set setCommand runAppState runLeanAppState runLogger+ Set setCommand -> set setCommand settings runAppState runLeanAppState runLogger UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger List lo -> list lo no_color (pager settings) runAppState Rm rmCommand -> rm rmCommand runAppState runLogger@@ -318,14 +319,14 @@ Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger Config configCommand -> config configCommand settings userConf keybindings runLogger Whereis whereisOptions- whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger+ whereisCommand -> whereis whereisCommand whereisOptions settings runAppState leanAppstate runLogger Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger ToolRequirements topts -> toolRequirements topts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger Nuke -> nuke appState runLogger- Prefetch pfCom -> prefetch pfCom runAppState runLogger+ Prefetch pfCom -> prefetch pfCom settings runAppState runLogger GC gcOpts -> gc gcOpts runAppState runLogger- Run runCommand -> run runCommand appState leanAppstate runLogger+ Run runCommand -> run runCommand settings appState leanAppstate runLogger PrintAppErrors -> putStrLn allHFError >> pure ExitSuccess case res of@@ -391,6 +392,6 @@ , NoToolVersionSet ] m Bool cmp' tool instVer ver = do- (v, _) <- liftE $ fromVersion instVer tool+ (v, _) <- liftE $ fromVersion instVer GLax tool pure (v == ver)
ghcup.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghcup-version: 0.1.40.0+version: 0.1.50.0 license: LGPL-3.0-only license-file: LICENSE copyright: Julian Ospald 2024@@ -77,7 +77,19 @@ default: False manual: True +flag yaml-streamly+ description: Use yaml-streamly instead of yaml (based on conduit)+ default: False+ manual: True++common common-ghc-options+ ghc-options:+ -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns+ -fwarn-incomplete-record-updates -Werror=incomplete-patterns+ common app-common-depends+ import: common-ghc-options+ build-depends: , aeson >=1.4 , aeson-pretty ^>=0.8.8@@ -85,8 +97,8 @@ , attoparsec ^>= 0.14 , base >=4.12 && <5 , bytestring >=0.10 && <0.13- , containers ^>=0.6- , deepseq ^>=1.4 || ^>=1.5+ , containers ^>=0.6 || ^>=0.7+ , deepseq ^>=1.4 || ^>=1.5 || ^>=1.6 , directory ^>=1.3.6.0 , filepath >=1.4.101.0 , variant ^>=1.0@@ -102,17 +114,23 @@ , safe-exceptions ^>=0.1 , tagsoup ^>=0.14 , transformers ^>=0.5 || ^>=0.6- , template-haskell >=2.7 && <2.23+ , template-haskell >=2.7 && <2.24 , temporary ^>=1.3 , text ^>=2.0 || ^>=2.1- , time >=1.9.3 && <1.13+ , time >=1.9.3 && <1.15 , unordered-containers ^>=0.2- , uri-bytestring ^>=0.3.2.2+ , uri-bytestring ^>=0.4.0.0 , utf8-string ^>=1.0 , vector >=0.12 && <0.14 , versions >=6.0.5 && <6.1- , yaml ^>=0.11.0 + if flag(yaml-streamly)+ build-depends:+ yaml-streamly ^>=0.12.5+ else+ build-depends:+ yaml ^>=0.11.0+ if flag(tar) cpp-options: -DTAR build-depends:@@ -186,28 +204,24 @@ TypeFamilies ViewPatterns - ghc-options:- -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates- build-depends: , aeson >=1.4 , async >=0.8 && <2.3 , attoparsec ^>= 0.14 , base >=4.12 && <5 , base16-bytestring >=0.1.1.6 && <1.1- , binary ^>=0.8.6.0+ , binary ^>=0.8.6.0 || ^>=0.9 || ^>=0.10 , bytestring >=0.10 && <0.13 , bz2 ^>=1.0.1.1- , Cabal ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0- , Cabal-syntax ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0+ , Cabal ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0+ , Cabal-syntax ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0 , case-insensitive ^>=1.2.1.0 , casing ^>=0.1.4.1- , containers ^>=0.6+ , containers ^>=0.6 || ^>=0.7 , conduit ^>=1.3 , conduit-extra ^>=1.3 , cryptohash-sha256 ^>=0.11.101.0- , deepseq ^>=1.4.4.0 || ^>=1.5+ , deepseq ^>=1.4 || ^>=1.5 || ^>=1.6 , directory ^>=1.3.6.0 , disk-free-space ^>=0.1.0.1 , exceptions ^>=0.10@@ -229,22 +243,28 @@ , safe-exceptions ^>=0.1 , split ^>=0.2.3.4 , strict-base ^>=0.4- , template-haskell >=2.7 && <2.23+ , template-haskell >=2.7 && <2.24 , temporary ^>=1.3 , terminal-size ^>=0.3.3 , text ^>=2.0 || ^>=2.1- , time >=1.9.3 && <1.13+ , time >=1.9.3 && <1.15 , transformers ^>=0.5 || ^>=0.6 , unliftio-core ^>=0.2.0.1 , unordered-containers ^>=0.2.10.0- , uri-bytestring ^>=0.3.2.2+ , uri-bytestring ^>=0.4.0.0 , utf8-string ^>=1.0 , vector >=0.12 && <0.14 , versions >=6.0.5 && <6.1 , word8 ^>=0.1.3- , yaml ^>=0.11.0- , zlib ^>=0.6.2.2+ , zlib ^>=0.6.2.2 || ^>=0.7 + if flag(yaml-streamly)+ build-depends:+ yaml-streamly ^>=0.12.5+ else+ build-depends:+ yaml ^>=0.11.0+ if flag(tar) cpp-options: -DTAR build-depends:@@ -333,10 +353,6 @@ StrictData TupleSections - ghc-options:- -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates- build-depends: ghcup if flag(internal-downloader)@@ -382,13 +398,9 @@ StrictData TupleSections - ghc-options:- -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates- build-depends: , ghcup- , brick ^>=2.1+ , brick >=2.1 && <2.8 , vty ^>=6.0 || ^>=6.1 || ^>=6.2 if !flag(tui)@@ -417,8 +429,7 @@ TupleSections ghc-options:- -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates -threaded+ -threaded build-depends: , ghcup@@ -442,6 +453,7 @@ buildable: False test-suite ghcup-test+ import: common-ghc-options type: exitcode-stdio-1.0 main-is: Main.hs build-tool-depends: hspec-discover:hspec-discover -any@@ -451,6 +463,7 @@ GHCup.Prelude.File.Posix.TraversalsSpec GHCup.Types.JSONSpec GHCup.Utils.FileSpec+ GHCup.ParserSpec Spec default-language: Haskell2010@@ -463,25 +476,25 @@ TupleSections ghc-options:- -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates+ -fconstraint-solver-iterations=0 build-depends: , base >=4.12 && <5 , bytestring >=0.10 && <0.13- , containers ^>=0.6+ , containers ^>=0.6 || ^>=0.7 , conduit ^>=1.3 , directory ^>=1.3.6.0 , filepath >=1.4.101.0- , generic-arbitrary ^>=0.1.0 || ^>=0.2.2+ , generic-arbitrary ^>=0.1.0 || ^>=0.2.2 || ^>=1.0.0 , ghcup , hspec >=2.7.10 && <2.12 , hspec-golden-aeson ^>=0.9- , QuickCheck ^>=2.14.1+ , megaparsec >=8.0.0 && <9.8+ , QuickCheck ^>=2.14.1 || ^>=2.15 , quickcheck-arbitrary-adt ^>=0.3.1.0 , text ^>=2.0 || ^>=2.1- , time >=1.9.3 && <1.13- , uri-bytestring ^>=0.3.2.2+ , time >=1.9.3 && <1.15+ , uri-bytestring ^>=0.4.0.0 , versions >=6.0.5 && <6.1 if os(windows)@@ -491,6 +504,7 @@ build-depends: unix ^>=2.7 || ^>=2.8 test-suite ghcup-optparse-test+ import: common-ghc-options type: exitcode-stdio-1.0 hs-source-dirs: test/optparse-test main-is: Main.hs@@ -514,7 +528,6 @@ cpp-options: -DIS_WINDOWS default-language: Haskell2010- ghc-options: -Wall build-depends: , base , ghcup
lib-opt/GHCup/OptParse.hs view
@@ -89,6 +89,7 @@ , optGpg :: Maybe GPGSetting , optStackSetup :: Maybe Bool , optPager :: Maybe Bool+ , optGuessVersion :: Maybe Bool -- commands , optCommand :: Command }@@ -143,7 +144,7 @@ (eitherReader parseUrlSource) ( short 's' <> long "url-source"- <> metavar "<URL_SOURCE|cross|prereleases|vanilla>"+ <> metavar "<URL_SOURCE|cross|prereleases|vanilla|default>" <> help "Alternative ghcup download info" <> internal <> completer urlSourceCompleter@@ -186,6 +187,7 @@ )) <*> invertableSwitch "stack-setup" Nothing False (help "Use stack's setup info for discovering and installing GHC versions") <*> (invertableSwitch "paginate" Nothing False (help "Send output (e.g. from 'ghcup list') through pager (default: disabled)"))+ <*> invertableSwitch "guess-version" Nothing True (help "Whether to guess the full version from an incomplete tool version, e.g. GHC '9.12' resolving to '9.12.2'") <*> com
lib-opt/GHCup/OptParse/Compile.hs view
@@ -81,6 +81,7 @@ , buildFlavour :: Maybe String , buildSystem :: Maybe BuildSystem , isolateDir :: Maybe FilePath+ , installTargets :: T.Text } deriving (Eq, Show) @@ -166,7 +167,7 @@ ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts =- (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir -> GHCCompileOptions {..})+ (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir installTargets -> GHCCompileOptions {..}) <$> ((GHC.SourceDist <$> option (eitherReader (first (const "Not a valid version") . version . T.pack)@@ -315,6 +316,13 @@ <> completer (bashCompleter "directory") ) )+ <*> strOption+ ( long "install-targets"+ <> metavar "TARGETS"+ <> help "Space separated list of install targets (default: install)"+ <> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"])+ <> value "install"+ ) hlsCompileOpts :: Parser HLSCompileOptions hlsCompileOpts =@@ -479,6 +487,7 @@ , BuildFailed , UninstallFailed , MergeFileTreeError+ , URIParseError ] type HLSEffects = '[ AlreadyInstalled , BuildFailed@@ -501,6 +510,7 @@ , ArchiveResult , UninstallFailed , MergeFileTreeError+ , URIParseError ] @@ -563,7 +573,7 @@ "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene _ -> pure ()- ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)+ ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) guessMode $ GHC) targetVer <- liftE $ compileHLS targetHLS ghcs@@ -630,6 +640,7 @@ buildFlavour buildSystem (maybe GHCupInternal IsolateDir isolateDir)+ installTargets GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo targetVer GHC dls when setCompile $ void $ liftE $@@ -663,3 +674,6 @@ VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e pure $ ExitFailure 9+ where+ guessMode = if guessVersion settings then GLaxWithInstalled else GStrict+
lib-opt/GHCup/OptParse/Config.hs view
@@ -147,7 +147,8 @@ mirrors' = uMirrors usl <|> uMirrors usr defGHCconfOptions' = uDefGHCConfOptions usl <|> uDefGHCConfOptions usr pagerConfig' = uPager usl <|> uPager usr- in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' defGHCconfOptions' pagerConfig'+ guessVersion' = uGuessVersion usl <|> uGuessVersion usr+ in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' defGHCconfOptions' pagerConfig' guessVersion' where updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings updateKeyBindings Nothing Nothing = Nothing
lib-opt/GHCup/OptParse/DInfo.hs view
@@ -29,11 +29,14 @@ import Control.Monad.Trans.Resource import Data.Functor import Data.Maybe+import Data.List ( intercalate ) import Data.Variant.Excepts import Options.Applicative hiding ( style ) import Prelude hiding ( appendFile ) import System.Exit+import System.FilePath import Text.PrettyPrint.HughesPJClass ( prettyShow )+import URI.ByteString (serializeURIRef') import qualified Data.Text as T import Control.Exception.Safe (MonadMask)@@ -63,15 +66,34 @@ prettyDebugInfo :: DebugInfo -> String-prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>- "==========" <> "\n" <>- "GHCup base dir: " <> diBaseDir <> "\n" <>- "GHCup bin dir: " <> diBinDir <> "\n" <>- "GHCup GHC directory: " <> diGHCDir <> "\n" <>- "GHCup cache directory: " <> diCacheDir <> "\n" <>- "Architecture: " <> prettyShow diArch <> "\n" <>- "Platform: " <> prettyShow diPlatform <> "\n" <>- "Version: " <> describe_result+prettyDebugInfo DebugInfo { diDirs = Dirs { .. }, ..} =+ "===== Main ======" <> "\n" <>+ "Architecture: " <> prettyShow diArch <> "\n" <>+ "Platform: " <> prettyShow diPlatform <> "\n" <>+ "GHCup Version: " <> describe_result <> "\n" <>+ "===== Directories ======" <> "\n" <>+ "base: " <> fromGHCupPath baseDir <> "\n" <>+ "bin: " <> binDir <> "\n" <>+ "GHCs: " <> (fromGHCupPath baseDir </> "ghc") <> "\n" <>+ "cache: " <> fromGHCupPath cacheDir <> "\n" <>+ "logs: " <> fromGHCupPath logsDir <> "\n" <>+ "config: " <> fromGHCupPath confDir <> "\n" <>+ "db: " <> fromGHCupPath dbDir <> "\n" <>+ whenWin ("recycle: " <> fromGHCupPath recycleDir <> "\n") <>+ "temp: " <> fromGHCupPath tmpDir <> "\n" <>+ whenWin ("msys2: " <> msys2Dir <> "\n") <>+ "\n===== Metadata ======\n" <>+ intercalate "\n" ((\(c, u) -> pad (c <> ":") <> " " <> u) <$> channels)+ where+ pad xs+ | xl < maxLength = xs <> replicate (maxLength - xl) ' '+ | otherwise = xs+ where+ xl = length xs+ channels = (\(c, u) -> (T.unpack . channelAliasText $ c, T.unpack . decUTF8Safe . serializeURIRef'$ u)) <$> diChannels+ maxLength = (+1) . maximum . fmap (length . fst) $ channels+ whenWin x = if isWindows then x else mempty+
lib-opt/GHCup/OptParse/Install.hs view
@@ -71,6 +71,7 @@ , instSet :: Bool , isolateDir :: Maybe FilePath , forceInstall :: Bool+ , installTargets :: T.Text , addConfArgs :: [T.Text] } deriving (Eq, Show) @@ -207,6 +208,13 @@ ) <*> switch (short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")+ <*> strOption+ ( long "install-targets"+ <> metavar "TARGETS"+ <> help "Space separated list of install targets (default: install)"+ <> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"])+ <> value "install"+ ) <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)")) where setDefault = case tool of@@ -259,6 +267,7 @@ , UninstallFailed , MergeFileTreeError , InstallSetError+ , URIParseError ] @@ -300,6 +309,7 @@ , UnsupportedSetupCombo , DistroNotFound , NoCompatibleArch+ , URIParseError ] runInstGHC :: AppState@@ -327,12 +337,13 @@ (Left (InstallHLS iopts)) -> installHLS iopts (Left (InstallStack iopts)) -> installStack iopts where+ guessMode = if guessVersion settings then GLax else GStrict installGHC :: InstallOptions -> IO ExitCode installGHC InstallOptions{..} = do s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' (case instBindist of Nothing -> runInstGHC s' $ do- (v, vi) <- liftE $ fromVersion instVer GHC+ (v, vi) <- liftE $ fromVersion instVer guessMode GHC forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn@@ -343,23 +354,25 @@ (maybe GHCupInternal IsolateDir isolateDir) forceInstall addConfArgs+ installTargets ) $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing pure vi Just uri -> do runInstGHC s'{ settings = settings {noVerify = True}} $ do- (v, vi) <- liftE $ fromVersion instVer GHC+ (v, vi) <- liftE $ fromVersion instVer guessMode GHC forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- give the user a sec to intervene liftE $ runBothE' (installGHCBindist- (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) (Just $ RegexDir "ghc-.*") "" Nothing Nothing Nothing) v (maybe GHCupInternal IsolateDir isolateDir) forceInstall addConfArgs+ installTargets ) $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing pure vi@@ -414,7 +427,7 @@ s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' (case instBindist of Nothing -> runInstTool s' $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode Cabal forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn@@ -428,14 +441,14 @@ pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode Cabal forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- give the user a sec to intervene liftE $ runBothE' (installCabalBindist- (DownloadInfo uri Nothing "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) Nothing "" Nothing Nothing Nothing) v (maybe GHCupInternal IsolateDir isolateDir) forceInstall@@ -473,7 +486,7 @@ s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' (case instBindist of Nothing -> runInstTool s' $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode HLS forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn@@ -487,7 +500,7 @@ pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode HLS forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn@@ -495,7 +508,7 @@ liftIO $ threadDelay 5000000 -- give the user a sec to intervene -- TODO: support legacy liftE $ runBothE' (installHLSBindist- (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing Nothing) v (maybe GHCupInternal IsolateDir isolateDir) forceInstall@@ -533,7 +546,7 @@ s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' (case instBindist of Nothing -> runInstTool s' $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode Stack forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn@@ -547,14 +560,14 @@ pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} $ do- (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack+ (_tvVersion -> v, vi) <- liftE $ fromVersion instVer guessMode Stack forM_ (_viPreInstall =<< vi) $ \msg -> do lift $ logWarn msg lift $ logWarn "...waiting for 5 seconds, you can still abort..." liftIO $ threadDelay 5000000 -- give the user a sec to intervene liftE $ runBothE' (installStackBindist- (DownloadInfo uri Nothing "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) Nothing "" Nothing Nothing Nothing) v (maybe GHCupInternal IsolateDir isolateDir) forceInstall
lib-opt/GHCup/OptParse/Prefetch.hs view
@@ -162,6 +162,7 @@ , JSONError , FileDoesNotExistError , StackPlatformDetectError+ , URIParseError ] @@ -189,30 +190,31 @@ , MonadFail m ) => PrefetchCommand+ -> Settings -> (forall a. ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a)) -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode-prefetch prefetchCommand runAppState runLogger =+prefetch prefetchCommand settings runAppState runLogger = runPrefetch runAppState (do case prefetchCommand of PrefetchGHC (PrefetchGHCOptions pfGHCSrc pfCacheDir) mt -> do forM_ pfCacheDir (liftIO . createDirRecursive')- (v, _) <- liftE $ fromVersion mt GHC+ (v, _) <- liftE $ fromVersion mt guessMode GHC if pfGHCSrc then liftE $ fetchGHCSrc v pfCacheDir else liftE $ fetchToolBindist v GHC pfCacheDir PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do forM_ pfCacheDir (liftIO . createDirRecursive')- (v, _) <- liftE $ fromVersion mt Cabal+ (v, _) <- liftE $ fromVersion mt guessMode Cabal liftE $ fetchToolBindist v Cabal pfCacheDir PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do forM_ pfCacheDir (liftIO . createDirRecursive')- (v, _) <- liftE $ fromVersion mt HLS+ (v, _) <- liftE $ fromVersion mt guessMode HLS liftE $ fetchToolBindist v HLS pfCacheDir PrefetchStack PrefetchOptions {pfCacheDir} mt -> do forM_ pfCacheDir (liftIO . createDirRecursive')- (v, _) <- liftE $ fromVersion mt Stack+ (v, _) <- liftE $ fromVersion mt guessMode Stack liftE $ fetchToolBindist v Stack pfCacheDir PrefetchMetadata -> do pfreq <- lift getPlatformReq@@ -224,3 +226,6 @@ VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e pure $ ExitFailure 15++ where+ guessMode = if guessVersion settings then GLaxWithInstalled else GStrict
lib-opt/GHCup/OptParse/Rm.hs view
@@ -35,6 +35,7 @@ import Options.Applicative hiding ( style ) import Prelude hiding ( appendFile ) import System.Exit+import Text.PrettyPrint.HughesPJClass ( prettyShow ) import qualified Data.Text as T import Control.Exception.Safe (MonadMask)@@ -176,8 +177,8 @@ ) >>= \case VRight vi -> do+ postRmLog (tVerToText ghcVer) GHC vi runLogger $ logGHCPostRm ghcVer- postRmLog vi pure ExitSuccess VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e@@ -192,7 +193,7 @@ ) >>= \case VRight vi -> do- postRmLog vi+ postRmLog (prettyVer tv) Cabal vi pure ExitSuccess VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e@@ -207,7 +208,7 @@ ) >>= \case VRight vi -> do- postRmLog vi+ postRmLog (prettyVer tv) HLS vi pure ExitSuccess VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e@@ -222,12 +223,12 @@ ) >>= \case VRight vi -> do- postRmLog vi+ postRmLog (prettyVer tv) Stack vi pure ExitSuccess VLeft e -> do runLogger $ logError $ T.pack $ prettyHFError e pure $ ExitFailure 15 - postRmLog vi =- forM_ (_viPostRemove =<< vi) $ \msg ->- runLogger $ logInfo msg+ postRmLog tv tool vi = runLogger $ do+ logInfo $ "Successfuly removed " <> T.pack (prettyShow tool) <> " " <> tv+ forM_ (_viPostRemove =<< vi) logInfo
lib-opt/GHCup/OptParse/Run.hs view
@@ -193,6 +193,7 @@ , UnsupportedSetupCombo , DistroNotFound , NoCompatibleArch+ , URIParseError ] runLeanRUN :: (MonadUnliftIO m, MonadIO m)@@ -235,11 +236,12 @@ , Alternative m ) => RunOptions+ -> Settings -> IO AppState -> LeanAppState -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode-run RunOptions{..} runAppState leanAppstate runLogger = do+run RunOptions{..} settings runAppState leanAppstate runLogger = do r <- if not runQuick then runRUN runAppState $ do toolchain <- liftE resolveToolchainFull@@ -285,6 +287,8 @@ where + guessMode = if guessVersion settings then GLaxWithInstalled else GStrict+ -- TODO: doesn't work for cross resolveToolchainFull :: ( MonadFail m , MonadThrow m@@ -299,16 +303,16 @@ ] (ResourceT (ReaderT AppState m)) Toolchain resolveToolchainFull = do ghcVer <- forM runGHCVer $ \ver -> do- (v, _) <- liftE $ fromVersion (Just ver) GHC+ (v, _) <- liftE $ fromVersion (Just ver) guessMode GHC pure v cabalVer <- forM runCabalVer $ \ver -> do- (v, _) <- liftE $ fromVersion (Just ver) Cabal+ (v, _) <- liftE $ fromVersion (Just ver) guessMode Cabal pure (_tvVersion v) hlsVer <- forM runHLSVer $ \ver -> do- (v, _) <- liftE $ fromVersion (Just ver) HLS+ (v, _) <- liftE $ fromVersion (Just ver) guessMode HLS pure (_tvVersion v) stackVer <- forM runStackVer $ \ver -> do- (v, _) <- liftE $ fromVersion (Just ver) Stack+ (v, _) <- liftE $ fromVersion (Just ver) guessMode Stack pure (_tvVersion v) pure Toolchain{..} @@ -370,6 +374,7 @@ , UnsupportedSetupCombo , DistroNotFound , NoCompatibleArch+ , URIParseError ] (ResourceT (ReaderT AppState m)) () installToolChainFull Toolchain{..} tmp = do case ghcVer of@@ -380,6 +385,7 @@ GHCupInternal False []+ (T.pack "install") setGHC' v tmp _ -> pure () case cabalVer of
lib-opt/GHCup/OptParse/Set.hs view
@@ -259,13 +259,14 @@ , HasLog env ) => Either SetCommand SetOptions+ -> Settings -> (forall eff . ReaderT AppState m (VEither eff GHCTargetVersion) -> m (VEither eff GHCTargetVersion)) -> (forall eff. ReaderT env m (VEither eff GHCTargetVersion) -> m (VEither eff GHCTargetVersion)) -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode-set setCommand runAppState _ runLogger = case setCommand of+set setCommand settings runAppState _ runLogger = case setCommand of (Right sopts) -> do runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.") setGHC' sopts@@ -275,10 +276,12 @@ (Left (SetStack sopts)) -> setStack' sopts where+ guessMode = if guessVersion settings then GLaxWithInstalled else GStrict+ setGHC' :: SetOptions -> m ExitCode setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do- v <- liftE $ fst <$> fromVersion' sToolVer GHC+ v <- liftE $ fst <$> fromVersion' sToolVer guessMode GHC liftE $ setGHC v SetGHCOnly Nothing ) >>= \case@@ -295,7 +298,7 @@ setCabal' :: SetOptions -> m ExitCode setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do- v <- liftE $ fst <$> fromVersion' sToolVer Cabal+ v <- liftE $ fst <$> fromVersion' sToolVer guessMode Cabal liftE $ setCabal (_tvVersion v) pure v )@@ -312,7 +315,7 @@ setHLS' :: SetOptions -> m ExitCode setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do- v <- liftE $ fst <$> fromVersion' sToolVer HLS+ v <- liftE $ fst <$> fromVersion' sToolVer guessMode HLS liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing pure v )@@ -330,7 +333,7 @@ setStack' :: SetOptions -> m ExitCode setStack' SetOptions{ sToolVer } = runSetStack runAppState (do- v <- liftE $ fst <$> fromVersion' sToolVer Stack+ v <- liftE $ fst <$> fromVersion' sToolVer guessMode Stack liftE $ setStack (_tvVersion v) pure v )
lib-opt/GHCup/OptParse/Test.hs view
@@ -21,6 +21,7 @@ import GHCup.Types import GHCup.Utils.Dirs import GHCup.Utils.Parsers (fromVersion, uriParser)+import GHCup.Prelude import GHCup.Prelude.Logger import GHCup.Prelude.String.QQ @@ -142,6 +143,7 @@ , TagNotFound , DayNotFound , NoToolVersionSet+ , URIParseError ] runTestGHC :: AppState@@ -163,18 +165,20 @@ test testCommand settings getAppState' runLogger = case testCommand of (TestGHC iopts) -> go iopts where+ guessMode = if guessVersion settings then GLaxWithInstalled else GStrict+ go :: TestOptions -> IO ExitCode go TestOptions{..} = do s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' (case testBindist of Nothing -> runTestGHC s' $ do- (v, vi) <- liftE $ fromVersion testVer GHC+ (v, vi) <- liftE $ fromVersion testVer guessMode GHC liftE $ testGHCVer v addMakeArgs pure vi Just uri -> do runTestGHC s'{ settings = settings {noVerify = True}} $ do- (v, vi) <- liftE $ fromVersion testVer GHC- liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing Nothing) v addMakeArgs+ (v, vi) <- liftE $ fromVersion testVer guessMode GHC+ liftE $ testGHCBindist (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) (Just $ RegexDir ".*/.*") "" Nothing Nothing Nothing) v addMakeArgs pure vi ) >>= \case
lib-opt/GHCup/OptParse/Upgrade.hs view
@@ -97,6 +97,7 @@ , CopyError , DownloadFailed , ToolShadowed+ , URIParseError ]
lib-opt/GHCup/OptParse/Whereis.hs view
@@ -264,11 +264,12 @@ ) => WhereisCommand -> WhereisOptions+ -> Settings -> (forall a. ReaderT AppState m (VEither WhereisEffects a) -> m (VEither WhereisEffects a)) -> LeanAppState -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode-whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do+whereis whereisCommand whereisOptions settings runAppState leanAppstate runLogger = do Dirs{ .. } <- runReaderT getDirs leanAppstate case (whereisCommand, whereisOptions) of (WhereisTool GHCup _, WhereisOptions{..}) -> do@@ -309,7 +310,7 @@ (WhereisTool tool whereVer, WhereisOptions{..}) -> do runWhereIs runAppState (do- (v, _) <- liftE $ fromVersion whereVer tool+ (v, _) <- liftE $ fromVersion whereVer guessMode tool loc <- liftE $ whereIsTool tool v if directory then pure $ takeDirectory loc@@ -342,3 +343,5 @@ (WhereisConfDir, _) -> do liftIO $ putStr $ fromGHCupPath confDir pure ExitSuccess+ where+ guessMode = if guessVersion settings then GLaxWithInstalled else GStrict
lib-tui/GHCup/Brick/Actions.hs view
@@ -193,6 +193,7 @@ shouldForce = opts ^. AdvanceInstall.forceInstallL shouldSet = opts ^. AdvanceInstall.instSetL extraArgs = opts ^. AdvanceInstall.addConfArgsL+ installTargets = opts ^. AdvanceInstall.installTargetsL v = fromMaybe (GHCTargetVersion lCross lVer) (opts ^. AdvanceInstall.instVersionL) toolV = _tvVersion v let run =@@ -225,6 +226,7 @@ , DistroNotFound , NoCompatibleArch , InstallSetError+ , URIParseError ] withNoVerify :: (MonadReader AppState m) => m a -> m a@@ -237,27 +239,39 @@ case lTool of GHC -> do let vi = getVersionInfo v GHC dls+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene case opts ^. AdvanceInstall.instBindistL of Nothing -> do liftE $ runBothE'- (installGHCBin v shouldIsolate shouldForce extraArgs)+ (installGHCBin v shouldIsolate shouldForce extraArgs installTargets) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) pure (vi, dirs, ce) Just uri -> do liftE $ runBothE' (withNoVerify $ installGHCBindist- (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) (Just $ RegexDir "ghc-.*") "" Nothing Nothing Nothing) v shouldIsolate shouldForce- extraArgs)+ extraArgs+ installTargets+ ) (when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing)) pure (vi, dirs, ce) Cabal -> do let vi = getVersionInfo v Cabal dls+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene case opts ^. AdvanceInstall.instBindistL of Nothing -> do liftE $@@ -268,15 +282,25 @@ Just uri -> do liftE $ runBothE'- (withNoVerify $ installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing Nothing) toolV shouldIsolate shouldForce)+ (withNoVerify $ installCabalBindist (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) Nothing "" Nothing Nothing Nothing) toolV shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setCabal toolV)) pure (vi, dirs, ce) GHCup -> do let vi = snd <$> getLatest dls GHCup+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce) HLS -> do let vi = getVersionInfo v HLS dls+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene case opts ^. AdvanceInstall.instBindistL of Nothing -> do liftE $@@ -288,7 +312,7 @@ liftE $ runBothE' (withNoVerify $ installHLSBindist- (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing Nothing)+ (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing Nothing) toolV shouldIsolate shouldForce)@@ -307,7 +331,7 @@ Just uri -> do liftE $ runBothE'- (withNoVerify $ installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing Nothing) toolV shouldIsolate shouldForce)+ (withNoVerify $ installStackBindist (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) Nothing "" Nothing Nothing Nothing) toolV shouldIsolate shouldForce) (when (shouldSet && isNothing misolated) (liftE $ void $ setStack toolV)) pure (vi, dirs, ce) @@ -339,7 +363,7 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) => (Int, ListResult) -> m (Either String ())-install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False [])+install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing Nothing False [] "install") set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m) => (Int, ListResult)@@ -377,6 +401,7 @@ , UnsupportedSetupCombo , DistroNotFound , NoCompatibleArch+ , URIParseError ] run (do@@ -433,9 +458,9 @@ let run = runE @'[NotInstalled, UninstallFailed] run (do- let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls+ let vi = getVersionInfo crossVer lTool dls case lTool of- GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi+ GHC -> liftE $ rmGHCVer crossVer $> vi Cabal -> liftE $ rmCabalVer lVer $> vi HLS -> liftE $ rmHLSVer lVer $> vi Stack -> liftE $ rmStackVer lVer $> vi@@ -443,11 +468,14 @@ ) >>= \case VRight vi -> do- when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)+ when (lTool == GHC) $ logGHCPostRm crossVer+ logInfo $ "Successfuly removed " <> T.pack (prettyShow lTool) <> " " <> (if lTool == GHC then tVerToText crossVer else prettyVer lVer) forM_ (_viPostRemove =<< vi) $ \msg -> logInfo msg pure $ Right () VLeft e -> pure $ Left (prettyHFError e)+ where+ crossVer = GHCTargetVersion lCross lVer changelog' :: (MonadReader AppState m, MonadIO m)@@ -463,6 +491,7 @@ Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing+ OpenBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing Windows -> do let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri) c <- liftIO $ system $ args@@ -503,6 +532,7 @@ , BuildFailed , UninstallFailed , MergeFileTreeError+ , URIParseError ] compileResult <- run (do AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask@@ -511,6 +541,11 @@ Nothing -> do -- Compile the version user is pointing to in the tui let vi = getVersionInfo (mkTVer lVer) GHC dls+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene forM_ (_viPreCompile =<< vi) $ \msg -> do logInfo msg logInfo@@ -531,6 +566,7 @@ (compopts ^. CompileGHC.buildFlavour) (compopts ^. CompileGHC.buildSystem) (maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir)+ (compopts ^. CompileGHC.installTargets) AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask let vi2 = getVersionInfo targetVer GHC dls2 when@@ -592,6 +628,7 @@ , ArchiveResult , UninstallFailed , MergeFileTreeError+ , URIParseError ] compileResult <- run (do AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask@@ -600,6 +637,11 @@ Nothing -> do -- Compile the version user is pointing to in the tui let vi = getVersionInfo (mkTVer lVer) HLS dls+ forM_ (_viPreInstall =<< vi) $ \msg -> do+ lift $ logWarn msg+ lift $ logWarn+ "...waiting for 5 seconds, you can still abort..."+ liftIO $ threadDelay 5000000 -- give the user a sec to intervene forM_ (_viPreCompile =<< vi) $ \msg -> do logInfo msg logInfo@@ -609,7 +651,7 @@ ghcs <- liftE $ forM (compopts ^. CompileHLS.targetGHCs)- (\ghc -> fmap (_tvVersion . fst) . Utils.fromVersion (Just ghc) $ GHC)+ (\ghc -> fmap (_tvVersion . fst) . Utils.fromVersion (Just ghc) GStrict $ GHC) targetVer <- liftE $ GHCup.compileHLS hlsVer ghcs
lib-tui/GHCup/Brick/Common.hs view
@@ -48,7 +48,7 @@ , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton , CompileGHCButton, CompileHLSButton, CabalProjectEditBox , CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox- , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox+ , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox, GHCInstallTargets ) ) where import GHCup.List ( ListResult )@@ -135,6 +135,9 @@ pattern ToolVersionBox :: ResourceId pattern ToolVersionBox = ResourceId 23++pattern GHCInstallTargets :: ResourceId+pattern GHCInstallTargets = ResourceId 24 -- | Name data type. Uniquely identifies each widget in the TUI. -- some constructors might end up unused, but still is a good practise
lib-tui/GHCup/Brick/Widgets/Menu.hs view
@@ -248,8 +248,8 @@ type EditableField = MenuField -createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n-createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit handler+createEditableInput :: (Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (EditState n) n+createEditableInput initText name validator = FieldInput initEdit validateEditContent "" drawEdit handler where drawEdit focus errMsg help label (EditState edi overlayOpen) amp = (field, mOverlay) where@@ -258,6 +258,8 @@ borderBox w = amp (Brick.vLimit 1 $ Border.vBorder <+> Brick.padRight Brick.Max w <+> Border.vBorder) editorContents = Brick.txt $ T.unlines $ Edit.getEditContents edi isEditorEmpty = Edit.getEditContents edi == [mempty]+ || Edit.getEditContents edi == [initText]+ in case errMsg of Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help | otherwise -> borderBox editorContents@@ -287,12 +289,15 @@ VtyEvent (Vty.EvKey Vty.KEnter []) -> editStateOverlayOpenL .= True _ -> pure () validateEditContent = validator . T.init . T.unlines . Edit.getEditContents . editState- initEdit = EditState (Edit.editorText name (Just 1) "") False+ initEdit = EditState (Edit.editorText name (Just 1) initText) False -createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n-createEditableField name validator access = MenuField access input "" Valid name+createEditableField' :: (Eq n, Ord n, Show n) => T.Text -> n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n+createEditableField' initText name validator access = MenuField access input "" Valid name where- input = createEditableInput name validator+ input = createEditableInput initText name validator++createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n+createEditableField = createEditableField' "" {- ***************** Button widget
lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs view
@@ -26,6 +26,7 @@ isolateDirL, forceInstallL, addConfArgsL,+ installTargetsL, ) where import GHCup.Types (GHCTargetVersion(..))@@ -55,6 +56,7 @@ , isolateDir :: Maybe FilePath , forceInstall :: Bool , addConfArgs :: [T.Text]+ , installTargets :: T.Text } deriving (Eq, Show) makeLensesFor [@@ -64,6 +66,7 @@ , ("isolateDir", "isolateDirL") , ("forceInstall", "forceInstallL") , ("addConfArgs", "addConfArgsL")+ , ("installTargets", "installTargetsL") ] ''InstallOptions @@ -72,7 +75,8 @@ create :: MenuKeyBindings -> AdvanceInstallMenu create k = Menu.createMenu AdvanceInstallBox initialState "Advance Install" validator k [ok] fields where- initialState = InstallOptions Nothing False Nothing Nothing False []+ initialInstallTargets = "install"+ initialState = InstallOptions Nothing False Nothing Nothing False [] initialInstallTargets validator InstallOptions {..} = case (instSet, isolateDir) of (True, Just _) -> Just "Cannot set active when doing an isolated install" _ -> Nothing@@ -105,6 +109,9 @@ , Menu.createEditableField (Common.MenuElement Common.ToolVersionBox) toolVersionValidator instVersionL & Menu.fieldLabelL .~ "version" & Menu.fieldHelpMsgL .~ "Specify a custom version"+ , Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargetsL+ & Menu.fieldLabelL .~ "install-targets"+ & Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets" , Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL & Menu.fieldLabelL .~ "isolated" & Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs view
@@ -33,6 +33,7 @@ buildSystem, isolateDir, gitRef,+ installTargets, ) where import GHCup.Brick.Widgets.Menu (Menu, MenuKeyBindings)@@ -77,6 +78,7 @@ , _buildSystem :: Maybe BuildSystem , _isolateDir :: Maybe FilePath , _gitRef :: Maybe String+ , _installTargets :: T.Text } deriving (Eq, Show) makeLenses ''CompileGHCOptions@@ -86,6 +88,7 @@ create :: MenuKeyBindings -> [Version] -> CompileGHCMenu create k availableGHCs = Menu.createMenu CompileGHCBox initialState "Compile GHC" validator k buttons fields where+ initialInstallTargets = "install" initialState = CompileGHCOptions (Right "")@@ -101,6 +104,7 @@ Nothing Nothing Nothing+ initialInstallTargets validator CompileGHCOptions {..} = case (_setCompile, _isolateDir) of (True, Just _) -> Just "Cannot set active when doing an isolated install" _ -> case (_buildConfig, _buildSystem) of@@ -223,6 +227,9 @@ , Menu.createEditableField (Common.MenuElement Common.GitRefEditBox) (Right . Just . T.unpack) gitRef & Menu.fieldLabelL .~ "git-ref" & Menu.fieldHelpMsgL .~ "The git commit/branch/ref to build from"+ , Menu.createEditableField' initialInstallTargets (Common.MenuElement Common.GHCInstallTargets) Right installTargets+ & Menu.fieldLabelL .~ "install-targets"+ & Menu.fieldHelpMsgL .~ "Specify space separated list of make install targets" ] buttons = [
lib/GHCup.hs view
@@ -109,6 +109,7 @@ , GPGError , DownloadFailed , NoDownload+ , URIParseError ] m FilePath@@ -258,11 +259,9 @@ m DebugInfo getDebugInfo = do- Dirs {..} <- lift getDirs- let diBaseDir = fromGHCupPath baseDir- let diBinDir = binDir- diGHCDir <- fromGHCupPath <$> lift ghcupGHCBaseDir- let diCacheDir = fromGHCupPath cacheDir+ diDirs <- lift getDirs+ let diChannels = fmap (\c -> (c, channelURL c)) [minBound..maxBound]+ let diShimGenURL = shimGenURL diArch <- lE getArchitecture diPlatform <- liftE getPlatform pure $ DebugInfo { .. }@@ -304,6 +303,7 @@ , NoDownload , NoUpdate , ToolShadowed+ , URIParseError ] m Version@@ -344,6 +344,7 @@ , NoDownload , NoUpdate , ToolShadowed+ , URIParseError ] m Version@@ -355,7 +356,8 @@ dli <- liftE $ getDownloadInfo GHCup latestVer tmp <- fromGHCupPath <$> lift withGHCupTmpDir let fn = "ghcup" <> exeExt- p <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) tmp (Just fn) False+ dlu <- lE $ parseURI' (_dlUri dli)+ p <- liftE $ download dlu Nothing (Just (_dlHash dli)) (_dlCSize dli) tmp (Just fn) False let destDir = takeDirectory destFile destFile = fromMaybe (binDir </> fn) mtarget lift $ logDebug $ "mkdir -p " <> T.pack destDir
lib/GHCup/Cabal.hs view
@@ -89,6 +89,7 @@ , TarDirDoesNotExist , ArchiveResult , FileAlreadyExistsError+ , URIParseError ] m ()@@ -193,6 +194,7 @@ , TarDirDoesNotExist , ArchiveResult , FileAlreadyExistsError+ , URIParseError ] m ()
lib/GHCup/Download.hs view
@@ -153,6 +153,7 @@ m (Either GHCupInfo Stack.SetupInfo) dl' NewGHCupURL = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo dl' NewStackSetupURL = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo+ dl' (NewChannelAlias StackChannel) = fmap Right $ liftE (getBase $ channelURL StackChannel) >>= liftE . decodeMetadata @Stack.SetupInfo dl' (NewChannelAlias c) = fmap Left $ liftE (getBase $ channelURL c) >>= liftE . decodeMetadata @GHCupInfo dl' (NewGHCupInfo gi) = pure (Left gi) dl' (NewSetupInfo si) = pure (Right si)@@ -181,9 +182,8 @@ fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do- url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI . E.encodeUtf8 $ downloadInfoUrl- sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256- pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing Nothing+ sha256 <- maybe (throwM $ DigestMissing downloadInfoUrl) (pure . E.decodeUtf8) downloadInfoSha256+ pure $ DownloadInfo downloadInfoUrl (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing Nothing mergeGhcupInfo :: MonadFail m@@ -741,14 +741,15 @@ ) => DownloadInfo -> Maybe FilePath -- ^ optional filename- -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath+ -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath downloadCached dli mfn = do Settings{ cache } <- lift getSettings case cache of True -> downloadCached' dli mfn Nothing False -> do+ dlu <- lE $ parseURI' (_dlUri dli) tmp <- lift withGHCupTmpDir- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False+ liftE $ download dlu Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False where outputFileName = mfn <|> _dlOutput dli @@ -765,11 +766,12 @@ => DownloadInfo -> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional destination dir (default: cacheDir)- -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath+ -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath downloadCached' dli mfn mDestDir = do Dirs { cacheDir } <- lift getDirs+ dlu <- lE $ parseURI' (_dlUri dli) let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir- let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName+ let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view pathL' dlu) outputFileName let cachfile = destDir </> fn fileExists <- liftIO $ doesFileExist cachfile if@@ -777,7 +779,7 @@ forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile liftE $ checkDigest (view dlHash dli) cachfile pure cachfile- | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False+ | otherwise -> liftE $ download dlu Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False where outputFileName = mfn <|> _dlOutput dli
lib/GHCup/Errors.hs view
@@ -17,7 +17,7 @@ Stability : experimental Portability : portable -}-module GHCup.Errors where+module GHCup.Errors ( module GHCup.Errors, URIParseError ) where import GHCup.Types @@ -34,8 +34,6 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import qualified Data.Text.Encoding.Error as E import Data.Data (Proxy(..)) import Data.Time (Day) @@ -849,12 +847,12 @@ eBase _ = 520 eDesc _ = "URL does not have a base filename." -data DigestMissing = DigestMissing URI+data DigestMissing = DigestMissing Text deriving Show instance Pretty DigestMissing where pPrint (DigestMissing uri) =- text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri+ text "Digest missing for:" <+> text (T.unpack uri) instance Exception DigestMissing
lib/GHCup/GHC.hs view
@@ -118,6 +118,7 @@ , TarDirDoesNotExist , UnknownArchive , TestFailed+ , URIParseError ] m ()@@ -158,6 +159,7 @@ , TarDirDoesNotExist , UnknownArchive , TestFailed+ , URIParseError ] m ()@@ -256,6 +258,7 @@ , GPGError , DownloadFailed , NoDownload+ , URIParseError ] m FilePath@@ -292,6 +295,7 @@ -> InstallDir -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist+ -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed@@ -308,10 +312,11 @@ , ProcessError , UninstallFailed , MergeFileTreeError+ , URIParseError ] m ()-installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do+installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets = do lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver regularGHCInstalled <- lift $ ghcInstalled tver@@ -339,12 +344,12 @@ case installDir of IsolateDir isoDir -> do -- isolated install lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir- liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs+ liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs installTargets GHCupInternal -> do -- regular install -- prepare paths ghcdir <- lift $ ghcupGHCDir tver - liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs+ liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs installTargets -- make symlinks & stuff when regular install, liftE $ postGHCInstall tver@@ -381,6 +386,7 @@ -> GHCTargetVersion -- ^ The GHC version -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist+ -> T.Text -> Excepts '[ BuildFailed , UnknownArchive@@ -390,7 +396,7 @@ , ProcessError , MergeFileTreeError ] m ()-installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do+installPackedGHC dl msubdir inst ver forceInstall addConfArgs installTargets = do PlatformRequest {..} <- lift getPlatformReq unless forceInstall@@ -407,7 +413,7 @@ msubdir liftE $ runBuildAction tmpUnpack- (installUnpackedGHC workdir inst ver forceInstall addConfArgs)+ (installUnpackedGHC workdir inst ver forceInstall addConfArgs installTargets) -- | Install an unpacked GHC distribution. This only deals with the GHC@@ -429,8 +435,9 @@ -> GHCTargetVersion -- ^ The GHC version -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist+ -> T.Text -> Excepts '[ProcessError, MergeFileTreeError] m ()-installUnpackedGHC path inst tver forceInstall addConfArgs+installUnpackedGHC path inst tver forceInstall addConfArgs installTargets | isWindows = do lift $ logInfo "Installing GHC (this may take a while)" -- Windows bindists are relocatable and don't need@@ -456,7 +463,7 @@ "ghc-configure" Nothing tmpInstallDest <- lift withGHCupTmpDir- lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)+ lEM $ make (["DESTDIR=" <> fromGHCupPath tmpInstallDest] <> (words . T.unpack $ installTargets)) (Just $ fromGHCupPath path) liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest) liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall pure ()@@ -521,6 +528,7 @@ -> InstallDir -> Bool -- ^ force install -> [T.Text] -- ^ additional configure args for bindist+ -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed@@ -542,12 +550,13 @@ , UnsupportedSetupCombo , DistroNotFound , NoCompatibleArch+ , URIParseError ] m ()-installGHCBin tver installDir forceInstall addConfArgs = do+installGHCBin tver installDir forceInstall addConfArgs installTargets = do dlinfo <- liftE $ getDownloadInfo' GHC tver- liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs+ liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs installTargets @@ -801,6 +810,7 @@ -> Maybe String -- ^ build flavour -> Maybe BuildSystem -> InstallDir+ -> T.Text -> Excepts '[ AlreadyInstalled , BuildFailed@@ -825,10 +835,11 @@ , BuildFailed , UninstallFailed , MergeFileTreeError+ , URIParseError ] m GHCTargetVersion-compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir+compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir installTargets = do pfreq@PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo@@ -1022,6 +1033,7 @@ installVer False -- not a force install, since we already overwrite when compiling. []+ installTargets case installDir of -- set and make symlinks for regular (non-isolated) installs
lib/GHCup/HLS.hs view
@@ -118,6 +118,7 @@ , DirNotEmpty , UninstallFailed , MergeFileTreeError+ , URIParseError ] m ()@@ -311,6 +312,7 @@ , DirNotEmpty , UninstallFailed , MergeFileTreeError+ , URIParseError ] m ()@@ -352,6 +354,7 @@ , ArchiveResult , BuildFailed , NotInstalled+ , URIParseError ] m Version compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do pfreq@PlatformRequest { .. } <- lift getPlatformReq
lib/GHCup/List.hs view
@@ -117,16 +117,17 @@ hlses <- getInstalledHLSs sSet <- stackSet stacks <- getInstalledStacks+ hlsGHCVs <- fmap mkTVer <$> hlsGHCVersions - go lt' cSet cabals hlsSet' hlses sSet stacks+ go lt' hlsGHCVs cSet cabals hlsSet' hlses sSet stacks where- go lt cSet cabals hlsSet' hlses sSet stacks = do+ go lt hlsGHCVs cSet cabals hlsSet' hlses sSet stacks = do case lt of Just t -> do GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo -- get versions from GHCupDownloads let avTools = availableToolVersions dls t- lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses sSet stacks)+ lr <- filter' <$> forM (Map.toList avTools) (toListResult t hlsGHCVs cSet cabals hlsSet' hlses sSet stacks) case t of GHC -> do@@ -145,11 +146,11 @@ let cg = maybeToList $ currentGHCup avTools pure (sort (cg ++ lr)) Nothing -> do- ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks- cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks- hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses sSet stacks- ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks- stackvers <- go (Just Stack) cSet cabals hlsSet' hlses sSet stacks+ ghcvers <- go (Just GHC) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks+ cabalvers <- go (Just Cabal) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks+ hlsvers <- go (Just HLS) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks+ ghcupvers <- go (Just GHCup) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks+ stackvers <- go (Just Stack) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers) strayGHCs :: ( MonadCatch m , MonadReader env m@@ -182,7 +183,7 @@ } Left e -> do logWarn- $ "Could not parse version of stray directory" <> T.pack e+ $ "Could not parse version of stray directory " <> T.pack e pure Nothing strayCabals :: ( MonadReader env m@@ -217,7 +218,7 @@ } Left e -> do logWarn- $ "Could not parse version of stray directory" <> T.pack e+ $ "Could not parse version of stray directory " <> T.pack e pure Nothing strayHLS :: ( MonadReader env m@@ -251,7 +252,7 @@ } Left e -> do logWarn- $ "Could not parse version of stray directory" <> T.pack e+ $ "Could not parse version of stray directory " <> T.pack e pure Nothing strayStacks :: ( MonadReader env m@@ -286,7 +287,7 @@ } Left e -> do logWarn- $ "Could not parse version of stray directory" <> T.pack e+ $ "Could not parse version of stray directory " <> T.pack e pure Nothing currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult@@ -319,6 +320,7 @@ , MonadCatch m ) => Tool+ -> [GHCTargetVersion] -> Maybe Version -> [Either FilePath Version] -> Maybe Version@@ -327,7 +329,7 @@ -> [Either FilePath Version] -> (GHCTargetVersion, VersionInfo) -> m ListResult- toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do+ toListResult t hlsGHCVs cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do let v = _tvVersion tver case t of GHC -> do@@ -336,7 +338,7 @@ let bTags = either (const []) (fromMaybe [] . _dlTag) dli lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver) lInstalled <- ghcInstalled tver- hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)+ let hlsPowered = tver `elem` hlsGHCVs pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags <> bTags
lib/GHCup/Prelude/MegaParsec.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-|-Module : GHCup.Utils.MegaParsec+Module : GHCup.Prelude.MegaParsec Description : MegaParsec utilities Copyright : (c) Julian Ospald, 2020 License : LGPL-3.0@@ -137,3 +137,16 @@ isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') {-# INLINE isSpace #-} +-- Obtain the version from the link or shim path+-- ../ghc/<ver>/bin/ghc+-- ../ghc/<ver>/bin/ghc-<ver>+ghcVersionFromPath :: MP.Parsec Void Text GHCTargetVersion+ghcVersionFromPath =+ do+ beforeBin <- parseUntil1 binDir <* MP.some pathSep+ MP.setInput beforeBin+ _ <- parseTillLastPathSep+ ghcTargetVerP+ where+ binDir = MP.some pathSep <* MP.chunk "bin" *> MP.some pathSep <* MP.takeWhile1P Nothing (not . isPathSeparator) <* MP.eof+ parseTillLastPathSep = (MP.try (parseUntil1 pathSep *> MP.some pathSep) *> parseTillLastPathSep) <|> pure ()
lib/GHCup/Stack.hs view
@@ -90,6 +90,7 @@ , TarDirDoesNotExist , ArchiveResult , FileAlreadyExistsError+ , URIParseError ] m ()@@ -129,6 +130,7 @@ , TarDirDoesNotExist , ArchiveResult , FileAlreadyExistsError+ , URIParseError ] m ()
lib/GHCup/Types.hs view
@@ -329,7 +329,7 @@ -- | An encapsulation of a download. This can be used -- to download, extract and install a tool. data DownloadInfo = DownloadInfo- { _dlUri :: URI+ { _dlUri :: Text , _dlSubdir :: Maybe TarDir , _dlHash :: Text , _dlCSize :: Maybe Integer@@ -396,12 +396,16 @@ instance NFData NewURLSource -- | Alias for ease of URLSource selection-data ChannelAlias = CrossChannel+data ChannelAlias = DefaultChannel+ | StackChannel+ | CrossChannel | PrereleasesChannel | VanillaChannel deriving (Eq, GHC.Generic, Show, Enum, Bounded) channelAliasText :: ChannelAlias -> Text+channelAliasText DefaultChannel = "default"+channelAliasText StackChannel = "stack" channelAliasText CrossChannel = "cross" channelAliasText PrereleasesChannel = "prereleases" channelAliasText VanillaChannel = "vanilla"@@ -448,11 +452,12 @@ , uMirrors :: Maybe DownloadMirrors , uDefGHCConfOptions :: Maybe [String] , uPager :: Maybe PagerConfig+ , uGuessVersion :: Maybe Bool } deriving (Show, GHC.Generic, Eq) defaultUserSettings :: UserSettings-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing fromSettings :: Settings -> Maybe KeyBindings -> UserSettings fromSettings Settings{..} Nothing =@@ -472,6 +477,7 @@ , uMirrors = Just mirrors , uDefGHCConfOptions = Just defGHCConfOptions , uPager = Just pager+ , uGuessVersion = Just guessVersion } fromSettings Settings{..} (Just KeyBindings{..}) = let ukb = UserKeyBindings@@ -500,6 +506,7 @@ , uMirrors = Just mirrors , uDefGHCConfOptions = Just defGHCConfOptions , uPager = Just pager+ , uGuessVersion = Just guessVersion } data UserKeyBindings = UserKeyBindings@@ -587,6 +594,7 @@ , mirrors :: DownloadMirrors , defGHCConfOptions :: [String] , pager :: PagerConfig+ , guessVersion :: Bool } deriving (Show, GHC.Generic) @@ -608,7 +616,7 @@ defaultMetaCache = 300 -- 5 minutes defaultSettings :: Settings-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False [NewGHCupURL] False GPGNone False Nothing (DM mempty) [] defaultPagerConfig+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False [NewGHCupURL] False GPGNone False Nothing (DM mempty) [] defaultPagerConfig True instance NFData Settings @@ -662,12 +670,11 @@ instance NFData GPGSetting data DebugInfo = DebugInfo- { diBaseDir :: FilePath- , diBinDir :: FilePath- , diGHCDir :: FilePath- , diCacheDir :: FilePath- , diArch :: Architecture- , diPlatform :: PlatformResult+ { diDirs :: Dirs+ , diArch :: Architecture+ , diPlatform :: PlatformResult+ , diChannels :: [(ChannelAlias, URI)]+ , diShimGenURL :: URI } deriving Show @@ -880,3 +887,11 @@ deriving (Eq, Show, GHC.Generic) instance (NFData k, NFData v) => NFData (MapIgnoreUnknownKeys k v)++-- | Type representing our guessing modes when e.g. "incomplete" PVP version+-- is specified, such as @ghcup set ghc 9.12@.+data GuessMode = GStrict -- ^ don't guess the proper tool version+ | GLax -- ^ guess by using the metadata+ | GLaxWithInstalled -- ^ guess by using metadata and installed versions+ deriving (Eq, Show)+
lib/GHCup/Types/JSON.hs view
@@ -220,23 +220,16 @@ versionCmpToText (VR_eq ver') = "== " <> prettyV ver' versionCmpP :: MP.Parsec Void T.Text VersionCmp-versionCmpP =- fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)- <|> fmap- VR_gteq- (MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)- <|> fmap- VR_lt- (MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)- <|> fmap- VR_lteq- (MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)- <|> fmap- VR_eq- (MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)- <|> fmap- VR_eq- (MP.try $ MPC.space *> versioningEnd)+versionCmpP = either (fail . T.unpack) pure =<< (translate <$> (MPC.space *> MP.try (MP.takeWhileP Nothing (`elem` ['>', '<', '=']))) <*> (MPC.space *> versioningEnd))+ where+ translate ">" v = Right $ VR_gt v+ translate ">=" v = Right $ VR_gteq v+ translate "<" v = Right $ VR_lt v+ translate "<=" v = Right $ VR_lteq v+ translate "==" v = Right $ VR_eq v+ translate "" v = Right $ VR_eq v+ translate c _ = Left $ "unexpected comparator: " <> c+ instance ToJSON VersionRange where toJSON = String . verRangeToText
lib/GHCup/Utils.hs view
@@ -305,23 +305,7 @@ Just <$> ghcLinkVersion link where ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion- ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t- where- parser =- (do- _ <- parseUntil1 ghcSubPath- _ <- ghcSubPath- r <- parseUntil1 pathSep- rest <- MP.getInput- MP.setInput r- x <- ghcTargetVerP- MP.setInput rest- pure x- )- <* MP.some pathSep- <* MP.takeRest- <* MP.eof- ghcSubPath = MP.some pathSep <* MP.chunk "ghc" *> MP.some pathSep+ ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse ghcVersionFromPath "ghcLinkVersion" t -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>. -- If a dir cannot be parsed, returns left.@@ -1119,18 +1103,18 @@ , MonadUnliftIO m , MonadFail m )- => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()+ => Excepts '[URIParseError, GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m () ensureShimGen | isWindows = do dirs <- lift getDirs- let shimDownload = DownloadInfo shimGenURL Nothing shimGenSHA Nothing Nothing Nothing+ let shimDownload = DownloadInfo (decUTF8Safe . serializeURIRef' $ shimGenURL) Nothing shimGenSHA Nothing Nothing Nothing let dl = downloadCached' shimDownload (Just "gs.exe") Nothing void $ (\DigestError{} -> do lift $ logWarn "Digest doesn't match, redownloading gs.exe..." lift $ logDebug ("rm -f " <> T.pack (fromGHCupPath (cacheDir dirs) </> "gs.exe")) lift $ hideError doesNotExistErrorType $ recycleFile (fromGHCupPath (cacheDir dirs) </> "gs.exe")- liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] $ dl- ) `catchE` liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] dl+ liftE @'[URIParseError, GPGError, DigestError, ContentLengthError, DownloadFailed] $ dl+ ) `catchE` liftE @'[URIParseError, GPGError, DigestError, ContentLengthError, DownloadFailed] dl | otherwise = pure () @@ -1286,4 +1270,3 @@ go (GitDescribe:xs) = gitDescribe <> go xs go (GitBranchName:xs) = gitBranch <> go xs go (S str:xs) = str <> go xs-
lib/GHCup/Utils/Parsers.hs view
@@ -44,6 +44,7 @@ import Data.Versions import Data.Void import Data.Variant.Excepts+import Optics hiding ( set ) import Prelude hiding ( appendFile ) import Safe import System.FilePath@@ -56,7 +57,43 @@ import qualified Text.Megaparsec as MP import GHCup.Version +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> :set -XDataKinds+-- >>> :set -XTypeApplications+-- >>> :set -XQuasiQuotes+-- >>> import System.Directory+-- >>> import URI.ByteString+-- >>> import qualified Data.Text as T+-- >>> import GHCup.Prelude+-- >>> import GHCup.Download+-- >>> import GHCup.Version+-- >>> import GHCup.Errors+-- >>> import GHCup.Types+-- >>> import GHCup.Utils.Dirs+-- >>> import GHCup.Types.Optics+-- >>> import Data.Versions+-- >>> import Optics+-- >>> import GHCup.Prelude.Version.QQ+-- >>> import qualified Data.Text.Encoding as E+-- >>> import qualified Data.Map.Strict as M+-- >>> import Control.Monad.Reader+-- >>> import Data.Variant.Excepts+-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )+-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }+-- >>> dirs' <- getAllDirs+-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]+-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }+-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc+-- >>> cwd <- getCurrentDirectory+-- >>> (Right ref) <- pure $ GHCup.Utils.parseURI $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)+-- >>> (Right ref') <- pure $ GHCup.Utils.parseURI $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ channelURL PrereleasesChannel)+-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE (getBase ref) >>= liftE . decodeMetadata @GHCupInfo+-- >>> (VRight r') <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE (getBase ref') >>= liftE . decodeMetadata @GHCupInfo+-- >>> let rr = M.unionsWith (M.unionWith (\_ b2 -> b2)) [r, r']+-- >>> let go = flip runReaderT leanAppState . fmap (tVerToText . fst) + ------------- --[ Types ]-- -------------@@ -259,6 +296,7 @@ , MonadCatch m ) => Maybe ToolVersion+ -> GuessMode -> Tool -> Excepts '[ TagNotFound@@ -278,6 +316,7 @@ , MonadCatch m ) => SetToolVersion+ -> GuessMode -> Tool -> Excepts '[ TagNotFound@@ -285,55 +324,37 @@ , NextVerNotFound , NoToolVersionSet ] m (GHCTargetVersion, Maybe VersionInfo)-fromVersion' SetRecommended tool = do+fromVersion' SetRecommended _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getRecommended dls tool ?? TagNotFound Recommended tool-fromVersion' (SetGHCVersion v) tool = do+fromVersion' (SetGHCVersion v) guessMode tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo- let vi = getVersionInfo v tool dls- case pvp $ prettyVer (_tvVersion v) of -- need to be strict here- Left _ -> pure (v, vi)- Right pvpIn ->- lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case- Just (pvp_, vi', mt) -> do- v' <- lift $ pvpToVersion pvp_ ""- when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')- pure (GHCTargetVersion mt v', Just vi')- Nothing -> pure (v, vi)-fromVersion' (SetToolVersion (mkTVer -> v)) tool = do+ lift $ guessFullVersion dls v tool guessMode+fromVersion' (SetToolVersion (mkTVer -> v)) guessMode tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo- let vi = getVersionInfo v tool dls- case pvp $ prettyVer (_tvVersion v) of -- need to be strict here- Left _ -> pure (v, vi)- Right pvpIn ->- lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case- Just (pvp_, vi', mt) -> do- v' <- lift $ pvpToVersion pvp_ ""- when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')- pure (GHCTargetVersion mt v', Just vi')- Nothing -> pure (v, vi)-fromVersion' (SetToolTag Latest) tool = do+ lift $ guessFullVersion dls v tool guessMode+fromVersion' (SetToolTag Latest) _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getLatest dls tool ?? TagNotFound Latest tool-fromVersion' (SetToolDay day) tool = do+fromVersion' (SetToolDay day) _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> case getByReleaseDay dls tool day of Left ad -> throwE $ DayNotFound day tool ad Right v -> pure v-fromVersion' (SetToolTag LatestPrerelease) tool = do+fromVersion' (SetToolTag LatestPrerelease) _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool-fromVersion' (SetToolTag LatestNightly) tool = do+fromVersion' (SetToolTag LatestNightly) _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool-fromVersion' (SetToolTag Recommended) tool = do+fromVersion' (SetToolTag Recommended) _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getRecommended dls tool ?? TagNotFound Recommended tool-fromVersion' (SetToolTag (Base pvp'')) GHC = do+fromVersion' (SetToolTag (Base pvp'')) _ GHC = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo second Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC-fromVersion' SetNext tool = do+fromVersion' SetNext _ tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo next <- case tool of GHC -> do@@ -379,10 +400,60 @@ GHCup -> fail "GHCup cannot be set" let vi = getVersionInfo next tool dls pure (next, vi)-fromVersion' (SetToolTag t') tool =+fromVersion' (SetToolTag t') _ tool = throwE $ TagNotFound t' tool +-- | Guess the full version from an input version, by possibly+-- examining the metadata and the installed versions.+--+-- >>> go $ guessFullVersion rr (mkTVer [vver|8|]) GHC GLax+-- "8.10.7"+-- >>> go $ guessFullVersion rr (mkTVer [vver|8.10|]) GHC GLax+-- "8.10.7"+-- >>> go $ guessFullVersion rr (mkTVer [vver|8.10.7|]) GHC GLax+-- "8.10.7"+-- >>> go $ guessFullVersion rr (mkTVer [vver|9.12.1|]) GHC GLax+-- "9.12.1"+-- >>> go $ guessFullVersion rr (mkTVer [vver|8|]) GHC GStrict+-- "8"+guessFullVersion :: ( HasLog env+ , MonadFail m+ , MonadReader env m+ , HasDirs env+ , MonadThrow m+ , MonadIO m+ , MonadCatch m+ )+ => GHCupDownloads+ -> GHCTargetVersion+ -> Tool+ -> GuessMode+ -> m (GHCTargetVersion, Maybe VersionInfo)+guessFullVersion dls v tool guessMode = do+ let vi = getVersionInfo v tool dls+ case pvp $ prettyVer (_tvVersion v) of -- need to be strict here+ Left _ -> pure (v, vi)+ Right pvpIn+ | (guessMode /= GStrict) && hasn't (ix tool % ix v) dls -> do+ ghcs <- if guessMode == GLaxWithInstalled then fmap rights getInstalledTools else pure []+ if v `notElem` ghcs+ then getLatestToolFor tool (_tvTarget v) pvpIn dls >>= \case+ Just (pvp_, vi', mt) -> do+ v' <- pvpToVersion pvp_ ""+ when (v' /= _tvVersion v) $ logWarn ("Assuming you meant version " <> prettyVer v')+ pure (GHCTargetVersion mt v', Just vi')+ Nothing -> pure (v, vi)+ else pure (v, vi)+ _ -> pure (v, vi)+ where+ getInstalledTools = case tool of+ GHC -> getInstalledGHCs+ Cabal -> (fmap . fmap) mkTVer <$> getInstalledCabals+ HLS -> (fmap . fmap) mkTVer <$> getInstalledHLSs+ Stack -> (fmap . fmap) mkTVer <$> getInstalledStacks+ GHCup -> pure [] + parseUrlSource :: String -> Either String [NewURLSource] parseUrlSource s = (fromURLSource <$> parseUrlSource' s) <|> ((:[]) <$> parseNewUrlSource s)@@ -413,7 +484,7 @@ parse = (NewGHCupURL <$ AP.string "GHCupURL") <|> (NewStackSetupURL <$ AP.string "StackSetupURL") <|> AP.choice ((\x -> AP.string (UTF8.fromString . T.unpack . channelAliasText $ x) $> NewChannelAlias x) <$> ([minBound..maxBound] :: [ChannelAlias]))- <|> (NewURI <$> parseURI')+ <|> (NewURI <$> parseURIP) parseChannelAlias :: String -> Either String ChannelAlias parseChannelAlias s =
lib/GHCup/Utils/URI.hs view
@@ -15,12 +15,16 @@ -} module GHCup.Utils.URI where +import GHCup.Prelude.Internal+ import Data.Bifunctor (first)+import Data.Text ( Text ) import Control.Applicative import Data.Attoparsec.ByteString import Data.ByteString import URI.ByteString hiding (parseURI) import System.URI.File+import qualified Data.Text.Encoding as E @@ -30,10 +34,13 @@ parseURI :: ByteString -> Either URIParseError (URIRef Absolute)-parseURI = first OtherError . parseOnly parseURI'+parseURI = first OtherError . parseOnly parseURIP -parseURI' :: Parser (URIRef Absolute)-parseURI' = do+parseURI' :: Text -> Either URIParseError (URIRef Absolute)+parseURI' = first OtherError . parseOnly parseURIP . E.encodeUtf8++parseURIP :: Parser (URIRef Absolute)+parseURIP = do ref <- (Right <$> parseFile) <|> (Left <$> uriParser laxURIParserOptions) case ref of Left (URI { uriScheme = (Scheme "file") }) ->
lib/GHCup/Version.hs view
@@ -89,6 +89,8 @@ channelURL :: ChannelAlias -> URI channelURL = \case+ DefaultChannel -> ghcupURL+ StackChannel -> stackSetupURL CrossChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.9.yaml|] PrereleasesChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.9.yaml|] VanillaChannel -> [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-vanilla-0.0.9.yaml|]
scripts/bootstrap/bootstrap-haskell view
@@ -41,7 +41,7 @@ plat="$(uname -s)" arch=$(uname -m)-ghver="0.1.40.0"+ghver="0.1.50.0" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}" export GHCUP_SKIP_UPDATE_CHECK=yes@@ -307,16 +307,17 @@ _url=${GHCUP_BASE_URL}/${ghver}/i386-linux-ghcup-${ghver} ;; armv7*|*armv8l*)- _url=${GHCUP_BASE_URL}/${ghver}/armv7-linux-ghcup-${ghver}+ # later versions don't support armv7 anymore+ _url=${GHCUP_BASE_URL}/0.1.40.0/armv7-linux-ghcup-0.1.40.0 ;; aarch64|arm64) # we could be in a 32bit docker container, in which # case uname doesn't give us what we want if [ "$(getconf LONG_BIT)" = "32" ] ; then- _url=${GHCUP_BASE_URL}/${ghver}/armv7-linux-ghcup-${ghver}+ # later versions don't support armv7 anymore+ _url=${GHCUP_BASE_URL}/0.1.40.0/armv7-linux-ghcup-0.1.40.0 elif [ "$(getconf LONG_BIT)" = "64" ] ; then- # TODO: rm 'static-'- _url=${GHCUP_BASE_URL}/${ghver}/aarch64-linux-static-ghcup-${ghver}+ _url=${GHCUP_BASE_URL}/${ghver}/aarch64-linux-ghcup-${ghver} else die "Unknown long bit size: $(getconf LONG_BIT)" fi@@ -467,6 +468,127 @@ esac } +ask_base_channel() {+ if [ -n "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then+ return 0+ fi+ echo "-------------------------------------------------------------------------------"+ warn ""+ warn "GHCup provides different binary distribution \"channels\". These are collections of tools"+ warn "and may differ in purpose and philosophy. First, we select the base channel."+ warn ""+ while true; do++ warn "[S] Skip [D] Default (GHCup maintained) [V] Vanilla (Upstream maintained) [?] Help (default is \"Skip\")."+ warn ""++ read -r bashrc_answer </dev/tty++ case $bashrc_answer in+ [Ss]* | "")+ return 0+ ;;+ [Dd]*)+ return 1+ ;;+ [Vv]*)+ return 2+ ;;+ *)+ echo "Possible choices are:"+ echo+ echo "[S]kip - Do nothing and leave GHCup config as is"+ echo "[D]efault - The default channel maintained by GHCup developers"+ echo " (receives QA and support from GHCup and may provide"+ echo " unofficial bindists for less supported platforms)"+ echo "[V]anilla - Only contains unchanged upstream binary distributions"+ echo " (is updated with newer releases faster since it receives no GHCup QA)"+ echo+ echo "Selecting Default or Vanilla will overwrite any pre-existing channel"+ echo "config you might have (if you've previously installed GHCup)."+ echo+ echo "Please make your choice and press ENTER."+ ;;+ esac+ done++ unset bashrc_answer+}++ask_prerelease_channel() {+ if [ -n "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then+ return 0+ fi+ echo "-------------------------------------------------------------------------------"++ warn ""+ warn "Do you also want to enable the pre-releases channel, getting access to."+ warn "alpha, betas and release candidates?"+ warn ""+ warn "[N] No [Y] Yes [?] Help (default is \"N\")."+ while true; do++ read -r bashrc_answer </dev/tty++ case $bashrc_answer in+ [Nn]* | "")+ return 0+ ;;+ [Yy]*)+ return 1+ ;;+ *)+ echo "Possible choices are:"+ echo+ echo "N - No, don't enable prereleases (default)"+ echo "Y - Yes, enable prereleases"+ echo+ echo "Please make your choice and press ENTER."+ ;;+ esac+ done++ unset bashrc_answer+}++ask_cross_channel() {+ if [ -n "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then+ return 0+ fi+ while true; do+ echo "-------------------------------------------------------------------------------"++ warn ""+ warn "Do you also want to enable the cross channel, getting access to"+ warn "experimental GHCJS, WASM, etc.?"+ warn ""+ warn "[N] No [Y] Yes [?] Help (default is \"N\")."+ warn ""++ read -r bashrc_answer </dev/tty++ case $bashrc_answer in+ [Nn]* | "")+ return 0+ ;;+ [Yy]*)+ return 1+ ;;+ *)+ echo "Possible choices are:"+ echo+ echo "N - No, don't enable cross (default)"+ echo "Y - Yes, enable prereleases"+ echo+ echo "Please make your choice and press ENTER."+ ;;+ esac+ done++ unset bashrc_answer+}++ # Ask user if they want to adjust the bashrc. ask_bashrc() { if [ -n "${BOOTSTRAP_HASKELL_ADJUST_BASHRC}" ] ; then@@ -829,6 +951,16 @@ read -r answer </dev/tty fi +if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then+ ask_base_channel+ ask_base_channel_answer=$?+ if [ $ask_base_channel_answer != 0 ] ; then+ ask_prerelease_channel+ ask_prerelease_channel_answer=$?+ ask_cross_channel+ ask_cross_channel_answer=$?+ fi+fi ask_bashrc ask_bashrc_answer=$? ask_cabal_config_init@@ -863,6 +995,30 @@ # shellcheck disable=SC2034 read -r answer </dev/tty fi++case $ask_base_channel_answer in+ 1)+ _eghcup config set url-source GHCupURL+ ;;+ 2)+ _eghcup config set url-source vanilla+ ;;+ *) ;;+esac++case $ask_prerelease_channel_answer in+ 1)+ _eghcup config add-release-channel prereleases+ ;;+ *) ;;+esac++case $ask_cross_channel_answer in+ 1)+ _eghcup config add-release-channel cross+ ;;+ *) ;;+esac if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+ test/ghcup-test/GHCup/ParserSpec.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module GHCup.ParserSpec where++import GHCup.Types+import GHCup.Types.JSON+import GHCup.Prelude.Version.QQ+import GHCup.Prelude.MegaParsec++import Data.List.NonEmpty ( NonEmpty (..) )+import qualified Data.Set as Set+import Data.Versions+import qualified Text.Megaparsec as MP+import Text.Megaparsec++import Test.Hspec++spec :: Spec+spec = do+ describe "GHCup Parsers" $ do+ it "versionRangeP" $ do+ MP.parse versionRangeP "" ">= 8" `shouldBe` Right (SimpleRange (VR_gteq [vers|8|]:| []))+ MP.parse versionRangeP "" "< 9" `shouldBe` Right (SimpleRange (VR_lt [vers|9|]:| []))+ MP.parse versionRangeP "" "<= 10" `shouldBe` Right (SimpleRange (VR_lteq [vers|10|]:| []))+ MP.parse versionRangeP "" "=< 100" `shouldBe` Left (ParseErrorBundle {bundleErrors = FancyError 6 (Set.fromList [ErrorFail "unexpected comparator: =<"]) :| [], bundlePosState = PosState {pstateInput = "=< 100", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "", sourceLine = mkPos 1, sourceColumn = mkPos 1}, pstateTabWidth = mkPos 8, pstateLinePrefix = ""}})+ MP.parse versionRangeP "" "> 11" `shouldBe` Right (SimpleRange (VR_gt [vers|11|]:| []))+ MP.parse versionRangeP "" "12" `shouldBe` Right (SimpleRange (VR_eq [vers|12|]:| []))+ MP.parse versionRangeP "" "( >= 8 && < 9 )" `shouldBe` Right (SimpleRange (VR_gteq [vers|8|]:| [VR_lt [vers|9|]]))+ MP.parse versionRangeP "" ">= 3 || < 1" `shouldBe` Right (OrRange (VR_gteq [vers|3|]:| []) (SimpleRange (VR_lt [vers|1|]:|[])))++ it "ghcVersionFromPath" $ do+ MP.parse ghcVersionFromPath "" "../ghc/8.10.7/bin/ghc" `shouldBe` Right ghc8107+ MP.parse ghcVersionFromPath "" "../ghc/8.10.7/bin/ghc-8.10.7" `shouldBe` Right ghc8107+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/8.10.7/bin/ghc" `shouldBe` Right ghc8107+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/8.10.7/bin/ghc-8.10.7" `shouldBe` Right ghc8107+ MP.parse ghcVersionFromPath "" "c:/ghc/ghcup/ghc/8.10.7/bin/ghc" `shouldBe` Right ghc8107+ MP.parse ghcVersionFromPath "" "c:/ghc/ghcup/ghc/8.10.7/bin/ghc-8.10.7" `shouldBe` Right ghc8107++ -- a user specified version+ MP.parse ghcVersionFromPath "" "../ghc/9.4.8-rc2/bin/ghc-9.4.8" `shouldBe` Right ghc948rc2+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/9.4.8-rc2/bin/ghc" `shouldBe` Right ghc948rc2+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/9.4.8-rc2/bin/ghc-9.4.8" `shouldBe` Right ghc948rc2+ MP.parse ghcVersionFromPath "" "c:/ghc/ghcup/ghc/9.4.8-rc2/bin/ghc" `shouldBe` Right ghc948rc2+ MP.parse ghcVersionFromPath "" "c:/ghc/ghcup/ghc/9.4.8-rc2/bin/ghc-9.4.8" `shouldBe` Right ghc948rc2++ -- a user specified alphanum+ MP.parse ghcVersionFromPath "" "../ghc/mytag9.4.8/bin/ghc-9.4.8" `shouldBe` Right ghcMytag+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/mytag9.4.8/bin/ghc" `shouldBe` Right ghcMytag+ MP.parse ghcVersionFromPath "" "c:/ghcup/ghc/mytag9.4.8/bin/ghc-9.4.8" `shouldBe` Right ghcMytag++ -- With Target+ MP.parse ghcVersionFromPath "" "../ghc/javascript-unknown-ghcjs-9.6.2/bin/javascript-unknown-ghcjs-ghc-9.6.2" `shouldBe` Right ghcjs962+ MP.parse ghcVersionFromPath "" "c:/ghc/bin/ghcup/ghc/javascript-unknown-ghcjs-9.6.2/bin/javascript-unknown-ghcjs-ghc-9.6.2" `shouldBe` Right ghcjs962++ where+ ghc8107 = GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Nothing, _vMeta = Nothing}}+ ghc948rc2 = GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 9 :| [Numeric 4,Numeric 8]), _vRel = Just (Release (Alphanum "rc2" :| [])), _vMeta = Nothing}}+ ghcMytag = GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Alphanum "mytag9" :| [Numeric 4,Numeric 8]), _vRel = Nothing, _vMeta = Nothing}}+ ghcjs962 = GHCTargetVersion {_tvTarget = Just "javascript-unknown-ghcjs", _tvVersion = Version { _vEpoch = Nothing, _vChunks = Chunks (Numeric 9 :| [Numeric 6,Numeric 2]), _vRel = Nothing, _vMeta = Nothing}}
test/optparse-test/CompileTest.hs view
@@ -40,6 +40,7 @@ Nothing Nothing Nothing+ "install" mkDefaultHLSCompileOptions :: HLSVer -> [ToolVersion] -> HLSCompileOptions mkDefaultHLSCompileOptions target ghcs =
test/optparse-test/ConfigTest.hs view
@@ -32,6 +32,12 @@ , ("config add-release-channel StackSetupURL" , AddReleaseChannel False NewStackSetupURL )+ , ("config add-release-channel default"+ , AddReleaseChannel False (NewChannelAlias DefaultChannel)+ )+ , ("config add-release-channel stack"+ , AddReleaseChannel False (NewChannelAlias StackChannel)+ ) , ("config add-release-channel cross" , AddReleaseChannel False (NewChannelAlias CrossChannel) )
test/optparse-test/InstallTest.hs view
@@ -32,15 +32,15 @@ ] defaultOptions :: InstallOptions-defaultOptions = InstallOptions Nothing Nothing False Nothing False []+defaultOptions = InstallOptions Nothing Nothing False Nothing False "install" [] -- | Don't set as active version mkInstallOptions :: ToolVersion -> InstallOptions-mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []+mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False "install" [] -- | Set as active version mkInstallOptions' :: ToolVersion -> InstallOptions-mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []+mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False "install" [] oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)] oldStyleCheckList =