Compare commits
40 Commits
darwin-arc
...
v0.1.17.5-
| Author | SHA1 | Date | |
|---|---|---|---|
|
5c026591cb
|
|||
|
907365ddff
|
|||
|
684953464b
|
|||
|
6b978b42bc
|
|||
|
6831337289
|
|||
|
e40777a5d3
|
|||
|
51690d1df3
|
|||
|
72a06e964c
|
|||
|
9ffd402481
|
|||
|
dee8d4bc09
|
|||
|
6c57661797
|
|||
|
b9ff7c5af4
|
|||
|
072161ada2
|
|||
|
a67b3e8a57
|
|||
|
c9216fb444
|
|||
|
2aac17ac5f
|
|||
|
17a403b8ce
|
|||
|
b245c11b1d
|
|||
|
2ed047515e
|
|||
|
b16e561384
|
|||
|
|
2ebff1e887 | ||
|
655ee432f8
|
|||
|
67b7b2f292
|
|||
|
66961101c6
|
|||
|
326af49a8f
|
|||
|
3a7ed5ee2d
|
|||
|
56fa798406
|
|||
|
|
3fd9fae66a | ||
|
|
5d43168370 | ||
|
|
f8548fefb3 | ||
|
|
3565c32d51 | ||
|
7fab328acc
|
|||
|
a043b82b27
|
|||
|
20652fed94
|
|||
|
6fc52a4ec7
|
|||
|
834bcfa02c
|
|||
|
c99ecc0a66
|
|||
|
061e5dd832
|
|||
|
c97ade81fa
|
|||
|
82a22fe993
|
@@ -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:
|
||||||
@@ -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"
|
||||||
|
|||||||
@@ -8,7 +8,15 @@ set -eux
|
|||||||
|
|
||||||
mkdir -p "${TMPDIR}"
|
mkdir -p "${TMPDIR}"
|
||||||
|
|
||||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
if freebsd-version | grep -E '^12.*' ; then
|
||||||
|
freebsd_ver=12
|
||||||
|
elif freebsd-version | grep -E '^13.*' ; then
|
||||||
|
freebsd_ver=13
|
||||||
|
else
|
||||||
|
(>&2 echo "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues")
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-freebsd${freebsd_ver}-ghcup > ./ghcup-bin
|
||||||
chmod +x ghcup-bin
|
chmod +x ghcup-bin
|
||||||
|
|
||||||
./ghcup-bin -v upgrade -i -f
|
./ghcup-bin -v upgrade -i -f
|
||||||
|
|||||||
@@ -495,7 +495,7 @@ set' _ (_, ListResult {..}) = do
|
|||||||
case lTool of
|
case lTool of
|
||||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
||||||
Cabal -> liftE $ setCabal lVer $> ()
|
Cabal -> liftE $ setCabal lVer $> ()
|
||||||
HLS -> liftE $ setHLS lVer $> ()
|
HLS -> liftE $ setHLS lVer SetHLSOnly $> ()
|
||||||
Stack -> liftE $ setStack lVer $> ()
|
Stack -> liftE $ setStack lVer $> ()
|
||||||
GHCup -> pure ()
|
GHCup -> pure ()
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -212,7 +212,7 @@ ghcCompileOpts =
|
|||||||
(fmap Left $ option
|
(fmap Left $ option
|
||||||
str
|
str
|
||||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
"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)"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -340,7 +340,12 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> 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)"))
|
||||||
|
|
||||||
|
|
||||||
@@ -461,7 +466,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo targetVer HLS dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
setHLS targetVer
|
setHLS targetVer SetHLSOnly
|
||||||
pure (vi, targetVer)
|
pure (vi, targetVer)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
|
|||||||
@@ -132,7 +132,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
|
|||||||
when gcOldGHC rmOldGHC
|
when gcOldGHC rmOldGHC
|
||||||
lift $ when gcProfilingLibs rmProfilingLibs
|
lift $ when gcProfilingLibs rmProfilingLibs
|
||||||
lift $ when gcShareDir rmShareDir
|
lift $ when gcShareDir rmShareDir
|
||||||
lift $ when gcHLSNoGHC rmHLSNoGHC
|
liftE $ when gcHLSNoGHC rmHLSNoGHC
|
||||||
lift $ when gcCache rmCache
|
lift $ when gcCache rmCache
|
||||||
lift $ when gcTmp rmTmp
|
lift $ when gcTmp rmTmp
|
||||||
) >>= \case
|
) >>= \case
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -390,8 +469,9 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
Just uri -> do
|
Just uri -> do
|
||||||
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||||
|
-- TODO: support legacy
|
||||||
liftE $ installHLSBindist
|
liftE $ installHLSBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
isolateDir
|
isolateDir
|
||||||
forceInstall
|
forceInstall
|
||||||
|
|||||||
@@ -311,10 +311,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setHLS' SetOptions{ sToolVer } =
|
setHLS' SetOptions{ sToolVer } =
|
||||||
case sToolVer of
|
case sToolVer of
|
||||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v)
|
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly >> pure v)
|
||||||
_ -> runSetHLS runAppState (do
|
_ -> runSetHLS runAppState (do
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||||
liftE $ setHLS (_tvVersion v)
|
liftE $ setHLS (_tvVersion v) SetHLSOnly
|
||||||
pure v
|
pure v
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
|
|||||||
@@ -140,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
|
||||||
@@ -238,10 +243,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
||||||
when (not alreadyInstalling') $
|
when (not alreadyInstalling') $
|
||||||
case t of
|
case t of
|
||||||
|
#ifdef DISABLE_UPGRADE
|
||||||
|
GHCup -> pure ()
|
||||||
|
#else
|
||||||
GHCup -> runLogger $
|
GHCup -> runLogger $
|
||||||
logWarn ("New GHCup version available: "
|
logWarn ("New GHCup version available: "
|
||||||
<> prettyVer l
|
<> prettyVer l
|
||||||
<> ". To upgrade, run 'ghcup upgrade'")
|
<> ". To upgrade, run 'ghcup upgrade'")
|
||||||
|
#endif
|
||||||
_ -> runLogger $
|
_ -> runLogger $
|
||||||
logWarn ("New "
|
logWarn ("New "
|
||||||
<> T.pack (prettyShow t)
|
<> T.pack (prettyShow t)
|
||||||
@@ -296,7 +305,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
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
|
||||||
|
#ifndef DISABLE_UPGRADE
|
||||||
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
|
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
|
||||||
@@ -339,7 +350,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||||
|
#ifndef DISABLE_UPGRADE
|
||||||
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
|
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
|
||||||
|
#endif
|
||||||
alreadyInstalling _ _ = pure False
|
alreadyInstalling _ _ = pure False
|
||||||
|
|
||||||
cmp' :: ( HasLog env
|
cmp' :: ( HasLog env
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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.
|
||||||
@@ -188,66 +224,10 @@ For the full list of env variables and parameters to tweak the script behavior,
|
|||||||
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
|
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
|
||||||
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
|
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
|
||||||
|
|
||||||
### Example github workflow
|
### github workflows
|
||||||
|
|
||||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/)
|
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
|
||||||
|
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
|
||||||
If you want to install ghcup manually though, here's an example config:
|
|
||||||
|
|
||||||
```yml
|
|
||||||
name: Haskell CI
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
branches: [ master ]
|
|
||||||
pull_request:
|
|
||||||
branches: [ master ]
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
build-cabal:
|
|
||||||
|
|
||||||
runs-on: ${{ matrix.os }}
|
|
||||||
strategy:
|
|
||||||
fail-fast: false
|
|
||||||
matrix:
|
|
||||||
os: [ubuntu-latest, macOS-latest, windows-latest]
|
|
||||||
ghc: ['8.10.7', '9.0.1']
|
|
||||||
cabal: ['3.4.0.0']
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- uses: actions/checkout@v2
|
|
||||||
|
|
||||||
- if: matrix.os == 'windows-latest'
|
|
||||||
name: Install ghcup on windows
|
|
||||||
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
|
|
||||||
|
|
||||||
- if: matrix.os == 'windows-latest'
|
|
||||||
name: Add ghcup to PATH
|
|
||||||
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
|
|
||||||
shell: bash
|
|
||||||
|
|
||||||
- if: matrix.os != 'windows-latest'
|
|
||||||
name: Install ghcup on non-windows
|
|
||||||
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
|
||||||
|
|
||||||
- name: Install ghc/cabal
|
|
||||||
run: |
|
|
||||||
ghcup install ghc ${{ matrix.ghc }}
|
|
||||||
ghcup install cabal ${{ matrix.cabal }}
|
|
||||||
shell: bash
|
|
||||||
|
|
||||||
- name: Update cabal index
|
|
||||||
run: cabal update
|
|
||||||
shell: bash
|
|
||||||
|
|
||||||
- name: Build
|
|
||||||
run: cabal build --enable-tests --enable-benchmarks
|
|
||||||
shell: bash
|
|
||||||
|
|
||||||
- name: Run tests
|
|
||||||
run: cabal test
|
|
||||||
shell: bash
|
|
||||||
```
|
|
||||||
|
|
||||||
## GPG verification
|
## GPG verification
|
||||||
|
|
||||||
|
|||||||
@@ -24,10 +24,20 @@ 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
|
||||||
2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises
|
2. To learn Haskell, try any of those:
|
||||||
|
- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
|
||||||
|
- An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
|
||||||
3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
|
3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
|
||||||
|
|
||||||
## Uninstallation
|
## Uninstallation
|
||||||
@@ -78,14 +88,15 @@ May or may not work, several issues:
|
|||||||
|
|
||||||
Unsupported. GHC may or may not work. Upgrade to WSL2.
|
Unsupported. GHC may or may not work. Upgrade to WSL2.
|
||||||
|
|
||||||
### MacOS <13
|
### MacOS <10.13
|
||||||
|
|
||||||
Not supported. Would require separate binaries, since >=13 binaries are incompatible.
|
Not supported. Would require separate binaries, since >=10.13 binaries are incompatible.
|
||||||
Please upgrade.
|
Please upgrade.
|
||||||
|
|
||||||
### MacOS aarch64
|
### MacOS aarch64
|
||||||
|
|
||||||
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
|
HLS bindists are still experimental. Stack has only unofficial binaries for this platform.
|
||||||
|
There are various issues with GHC itself.
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
@@ -94,7 +105,7 @@ HLS bindists are experimental.
|
|||||||
|
|
||||||
### Linux ARMv7/AARCH64
|
### Linux ARMv7/AARCH64
|
||||||
|
|
||||||
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
|
Lower availability of bindists. Stack and HLS binaries are experimental.
|
||||||
|
|
||||||
## Manual install
|
## Manual install
|
||||||
|
|
||||||
|
|||||||
14
ghcup.cabal
14
ghcup.cabal
@@ -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
|
||||||
@@ -195,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
|
||||||
@@ -262,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
|
||||||
|
|||||||
196
lib/GHCup.hs
196
lib/GHCup.hs
@@ -5,8 +5,8 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup
|
Module : GHCup
|
||||||
@@ -301,22 +301,6 @@ installPackedGHC dl msubdir inst ver forceInstall = do
|
|||||||
liftE $ runBuildAction tmpUnpack
|
liftE $ runBuildAction tmpUnpack
|
||||||
(Just inst)
|
(Just inst)
|
||||||
(installUnpackedGHC workdir inst ver)
|
(installUnpackedGHC workdir inst ver)
|
||||||
where
|
|
||||||
-- | Does basic checks for isolated installs
|
|
||||||
-- Isolated Directory:
|
|
||||||
-- 1. if it doesn't exist -> proceed
|
|
||||||
-- 2. if it exists and is empty -> proceed
|
|
||||||
-- 3. if it exists and is non-empty -> panic and leave the house
|
|
||||||
installDestSanityCheck :: ( MonadIO m
|
|
||||||
, MonadCatch m
|
|
||||||
) =>
|
|
||||||
FilePath ->
|
|
||||||
Excepts '[DirNotEmpty] m ()
|
|
||||||
installDestSanityCheck isoDir = do
|
|
||||||
hideErrorDef [doesNotExistErrorType] () $ do
|
|
||||||
contents <- liftIO $ getDirectoryContentsRecursive isoDir
|
|
||||||
unless (null contents) (throwE $ DirNotEmpty isoDir)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Install an unpacked GHC distribution. This only deals with the GHC
|
-- | Install an unpacked GHC distribution. This only deals with the GHC
|
||||||
@@ -582,6 +566,8 @@ installHLSBindist :: ( MonadMask m
|
|||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
, FileAlreadyExistsError
|
, FileAlreadyExistsError
|
||||||
|
, ProcessError
|
||||||
|
, DirNotEmpty
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
@@ -617,26 +603,55 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
|||||||
|
|
||||||
-- the subdir of the archive where we do the work
|
-- the subdir of the archive where we do the work
|
||||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||||
|
legacy <- liftIO $ isLegacyHLSBindist workdir
|
||||||
|
|
||||||
|
if
|
||||||
|
| not forceInstall
|
||||||
|
, not legacy
|
||||||
|
, (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
|
||||||
|
| otherwise -> pure ()
|
||||||
|
|
||||||
case isoFilepath of
|
case isoFilepath of
|
||||||
Just isoDir -> do
|
Just isoDir -> do
|
||||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||||
liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall
|
if legacy
|
||||||
|
then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
|
||||||
|
else liftE $ installHLSUnpacked workdir isoDir ver
|
||||||
|
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
|
if legacy
|
||||||
|
then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
|
||||||
|
else do
|
||||||
|
inst <- ghcupHLSDir ver
|
||||||
|
liftE $ installHLSUnpacked workdir inst ver
|
||||||
|
liftE $ setHLS ver SetHLS_XYZ
|
||||||
|
|
||||||
liftE $ installHLSPostInst isoFilepath ver
|
liftE $ installHLSPostInst isoFilepath ver
|
||||||
|
|
||||||
|
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
|
||||||
|
-> IO Bool
|
||||||
|
isLegacyHLSBindist path = do
|
||||||
|
not <$> doesFileExist (path </> "GNUmakefile")
|
||||||
|
|
||||||
-- | Install an unpacked hls distribution.
|
-- | Install an unpacked hls distribution.
|
||||||
installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
|
||||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||||
-> FilePath -- ^ Path to install to
|
-> FilePath -- ^ Path to install to
|
||||||
-> Maybe Version -- ^ Nothing for isolated install
|
-> Version
|
||||||
-> Bool -- ^ is it a force install
|
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
|
||||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
installHLSUnpacked path inst _ = do
|
||||||
installHLSUnpacked path inst mver' forceInstall = do
|
lift $ logInfo "Installing HLS"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
|
||||||
|
|
||||||
|
-- | Install an unpacked hls distribution (legacy).
|
||||||
|
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||||
|
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Maybe Version -- ^ Nothing for isolated install
|
||||||
|
-> Bool -- ^ is it a force install
|
||||||
|
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||||
|
installHLSUnpackedLegacy path inst mver' forceInstall = do
|
||||||
lift $ logInfo "Installing HLS"
|
lift $ logInfo "Installing HLS"
|
||||||
liftIO $ createDirRecursive' inst
|
liftIO $ createDirRecursive' inst
|
||||||
|
|
||||||
@@ -692,7 +707,7 @@ installHLSPostInst isoFilepath ver =
|
|||||||
-- create symlink if this is the latest version in a regular install
|
-- create symlink if this is the latest version in a regular install
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
let lInstHLS = headMay . reverse . sort $ hlsVers
|
let lInstHLS = headMay . reverse . sort $ hlsVers
|
||||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly
|
||||||
|
|
||||||
|
|
||||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||||
@@ -725,6 +740,8 @@ installHLSBin :: ( MonadMask m
|
|||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
, FileAlreadyExistsError
|
, FileAlreadyExistsError
|
||||||
|
, ProcessError
|
||||||
|
, DirNotEmpty
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
@@ -894,9 +911,9 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
|||||||
case isolateDir of
|
case isolateDir of
|
||||||
Just isoDir -> do
|
Just isoDir -> do
|
||||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||||
liftE $ installHLSUnpacked installDir isoDir Nothing True
|
liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
liftE $ installHLSUnpacked installDir binDir (Just installVer) True
|
liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
|
||||||
)
|
)
|
||||||
|
|
||||||
liftE $ installHLSPostInst isolateDir installVer
|
liftE $ installHLSPostInst isolateDir installVer
|
||||||
@@ -1088,9 +1105,9 @@ setGHC ver sghc = do
|
|||||||
-- first delete the old symlinks (this fixes compatibility issues
|
-- first delete the old symlinks (this fixes compatibility issues
|
||||||
-- with old ghcup)
|
-- with old ghcup)
|
||||||
case sghc of
|
case sghc of
|
||||||
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
|
SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
|
||||||
SetGHC_XY -> liftE $ rmMajorSymlinks ver
|
SetGHC_XY -> liftE $ rmMajorGHCSymlinks ver
|
||||||
SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
|
SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver
|
||||||
|
|
||||||
-- for ghc tools (ghc, ghci, haddock, ...)
|
-- for ghc tools (ghc, ghci, haddock, ...)
|
||||||
verfiles <- ghcToolFiles ver
|
verfiles <- ghcToolFiles ver
|
||||||
@@ -1109,9 +1126,10 @@ setGHC ver sghc = do
|
|||||||
|
|
||||||
-- create symlink
|
-- create symlink
|
||||||
forM_ mTargetFile $ \targetFile -> do
|
forM_ mTargetFile $ \targetFile -> do
|
||||||
|
bindir <- ghcInternalBinDir ver
|
||||||
let fullF = binDir </> targetFile <> exeExt
|
let fullF = binDir </> targetFile <> exeExt
|
||||||
fileWithExt = file <> exeExt
|
fileWithExt = bindir </> file <> exeExt
|
||||||
destL <- lift $ ghcLinkDestination fileWithExt ver
|
destL <- binarySymLinkDestination fileWithExt
|
||||||
lift $ createLink destL fullF
|
lift $ createLink destL fullF
|
||||||
|
|
||||||
-- create symlink for share dir
|
-- create symlink for share dir
|
||||||
@@ -1170,7 +1188,7 @@ unsetGHC :: ( MonadReader env m
|
|||||||
)
|
)
|
||||||
=> Maybe Text
|
=> Maybe Text
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
unsetGHC = rmPlain
|
unsetGHC = rmPlainGHC
|
||||||
|
|
||||||
|
|
||||||
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
|
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
|
||||||
@@ -1222,35 +1240,52 @@ setHLS :: ( MonadReader env m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> SetHLS -- Nothing for legacy
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
setHLS ver = do
|
setHLS ver shls = do
|
||||||
|
whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
|
||||||
|
|
||||||
|
-- symlink destination
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
-- Delete old symlinks, since these might have different ghc versions than the
|
-- first delete the old symlinks
|
||||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
case shls of
|
||||||
oldSyms <- lift hlsSymlinks
|
-- not for legacy
|
||||||
forM_ oldSyms $ \f -> do
|
SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
|
||||||
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
-- legacy and new
|
||||||
lift $ rmLink (binDir </> f)
|
SetHLSOnly -> liftE rmPlainHLS
|
||||||
|
|
||||||
-- set haskell-language-server-<ghcver> symlinks
|
case shls of
|
||||||
bins <- lift $ hlsServerBinaries ver Nothing
|
-- not for legacy
|
||||||
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
SetHLS_XYZ -> do
|
||||||
|
bins <- lift $ hlsInternalServerScripts ver Nothing
|
||||||
|
|
||||||
forM_ bins $ \f -> do
|
forM_ bins $ \f -> do
|
||||||
let destL = f
|
let fname = takeFileName f
|
||||||
let target = (<> exeExt) . head . splitOn "~" $ f
|
destL <- binarySymLinkDestination f
|
||||||
lift $ createLink destL (binDir </> target)
|
let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
|
||||||
|
then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
lift $ createLink destL (binDir </> target)
|
||||||
|
|
||||||
-- set haskell-language-server-wrapper symlink
|
-- legacy and new
|
||||||
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
|
SetHLSOnly -> do
|
||||||
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
-- set haskell-language-server-<ghcver> symlinks
|
||||||
|
bins <- lift $ hlsServerBinaries ver Nothing
|
||||||
|
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||||
|
|
||||||
lift $ createLink destL wrapper
|
forM_ bins $ \f -> do
|
||||||
|
let destL = f
|
||||||
|
let target = (<> exeExt) . head . splitOn "~" $ f
|
||||||
|
lift $ createLink destL (binDir </> target)
|
||||||
|
|
||||||
lift warnAboutHlsCompatibility
|
-- set haskell-language-server-wrapper symlink
|
||||||
|
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||||
|
|
||||||
pure ()
|
lift $ createLink destL wrapper
|
||||||
|
|
||||||
|
lift warnAboutHlsCompatibility
|
||||||
|
|
||||||
|
|
||||||
unsetHLS :: ( MonadMask m
|
unsetHLS :: ( MonadMask m
|
||||||
@@ -1720,14 +1755,14 @@ rmGHCVer ver = do
|
|||||||
-- this isn't atomic, order matters
|
-- this isn't atomic, order matters
|
||||||
when isSetGHC $ do
|
when isSetGHC $ do
|
||||||
lift $ logInfo "Removing ghc symlinks"
|
lift $ logInfo "Removing ghc symlinks"
|
||||||
liftE $ rmPlain (_tvTarget ver)
|
liftE $ rmPlainGHC (_tvTarget ver)
|
||||||
|
|
||||||
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||||
liftE $ rmMinorSymlinks ver
|
liftE $ rmMinorGHCSymlinks ver
|
||||||
|
|
||||||
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||||
-- first remove
|
-- first remove
|
||||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
|
||||||
-- then fix them (e.g. with an earlier version)
|
-- then fix them (e.g. with an earlier version)
|
||||||
|
|
||||||
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
||||||
@@ -1794,24 +1829,19 @@ rmHLSVer :: ( MonadMask m
|
|||||||
rmHLSVer ver = do
|
rmHLSVer ver = do
|
||||||
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
|
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
|
||||||
|
|
||||||
isHlsSet <- lift hlsSet
|
isHlsSet <- lift hlsSet
|
||||||
|
|
||||||
Dirs {..} <- lift getDirs
|
liftE $ rmMinorHLSSymlinks ver
|
||||||
|
hlsDir <- ghcupHLSDir ver
|
||||||
bins <- lift $ hlsAllBinaries ver
|
recyclePathForcibly hlsDir
|
||||||
forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
|
|
||||||
|
|
||||||
when (Just ver == isHlsSet) $ do
|
when (Just ver == isHlsSet) $ do
|
||||||
-- delete all set symlinks
|
-- delete all set symlinks
|
||||||
oldSyms <- lift hlsSymlinks
|
rmPlainHLS
|
||||||
forM_ oldSyms $ \f -> do
|
|
||||||
let fullF = binDir </> f
|
|
||||||
lift $ logDebug $ "rm " <> T.pack fullF
|
|
||||||
lift $ rmLink fullF
|
|
||||||
-- set latest hls
|
-- set latest hls
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
case headMay . reverse . sort $ hlsVers of
|
case headMay . reverse . sort $ hlsVers of
|
||||||
Just latestver -> setHLS latestver
|
Just latestver -> setHLS latestver SetHLSOnly
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
|
|
||||||
|
|
||||||
@@ -2687,7 +2717,11 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
|||||||
HLS -> do
|
HLS -> do
|
||||||
whenM (lift $ fmap not $ hlsInstalled _tvVersion)
|
whenM (lift $ fmap not $ hlsInstalled _tvVersion)
|
||||||
$ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
|
$ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
|
||||||
pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt)
|
ifM (lift $ isLegacyHLS _tvVersion)
|
||||||
|
(pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt))
|
||||||
|
$ do
|
||||||
|
bdir <- lift $ ghcupHLSDir _tvVersion
|
||||||
|
pure (bdir </> "bin" </> "haskell-language-server-wrapper" <> exeExt)
|
||||||
|
|
||||||
Stack -> do
|
Stack -> do
|
||||||
whenM (lift $ fmap not $ stackInstalled _tvVersion)
|
whenM (lift $ fmap not $ stackInstalled _tvVersion)
|
||||||
@@ -2800,21 +2834,31 @@ rmHLSNoGHC :: ( MonadReader env m
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
|
, MonadFail m
|
||||||
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> m ()
|
=> Excepts '[NotInstalled] m ()
|
||||||
rmHLSNoGHC = do
|
rmHLSNoGHC = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
ghcs <- fmap rights getInstalledGHCs
|
ghcs <- fmap rights getInstalledGHCs
|
||||||
hlses <- fmap rights getInstalledHLSs
|
hlses <- fmap rights getInstalledHLSs
|
||||||
forM_ hlses $ \hls -> do
|
forM_ hlses $ \hls -> do
|
||||||
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
|
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
|
||||||
forM_ hlsGHCs $ \ghc -> do
|
let candidates = filter (`notElem` ghcs) hlsGHCs
|
||||||
when (ghc `notElem` ghcs) $ do
|
if (length hlsGHCs - length candidates) <= 0
|
||||||
bins <- hlsServerBinaries hls (Just $ _tvVersion ghc)
|
then rmHLSVer hls
|
||||||
forM_ bins $ \bin -> do
|
else
|
||||||
let f = binDir </> bin
|
forM_ candidates $ \ghc -> do
|
||||||
|
bins1 <- fmap (binDir </>) <$> hlsServerBinaries hls (Just $ _tvVersion ghc)
|
||||||
|
bins2 <- ifM (isLegacyHLS hls) (pure []) $ do
|
||||||
|
shs <- hlsInternalServerScripts hls (Just $ _tvVersion ghc)
|
||||||
|
bins <- hlsInternalServerBinaries hls (Just $ _tvVersion ghc)
|
||||||
|
libs <- hlsInternalServerLibs hls (_tvVersion ghc)
|
||||||
|
pure (shs ++ bins ++ libs)
|
||||||
|
forM_ (bins1 ++ bins2) $ \f -> do
|
||||||
logDebug $ "rm " <> T.pack f
|
logDebug $ "rm " <> T.pack f
|
||||||
rmFile f
|
rmFile f
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
rmCache :: ( MonadReader env m
|
rmCache :: ( MonadReader env m
|
||||||
|
|||||||
@@ -4,7 +4,7 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||||
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
|||||||
@@ -484,6 +484,10 @@ data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
|
|||||||
| SetGHC_XYZ -- ^ ghc-x.y.z
|
| SetGHC_XYZ -- ^ ghc-x.y.z
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data SetHLS = SetHLSOnly -- ^ unversioned 'hls'
|
||||||
|
| SetHLS_XYZ -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
data PlatformResult = PlatformResult
|
data PlatformResult = PlatformResult
|
||||||
{ _platform :: Platform
|
{ _platform :: Platform
|
||||||
|
|||||||
@@ -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 #-}
|
||||||
|
|
||||||
@@ -125,31 +125,34 @@ import qualified Data.List.NonEmpty as NE
|
|||||||
------------------------
|
------------------------
|
||||||
|
|
||||||
|
|
||||||
-- | The symlink destination of a ghc tool.
|
-- | Create a relative symlink destination for the binary directory,
|
||||||
ghcLinkDestination :: ( MonadReader env m
|
-- given a target toolpath.
|
||||||
, HasDirs env
|
binarySymLinkDestination :: ( MonadReader env m
|
||||||
, MonadThrow m, MonadIO m)
|
, HasDirs env
|
||||||
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
|
, MonadThrow m
|
||||||
-> GHCTargetVersion
|
, MonadIO m
|
||||||
-> m FilePath
|
)
|
||||||
ghcLinkDestination tool ver = do
|
=> FilePath -- ^ the full toolpath
|
||||||
|
-> m FilePath
|
||||||
|
binarySymLinkDestination toolPath = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
ghcd <- ghcupGHCDir ver
|
toolPath' <- liftIO $ canonicalizePath toolPath
|
||||||
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
|
binDir' <- liftIO $ canonicalizePath binDir
|
||||||
|
pure (relativeSymlink binDir' toolPath')
|
||||||
|
|
||||||
|
|
||||||
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
||||||
rmMinorSymlinks :: ( MonadReader env m
|
rmMinorGHCSymlinks :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
files <- liftE $ ghcToolFiles tv
|
files <- liftE $ ghcToolFiles tv
|
||||||
@@ -161,17 +164,17 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Removes the set ghc version for the given target, if any.
|
-- | Removes the set ghc version for the given target, if any.
|
||||||
rmPlain :: ( MonadReader env m
|
rmPlainGHC :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> Maybe Text -- ^ target
|
=> Maybe Text -- ^ target
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
rmPlain target = do
|
rmPlainGHC target = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
mtv <- lift $ ghcSet target
|
mtv <- lift $ ghcSet target
|
||||||
forM_ mtv $ \tv -> do
|
forM_ mtv $ \tv -> do
|
||||||
@@ -187,17 +190,17 @@ rmPlain target = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
||||||
rmMajorSymlinks :: ( MonadReader env m
|
rmMajorGHCSymlinks :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
(mj, mi) <- getMajorMinorV _tvVersion
|
(mj, mi) <- getMajorMinorV _tvVersion
|
||||||
let v' = intToText mj <> "." <> intToText mi
|
let v' = intToText mj <> "." <> intToText mi
|
||||||
@@ -210,6 +213,62 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
|||||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||||
|
|
||||||
|
|
||||||
|
-- | Removes the minor HLS files, e.g. 'haskell-language-server-8.10.7~1.6.1.0'
|
||||||
|
-- and 'haskell-language-server-wrapper-1.6.1.0'.
|
||||||
|
rmMinorHLSSymlinks :: ( MonadReader env m
|
||||||
|
, HasDirs env
|
||||||
|
, MonadIO m
|
||||||
|
, HasLog env
|
||||||
|
, MonadThrow m
|
||||||
|
, MonadFail m
|
||||||
|
, MonadMask m
|
||||||
|
)
|
||||||
|
=> Version
|
||||||
|
-> Excepts '[NotInstalled] m ()
|
||||||
|
rmMinorHLSSymlinks ver = do
|
||||||
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
|
hlsBins <- hlsAllBinaries ver
|
||||||
|
forM_ hlsBins $ \f -> do
|
||||||
|
let fullF = binDir </> f <> exeExt
|
||||||
|
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||||
|
-- on unix, this may be either a file (legacy) or a symlink
|
||||||
|
-- on windows, this is always a file... hence 'rmFile'
|
||||||
|
-- works consistently across platforms
|
||||||
|
lift $ rmFile fullF
|
||||||
|
|
||||||
|
-- | Removes the set HLS version, if any.
|
||||||
|
rmPlainHLS :: ( MonadReader env m
|
||||||
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
|
, MonadThrow m
|
||||||
|
, MonadFail m
|
||||||
|
, MonadIO m
|
||||||
|
, MonadMask m
|
||||||
|
)
|
||||||
|
=> Excepts '[NotInstalled] m ()
|
||||||
|
rmPlainHLS = do
|
||||||
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
|
-- delete 'haskell-language-server-8.10.7'
|
||||||
|
hlsBins <- fmap (filter (\f -> not ("haskell-language-server-wrapper" `isPrefixOf` f) && ('~' `notElem` f)))
|
||||||
|
$ liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
|
binDir
|
||||||
|
(makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
|
||||||
|
forM_ hlsBins $ \f -> do
|
||||||
|
let fullF = binDir </> f
|
||||||
|
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||||
|
if isWindows
|
||||||
|
then lift $ rmLink fullF
|
||||||
|
else lift $ rmFile fullF
|
||||||
|
|
||||||
|
-- 'haskell-language-server-wrapper'
|
||||||
|
let hlswrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||||
|
lift $ logDebug ("rm -f " <> T.pack hlswrapper)
|
||||||
|
if isWindows
|
||||||
|
then lift $ hideError doesNotExistErrorType $ rmLink hlswrapper
|
||||||
|
else lift $ hideError doesNotExistErrorType $ rmFile hlswrapper
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------------------------------
|
-----------------------------------
|
||||||
@@ -353,7 +412,8 @@ cabalSet = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Get all installed hls, by matching on
|
-- | Get all installed hls, by matching on
|
||||||
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
|
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
|
||||||
|
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
|
||||||
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||||
=> m [Either FilePath Version]
|
=> m [Either FilePath Version]
|
||||||
getInstalledHLSs = do
|
getInstalledHLSs = do
|
||||||
@@ -364,7 +424,7 @@ getInstalledHLSs = do
|
|||||||
execBlank
|
execBlank
|
||||||
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
|
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
|
||||||
)
|
)
|
||||||
forM bins $ \f ->
|
legacy <- forM bins $ \f ->
|
||||||
case
|
case
|
||||||
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
||||||
of
|
of
|
||||||
@@ -372,6 +432,14 @@ getInstalledHLSs = do
|
|||||||
Just (Left _) -> pure $ Left f
|
Just (Left _) -> pure $ Left f
|
||||||
Nothing -> pure $ Left f
|
Nothing -> pure $ Left f
|
||||||
|
|
||||||
|
hlsdir <- ghcupHLSBaseDir
|
||||||
|
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory hlsdir
|
||||||
|
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
||||||
|
Right r -> pure $ Right r
|
||||||
|
Left _ -> pure $ Left f
|
||||||
|
pure (nub (new <> legacy))
|
||||||
|
|
||||||
|
|
||||||
-- | Get all installed stacks, by matching on
|
-- | Get all installed stacks, by matching on
|
||||||
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
||||||
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||||
@@ -447,6 +515,10 @@ hlsInstalled ver = do
|
|||||||
vers <- fmap rights getInstalledHLSs
|
vers <- fmap rights getInstalledHLSs
|
||||||
pure $ elem ver vers
|
pure $ elem ver vers
|
||||||
|
|
||||||
|
isLegacyHLS :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||||
|
isLegacyHLS ver = do
|
||||||
|
bdir <- ghcupHLSDir ver
|
||||||
|
not <$> liftIO (doesDirectoryExist bdir)
|
||||||
|
|
||||||
|
|
||||||
-- Return the currently set hls version, if any.
|
-- Return the currently set hls version, if any.
|
||||||
@@ -518,7 +590,7 @@ hlsGHCVersions' v' = do
|
|||||||
pure . sortBy (flip compare) . rights $ vers
|
pure . sortBy (flip compare) . rights $ vers
|
||||||
|
|
||||||
|
|
||||||
-- | Get all server binaries for an hls version, if any.
|
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
|
||||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||||
=> Version
|
=> Version
|
||||||
-> Maybe Version -- ^ optional GHC version
|
-> Maybe Version -- ^ optional GHC version
|
||||||
@@ -539,6 +611,44 @@ hlsServerBinaries ver mghcVer = do
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
-- | Get all scripts for a hls version from the ~/.ghcup/hls/<ver>/bin directory, if any.
|
||||||
|
-- Returns the full path.
|
||||||
|
hlsInternalServerScripts :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||||
|
=> Version
|
||||||
|
-> Maybe Version -- ^ optional GHC version
|
||||||
|
-> m [FilePath]
|
||||||
|
hlsInternalServerScripts ver mghcVer = do
|
||||||
|
dir <- ghcupHLSDir ver
|
||||||
|
let bdir = dir </> "bin"
|
||||||
|
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||||
|
<$> liftIO (listDirectory bdir)
|
||||||
|
|
||||||
|
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
|
||||||
|
-- Returns the full path.
|
||||||
|
hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
|
||||||
|
=> Version
|
||||||
|
-> Maybe Version -- ^ optional GHC version
|
||||||
|
-> m [FilePath]
|
||||||
|
hlsInternalServerBinaries ver mghcVer = do
|
||||||
|
dir <- ghcupHLSDir ver
|
||||||
|
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||||
|
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
|
||||||
|
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||||
|
<$> liftIO (listDirectory bdir)
|
||||||
|
|
||||||
|
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
|
||||||
|
-- directory, if any.
|
||||||
|
-- Returns the full path.
|
||||||
|
hlsInternalServerLibs :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
|
||||||
|
=> Version
|
||||||
|
-> Version -- ^ GHC version
|
||||||
|
-> m [FilePath]
|
||||||
|
hlsInternalServerLibs ver ghcVer = do
|
||||||
|
dir <- ghcupHLSDir ver
|
||||||
|
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||||
|
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
|
||||||
|
fmap (bdir </>) <$> liftIO (listDirectory bdir)
|
||||||
|
|
||||||
|
|
||||||
-- | Get the wrapper binary for an hls version, if any.
|
-- | Get the wrapper binary for an hls version, if any.
|
||||||
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||||
@@ -569,22 +679,6 @@ hlsAllBinaries ver = do
|
|||||||
pure (maybeToList wrapper ++ hls)
|
pure (maybeToList wrapper ++ hls)
|
||||||
|
|
||||||
|
|
||||||
-- | Get the active symlinks for hls.
|
|
||||||
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
|
|
||||||
hlsSymlinks = do
|
|
||||||
Dirs {..} <- getDirs
|
|
||||||
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
|
||||||
binDir
|
|
||||||
(makeRegexOpts compExtended
|
|
||||||
execBlank
|
|
||||||
([s|^haskell-language-server-.*$|] :: ByteString)
|
|
||||||
)
|
|
||||||
filterM
|
|
||||||
( liftIO
|
|
||||||
. pathIsLink
|
|
||||||
. (binDir </>)
|
|
||||||
)
|
|
||||||
oldSyms
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -715,7 +809,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 +838,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)
|
||||||
@@ -809,8 +903,16 @@ getLatestBaseVersion av pvpVer =
|
|||||||
--[ Other ]--
|
--[ Other ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
|
-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
|
||||||
|
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||||
|
=> GHCTargetVersion
|
||||||
|
-> m FilePath
|
||||||
|
ghcInternalBinDir ver = do
|
||||||
|
ghcdir <- ghcupGHCDir ver
|
||||||
|
pure (ghcdir </> "bin")
|
||||||
|
|
||||||
-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
|
|
||||||
|
-- | Get tool files from @~\/.ghcup\/ghc\/\<ver\>\/bin\/\*@
|
||||||
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
|
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
|
||||||
--
|
--
|
||||||
-- Returns unversioned relative files without extension, e.g.:
|
-- Returns unversioned relative files without extension, e.g.:
|
||||||
@@ -820,11 +922,10 @@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, Mona
|
|||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> Excepts '[NotInstalled] m [FilePath]
|
-> Excepts '[NotInstalled] m [FilePath]
|
||||||
ghcToolFiles ver = do
|
ghcToolFiles ver = do
|
||||||
ghcdir <- lift $ ghcupGHCDir ver
|
bindir <- ghcInternalBinDir ver
|
||||||
let bindir = ghcdir </> "bin"
|
|
||||||
|
|
||||||
-- fail if ghc is not installed
|
-- fail if ghc is not installed
|
||||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
whenM (fmap not $ ghcInstalled ver)
|
||||||
(throwE (NotInstalled GHC ver))
|
(throwE (NotInstalled GHC ver))
|
||||||
|
|
||||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||||
@@ -879,20 +980,28 @@ 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' -> applyPatch patch' ddir
|
let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
|
||||||
|
|
||||||
|
patches <- liftIO $ quilt `catchIO` (\e ->
|
||||||
|
if isDoesNotExistError e || isPermissionError e then
|
||||||
|
lexicographical
|
||||||
|
else throwIO e)
|
||||||
|
forM_ patches $ \patch' -> applyPatch patch' ddir
|
||||||
|
|
||||||
|
|
||||||
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||||
@@ -1149,3 +1258,19 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
|
|||||||
ghcBinaryName :: GHCTargetVersion -> String
|
ghcBinaryName :: GHCTargetVersion -> String
|
||||||
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
|
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
|
||||||
ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
|
ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Does basic checks for isolated installs
|
||||||
|
-- Isolated Directory:
|
||||||
|
-- 1. if it doesn't exist -> proceed
|
||||||
|
-- 2. if it exists and is empty -> proceed
|
||||||
|
-- 3. if it exists and is non-empty -> panic and leave the house
|
||||||
|
installDestSanityCheck :: ( MonadIO m
|
||||||
|
, MonadCatch m
|
||||||
|
) =>
|
||||||
|
FilePath ->
|
||||||
|
Excepts '[DirNotEmpty] m ()
|
||||||
|
installDestSanityCheck isoDir = do
|
||||||
|
hideErrorDef [doesNotExistErrorType] () $ do
|
||||||
|
contents <- liftIO $ getDirectoryContentsRecursive isoDir
|
||||||
|
unless (null contents) (throwE $ DirNotEmpty isoDir)
|
||||||
|
|||||||
@@ -20,8 +20,11 @@ module GHCup.Utils.Dirs
|
|||||||
, ghcupCacheDir
|
, ghcupCacheDir
|
||||||
, ghcupGHCBaseDir
|
, ghcupGHCBaseDir
|
||||||
, ghcupGHCDir
|
, ghcupGHCDir
|
||||||
|
, ghcupHLSBaseDir
|
||||||
|
, ghcupHLSDir
|
||||||
, mkGhcupTmpDir
|
, mkGhcupTmpDir
|
||||||
, parseGHCupGHCDir
|
, parseGHCupGHCDir
|
||||||
|
, parseGHCupHLSDir
|
||||||
, relativeSymlink
|
, relativeSymlink
|
||||||
, withGHCupTmpDir
|
, withGHCupTmpDir
|
||||||
, getConfigFilePath
|
, getConfigFilePath
|
||||||
@@ -46,6 +49,7 @@ import Control.Monad.Reader
|
|||||||
import Control.Monad.Trans.Resource hiding (throwM)
|
import Control.Monad.Trans.Resource hiding (throwM)
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Versions
|
||||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
@@ -244,6 +248,24 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
|
|||||||
parseGHCupGHCDir (T.pack -> fp) =
|
parseGHCupGHCDir (T.pack -> fp) =
|
||||||
throwEither $ MP.parse ghcTargetVerP "" fp
|
throwEither $ MP.parse ghcTargetVerP "" fp
|
||||||
|
|
||||||
|
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
|
||||||
|
parseGHCupHLSDir (T.pack -> fp) =
|
||||||
|
throwEither $ MP.parse version' "" fp
|
||||||
|
|
||||||
|
-- | ~/.ghcup/hls by default, for new-style installs.
|
||||||
|
ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
|
||||||
|
ghcupHLSBaseDir = do
|
||||||
|
Dirs {..} <- getDirs
|
||||||
|
pure (baseDir </> "hls")
|
||||||
|
|
||||||
|
-- | Gets '~/.ghcup/hls/<hls-ver>' for new-style installs.
|
||||||
|
ghcupHLSDir :: (MonadReader env m, HasDirs env, MonadThrow m)
|
||||||
|
=> Version
|
||||||
|
-> m FilePath
|
||||||
|
ghcupHLSDir ver = do
|
||||||
|
basedir <- ghcupHLSBaseDir
|
||||||
|
let verdir = T.unpack $ prettyVer ver
|
||||||
|
pure (basedir </> verdir)
|
||||||
|
|
||||||
mkGhcupTmpDir :: ( MonadReader env m
|
mkGhcupTmpDir :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -313,6 +335,7 @@ useXDG :: IO Bool
|
|||||||
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
|
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Like 'relpath'. Assumes the inputs are resolved in case of symlinks.
|
||||||
relativeSymlink :: FilePath -- ^ the path in which to create the symlink
|
relativeSymlink :: FilePath -- ^ the path in which to create the symlink
|
||||||
-> FilePath -- ^ the symlink destination
|
-> FilePath -- ^ the symlink destination
|
||||||
-> FilePath
|
-> FilePath
|
||||||
|
|||||||
@@ -13,7 +13,7 @@ import Data.Text ( Text )
|
|||||||
import Data.Void
|
import Data.Void
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
import Optics hiding ((<|), (|>))
|
import Optics hiding ((<|), (|>))
|
||||||
import System.Directory
|
import System.Directory hiding (findFiles)
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
@@ -100,6 +100,21 @@ isInPath p = do
|
|||||||
else pure False
|
else pure False
|
||||||
|
|
||||||
|
|
||||||
|
-- | Follows the first match in case of Regex.
|
||||||
|
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
|
||||||
|
expandFilePath = go ""
|
||||||
|
where
|
||||||
|
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
|
||||||
|
go p [] = pure [p]
|
||||||
|
go p (x:xs) = do
|
||||||
|
case x of
|
||||||
|
Left s -> go (p </> s) xs
|
||||||
|
Right regex -> do
|
||||||
|
fps <- findFiles p regex
|
||||||
|
res <- forM fps $ \fp -> go (p </> fp) xs
|
||||||
|
pure $ mconcat res
|
||||||
|
|
||||||
|
|
||||||
findFiles :: FilePath -> Regex -> IO [FilePath]
|
findFiles :: FilePath -> Regex -> IO [FilePath]
|
||||||
findFiles path regex = do
|
findFiles path regex = do
|
||||||
contents <- listDirectory path
|
contents <- listDirectory path
|
||||||
|
|||||||
@@ -35,6 +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.IO ( stderr )
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Directory
|
import System.Directory
|
||||||
@@ -142,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
|
||||||
|
|
||||||
@@ -184,7 +185,7 @@ execLogged exe args chdir lfile env = do
|
|||||||
Just (TP.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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Utils.String.QQ
|
Module : GHCup.Utils.String.QQ
|
||||||
|
|||||||
@@ -4,7 +4,7 @@
|
|||||||
{-# LANGUAGE DeriveLift #-}
|
{-# LANGUAGE DeriveLift #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||||
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
|||||||
@@ -222,8 +222,7 @@ download_ghcup() {
|
|||||||
if freebsd-version | grep -E '^12.*' ; then
|
if freebsd-version | grep -E '^12.*' ; then
|
||||||
freebsd_ver=12
|
freebsd_ver=12
|
||||||
elif freebsd-version | grep -E '^13.*' ; then
|
elif freebsd-version | grep -E '^13.*' ; then
|
||||||
# TODO: missing FreeBSD13 version
|
freebsd_ver=13
|
||||||
freebsd_ver=12
|
|
||||||
else
|
else
|
||||||
die "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues"
|
die "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues"
|
||||||
fi
|
fi
|
||||||
@@ -240,9 +239,7 @@ download_ghcup() {
|
|||||||
_url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
_url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
||||||
;;
|
;;
|
||||||
"Darwin"|"darwin")
|
"Darwin"|"darwin")
|
||||||
# uname -m and arch seem to behave different under rosetta
|
case "${arch}" in
|
||||||
# https://superuser.com/questions/835514/why-do-uname-p-and-uname-m-and-arch-output-different-architectures
|
|
||||||
case "$(arch)" in
|
|
||||||
x86_64|amd64)
|
x86_64|amd64)
|
||||||
_url=${base_url}/${ghver}/x86_64-apple-darwin-ghcup-${ghver}
|
_url=${base_url}/${ghver}/x86_64-apple-darwin-ghcup-${ghver}
|
||||||
;;
|
;;
|
||||||
@@ -283,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
|
||||||
@@ -371,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
|
||||||
;;
|
;;
|
||||||
*) ;;
|
*) ;;
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
38
scripts/update-sftp.sh
Executable file
38
scripts/update-sftp.sh
Executable file
@@ -0,0 +1,38 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
url=$1
|
||||||
|
ver=$2
|
||||||
|
|
||||||
|
die() {
|
||||||
|
(>&2 printf "%s\\n" "$1")
|
||||||
|
exit 2
|
||||||
|
}
|
||||||
|
|
||||||
|
[ -z $url ] && die "no url set"
|
||||||
|
[ -z $ver ] && die "no version set"
|
||||||
|
|
||||||
|
sftp $url <<EOF
|
||||||
|
cd ghcup
|
||||||
|
|
||||||
|
rm aarch64-apple-darwin-ghcup
|
||||||
|
rm aarch64-linux-ghcup
|
||||||
|
rm armv7-linux-ghcup
|
||||||
|
rm i386-linux-ghcup
|
||||||
|
rm x86_64-apple-darwin-ghcup
|
||||||
|
rm x86_64-linux-ghcup
|
||||||
|
rm x86_64-mingw64-ghcup.exe
|
||||||
|
rm x86_64-freebsd12-ghcup
|
||||||
|
rm x86_64-freebsd13-ghcup
|
||||||
|
|
||||||
|
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
|
||||||
|
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
|
||||||
|
symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
|
||||||
|
symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
|
||||||
|
symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
|
||||||
|
symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
|
||||||
|
symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
|
||||||
|
symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
|
||||||
|
symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
|
||||||
|
EOF
|
||||||
|
|
||||||
|
curl -X PURGE https://downloads.haskell.org/~ghcup/
|
||||||
Reference in New Issue
Block a user