Compare commits

...

53 Commits

Author SHA1 Message Date
072161ada2 Don't fail to set ghc version if already installed
Fixes #291
2022-01-30 17:59:27 +01:00
a67b3e8a57 Merge branch 'improve-hls-compile-help' 2022-01-29 20:37:32 +01:00
c9216fb444 Improve help output of hls compile 2022-01-29 20:02:33 +01:00
2aac17ac5f Merge branch 'issue-305' 2022-01-28 23:47:36 +01:00
17a403b8ce Merge branch 'issue-307' 2022-01-28 23:20:16 +01:00
b245c11b1d Allow to disable self-upgrade functionality wrt #305 2022-01-28 23:08:35 +01:00
2ed047515e Merge remote-tracking branch 'origin/merge-requests/232' 2022-01-28 22:51:22 +01:00
b16e561384 Allow unpacking legacy lzma archives, fixes #307 2022-01-28 22:48:23 +01:00
Phil Ruffwind
2ebff1e887 Fix the indentation in env files
This changes the indentation from tabs to spaces, since tabs get
stripped by the heredoc.
2022-01-26 01:15:06 -08:00
655ee432f8 Merge remote-tracking branch 'origin/merge-requests/231' 2022-01-19 17:03:29 +01:00
67b7b2f292 Don't print to stdout during logging 2022-01-19 15:40:58 +01:00
66961101c6 Add documentation about mirrors, fixes #300 2022-01-19 13:04:00 +01:00
326af49a8f Merge remote-tracking branch 'origin/merge-requests/229' 2022-01-17 21:15:30 +01:00
3a7ed5ee2d Fix hlint warnings 2022-01-12 22:55:00 +01:00
56fa798406 Merge remote-tracking branch 'origin/merge-requests/230' 2022-01-12 22:34:46 +01:00
James Hobson
3fd9fae66a Changed to use IO Exceptions 2022-01-12 13:31:10 +01:00
James Hobson
5d43168370 Updated help message for ghcup compile ghc -h 2022-01-12 10:06:38 +01:00
James Hobson
f8548fefb3 Added support for quilt series files when patching 2022-01-12 10:01:48 +01:00
Phil Ruffwind
3565c32d51 Avoid adding duplicates to PATH
Without this, each time the env script gets executed it will add a copy
of the paths to PATH. This can happen when shells are nested.

The "case" trick was inspired by:
184a899f45/src/cli/self_update/env.sh
2022-01-08 00:34:16 -08:00
7fab328acc Document versions and tags better 2022-01-06 15:54:27 +08:00
a043b82b27 Fix docs 2021-12-06 20:00:41 +01:00
20652fed94 Fix comments in bootstrap-haskell.ps1 2021-12-06 20:00:17 +01:00
6fc52a4ec7 Merge branch 'freebsd1333' 2021-12-02 17:49:19 +01:00
834bcfa02c Use FreeBSD 13 in bootstrap script as well 2021-12-02 17:48:56 +01:00
c99ecc0a66 Fix FreeBSD 13 build 2021-12-02 17:48:33 +01:00
061e5dd832 Fix FreeBSD 13 build 2021-12-02 15:53:06 +01:00
c97ade81fa Revert "Fix arch detection on macos"
This reverts commit dbadcf1858.
2021-12-01 20:54:44 +01:00
82a22fe993 Merge branch 'darwin-arch' 2021-12-01 20:39:05 +01:00
dbadcf1858 Fix arch detection on macos 2021-12-01 20:27:03 +01:00
ff8865c5c3 Fix bootstrap on FreeBSD 2021-11-30 22:40:18 +01:00
9833dee925 Fix freebsd bootstrap 2021-11-30 21:35:33 +01:00
aac2874f8f Fix boostrap-haskell on FreeBSD 13 2021-11-30 19:00:33 +01:00
17524b21b3 Merge branch 'issue-289' 2021-11-22 23:18:52 +01:00
3f0befe30d Fix ghcup whereis ghc for non-standard versions, fixes #289 2021-11-22 22:53:59 +01:00
76c286f95e Use upstream terminal-size 2021-11-22 22:51:58 +01:00
0c415314b6 Bump GHC version in bootstrap-haskell 2021-11-16 20:11:32 +01:00
717f386077 Merge branch 'issue-285' 2021-11-14 17:52:08 +01:00
7a841a480b Run cabal update with --ignore-project, fixes #285 2021-11-14 17:49:59 +01:00
43ea85b495 Also fix redundant upgrade warnings for 'ghcup upgrade' 2021-11-14 16:24:13 +01:00
8a6badca1d Update changelog 2021-11-14 14:03:06 +01:00
4064803e23 Merge branch 'issue-283' 2021-11-14 00:23:07 +01:00
2e03b075f8 Avoid redundant warnings when installing tools, fixes #283 2021-11-13 22:59:52 +01:00
fe9c125bd6 Refreeze 2021-11-13 22:53:39 +01:00
503fd57d7c Merge branch 'issue-282' 2021-11-13 20:42:13 +01:00
e74e746213 Trim whitespaces wrt #282 2021-11-13 20:35:50 +01:00
065f9c4965 Fix compile HLS CI 2021-11-13 16:56:38 +01:00
32f3c36589 Set HOMEBREW_TEMP to something shorter
This fixes unix socket errors, because there's a max path length for
those.
2021-11-13 16:53:31 +01:00
c2a8d39fb4 Bump to 0.1.17.4 2021-11-12 20:52:08 +01:00
f08cbe70fb Merge branch 'issue-281' 2021-11-12 20:42:43 +01:00
a9630d0802 Cooler patching 2021-11-12 19:52:00 +01:00
c5c6c431b5 Allow remote URIs for --cabal-project-local wrt #281 2021-11-12 19:05:13 +01:00
71d78d2d72 Update cabal.project 2021-11-12 19:04:46 +01:00
ccecda2eff Merge branch 'dynamic-hls' 2021-11-12 17:57:15 +01:00
28 changed files with 536 additions and 315 deletions

