Compare commits

...

16 Commits

Author SHA1 Message Date
13e01ab453 Fix hlint warnings 2022-07-07 15:05:51 +02:00
873dd77a6f Fix build on windows 2022-07-07 15:05:51 +02:00
544c618473 Don't remove legacy dir if it doesn't exist 2022-07-07 14:03:49 +02:00
a264cb088e Improve 'ghcup compile hls'
1. short hashes now work
2. print the long hash in addition to the detected cabal version of HLS
3. add `--git-describe-version` switch as an alternative to
   `--overwrite-version`

Fix 1. and 2. for GHC as well.
2022-07-06 22:49:11 +02:00
1a43fddca9 Improve about docs 2022-07-02 20:34:19 +02:00
bdfb1a3a9b Merge remote-tracking branch 'origin/merge-requests/264' 2022-06-26 23:14:36 +02:00
9b8b3e8126 Merge remote-tracking branch 'origin/merge-requests/263' 2022-06-26 23:14:10 +02:00
d657c17df4 Merge branch 'issue-375' 2022-06-26 23:11:32 +02:00
why-not-try-calmer
e143c06697 VSCode integration
Typo
2022-06-16 11:07:12 +02:00
Jens Petersen
29da21f5dc bootstrap-haskell: s/will download/can download/
A one word tweak to weaken the language in the initial explanation
to make it "less scary": in general ghcup does not always download
all of ghcup, ghc, cabal, stack, and hls
(unless requested or they are not already installed, etc),
but "will download" sounds like the user is has no choice here
except to always download everything,
which might give them second thoughts about trying this script
and hence adopting ghcup.

Perhaps the wording could be made further more precise,
but at least "can" gives one less anxiety.
2022-06-11 13:06:54 +08:00
d1c72cdff4 Add --mingw-path switch to 'ghcup run' 2022-06-06 23:03:45 +02:00
565bb59f45 Fix ghcup_bootstrap test 2022-06-06 23:03:07 +02:00
aae3f31c50 Fix bootstrap-haskell picking system cabal 2022-06-06 23:03:07 +02:00
0ce9b5d352 Fix test 2022-06-06 23:03:07 +02:00
bf0e5b37ca Test issue #375 2022-06-06 20:22:45 +02:00
fe620835be Fix 'ghcup run' on windows, fixes #375 2022-06-06 20:18:10 +02:00
13 changed files with 228 additions and 61 deletions

View File

@@ -97,17 +97,23 @@ rm -rf "${GHCUP_DIR}"
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}
eghcup unset ghc ${GHC_VERSION}
ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
[ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
[ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
eghcup set cabal ${CABAL_VERSION}
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
eghcup set cabal ${CABAL_VERSION}
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
if [ "${OS}" != "FREEBSD" ] ; then
if [ "${ARCH}" = "64" ] ; then

View File

@@ -82,7 +82,7 @@ data HLSCompileOptions = HLSCompileOptions
{ targetHLS :: Either Version GitBranch
, jobs :: Maybe Int
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, ovewrwiteVer :: Either Bool Version
, isolateDir :: Maybe FilePath
, cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe URI
@@ -145,14 +145,16 @@ Examples:
compileHLSFooter = [s|Discussion:
Compiles and installs the specified HLS version.
The last argument is a list of GHC versions to compile for.
The --ghc arguments are necessary to specify which GHC version to build for/against.
These need to be available in PATH prior to compilation.
Examples:
# compile 1.4.0 for ghc 8.10.5 and 8.10.7
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
# compile from master for ghc 8.10.7, linking everything dynamically
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
# compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
# compile from master for ghc 9.2.3 and use 'git describe' to name the binary
ghcup compile hls -g master --git-describe-version --ghc 9.2.3
# compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
ghcCompileOpts :: Parser GHCCompileOptions
@@ -280,7 +282,7 @@ hlsCompileOpts =
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from"
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
@@ -295,8 +297,9 @@ hlsCompileOpts =
)
)
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
<*> optional
(option
<*>
(
(Right <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
@@ -305,6 +308,14 @@ hlsCompileOpts =
<> (completer $ versionCompleter Nothing HLS)
)
)
<|>
(Left <$> (switch
(long "git-describe-version"
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
)
)
)
)
<*> optional
(option
(eitherReader isolateParser)

View File

@@ -18,6 +18,7 @@ import GHCup.Prelude
import GHCup.Prelude.File
#ifdef IS_WINDOWS
import GHCup.Prelude.Process
import GHCup.Prelude.Process.Windows ( execNoMinGW )
#endif
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
@@ -58,6 +59,7 @@ import qualified System.Posix.Process as SPP
data RunOptions = RunOptions
{ runAppendPATH :: Bool
, runInstTool' :: Bool
, runMinGWPath :: Bool
, runGHCVer :: Maybe ToolVersion
, runCabalVer :: Maybe ToolVersion
, runHLSVer :: Maybe ToolVersion
@@ -82,6 +84,8 @@ runOpts =
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
<*> switch
(short 'i' <> long "install" <> help "Install the tool, if missing")
<*> switch
(short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
<*> optional
(option
(eitherReader toolVersionEither)
@@ -249,7 +253,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
#else
r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
r' <- if runMinGWPath
then runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
else runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ execNoMinGW cmd args Nothing (Just newEnv)
case r' of
VRight _ -> pure ExitSuccess
VLeft e -> do

View File

@@ -340,7 +340,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(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 }))
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right 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

View File

@@ -74,12 +74,15 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
## Known users
* Github actions:
- [actions/virtual-environments](https://github.com/actions/virtual-environments)
- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
* CI:
- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
* mirrors:
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
* tools:
- [vscode-haskell](https://github.com/haskell/vscode-haskell)
- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
- [vabal](https://github.com/Franciman/vabal)
## Known problems

View File

@@ -200,6 +200,14 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## VSCode integration
The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
- instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
## Get help
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)

View File

@@ -164,8 +164,10 @@ library
cpp-options: -DIS_WINDOWS
other-modules:
GHCup.Prelude.File.Windows
GHCup.Prelude.Process.Windows
GHCup.Prelude.Windows
-- GHCup.OptParse.Run uses this
exposed-modules:
GHCup.Prelude.Process.Windows
build-depends:
, bzlib

View File

@@ -566,8 +566,11 @@ rmGHCVer ver = do
lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
lift $ recyclePathForcibly dir'
isDir <- liftIO $ doesDirectoryExist dir
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
recyclePathForcibly dir'
v' <-
handle
@@ -681,28 +684,53 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
-- figure out if we can do a shallow clone
remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
let shallow_clone
| isCommitHash ref = True
| fromString ref `elem` remoteBranches = True
| otherwise = False
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-- fetch
let fetch_args
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
-- initial checkout
lEM $ git [ "checkout", fromString ref ]
-- gather some info
git_describe <- if shallow_clone
then pure Nothing
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-- clone submodules
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
-- apply patches
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
-- bootstrap
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
tver <- case _exitCode of
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
"GHC version (from Makefile): " <> prettyVer tver <>
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
pure tver
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
-- the version that's installed may differ from the

View File

@@ -327,7 +327,7 @@ compileHLS :: ( MonadMask m
=> Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> Either Bool Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
@@ -349,7 +349,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
Dirs { .. } <- lift getDirs
(workdir, tver) <- case targetHLS of
(workdir, tver, git_describe) <- case targetHLS of
-- unpack from version tarball
Left tver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
@@ -369,13 +369,13 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tver)
pure (workdir, tver, Nothing)
-- clone from git
Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ]
@@ -384,33 +384,61 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
-- figure out if we can do a shallow clone
remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
let shallow_clone
| gitDescribeRequested = False
| isCommitHash ref = True
| fromString ref `elem` remoteBranches = True
| otherwise = False
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-- fetch
let fetch_args
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
(Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
pure . (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
-- checkout
lEM $ git [ "checkout", fromString ref ]
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
-- gather some info
git_describe <- if shallow_clone
then pure Nothing
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
(Just gpd) <- parseGenericPackageDescriptionMaybe
<$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
let tver = (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
pure (tmpUnpack, tver)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
"HLS version (from cabal file): " <> prettyVer tver <>
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
pure (tmpUnpack, tver, git_describe)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
let installVer = fromMaybe tver ov
installVer <- case ov of
Left True -> case git_describe of
-- git describe
Just h -> either (fail . displayException) pure . version $ h
-- git describe, but not building from git, lol
Nothing -> pure tver
-- default: use detected version
Left False -> pure tver
-- overwrite version with users value
Right v -> pure v
liftE $ runBuildAction
workdir
@@ -464,7 +492,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
pure ghcInstallDir
forM_ artifacts $ \artifact -> do
logInfo $ T.pack (show artifact)
logDebug $ T.pack (show artifact)
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
@@ -479,6 +507,10 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
)
pure installVer
where
gitDescribeRequested = case ov of
Left b -> b
_ -> False
-----------------
@@ -614,8 +646,11 @@ rmHLSVer ver = do
lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
isDir <- liftIO $ doesDirectoryExist hlsDir
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
when (Just ver == isHlsSet) $ do
-- set latest hls

View File

@@ -206,10 +206,36 @@ exec :: MonadIO m
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
exec exe args chdir env = do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
forM_ (Map.fromList <$> env) $ \cEnv -> do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
-- | Like 'exec', except doesn't add msys2 stuff to PATH.
execNoMinGW :: MonadIO m
=> FilePath -- ^ thing to execute
-> [FilePath] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execNoMinGW exe args chdir env = do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
forM_ (Map.fromList <$> env) $ \cEnv -> do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
let cp = (proc exe args) { cwd = chdir, env = env }
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
-- | Thin wrapper around `executeFile`.
execShell :: MonadIO m

View File

@@ -61,6 +61,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Char ( isHexDigit )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
@@ -1275,3 +1276,35 @@ warnAboutHlsCompatibility = do
T.pack (prettyShow supportedGHC)
_ -> return ()
-----------
--[ Git ]--
-----------
isCommitHash :: String -> Bool
isCommitHash str' = let hex = all isHexDigit str'
len = length str'
in hex && len == 40
gitOut :: (MonadReader env m, HasLog env, MonadIO m) => [String] -> FilePath -> Excepts '[ProcessError] m T.Text
gitOut args dir = do
CapturedProcess {..} <- lift $ executeOut "git" args (Just dir)
case _exitCode of
ExitSuccess -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
ExitFailure c -> do
let pe = NonZeroExit c "git" args
lift $ logDebug $ T.pack (prettyShow pe)
throwE pe
processBranches :: T.Text -> [String]
processBranches str' = let lines' = lines (T.unpack str')
words' = fmap words lines'
refs = catMaybes $ fmap (`atMay` 1) words'
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
in branches

View File

@@ -133,6 +133,15 @@ _eghcup() {
fi
}
ecabal() {
edo _ecabal "$@"
}
_ecabal() {
# shellcheck disable=SC2086
"${GHCUP_BIN}/cabal" "$@"
}
_done() {
echo
echo "==============================================================================="
@@ -537,7 +546,7 @@ adjust_cabal_config() {
else
cabal_bin="$HOME/AppData/Roaming/cabal/bin"
fi
edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
}
ask_cabal_config_init() {
@@ -688,7 +697,7 @@ find_shell
echo
echo "Welcome to Haskell!"
echo
echo "This script will download and install the following binaries:"
echo "This script can download and install the following binaries:"
echo " * ghcup - The Haskell toolchain installer"
echo " * ghc - The Glasgow Haskell Compiler"
echo " * cabal - The Cabal build tool for managing Haskell software"

View File

@@ -242,7 +242,7 @@ if ($Silent -and !($InstallDir)) {
Print-Msg -color Magenta -msg (@'
Welcome to Haskell!
This script will download and install the following programs:
This script can download and install the following programs:
* ghcup - The Haskell toolchain installer
* ghc - The Glasgow Haskell Compiler
* msys2 - A linux-style toolchain environment required for many operations