View File

@@ -186,8 +186,8 @@ variables:
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs - mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p $CI_PROJECT_DIR/.brew_tmp - mkdir -p /private/tmp/.brew_tmp
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp - export HOMEBREW_TEMP=/private/tmp/.brew_tmp
# update and install packages # update and install packages
- brew update - brew update
@@ -217,6 +217,9 @@ variables:
- .freebsd13 - .freebsd13
- .root_cleanup - .root_cleanup
before_script: before_script:
- sudo pkg update
- sudo pkg install --yes compat12x-amd64
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
.test_ghcup_version:windows: .test_ghcup_version:windows:
@@ -545,8 +548,8 @@ release:darwin:aarch64:
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs - mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p $CI_PROJECT_DIR/.brew_tmp - mkdir -p /private/tmp/.brew_tmp
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp - export HOMEBREW_TEMP=/private/tmp/.brew_tmp
# update and install packages # update and install packages
- brew update - brew update
@@ -595,6 +598,9 @@ release:freebsd13:
- .release_ghcup - .release_ghcup
- .root_cleanup - .root_cleanup
before_script: before_script:
- sudo pkg update
- sudo pkg install --yes compat12x-amd64
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
variables: variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup" ARTIFACT: "x86_64-portbld-freebsd-ghcup"

View File

@@ -12,4 +12,8 @@ if [ "${OS}" = "WINDOWS" ] ; then
rm -Rf /c/ghcup rm -Rf /c/ghcup
fi fi
if [ "${OS}" = "DARWIN" ] ; then
rm -Rf /private/tmp/.brew_tmp
fi
exit 0 exit 0

View File

@@ -43,7 +43,7 @@ cabal --version
eghcup debug-info eghcup debug-info
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION} eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ] [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]

View File

@@ -1,5 +1,14 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.17.4 -- 2021-11-13
* add `--metadata-caching` option, allowing to also disable yaml metadata caching wrt [#278](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/278)
* make upgrading ghcup in TUI more pleasant wrt [#276](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/276)
* fix parsing of atypical GHC versions (e.g. `8.10.5-patch1`)
* fix compiling HLS dynamically linked, also see [#245](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/245)
* redo (and break) some of the `ghcup compile <tool>` interface, improving patch options and setting custom cabal.project files
* avoid redundant update warnings wrt [#283](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283)
## 0.1.17.3 -- 2021-10-27 ## 0.1.17.3 -- 2021-10-27
* clean up during unpack failures as well * clean up during unpack failures as well

View File

@@ -15,7 +15,9 @@ module GHCup.OptParse (
, module GHCup.OptParse.Config , module GHCup.OptParse.Config
, module GHCup.OptParse.Whereis , module GHCup.OptParse.Whereis
, module GHCup.OptParse.List , module GHCup.OptParse.List
#ifndef DISABLE_UPGRADE
, module GHCup.OptParse.Upgrade , module GHCup.OptParse.Upgrade
#endif
, module GHCup.OptParse.ChangeLog , module GHCup.OptParse.ChangeLog
, module GHCup.OptParse.Prefetch , module GHCup.OptParse.Prefetch
, module GHCup.OptParse.GC , module GHCup.OptParse.GC
@@ -35,7 +37,9 @@ import GHCup.OptParse.Compile
import GHCup.OptParse.Config import GHCup.OptParse.Config
import GHCup.OptParse.Whereis import GHCup.OptParse.Whereis
import GHCup.OptParse.List import GHCup.OptParse.List
#ifndef DISABLE_UPGRADE
import GHCup.OptParse.Upgrade import GHCup.OptParse.Upgrade
#endif
import GHCup.OptParse.ChangeLog import GHCup.OptParse.ChangeLog
import GHCup.OptParse.Prefetch import GHCup.OptParse.Prefetch
import GHCup.OptParse.GC import GHCup.OptParse.GC
@@ -89,7 +93,9 @@ data Command
| Compile CompileCommand | Compile CompileCommand
| Config ConfigCommand | Config ConfigCommand
| Whereis WhereisOptions WhereisCommand | Whereis WhereisOptions WhereisCommand
#ifndef DISABLE_UPGRADE
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
#endif
| ToolRequirements | ToolRequirements
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
| Nuke | Nuke
@@ -208,6 +214,7 @@ com =
(info (List <$> listOpts <**> helper) (info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools") (progDesc "Show available GHCs and other tools")
) )
#ifndef DISABLE_UPGRADE
<> command <> command
"upgrade" "upgrade"
(info (info
@@ -218,6 +225,7 @@ com =
) )
(progDesc "Upgrade ghcup") (progDesc "Upgrade ghcup")
) )
#endif
<> command <> command
"compile" "compile"
( Compile ( Compile

View File

@@ -89,18 +89,6 @@ toolVersionArgument criteria tool =
mv _ = "VERSION|TAG" mv _ = "VERSION|TAG"
toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionOption criteria tool =
option (eitherReader toolVersionEither)
( sh tool
<> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool)
where
sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG"
sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG"
sh _ = long "version" <> metavar "VERSION|TAG"
versionParser :: Parser GHCTargetVersion versionParser :: Parser GHCTargetVersion
versionParser = option versionParser = option
(eitherReader tVersionEither) (eitherReader tVersionEither)
@@ -208,8 +196,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
] ]
bindistParser :: String -> Either String URI uriParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
absolutePathParser :: FilePath -> Either String FilePath absolutePathParser :: FilePath -> Either String FilePath
@@ -472,42 +460,22 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
=> m () => m [(Tool, Version)]
checkForUpdates = do checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled) lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
forM_ (getLatest dls GHCup) $ \(l, _) -> do ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
$ logWarn $
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
forM_ (getLatest dls GHC) $ \(l, _) -> do otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
let mghc_ver = latestInstalled GHC forMM (getLatest dls t) $ \(l, _) -> do
forM mghc_ver $ \ghc_ver -> let mver = latestInstalled t
when (l > ghc_ver) forMM mver $ \ver ->
$ logWarn $ if (l > ver) then pure $ Just (t, l) else pure Nothing
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
forM_ (getLatest dls Cabal) $ \(l, _) -> do pure $ catMaybes (ghcup:otherTools)
let mcabal_ver = latestInstalled Cabal where
forM mcabal_ver $ \cabal_ver -> forMM a f = fmap join $ forM a f
when (l > cabal_ver)
$ logWarn $
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
forM_ (getLatest dls HLS) $ \(l, _) -> do
let mhls_ver = latestInstalled HLS
forM mhls_ver $ \hls_ver ->
when (l > hls_ver)
$ logWarn $
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver ->
when (l > stack_ver)
$ logWarn $
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"

View File

@@ -40,6 +40,7 @@ import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import System.FilePath (isPathSeparator) import System.FilePath (isPathSeparator)
@@ -68,7 +69,7 @@ data GHCCompileOptions = GHCCompileOptions
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe FilePath , buildConfig :: Maybe FilePath
, patchDir :: Maybe FilePath , patches :: Maybe (Either FilePath [URI])
, crossTarget :: Maybe Text , crossTarget :: Maybe Text
, addConfArgs :: [Text] , addConfArgs :: [Text]
, setCompile :: Bool , setCompile :: Bool
@@ -84,9 +85,9 @@ data HLSCompileOptions = HLSCompileOptions
, setCompile :: Bool , setCompile :: Bool
, ovewrwiteVer :: Maybe Version , ovewrwiteVer :: Maybe Version
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, cabalProject :: Maybe FilePath , cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe FilePath , cabalProjectLocal :: Maybe URI
, patchDir :: Maybe FilePath , patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion] , targetGHCs :: [ToolVersion]
, cabalArgs :: [Text] , cabalArgs :: [Text]
} }
@@ -199,13 +200,23 @@ ghcCompileOpts =
"Absolute path to build config file" "Absolute path to build config file"
) )
) )
<*> optional <*> (optional
(option (
str (fmap Right $ many $ option
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (eitherReader uriParser)
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)"
)
)
<|>
(fmap Left $ option
str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
)
) )
) )
)
<*> optional <*> optional
(option (option
str str
@@ -300,26 +311,41 @@ hlsCompileOpts =
) )
<*> optional <*> optional
(option (option
str ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over." "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
) )
) )
<*> optional <*> optional
(option (option
(eitherReader absolutePathParser) (eitherReader uriParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
"Absolute path to a cabal.project.local to be used for the build. Will be copied over." "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
) )
) )
<*> optional <*> (optional
(option (
(eitherReader absolutePathParser) (fmap Right $ many $ option
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (eitherReader uriParser)
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)"
)
)
<|>
(fmap Left $ option
str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
)
) )
) )
<*> some (toolVersionOption Nothing (Just GHC)) )
<*> some (
option (eitherReader toolVersionEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC))
)
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)")) <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -408,11 +434,11 @@ compile :: ( Monad m
) )
=> CompileCommand => CompileCommand
-> Settings -> Settings
-> Dirs
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a)) -> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
compile compileCommand settings runAppState runLogger = do compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
case compileCommand of case compileCommand of
(CompileHLS HLSCompileOptions { .. }) -> do (CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS runAppState (do runCompileHLS runAppState (do
@@ -435,7 +461,7 @@ compile compileCommand settings runAppState runLogger = do
isolateDir isolateDir
cabalProject cabalProject
cabalProjectLocal cabalProjectLocal
patchDir patches
cabalArgs cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls let vi = getVersionInfo targetVer HLS dls
@@ -483,7 +509,7 @@ compile compileCommand settings runAppState runLogger = do
bootstrapGhc bootstrapGhc
jobs jobs
buildConfig buildConfig
patchDir patches
addConfArgs addConfArgs
buildFlavour buildFlavour
hadrian hadrian

View File

@@ -37,7 +37,7 @@ import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
@@ -187,7 +187,7 @@ installOpts tool =
<*> ( ( (,) <*> ( ( (,)
<$> optional <$> optional
(option (option
(eitherReader bindistParser) (eitherReader uriParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist" "Install the specified version from this bindist"
) )
@@ -268,6 +268,64 @@ runInstTool appstate' mInstPlatform =
@InstallEffects @InstallEffects
type InstallGHCEffects = '[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
, BuildFailed
, DirNotEmpty
, AlreadyInstalled
, (AlreadyInstalled, NotInstalled)
, (UnknownArchive, NotInstalled)
, (ArchiveResult, NotInstalled)
, (FileDoesNotExistError, NotInstalled)
, (CopyError, NotInstalled)
, (NotInstalled, NotInstalled)
, (DirNotEmpty, NotInstalled)
, (NoDownload, NotInstalled)
, (BuildFailed, NotInstalled)
, (TagNotFound, NotInstalled)
, (DigestError, NotInstalled)
, (GPGError, NotInstalled)
, (DownloadFailed, NotInstalled)
, (TarDirDoesNotExist, NotInstalled)
, (NextVerNotFound, NotInstalled)
, (NoToolVersionSet, NotInstalled)
, (FileAlreadyExistsError, NotInstalled)
, (ProcessError, NotInstalled)
, (AlreadyInstalled, ())
, (UnknownArchive, ())
, (ArchiveResult, ())
, (FileDoesNotExistError, ())
, (CopyError, ())
, (NotInstalled, ())
, (DirNotEmpty, ())
, (NoDownload, ())
, (BuildFailed, ())
, (TagNotFound, ())
, (DigestError, ())
, (GPGError, ())
, (DownloadFailed, ())
, (TarDirDoesNotExist, ())
, (NextVerNotFound, ())
, (NoToolVersionSet, ())
, (FileAlreadyExistsError, ())
, (ProcessError, ())
, ((), NotInstalled)
]
runInstGHC :: AppState
-> Maybe PlatformRequest
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC appstate' mInstPlatform =
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT
. runE
@InstallGHCEffects
------------------- -------------------
--[ Entrypoints ]-- --[ Entrypoints ]--
@@ -288,23 +346,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
installGHC InstallOptions{..} = do installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do Nothing -> runInstGHC s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin void $ liftE $ sequenceE (installGHCBin
(_tvVersion v)
isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
Just uri -> do
runInstTool s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly )
$ when instSet $ void $ setGHC v SetGHCOnly
pure vi
Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
void $ liftE $ sequenceE (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
isolateDir
forceInstall
)
$ when instSet $ void $ setGHC v SetGHCOnly
pure vi pure vi
) )
>>= \case >>= \case
@@ -313,14 +373,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'" "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless." "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (DirNotEmpty fp, ())) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyShow err) Never -> runLogger (logError $ T.pack $ prettyShow err)
@@ -328,6 +399,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <> "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _, ())) -> do
case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyShow err)
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e

View File

@@ -113,17 +113,17 @@ runUpgrade runAppState =
upgrade :: ( Monad m upgrade :: ( Monad m
, MonadMask m , MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> UpgradeOpts => UpgradeOpts
-> Bool -> Bool
-> Dirs
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
upgrade uOpts force' runAppState runLogger = do upgrade uOpts force' Dirs{..} runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p

View File

@@ -20,6 +20,7 @@ import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Platform import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics hiding ( toolRequirements )
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
@@ -39,6 +40,7 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions
import GHC.IO.Encoding import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH import Language.Haskell.TH
@@ -138,7 +140,12 @@ main = do
<> hidden <> hidden
) )
let listCommands = infoOption let listCommands = infoOption
"install set rm install-cabal list upgrade compile debug-info tool-requirements changelog" ("install set rm install-cabal list"
#ifndef DISABLE_UPGRADE
<> " upgrade"
#endif
<> " compile debug-info tool-requirements changelog"
)
( long "list-commands" ( long "list-commands"
<> help "List available commands for shell completion" <> help "List available commands for shell completion"
<> internal <> internal
@@ -191,7 +198,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
------------------------- -------------------------
appState = do let appState = do
pfreq <- ( pfreq <- (
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
) >>= \case ) >>= \case
@@ -227,8 +234,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#if defined(BRICK) #if defined(BRICK)
Interactive -> pure () Interactive -> pure ()
#endif #endif
-- check for new tools
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runReaderT checkForUpdates s' Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
alreadyInstalling' <- alreadyInstalling optCommand newTool
when (not alreadyInstalling') $
case t of
#ifdef DISABLE_UPGRADE
GHCup -> pure ()
#else
GHCup -> runLogger $
logWarn ("New GHCup version available: "
<> prettyVer l
<> ". To upgrade, run 'ghcup upgrade'")
#endif
_ -> runLogger $
logWarn ("New "
<> T.pack (prettyShow t)
<> " version available. "
<> "To upgrade, run 'ghcup install "
<> T.pack (prettyShow t)
<> " "
<> prettyVer l
<> "'")
Just _ -> pure () Just _ -> pure ()
-- TODO: always run for windows -- TODO: always run for windows
@@ -270,11 +301,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
List lo -> list lo no_color runAppState List lo -> list lo no_color runAppState
Rm rmCommand -> rm rmCommand runAppState runLogger Rm rmCommand -> rm rmCommand runAppState runLogger
DInfo -> dinfo runAppState runLogger DInfo -> dinfo runAppState runLogger
Compile compileCommand -> compile compileCommand settings runAppState runLogger Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
Config configCommand -> config configCommand settings keybindings runLogger Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
Upgrade uOpts force' -> upgrade uOpts force' runAppState runLogger #ifndef DISABLE_UPGRADE
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
#endif
ToolRequirements -> toolRequirements runAppState runLogger ToolRequirements -> toolRequirements runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
Nuke -> nuke appState runLogger Nuke -> nuke appState runLogger
@@ -287,4 +320,58 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure () pure ()
where
alreadyInstalling :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Command
-> (Tool, Version)
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
#ifndef DISABLE_UPGRADE
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
#endif
alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Tool
-> Maybe ToolVersion
-> Version
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == mkTVer ver)

View File

@@ -4,6 +4,7 @@ constraints: any.Cabal ==3.6.2.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2, any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
@@ -28,10 +29,10 @@ constraints: any.Cabal ==3.6.2.0,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.base ==4.14.3.0, any.base ==4.14.3.0,
any.base-compat ==0.12.0, any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.0, any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.5, any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.1.0, any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.1.0.0, any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
@@ -87,13 +88,13 @@ constraints: any.Cabal ==3.6.2.0,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1, any.ghc-prim ==0.6.1,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.4.1, any.hashable ==1.3.5.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4, any.heaps ==0.4,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
@@ -103,8 +104,8 @@ constraints: any.Cabal ==3.6.2.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor, http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1, any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1, any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1, any.indexed-traversable-instances ==0.1.1,
any.integer-gmp ==1.0.3.0, any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1, any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp, integer-logarithms -check-bounds +integer-gmp,
@@ -145,13 +146,13 @@ constraints: any.Cabal ==3.6.2.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.2.0, any.primitive ==0.7.3.0,
any.process ==1.6.13.2, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1, any.random ==1.2.1,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
@@ -164,13 +165,13 @@ constraints: any.Cabal ==3.6.2.0,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0, any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple, scientific -bytestring-builder -integer-simple,
any.semialign ==1.2, any.semialign ==1.2.0.1,
semialign +semigroupoids, semialign +semigroupoids,
any.semigroupoids ==5.3.6, any.semigroupoids ==5.3.6,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.1, any.stm ==2.5.0.1,
any.streamly ==0.8.0, any.streamly ==0.8.0,
@@ -200,14 +201,14 @@ constraints: any.Cabal ==3.6.2.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.5, any.unix-bytestring ==0.3.7.6,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
unix-compat -old-time, unix-compat -old-time,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.15.0,
unordered-containers -debug, unordered-containers -debug,
any.uri-bytestring ==0.3.3.1, any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror, uri-bytestring -lib-werror,
@@ -226,4 +227,4 @@ constraints: any.Cabal ==3.6.2.0,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5 any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-24T10:21:56Z index-state: hackage.haskell.org 2021-11-12T11:11:19Z

View File

@@ -4,6 +4,7 @@ constraints: any.Cabal ==3.6.2.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2, any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
@@ -28,10 +29,10 @@ constraints: any.Cabal ==3.6.2.0,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.base ==4.15.0.0, any.base ==4.15.0.0,
any.base-compat ==0.12.0, any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.0, any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.5, any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.1.0, any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.1.0.0, any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
@@ -88,13 +89,13 @@ constraints: any.Cabal ==3.6.2.0,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0, any.ghc-prim ==0.7.0,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.4.1, any.hashable ==1.3.5.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4, any.heaps ==0.4,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
@@ -104,8 +105,8 @@ constraints: any.Cabal ==3.6.2.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor, http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1, any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1, any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1, any.indexed-traversable-instances ==0.1.1,
any.integer-logarithms ==1.0.3.1, any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp, integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1, any.io-streams ==1.5.2.1,
@@ -145,13 +146,13 @@ constraints: any.Cabal ==3.6.2.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.2.0, any.primitive ==0.7.3.0,
any.process ==1.6.11.0, any.process ==1.6.11.0,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1, any.random ==1.2.1,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
@@ -164,13 +165,13 @@ constraints: any.Cabal ==3.6.2.0,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0, any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple, scientific -bytestring-builder -integer-simple,
any.semialign ==1.2, any.semialign ==1.2.0.1,
semialign +semigroupoids, semialign +semigroupoids,
any.semigroupoids ==5.3.6, any.semigroupoids ==5.3.6,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.0, any.stm ==2.5.0.0,
any.streamly ==0.8.0, any.streamly ==0.8.0,
@@ -200,14 +201,14 @@ constraints: any.Cabal ==3.6.2.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.5, any.unix-bytestring ==0.3.7.6,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
unix-compat -old-time, unix-compat -old-time,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.15.0,
unordered-containers -debug, unordered-containers -debug,
any.uri-bytestring ==0.3.3.1, any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror, uri-bytestring -lib-werror,
@@ -226,4 +227,4 @@ constraints: any.Cabal ==3.6.2.0,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5 any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-24T10:21:56Z index-state: hackage.haskell.org 2021-11-12T11:11:19Z

View File

@@ -8,16 +8,15 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0, any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/hasufell/packages.git
tag: cc0b4688f8bb374fa92f17c856949de795b56291
subdir: haskus-utils-variant
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive

View File

@@ -12,8 +12,7 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`. `GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in the appropriate Download information on where to fetch bindists from is in the [ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository.
yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
## Design decisions ## Design decisions

View File

@@ -32,6 +32,17 @@ ghcup install cabal
ghcup upgrade ghcup upgrade
``` ```
### Tags and shortcuts
GHCup has a number of tags and version shortcuts, that can be used as arguments to **install**/**set** etc.
All of the following are valid arguments to `ghcup install ghc`:
* `latest`, `recommended`
* `base-4.15.1.0`
* `9.0.2`, `9.0`, `9`
If the argument is omitted, the default is `recommended`.
## Configuration ## Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
@@ -138,6 +149,31 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected). detected).
## Mirrors
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
To use a mirror, set the following option in `~/.ghcup/config.yaml`:
```yml
url-source:
# Accepts file/http/https scheme
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
```
See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
for more options.
Alternatively you can do it via a cli switch:
```sh
ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
```
### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
## Isolated installs ## Isolated installs
Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing. Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.

View File

@@ -24,6 +24,14 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries. If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
### Which versions get installed?
GHCup has two main channels for every tool: **recommended** and **latest**. By default, it installs *recommended*.
*latest* follows the latest release of every tool, while *recommended* is at the discretion of the GHCup maintainers and based on community adoption (hackage libraries, tools like HLS, stackage support, etc.) and known bugs.
Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
## First steps ## First steps
1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide 1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.17.3 version: 0.1.17.4
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -48,6 +48,13 @@ flag no-exe
default: False default: False
manual: True manual: True
flag disable-upgrade
description:
Build the brick powered tui (ghcup tui). This is disabled on windows.
default: False
manual: True
library library
exposed-modules: exposed-modules:
GHCup GHCup
@@ -166,11 +173,10 @@ library
GHCup.Utils.File.Posix GHCup.Utils.File.Posix
GHCup.Utils.Posix GHCup.Utils.Posix
GHCup.Utils.Prelude.Posix GHCup.Utils.Prelude.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
build-depends: build-depends:
, bz2 >=0.5.0.5 && <1.1 , bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.2.1
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3.7.3 , unix-bytestring ^>=0.3.7.3
@@ -196,7 +202,6 @@ executable ghcup
GHCup.OptParse.Set GHCup.OptParse.Set
GHCup.OptParse.ToolRequirements GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup hs-source-dirs: app/ghcup
@@ -263,6 +268,12 @@ executable ghcup
if flag(no-exe) if flag(no-exe)
buildable: False buildable: False
if (flag(disable-upgrade))
cpp-options: -DDISABLE_UPGRADE
else
other-modules:
GHCup.OptParse.Upgrade
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs

View File

@@ -62,7 +62,7 @@ import Data.String ( fromString )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Format.ISO8601 import Data.Time.Format.ISO8601
import Data.Versions import Data.Versions hiding ( patch )
import Distribution.Types.Version hiding ( Version ) import Distribution.Types.Version hiding ( Version )
import Distribution.Types.PackageId import Distribution.Types.PackageId
import Distribution.Types.PackageDescription import Distribution.Types.PackageDescription
@@ -84,6 +84,7 @@ import System.IO.Error
import System.IO.Temp import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
@@ -750,9 +751,9 @@ compileHLS :: ( MonadMask m
-> Maybe Int -> Maybe Int
-> Maybe Version -> Maybe Version
-> Maybe FilePath -> Maybe FilePath
-> Maybe FilePath -> Maybe (Either FilePath URI)
-> Maybe FilePath -> Maybe URI
-> Maybe FilePath -> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to cabal install -> [Text] -- ^ additional args to cabal install
-> Excepts '[ NoDownload -> Excepts '[ NoDownload
, GPGError , GPGError
@@ -764,7 +765,7 @@ compileHLS :: ( MonadMask m
, BuildFailed , BuildFailed
, NotInstalled , NotInstalled
] m Version ] m Version
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir cabalArgs = do compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs Dirs { .. } <- lift getDirs
@@ -836,23 +837,30 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
liftE $ runBuildAction liftE $ runBuildAction
workdir workdir
Nothing Nothing
(reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
let installDir = workdir </> "out" let installDir = workdir </> "out"
liftIO $ createDirRecursive' installDir liftIO $ createDirRecursive' installDir
-- apply patches -- apply patches
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) liftE $ applyAnyPatch patches workdir
-- set up project files -- set up project files
cp <- case cabalProject of cp <- case cabalProject of
Just cp Just (Left cp)
| isAbsolute cp -> do | isAbsolute cp -> do
copyFileE cp (workdir </> "cabal.project") copyFileE cp (workdir </> "cabal.project")
pure "cabal.project" pure "cabal.project"
| otherwise -> pure (takeFileName cp) | otherwise -> pure (takeFileName cp)
Just (Right uri) -> do
tmpUnpack <- lift withGHCupTmpDir
cp <- liftE $ download uri Nothing Nothing tmpUnpack (Just "cabal.project") False
copyFileE cp (workdir </> "cabal.project")
pure "cabal.project"
Nothing -> pure "cabal.project" Nothing -> pure "cabal.project"
forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local") forM_ cabalProjectLocal $ \uri -> do
tmpUnpack <- lift withGHCupTmpDir
cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
copyFileE cpl (workdir </> cp <.> "local")
artifacts <- forM (sort ghcs) $ \ghc -> do artifacts <- forM (sort ghcs) $ \ghc -> do
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc) let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
liftIO $ createDirRecursive' installDir liftIO $ createDirRecursive' installDir
@@ -2088,7 +2096,7 @@ compileGHC :: ( MonadMask m
-> Either Version FilePath -- ^ version to bootstrap with -> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
-> Maybe FilePath -- ^ build config -> Maybe FilePath -- ^ build config
-> Maybe FilePath -- ^ patch directory -> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to ./configure -> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour -> Maybe String -- ^ build flavour
-> Bool -> Bool
@@ -2117,7 +2125,7 @@ compileGHC :: ( MonadMask m
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -2141,7 +2149,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
workdir <- maybe (pure tmpUnpack) workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack) (liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo) (view dlSubdir dlInfo)
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) liftE $ applyAnyPatch patches workdir
pure (workdir, tmpUnpack, tver) pure (workdir, tmpUnpack, tver)
@@ -2149,7 +2157,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
Right GitBranch{..} -> do Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH] DownloadFailed $ do tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)" lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ] lEM $ git [ "init" ]
@@ -2169,7 +2177,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
lEM $ git [ "checkout", "FETCH_HEAD" ] lEM $ git [ "checkout", "FETCH_HEAD" ]
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ] lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
forM_ patchdir (\dir -> liftE $ applyPatches dir tmpUnpack) liftE $ applyAnyPatch patches tmpUnpack
lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap" lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap" lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut CapturedProcess {..} <- lift $ makeOut
@@ -2844,3 +2852,25 @@ rmTmp = do
let p = tmpdir </> f let p = tmpdir </> f
logDebug $ "rm -rf " <> T.pack p logDebug $ "rm -rf " <> T.pack p
rmPathForcibly p rmPathForcibly p
applyAnyPatch :: ( MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
, MonadUnliftIO m
, MonadCatch m
, MonadResource m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> Maybe (Either FilePath [URI])
-> FilePath
-> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Nothing _ = pure ()
applyAnyPatch (Just (Left pdir)) workdir = liftE $ applyPatches pdir workdir
applyAnyPatch (Just (Right uris)) workdir = do
tmpUnpack <- lift withGHCupTmpDir
forM_ uris $ \uri -> do
patch <- liftE $ download uri Nothing Nothing tmpUnpack Nothing False
liftE $ applyPatch patch workdir

View File

@@ -4,7 +4,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|

View File

@@ -3,7 +3,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
@@ -67,7 +67,7 @@ import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions hiding ( patch )
import GHC.IO.Exception import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@@ -715,7 +715,7 @@ unpackToDir dfp av = do
(untar . GZip.decompress =<< rf av) (untar . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do | ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av filecontents <- liftE $ rf av
let decompressed = Lzma.decompress filecontents let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ untar decompressed liftE $ untar decompressed
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av) liftE (untar . BZip.decompress =<< rf av)
@@ -744,7 +744,7 @@ getArchiveFiles av = do
(entries . GZip.decompress =<< rf av) (entries . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do | ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av filecontents <- liftE $ rf av
let decompressed = Lzma.decompress filecontents let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ entries decompressed liftE $ entries decompressed
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av) liftE (entries . BZip.decompress =<< rf av)
@@ -879,28 +879,43 @@ makeOut args workdir = do
executeOut mymake args workdir executeOut mymake args workdir
-- | Try to apply patches in order. Fails with 'PatchFailed' -- | Try to apply patches in order. The order is determined by
-- on first failure. -- a quilt series file (in the patch directory) if one exists,
-- else the patches are applied in lexicographical order.
-- Fails with 'PatchFailed' on first failure.
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m) applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ dir containing patches => FilePath -- ^ dir containing patches
-> FilePath -- ^ dir to apply patches in -> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m () -> Excepts '[PatchFailed] m ()
applyPatches pdir ddir = do applyPatches pdir ddir = do
patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles let lexicographical = (fmap . fmap) (pdir </>) $ sort <$> findFiles
pdir pdir
(makeRegexOpts compExtended (makeRegexOpts compExtended
execBlank execBlank
([s|.+\.(patch|diff)$|] :: ByteString) ([s|.+\.(patch|diff)$|] :: ByteString)
) )
forM_ (sort patches) $ \patch' -> do let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
lift $ logInfo $ "Applying patch " <> T.pack patch'
fmap (either (const Nothing) Just) patches <- liftIO $ quilt `catchIO` (\e ->
(exec if isDoesNotExistError e || isPermissionError e then
"patch" lexicographical
["-p1", "-i", patch'] else throwIO e)
(Just ddir) forM_ patches $ \patch' -> applyPatch patch' ddir
Nothing)
!? PatchFailed
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ Patch
-> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m ()
applyPatch patch ddir = do
lift $ logInfo $ "Applying patch " <> T.pack patch
fmap (either (const Nothing) Just)
(exec
"patch"
["-p1", "-s", "-f", "-i", patch]
(Just ddir)
Nothing)
!? PatchFailed
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
@@ -1134,11 +1149,11 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
-- | For ghc without arch triple, this is: -- | For ghc without arch triple, this is:
-- --
-- - ghc-<ver> (e.g. ghc-8.10.4) -- - ghc
-- --
-- For ghc with arch triple: -- For ghc with arch triple:
-- --
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4) -- - <triple>-ghc (e.g. arm-linux-gnueabihf-ghc)
ghcBinaryName :: GHCTargetVersion -> String ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)

View File

@@ -35,7 +35,7 @@ import Data.Sequence ( Seq, (|>) )
import Data.List import Data.List
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
import System.Console.Terminal.Common import System.IO ( stderr )
import System.IO.Error import System.IO.Error
import System.FilePath import System.FilePath
import System.Directory import System.Directory
@@ -51,7 +51,7 @@ import qualified Data.Sequence as Sq
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified System.Posix.Process as SPP import qualified System.Posix.Process as SPP
import qualified System.Console.Terminal.Posix as TP import qualified System.Console.Terminal.Size as TP
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified "unix-bytestring" System.Posix.IO.ByteString import qualified "unix-bytestring" System.Posix.IO.ByteString
@@ -143,14 +143,14 @@ execLogged exe args chdir lfile env = do
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO () printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
printToRegion fileFd fdIn size pState no_color = do printToRegion fileFd fdIn size pState no_color = do
-- init region -- init region
forM_ [1..size] $ \_ -> BS.putStr "\n" forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
void $ flip runStateT mempty void $ flip runStateT mempty
$ do $ do
handle handle
(\(ex :: SomeException) -> do (\(ex :: SomeException) -> do
ps <- liftIO $ takeMVar pState ps <- liftIO $ takeMVar pState
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen)) when ps (liftIO $ BS.hPut stderr (pos1 <> moveLineUp size <> clearScreen))
throw ex throw ex
) $ readTilEOF lineAction fdIn ) $ readTilEOF lineAction fdIn
@@ -182,10 +182,10 @@ execLogged exe args chdir lfile env = do
modify (swapRegs bs') modify (swapRegs bs')
liftIO TP.size >>= \case liftIO TP.size >>= \case
Nothing -> pure () Nothing -> pure ()
Just (Window _ w) -> do Just (TP.Window _ w) -> do
regs <- get regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr BS.hPut stderr
. overwriteNthLine (size - i) . overwriteNthLine (size - i)
. trim w . trim w
. blue . blue

View File

@@ -196,7 +196,8 @@ execLogged exe args chdir lfile env = do
then pure () then pure ()
else do else do
void $ BS.appendFile logFile some void $ BS.appendFile logFile some
void $ BS.hPut stdout some -- subprocess stdout also goes to stderr for logging
void $ BS.hPut stderr some
go go

View File

@@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|
Module : GHCup.Utils.String.QQ Module : GHCup.Utils.String.QQ

View File

@@ -4,7 +4,7 @@
{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|

View File

@@ -1,43 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
#if __GLASGOW_HASKELL__ >= 702
#define LANGUAGE_DeriveGeneric
{-# LANGUAGE DeriveGeneric #-}
#endif
module System.Console.Terminal.Common
( Window(..)
) where
import Data.Data (Typeable, Data)
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
#endif
#ifdef LANGUAGE_DeriveGeneric
import GHC.Generics
( Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
#endif
-- | Terminal window width and height
data Window a = Window
{ height :: !a
, width :: !a
} deriving
( Show, Eq, Read, Data, Typeable
, Foldable, Functor, Traversable
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)

View File

@@ -1,65 +0,0 @@
{-# LANGUAGE CApiFFI #-}
module System.Console.Terminal.Posix
( size, fdSize, hSize
) where
import System.Console.Terminal.Common
import Control.Exception (catch)
import Data.Typeable (cast)
import Foreign
import Foreign.C.Error
import Foreign.C.Types
import GHC.IO.FD (FD(FD, fdFD))
import GHC.IO.Handle.Internals (withHandle_)
import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
import Prelude hiding (catch)
#endif
import System.Posix.Types (Fd(Fd))
#include <sys/ioctl.h>
#include <unistd.h>
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
-- Interesting part of @struct winsize@
data CWin = CWin CUShort CUShort
instance Storable CWin where
sizeOf _ = (#size struct winsize)
alignment _ = (#alignment struct winsize)
peek ptr = do
row <- (#peek struct winsize, ws_row) ptr
col <- (#peek struct winsize, ws_col) ptr
return $ CWin row col
poke ptr (CWin row col) = do
(#poke struct winsize, ws_row) ptr row
(#poke struct winsize, ws_col) ptr col
fdSize :: Integral n => Fd -> IO (Maybe (Window n))
fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
_ <- throwErrnoIfMinus1 "ioctl" $
ioctl fd (#const TIOCGWINSZ) ws
CWin row col <- peek ws
return . Just $ Window (fromIntegral row) (fromIntegral col)
`catch`
handler
where
handler :: IOError -> IO (Maybe (Window h))
handler _ = return Nothing
foreign import capi "sys/ioctl.h ioctl"
ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
size :: Integral n => IO (Maybe (Window n))
size = fdSize (Fd (#const STDOUT_FILENO))
hSize :: Integral n => Handle -> IO (Maybe (Window n))
hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
case cast dev of
Nothing -> return Nothing
Just FD { fdFD = fd } -> fdSize (Fd fd)

View File

@@ -25,7 +25,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.17.3" ghver="0.1.17.4"
base_url="https://downloads.haskell.org/~ghcup" base_url="https://downloads.haskell.org/~ghcup"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -39,7 +39,6 @@ case "${plat}" in
;; ;;
*) *)
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}" : "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
export GHCUP_USE_XDG_DIRS
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
@@ -237,7 +236,7 @@ download_ghcup() {
*) die "Unknown architecture: ${arch}" *) die "Unknown architecture: ${arch}"
;; ;;
esac esac
_url=${base_url}/${ghver}/x86_64-portbld-freebsd${freebsd_ver}-ghcup-${ghver} _url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
;; ;;
"Darwin"|"darwin") "Darwin"|"darwin")
case "${arch}" in case "${arch}" in
@@ -281,7 +280,20 @@ download_ghcup() {
# we may overwrite this in adjust_bashrc # we may overwrite this in adjust_bashrc
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file" cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH" case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="${GHCUP_BIN}:\$PATH"
;;
esac
case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$HOME/.cabal/bin:\$PATH"
;;
esac
EOF EOF
# shellcheck disable=SC1090 # shellcheck disable=SC1090
@@ -369,12 +381,38 @@ adjust_bashrc() {
case $1 in case $1 in
1) 1)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file" cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH" case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="${GHCUP_BIN}:\$PATH"
;;
esac
case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$HOME/.cabal/bin:\$PATH"
;;
esac
EOF EOF
;; ;;
2) 2)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file" cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}" case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$PATH:\$HOME/.cabal/bin"
;;
esac
case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="\$PATH:${GHCUP_BIN}"
;;
esac
EOF EOF
;; ;;
*) ;; *) ;;
@@ -679,7 +717,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
do_cabal_config_init $ask_cabal_config_init_answer do_cabal_config_init $ask_cabal_config_init_answer
edo cabal new-update edo cabal new-update --ignore-project
else # don't install ghc and cabal else # don't install ghc and cabal
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)

View File

@@ -29,11 +29,11 @@ param (
[switch]$InstallStack, [switch]$InstallStack,
# Whether to install hls as well # Whether to install hls as well
[switch]$InstallHLS, [switch]$InstallHLS,
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$InstallDir,
# Instead of installing a new MSys2, use an existing installation
[string]$BootstrapUrl,
# Specify the install root (default: 'C:\') # Specify the install root (default: 'C:\')
[string]$InstallDir,
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$BootstrapUrl,
# Instead of installing a new MSys2, use an existing installation
[string]$ExistingMsys2Dir, [string]$ExistingMsys2Dir,
# Specify the cabal root directory (default: '$InstallDir\cabal') # Specify the cabal root directory (default: '$InstallDir\cabal')
[string]$CabalDir [string]$CabalDir
@@ -246,6 +246,7 @@ if ($Silent -and !($InstallDir)) {
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix) $GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
} }
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
if (!($GhcupBasePrefix)) { if (!($GhcupBasePrefix)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) { } elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) {
@@ -333,6 +334,7 @@ if ($CabalDir) {
$CabalDirPrompt = Read-Host $CabalDirPrompt = Read-Host
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt] $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
if (!($CabDirEnv)) { if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) { } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
@@ -444,6 +446,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:' Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
$MsysDir = Read-Host $MsysDir = Read-Host
} }
$MsysDir = $MsysDir.TrimEnd().TrimStart()
if (!($MsysDir)) { if (!($MsysDir)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) { } elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {