Compare commits
79 Commits
stack-fork
...
v0.1.16.2
| Author | SHA1 | Date | |
|---|---|---|---|
|
6701093c3b
|
|||
|
e9fdc073c6
|
|||
|
57c791106b
|
|||
|
fcba151fad
|
|||
|
3b24f503d1
|
|||
|
bd18fd9aa1
|
|||
|
|
c2c5625685 | ||
|
|
ce6fb0bb1e | ||
|
|
dcfb3afdad | ||
|
50c91345e8
|
|||
|
af3ecae792
|
|||
|
|
300cfd3ba6 | ||
|
|
bb430fa0b7 | ||
|
|
80fa7965a4 | ||
|
9975a2d4ba
|
|||
|
|
d1735bc446 | ||
|
dbf1d6f420
|
|||
|
0a0fbd0cb6
|
|||
|
f13f53b910
|
|||
|
6dfc04a9f6
|
|||
|
72133d0002
|
|||
|
6e07e9e56b
|
|||
|
e903aeb555
|
|||
|
2792f6f4b6
|
|||
|
|
80eb72ce49 | ||
|
|
2c6d0382cf | ||
|
|
e1bec789b0 | ||
|
|
5683493cae | ||
|
|
ae5e213b59 | ||
|
|
911089f334 | ||
|
|
6b89646c1e | ||
|
|
960d5ce79f | ||
|
|
90ed0895d6 | ||
|
|
7471f4f4dc | ||
|
|
781cf8eed5 | ||
|
|
236da31af6 | ||
|
|
1f760af880 | ||
|
|
62d03b776b | ||
|
|
37ea18a0d8 | ||
|
|
083dc59a8f | ||
|
|
a45d069cad | ||
|
|
fdbcd4fafd | ||
|
|
f3c1c925ed | ||
|
|
8f6a7ba39c | ||
|
|
f212eb4570 | ||
|
|
0d118e2fe1 | ||
|
|
c0f46ef81f | ||
|
|
476513b0a7 | ||
|
|
9a511669a8 | ||
|
|
a16a25a3cd | ||
|
|
8666fcd120 | ||
|
|
521ab0aedb | ||
|
|
1cfff674b7 | ||
|
|
03d77f5006 | ||
|
|
71e6dbfdca | ||
|
|
692cd1616b | ||
|
|
4e3dbea5d0 | ||
|
|
fd2add78bd | ||
|
|
e9da8ab439 | ||
|
|
9c22ba9d45 | ||
|
|
e5d3080b54 | ||
|
|
5995a8b592 | ||
|
|
bc6d006c57 | ||
|
|
b148d8e2e7 | ||
|
|
4f7d41a8cc | ||
|
|
5efe2e5f7a | ||
|
|
338f5f309d | ||
|
|
ba51cbad6f | ||
|
|
511272e86d | ||
|
|
873f75da9f | ||
|
|
42d4a66493 | ||
|
|
9a79af6fd2 | ||
|
|
63f10a1871 | ||
|
|
9686ee9826 | ||
|
|
4729364e99 | ||
|
|
91d982c7b2 | ||
|
|
8b7c22440e | ||
|
|
9b3d55a095 | ||
|
|
e2daf5381c |
8720
.gitlab/ghc-8.10.3-linux.files
Normal file
8720
.gitlab/ghc-8.10.3-linux.files
Normal file
File diff suppressed because it is too large
Load Diff
10321
.gitlab/ghc-8.10.3-windows.files
Normal file
10321
.gitlab/ghc-8.10.3-windows.files
Normal file
File diff suppressed because it is too large
Load Diff
@@ -116,7 +116,20 @@ else
|
|||||||
if [ "${OS}" = "LINUX" ] ; then
|
if [ "${OS}" = "LINUX" ] ; then
|
||||||
eghcup --downloader=wget prefetch ghc 8.10.3
|
eghcup --downloader=wget prefetch ghc 8.10.3
|
||||||
eghcup --offline install ghc 8.10.3
|
eghcup --offline install ghc 8.10.3
|
||||||
else # test wget a bit
|
if [ "${ARCH}" = "64" ] ; then
|
||||||
|
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
|
||||||
|
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||||
|
[ "${actual}" = "${expected}" ]
|
||||||
|
unset actual expected
|
||||||
|
fi
|
||||||
|
elif [ "${OS}" = "WINDOWS" ] ; then
|
||||||
|
eghcup prefetch ghc 8.10.3
|
||||||
|
eghcup --offline install ghc 8.10.3
|
||||||
|
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
|
||||||
|
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||||
|
[ "${actual}" = "${expected}" ]
|
||||||
|
unset actual expected
|
||||||
|
else
|
||||||
eghcup prefetch ghc 8.10.3
|
eghcup prefetch ghc 8.10.3
|
||||||
eghcup --offline install ghc 8.10.3
|
eghcup --offline install ghc 8.10.3
|
||||||
fi
|
fi
|
||||||
@@ -196,6 +209,21 @@ sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
|||||||
[ "${etag2}" = "${etag3}" ]
|
[ "${etag2}" = "${etag3}" ]
|
||||||
[ "${sha2}" = "${sha3}" ]
|
[ "${sha2}" = "${sha3}" ]
|
||||||
|
|
||||||
|
# test isolated installs
|
||||||
|
eghcup install ghc -i "$(pwd)/isolated" 8.10.5
|
||||||
|
[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
|
||||||
|
! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
|
||||||
|
if [ "${ARCH}" = "64" ] ; then
|
||||||
|
if [ "${OS}" = "LINUX" ] || [ "${OS}" = "WINDOWS" ] ; then
|
||||||
|
eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
|
||||||
|
[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
|
||||||
|
eghcup install stack -i "$(pwd)/isolated" 2.7.3
|
||||||
|
[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
|
||||||
|
eghcup install hls -i "$(pwd)/isolated" 1.3.0
|
||||||
|
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
|
||||||
|
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
|
||||||
eghcup upgrade
|
eghcup upgrade
|
||||||
eghcup upgrade -f
|
eghcup upgrade -f
|
||||||
|
|||||||
@@ -1,5 +1,14 @@
|
|||||||
# Revision history for ghcup
|
# Revision history for ghcup
|
||||||
|
|
||||||
|
## 0.1.16.2 -- 2021-08-12
|
||||||
|
|
||||||
|
* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria
|
||||||
|
* Implement config cli MVP wrt [#134](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/134) by Oleksii Dorozhkin
|
||||||
|
* Fix `ghcup compile ghc --flavor`
|
||||||
|
* Fix minor installation bug causing increased disk space wrt [#139](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/139)
|
||||||
|
* Improved error handling wrt [#136](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/136)
|
||||||
|
* Various improvements to metadata download when using `file://` and `--offline` wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/137)
|
||||||
|
|
||||||
## 0.1.16.1 -- 2021-07-29
|
## 0.1.16.1 -- 2021-07-29
|
||||||
|
|
||||||
* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
|
* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
|
||||||
|
|||||||
@@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
|||||||
($(logError) $ T.pack $ prettyShow e)
|
($(logError) $ T.pack $ prettyShow e)
|
||||||
liftIO $ exitWith (ExitFailure 2)
|
liftIO $ exitWith (ExitFailure 2)
|
||||||
|
|
||||||
let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
|
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
|
||||||
|
|
||||||
r <-
|
r <-
|
||||||
runLogger
|
runLogger
|
||||||
|
|||||||
@@ -440,27 +440,29 @@ install' _ (_, ListResult {..}) = do
|
|||||||
, TagNotFound
|
, TagNotFound
|
||||||
, DigestError
|
, DigestError
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
|
, DirNotEmpty
|
||||||
, NoUpdate
|
, NoUpdate
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
|
|
||||||
run (do
|
run (do
|
||||||
case lTool of
|
case lTool of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
let vi = getVersionInfo lVer GHC dls
|
let vi = getVersionInfo lVer GHC dls
|
||||||
liftE $ installGHCBin lVer $> vi
|
liftE $ installGHCBin lVer Nothing $> vi
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
let vi = getVersionInfo lVer Cabal dls
|
let vi = getVersionInfo lVer Cabal dls
|
||||||
liftE $ installCabalBin lVer $> vi
|
liftE $ installCabalBin lVer Nothing $> vi
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let vi = snd <$> getLatest dls GHCup
|
let vi = snd <$> getLatest dls GHCup
|
||||||
liftE $ upgradeGHCup Nothing False $> vi
|
liftE $ upgradeGHCup Nothing False $> vi
|
||||||
HLS -> do
|
HLS -> do
|
||||||
let vi = getVersionInfo lVer HLS dls
|
let vi = getVersionInfo lVer HLS dls
|
||||||
liftE $ installHLSBin lVer $> vi
|
liftE $ installHLSBin lVer Nothing $> vi
|
||||||
Stack -> do
|
Stack -> do
|
||||||
let vi = getVersionInfo lVer Stack dls
|
let vi = getVersionInfo lVer Stack dls
|
||||||
liftE $ installStackBin lVer $> vi
|
liftE $ installStackBin lVer Nothing $> vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
|
|||||||
@@ -78,6 +78,8 @@ import qualified Data.Map.Strict as M
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
|
import qualified Data.Yaml as Y
|
||||||
|
import qualified Data.Yaml.Pretty as YP
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import qualified Text.Megaparsec.Char as MPC
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
@@ -105,6 +107,7 @@ data Command
|
|||||||
| Rm (Either RmCommand RmOptions)
|
| Rm (Either RmCommand RmOptions)
|
||||||
| DInfo
|
| DInfo
|
||||||
| Compile CompileCommand
|
| Compile CompileCommand
|
||||||
|
| Config ConfigCommand
|
||||||
| Whereis WhereisOptions WhereisCommand
|
| Whereis WhereisOptions WhereisCommand
|
||||||
| Upgrade UpgradeOpts Bool
|
| Upgrade UpgradeOpts Bool
|
||||||
| ToolRequirements
|
| ToolRequirements
|
||||||
@@ -138,6 +141,7 @@ data InstallOptions = InstallOptions
|
|||||||
, instPlatform :: Maybe PlatformRequest
|
, instPlatform :: Maybe PlatformRequest
|
||||||
, instBindist :: Maybe URI
|
, instBindist :: Maybe URI
|
||||||
, instSet :: Bool
|
, instSet :: Bool
|
||||||
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
data SetCommand = SetGHC SetOptions
|
data SetCommand = SetGHC SetOptions
|
||||||
@@ -173,6 +177,8 @@ data RmOptions = RmOptions
|
|||||||
|
|
||||||
data CompileCommand = CompileGHC GHCCompileOptions
|
data CompileCommand = CompileGHC GHCCompileOptions
|
||||||
|
|
||||||
|
data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
|
||||||
|
|
||||||
data GHCCompileOptions = GHCCompileOptions
|
data GHCCompileOptions = GHCCompileOptions
|
||||||
{ targetGhc :: Either Version GitBranch
|
{ targetGhc :: Either Version GitBranch
|
||||||
, bootstrapGhc :: Either Version FilePath
|
, bootstrapGhc :: Either Version FilePath
|
||||||
@@ -185,6 +191,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, hadrian :: Bool
|
||||||
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
@@ -408,6 +415,12 @@ com =
|
|||||||
<> footerDoc (Just $ text changeLogFooter)
|
<> footerDoc (Just $ text changeLogFooter)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
<> command
|
||||||
|
"config"
|
||||||
|
( Config
|
||||||
|
<$> info (configP <**> helper)
|
||||||
|
(progDesc "Show or set config" <> footerDoc (Just $ text configFooter))
|
||||||
|
)
|
||||||
<> commandGroup "Other commands:"
|
<> commandGroup "Other commands:"
|
||||||
<> hidden
|
<> hidden
|
||||||
)
|
)
|
||||||
@@ -482,6 +495,17 @@ Examples:
|
|||||||
ghcup prefetch ghc 8.10.5
|
ghcup prefetch ghc 8.10.5
|
||||||
ghcup --offline install ghc 8.10.5|]
|
ghcup --offline install ghc 8.10.5|]
|
||||||
|
|
||||||
|
configFooter :: String
|
||||||
|
configFooter = [s|Examples:
|
||||||
|
|
||||||
|
# show current config
|
||||||
|
ghcup config
|
||||||
|
|
||||||
|
# initialize config
|
||||||
|
ghcup config init
|
||||||
|
|
||||||
|
# set <key> <value> configuration pair
|
||||||
|
ghcup config <key> <value>|]
|
||||||
|
|
||||||
installCabalFooter :: String
|
installCabalFooter :: String
|
||||||
installCabalFooter = [s|Discussion:
|
installCabalFooter = [s|Discussion:
|
||||||
@@ -574,7 +598,7 @@ Examples:
|
|||||||
|
|
||||||
installOpts :: Maybe Tool -> Parser InstallOptions
|
installOpts :: Maybe Tool -> Parser InstallOptions
|
||||||
installOpts tool =
|
installOpts tool =
|
||||||
(\p (u, v) b -> InstallOptions v p u b)
|
(\p (u, v) b is -> InstallOptions v p u b is)
|
||||||
<$> optional
|
<$> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader platformParser)
|
(eitherReader platformParser)
|
||||||
@@ -603,6 +627,15 @@ installOpts tool =
|
|||||||
(long "set" <> help
|
(long "set" <> help
|
||||||
"Set as active version after install"
|
"Set as active version after install"
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader isolateParser)
|
||||||
|
( short 'i'
|
||||||
|
<> long "isolate"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> help "install in an isolated dir instead of the default one"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
setParser :: Parser (Either SetCommand SetOptions)
|
setParser :: Parser (Either SetCommand SetOptions)
|
||||||
@@ -786,6 +819,19 @@ Examples:
|
|||||||
# build cross compiler
|
# build cross compiler
|
||||||
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
|
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
|
||||||
|
|
||||||
|
configP :: Parser ConfigCommand
|
||||||
|
configP = subparser
|
||||||
|
( command "init" initP
|
||||||
|
<> command "set" setP -- [set] KEY VALUE at help lhs
|
||||||
|
<> command "show" showP
|
||||||
|
)
|
||||||
|
<|> argsP -- add show for a single option
|
||||||
|
<|> pure ShowConfig
|
||||||
|
where
|
||||||
|
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
|
||||||
|
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
||||||
|
setP = info argsP (progDesc "Set config KEY to VALUE")
|
||||||
|
argsP = SetConfig <$> argument str (metavar "KEY") <*> argument str (metavar "VALUE")
|
||||||
|
|
||||||
whereisP :: Parser WhereisCommand
|
whereisP :: Parser WhereisCommand
|
||||||
whereisP = subparser
|
whereisP = subparser
|
||||||
@@ -1000,6 +1046,15 @@ ghcCompileOpts =
|
|||||||
<*> switch
|
<*> switch
|
||||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader isolateParser)
|
||||||
|
( short 'i'
|
||||||
|
<> long "isolate"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
toolVersionParser :: Parser ToolVersion
|
toolVersionParser :: Parser ToolVersion
|
||||||
@@ -1215,6 +1270,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
|||||||
bindistParser :: String -> Either String URI
|
bindistParser :: String -> Either String URI
|
||||||
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||||
|
|
||||||
|
isolateParser :: FilePath -> Either String FilePath
|
||||||
|
isolateParser f = case isValid f of
|
||||||
|
True -> Right $ normalise f
|
||||||
|
False -> Left "Please enter a valid filepath for isolate dir."
|
||||||
|
|
||||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||||
toSettings options = do
|
toSettings options = do
|
||||||
@@ -1258,6 +1317,21 @@ toSettings options = do
|
|||||||
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
|
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
|
||||||
}
|
}
|
||||||
|
|
||||||
|
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
||||||
|
updateSettings config settings = do
|
||||||
|
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
|
||||||
|
pure $ mergeConf settings' settings
|
||||||
|
where
|
||||||
|
mergeConf :: UserSettings -> Settings -> Settings
|
||||||
|
mergeConf UserSettings{..} Settings{..} =
|
||||||
|
let cache' = fromMaybe cache uCache
|
||||||
|
noVerify' = fromMaybe noVerify uNoVerify
|
||||||
|
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||||
|
downloader' = fromMaybe downloader uDownloader
|
||||||
|
verbose' = fromMaybe verbose uVerbose
|
||||||
|
urlSource' = fromMaybe urlSource uUrlSource
|
||||||
|
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||||
|
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork'
|
||||||
|
|
||||||
upgradeOptsP :: Parser UpgradeOpts
|
upgradeOptsP :: Parser UpgradeOpts
|
||||||
upgradeOptsP =
|
upgradeOptsP =
|
||||||
@@ -1292,6 +1366,11 @@ describe_result = $( LitE . StringL <$>
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
formatConfig :: UserSettings -> String
|
||||||
|
formatConfig settings
|
||||||
|
= UTF8.toString . YP.encodePretty yamlConfig $ settings
|
||||||
|
where
|
||||||
|
yamlConfig = YP.setConfCompare compare YP.defConfig
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
@@ -1445,6 +1524,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
#endif
|
#endif
|
||||||
, FileDoesNotExistError
|
, FileDoesNotExistError
|
||||||
, CopyError
|
, CopyError
|
||||||
|
, NotInstalled
|
||||||
|
, DirNotEmpty
|
||||||
, NoDownload
|
, NoDownload
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -1454,6 +1535,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
|
|
||||||
let runInstTool mInstPlatform action' = do
|
let runInstTool mInstPlatform action' = do
|
||||||
@@ -1555,6 +1637,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
@@ -1617,22 +1700,23 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
-----------------------
|
-----------------------
|
||||||
|
|
||||||
let installGHC InstallOptions{..} =
|
let installGHC InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
|
liftE $ installGHCBin (_tvVersion v) isolateDir
|
||||||
|
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||||
|
pure vi
|
||||||
|
Just uri -> do
|
||||||
|
s' <- liftIO appState
|
||||||
|
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ installGHCBin (_tvVersion v)
|
liftE $ installGHCBindist
|
||||||
|
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||||
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
)
|
||||||
s' <- liftIO appState
|
|
||||||
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
|
||||||
liftE $ installGHCBindist
|
|
||||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
|
||||||
(_tvVersion v)
|
|
||||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
|
||||||
pure vi
|
|
||||||
)
|
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "GHC installation successful"
|
runLogger $ $(logInfo) "GHC installation successful"
|
||||||
@@ -1661,7 +1745,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||||
liftE $ installCabalBin (_tvVersion v)
|
liftE $ installCabalBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
@@ -1670,6 +1754,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
liftE $ installCabalBindist
|
liftE $ installCabalBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
@@ -1689,10 +1774,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installHLS InstallOptions{..} =
|
let installHLS InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||||
liftE $ installHLSBin (_tvVersion v)
|
liftE $ installHLSBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
@@ -1701,6 +1786,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
liftE $ installHLSBindist
|
liftE $ installHLSBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
@@ -1720,19 +1806,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installStack InstallOptions{..} =
|
let installStack InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ installStackBin (_tvVersion v)
|
liftE $ installStackBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ installStackBindist
|
liftE $ installStackBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
pure vi
|
isolateDir
|
||||||
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -1961,6 +2048,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
hadrian
|
||||||
|
isolateDir
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
@@ -1990,6 +2078,37 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
|||||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
|
|
||||||
|
Config InitConfig -> do
|
||||||
|
path <- getConfigFilePath
|
||||||
|
writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||||
|
runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Config ShowConfig -> do
|
||||||
|
putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
|
Config (SetConfig k v) -> do
|
||||||
|
case v of
|
||||||
|
"" -> do
|
||||||
|
runLogger $ $(logError) "Empty values are not allowed"
|
||||||
|
pure $ ExitFailure 55
|
||||||
|
_ -> do
|
||||||
|
r <- runE @'[JSONError] $ do
|
||||||
|
settings' <- updateSettings [i|#{k}: #{v}\n|] settings
|
||||||
|
path <- liftIO getConfigFilePath
|
||||||
|
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||||
|
runLogger $ $(logDebug) $ T.pack $ show settings'
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
case r of
|
||||||
|
VRight _ -> pure ExitSuccess
|
||||||
|
VLeft (V (JSONDecodeError e)) -> do
|
||||||
|
runLogger $ $(logError)
|
||||||
|
[i|Error decoding config: #{e}|]
|
||||||
|
pure $ ExitFailure 65
|
||||||
|
VLeft _ -> pure $ ExitFailure 65
|
||||||
|
|
||||||
Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
|
Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
|
||||||
runLeanWhereIs (do
|
runLeanWhereIs (do
|
||||||
loc <- liftE $ whereIsTool tool v
|
loc <- liftE $ whereIsTool tool v
|
||||||
|
|||||||
@@ -371,7 +371,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||||
|
|
||||||
Print-Msg -msg 'Installing Dependencies...'
|
Print-Msg -msg 'Installing Dependencies...'
|
||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl mingw-w64-x86_64-pkgconf'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf'
|
||||||
|
|
||||||
Print-Msg -msg 'Updating SSL root certificate authorities...'
|
Print-Msg -msg 'Updating SSL root certificate authorities...'
|
||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
cabal-version: 3.0
|
cabal-version: 3.0
|
||||||
name: ghcup
|
name: ghcup
|
||||||
version: 0.1.16.1
|
version: 0.1.16.2
|
||||||
license: LGPL-3.0-only
|
license: LGPL-3.0-only
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
copyright: Julian Ospald 2020
|
copyright: Julian Ospald 2020
|
||||||
@@ -226,6 +226,7 @@ executable ghcup
|
|||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, utf8-string ^>=1.0
|
, utf8-string ^>=1.0
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
|
, yaml ^>=0.11.4.0
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if flag(internal-downloader)
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
|
|||||||
323
lib/GHCup.hs
323
lib/GHCup.hs
@@ -186,6 +186,7 @@ installGHCBindist :: ( MonadFail m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo -- ^ where/how to download
|
=> DownloadInfo -- ^ where/how to download
|
||||||
-> Version -- ^ the version to install
|
-> Version -- ^ the version to install
|
||||||
|
-> Maybe FilePath -- ^ isolated filepath if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -195,16 +196,22 @@ installGHCBindist :: ( MonadFail m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBindist dlinfo ver = do
|
installGHCBindist dlinfo ver isoFilepath = do
|
||||||
let tver = mkTVer ver
|
let tver = mkTVer ver
|
||||||
|
|
||||||
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
||||||
whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
|
|
||||||
|
case isoFilepath of
|
||||||
|
-- we only care for already installed errors in regular (non-isolated) installs
|
||||||
|
Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -214,9 +221,15 @@ installGHCBindist dlinfo ver = do
|
|||||||
|
|
||||||
toolchainSanityChecks
|
toolchainSanityChecks
|
||||||
|
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
|
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
|
||||||
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
|
||||||
|
Nothing -> do -- regular install
|
||||||
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
||||||
|
|
||||||
liftE $ postGHCInstall tver
|
-- make symlinks & stuff when regular install,
|
||||||
|
liftE $ postGHCInstall tver
|
||||||
|
|
||||||
where
|
where
|
||||||
toolchainSanityChecks = do
|
toolchainSanityChecks = do
|
||||||
@@ -250,6 +263,7 @@ installPackedGHC :: ( MonadMask m
|
|||||||
'[ BuildFailed
|
'[ BuildFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
@@ -257,6 +271,8 @@ installPackedGHC :: ( MonadMask m
|
|||||||
installPackedGHC dl msubdir inst ver = do
|
installPackedGHC dl msubdir inst ver = do
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
|
|
||||||
|
liftE $ installDestSanityCheck inst
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
tmpUnpack <- lift mkGhcupTmpDir
|
tmpUnpack <- lift mkGhcupTmpDir
|
||||||
liftE $ unpackToDir tmpUnpack dl
|
liftE $ unpackToDir tmpUnpack dl
|
||||||
@@ -270,6 +286,22 @@ installPackedGHC dl msubdir inst ver = 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
|
||||||
@@ -300,10 +332,6 @@ installUnpackedGHC path inst ver = do
|
|||||||
setModificationTime dest mtime
|
setModificationTime dest mtime
|
||||||
#else
|
#else
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
liftIO $ copyDirectoryRecursive path inst $ \source dest -> do
|
|
||||||
mtime <- getModificationTime source
|
|
||||||
copyFile source dest
|
|
||||||
setModificationTime dest mtime
|
|
||||||
|
|
||||||
let alpineArgs
|
let alpineArgs
|
||||||
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
||||||
@@ -343,6 +371,7 @@ installGHCBin :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version -- ^ the version to install
|
=> Version -- ^ the version to install
|
||||||
|
-> Maybe FilePath -- ^ isolated install filepath, if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -352,15 +381,16 @@ installGHCBin :: ( MonadFail m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBin ver = do
|
installGHCBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
dlinfo <- liftE $ getDownloadInfo GHC ver
|
||||||
installGHCBindist dlinfo ver
|
installGHCBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
|
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
|
||||||
@@ -379,6 +409,7 @@ installCabalBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath -- ^ isolated install filepath, if user provides any.
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -391,23 +422,28 @@ installCabalBindist :: ( MonadMask m
|
|||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installCabalBindist dlinfo ver = do
|
installCabalBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM
|
case isoFilepath of
|
||||||
(lift (cabalInstalled ver) >>= \a -> liftIO $
|
Nothing -> -- for regular install check if any previous versions installed
|
||||||
handleIO (\_ -> pure False)
|
whenM
|
||||||
$ fmap (\x -> a && x)
|
(lift (cabalInstalled ver) >>= \a -> liftIO $
|
||||||
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
handleIO (\_ -> pure False)
|
||||||
$ pathIsLink (binDir </> "cabal" <> exeExt)
|
$ fmap (\x -> a && x)
|
||||||
)
|
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
||||||
(throwE $ AlreadyInstalled Cabal ver)
|
$ pathIsLink (binDir </> "cabal" <> exeExt)
|
||||||
|
)
|
||||||
|
(throwE $ AlreadyInstalled Cabal ver)
|
||||||
|
|
||||||
|
_ -> pure () -- check isn't required in isolated installs
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -420,30 +456,37 @@ installCabalBindist dlinfo ver = 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)
|
||||||
|
|
||||||
liftE $ installCabal' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
|
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
|
||||||
|
liftE $ installCabalUnpacked workdir isoDir Nothing
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
Nothing -> do -- regular install
|
||||||
cVers <- lift $ fmap rights getInstalledCabals
|
liftE $ installCabalUnpacked workdir binDir (Just ver)
|
||||||
let lInstCabal = headMay . reverse . sort $ cVers
|
|
||||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
|
||||||
|
|
||||||
where
|
-- create symlink if this is the latest version for regular installs
|
||||||
-- | Install an unpacked cabal distribution.
|
cVers <- lift $ fmap rights getInstalledCabals
|
||||||
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
|
let lInstCabal = headMay . reverse . sort $ cVers
|
||||||
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installCabal' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing cabal"
|
|
||||||
let cabalFile = "cabal"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
let destPath = inst </> destFileName
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> cabalFile <> exeExt)
|
|
||||||
destPath
|
|
||||||
lift $ chmod_755 destPath
|
|
||||||
|
|
||||||
|
-- | Install an unpacked cabal distribution.
|
||||||
|
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
|
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Maybe Version -- ^ Nothing for isolated install
|
||||||
|
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||||
|
installCabalUnpacked path inst mver' = do
|
||||||
|
lift $ $(logInfo) "Installing cabal"
|
||||||
|
let cabalFile = "cabal"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
let destFileName = cabalFile
|
||||||
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
|
<> exeExt
|
||||||
|
let destPath = inst </> destFileName
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> cabalFile <> exeExt)
|
||||||
|
destPath
|
||||||
|
lift $ chmod_755 destPath
|
||||||
|
|
||||||
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
|
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
|
||||||
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
|
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
|
||||||
@@ -462,6 +505,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath -- isolated install Path, if user provided any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -474,12 +518,13 @@ installCabalBin :: ( MonadMask m
|
|||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
|
, FileAlreadyExistsError
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installCabalBin ver = do
|
installCabalBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
||||||
installCabalBindist dlinfo ver
|
installCabalBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
|
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
|
||||||
@@ -498,6 +543,7 @@ installHLSBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath -- ^ isolated install path, if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -513,14 +559,19 @@ installHLSBindist :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installHLSBindist dlinfo ver = do
|
installHLSBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM (lift (hlsInstalled ver))
|
case isoFilepath of
|
||||||
(throwE $ AlreadyInstalled HLS ver)
|
Nothing ->
|
||||||
|
-- we only check for already installed in regular (non-isolated) installs
|
||||||
|
whenM (lift (hlsInstalled ver))
|
||||||
|
(throwE $ AlreadyInstalled HLS ver)
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -533,46 +584,55 @@ installHLSBindist dlinfo ver = 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)
|
||||||
|
|
||||||
liftE $ installHLS' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do
|
||||||
|
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
|
||||||
|
liftE $ installHLSUnpacked workdir isoDir Nothing
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
Nothing -> do
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
liftE $ installHLSUnpacked workdir binDir (Just ver)
|
||||||
let lInstHLS = headMay . reverse . sort $ hlsVers
|
|
||||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
|
||||||
|
|
||||||
where
|
-- create symlink if this is the latest version in a regular install
|
||||||
-- | Install an unpacked hls distribution.
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
let lInstHLS = headMay . reverse . sort $ hlsVers
|
||||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installHLS' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing HLS"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
|
|
||||||
-- install haskell-language-server-<ghcver>
|
|
||||||
bins@(_:_) <- liftIO $ findFiles
|
|
||||||
path
|
|
||||||
(makeRegexOpts compExtended
|
|
||||||
execBlank
|
|
||||||
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
|
|
||||||
)
|
|
||||||
forM_ bins $ \f -> do
|
|
||||||
let toF = dropSuffix exeExt f
|
|
||||||
<> "~" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> f)
|
|
||||||
(inst </> toF)
|
|
||||||
lift $ chmod_755 (inst </> toF)
|
|
||||||
|
|
||||||
-- install haskell-language-server-wrapper
|
-- | Install an unpacked hls distribution.
|
||||||
let wrapper = "haskell-language-server-wrapper"
|
installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Maybe Version -- ^ Nothing for isolated install
|
||||||
|
-> Excepts '[CopyError] m ()
|
||||||
|
installHLSUnpacked path inst mver' = do
|
||||||
|
lift $ $(logInfo) "Installing HLS"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
|
||||||
|
-- install haskell-language-server-<ghcver>
|
||||||
|
bins@(_:_) <- liftIO $ findFiles
|
||||||
|
path
|
||||||
|
(makeRegexOpts compExtended
|
||||||
|
execBlank
|
||||||
|
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
|
||||||
|
)
|
||||||
|
forM_ bins $ \f -> do
|
||||||
|
let toF = dropSuffix exeExt f
|
||||||
|
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
|
||||||
|
<> exeExt
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> wrapper <> exeExt)
|
(path </> f)
|
||||||
(inst </> toF)
|
(inst </> toF)
|
||||||
lift $ chmod_755 (inst </> toF)
|
lift $ chmod_755 (inst </> toF)
|
||||||
|
|
||||||
|
-- install haskell-language-server-wrapper
|
||||||
|
let wrapper = "haskell-language-server-wrapper"
|
||||||
|
toF = wrapper
|
||||||
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
|
<> exeExt
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> wrapper <> exeExt)
|
||||||
|
(inst </> toF)
|
||||||
|
lift $ chmod_755 (inst </> toF)
|
||||||
|
|
||||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||||
@@ -590,6 +650,7 @@ installHLSBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -605,9 +666,9 @@ installHLSBin :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installHLSBin ver = do
|
installHLSBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo HLS ver
|
dlinfo <- liftE $ getDownloadInfo HLS ver
|
||||||
installHLSBindist dlinfo ver
|
installHLSBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
|
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
|
||||||
@@ -627,6 +688,7 @@ installStackBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -642,9 +704,9 @@ installStackBin :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installStackBin ver = do
|
installStackBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo Stack ver
|
dlinfo <- liftE $ getDownloadInfo Stack ver
|
||||||
installStackBindist dlinfo ver
|
installStackBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
|
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
|
||||||
@@ -663,6 +725,7 @@ installStackBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -678,14 +741,18 @@ installStackBindist :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installStackBindist dlinfo ver = do
|
installStackBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM (lift (stackInstalled ver))
|
case isoFilepath of
|
||||||
(throwE $ AlreadyInstalled Stack ver)
|
Nothing -> -- check previous versions in case of regular installs
|
||||||
|
whenM (lift (stackInstalled ver))
|
||||||
|
(throwE $ AlreadyInstalled Stack ver)
|
||||||
|
|
||||||
|
_ -> pure () -- don't do shit for isolates
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -698,31 +765,37 @@ installStackBindist dlinfo ver = 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)
|
||||||
|
|
||||||
liftE $ installStack' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
|
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
|
||||||
|
liftE $ installStackUnpacked workdir isoDir Nothing
|
||||||
|
Nothing -> do -- regular install
|
||||||
|
liftE $ installStackUnpacked workdir binDir (Just ver)
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
-- create symlink if this is the latest version and a regular install
|
||||||
sVers <- lift $ fmap rights getInstalledStacks
|
sVers <- lift $ fmap rights getInstalledStacks
|
||||||
let lInstStack = headMay . reverse . sort $ sVers
|
let lInstStack = headMay . reverse . sort $ sVers
|
||||||
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
|
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
|
||||||
|
|
||||||
where
|
|
||||||
-- | Install an unpacked stack distribution.
|
|
||||||
installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
|
|
||||||
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installStack' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing stack"
|
|
||||||
let stackFile = "stack"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
let destPath = inst </> destFileName
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> stackFile <> exeExt)
|
|
||||||
destPath
|
|
||||||
lift $ chmod_755 destPath
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Install an unpacked stack distribution.
|
||||||
|
installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
|
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Maybe Version -- ^ Nothing for isolated installs
|
||||||
|
-> Excepts '[CopyError] m ()
|
||||||
|
installStackUnpacked path inst mver' = do
|
||||||
|
lift $ $(logInfo) "Installing stack"
|
||||||
|
let stackFile = "stack"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
let destFileName = stackFile
|
||||||
|
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||||
|
<> exeExt
|
||||||
|
let destPath = inst </> destFileName
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> stackFile <> exeExt)
|
||||||
|
destPath
|
||||||
|
lift $ chmod_755 destPath
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
@@ -1704,6 +1777,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Bool
|
||||||
|
-> Maybe FilePath -- ^ isolate dir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -1716,13 +1790,14 @@ compileGHC :: ( MonadMask m
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
|
, DirNotEmpty
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian
|
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
@@ -1792,12 +1867,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
||||||
when alreadyInstalled $ do
|
when alreadyInstalled $ do
|
||||||
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
case isolateDir of
|
||||||
|
Just isoDir ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
|
||||||
|
Nothing ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
||||||
lift $ $(logWarn)
|
lift $ $(logWarn)
|
||||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
ghcdir <- lift $ ghcupGHCDir installVer
|
ghcdir <- case isolateDir of
|
||||||
|
Just isoDir -> pure isoDir
|
||||||
|
Nothing -> lift $ ghcupGHCDir installVer
|
||||||
|
|
||||||
bghc <- case bstrap of
|
bghc <- case bstrap of
|
||||||
Right g -> pure $ Right g
|
Right g -> pure $ Right g
|
||||||
@@ -1814,9 +1895,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
pure (b, bmk)
|
pure (b, bmk)
|
||||||
)
|
)
|
||||||
|
|
||||||
when alreadyInstalled $ do
|
case isolateDir of
|
||||||
lift $ $(logInfo) [i|Deleting existing installation|]
|
Nothing ->
|
||||||
liftE $ rmGHCVer tver
|
-- only remove old ghc in regular installs
|
||||||
|
when alreadyInstalled $ do
|
||||||
|
lift $ $(logInfo) [i|Deleting existing installation|]
|
||||||
|
liftE $ rmGHCVer tver
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
forM_ mBindist $ \bindist -> do
|
forM_ mBindist $ \bindist -> do
|
||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
@@ -1826,10 +1912,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
|
|
||||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||||
|
|
||||||
reThrowAll GHCupSetError $ postGHCInstall tver
|
case isolateDir of
|
||||||
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
|
Nothing -> do
|
||||||
|
reThrowAll GHCupSetError $ postGHCInstall tver
|
||||||
|
-- restore
|
||||||
|
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
||||||
|
|
||||||
-- restore
|
_ -> pure ()
|
||||||
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
|
||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
@@ -2037,7 +2127,7 @@ endif|]
|
|||||||
liftIO $ threadDelay 5000000
|
liftIO $ threadDelay 5000000
|
||||||
|
|
||||||
addBuildFlavourToConf bc = case buildFlavour of
|
addBuildFlavourToConf bc = case buildFlavour of
|
||||||
Just bf -> [i|BuildFlavour = #{bf}|] <> [s|
|
Just bf -> [i|BuildFlavour = #{bf}
|
||||||
|] <> [i|#{bc}|]
|
|] <> [i|#{bc}|]
|
||||||
Nothing -> bc
|
Nothing -> bc
|
||||||
|
|
||||||
@@ -2189,6 +2279,7 @@ upgradeGHCup mtarget force' = do
|
|||||||
-------------
|
-------------
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
|
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
|
||||||
-- both installing from source and bindist.
|
-- both installing from source and bindist.
|
||||||
postGHCInstall :: ( MonadReader env m
|
postGHCInstall :: ( MonadReader env m
|
||||||
|
|||||||
@@ -172,21 +172,31 @@ getBase :: ( MonadReader env m
|
|||||||
-> Excepts '[JSONError] m GHCupInfo
|
-> Excepts '[JSONError] m GHCupInfo
|
||||||
getBase uri = do
|
getBase uri = do
|
||||||
Settings { noNetwork } <- lift getSettings
|
Settings { noNetwork } <- lift getSettings
|
||||||
yaml <- lift $ yamlFromCache uri
|
|
||||||
unless noNetwork $
|
-- try to download yaml... usually this writes it into cache dir,
|
||||||
handleIO (\e -> warnCache (displayException e))
|
-- but in some cases not (e.g. when using file://), so we honour
|
||||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e))
|
-- the return filepath, if any
|
||||||
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
|
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
||||||
. smartDl
|
then pure Nothing
|
||||||
$ uri
|
else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
|
||||||
|
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
|
||||||
|
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
|
||||||
|
. fmap Just
|
||||||
|
. smartDl
|
||||||
|
$ uri
|
||||||
|
|
||||||
|
-- if we didn't get a filepath from the download, use the cached yaml
|
||||||
|
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||||
|
lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|]
|
||||||
|
|
||||||
liftE
|
liftE
|
||||||
. onE_ (onError yaml)
|
. onE_ (onError actualYaml)
|
||||||
. lEM' @_ @_ @'[JSONError] JSONDecodeError
|
. lEM' @_ @_ @'[JSONError] JSONDecodeError
|
||||||
. fmap (first (\e -> [i|#{displayException e}
|
. fmap (first (\e -> [i|#{displayException e}
|
||||||
Consider removing "#{yaml}" manually.|]))
|
Consider removing "#{actualYaml}" manually.|]))
|
||||||
. liftIO
|
. liftIO
|
||||||
. Y.decodeFileEither
|
. Y.decodeFileEither
|
||||||
$ yaml
|
$ actualYaml
|
||||||
where
|
where
|
||||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||||
-- may re-download and succeed.
|
-- may re-download and succeed.
|
||||||
@@ -221,28 +231,32 @@ Consider removing "#{yaml}" manually.|]))
|
|||||||
, DigestError
|
, DigestError
|
||||||
]
|
]
|
||||||
m1
|
m1
|
||||||
()
|
FilePath
|
||||||
smartDl uri' = do
|
smartDl uri' = do
|
||||||
json_file <- lift $ yamlFromCache uri'
|
json_file <- lift $ yamlFromCache uri'
|
||||||
|
let scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||||
e <- liftIO $ doesFileExist json_file
|
e <- liftIO $ doesFileExist json_file
|
||||||
currentTime <- liftIO getCurrentTime
|
currentTime <- liftIO getCurrentTime
|
||||||
if e
|
Dirs { cacheDir } <- lift getDirs
|
||||||
then do
|
|
||||||
accessTime <- liftIO $ getAccessTime json_file
|
|
||||||
|
|
||||||
-- access time won't work on most linuxes, but we can try regardless
|
-- for local files, let's short-circuit and ignore access time
|
||||||
when ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) $
|
if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
|
||||||
-- no access in last 5 minutes, re-check upstream mod time
|
| e -> do
|
||||||
dlWithMod currentTime json_file
|
accessTime <- liftIO $ getAccessTime json_file
|
||||||
else
|
|
||||||
dlWithMod currentTime json_file
|
-- access time won't work on most linuxes, but we can try regardless
|
||||||
|
if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
|
||||||
|
-- no access in last 5 minutes, re-check upstream mod time
|
||||||
|
dlWithMod currentTime json_file
|
||||||
|
| otherwise -> pure json_file
|
||||||
|
| otherwise -> dlWithMod currentTime json_file
|
||||||
where
|
where
|
||||||
dlWithMod modTime json_file = do
|
dlWithMod modTime json_file = do
|
||||||
let (dir, fn) = splitFileName json_file
|
let (dir, fn) = splitFileName json_file
|
||||||
f <- liftE $ download uri' Nothing dir (Just fn) True
|
f <- liftE $ download uri' Nothing dir (Just fn) True
|
||||||
liftIO $ setModificationTime f modTime
|
liftIO $ setModificationTime f modTime
|
||||||
liftIO $ setAccessTime f modTime
|
liftIO $ setAccessTime f modTime
|
||||||
|
pure f
|
||||||
|
|
||||||
|
|
||||||
getDownloadInfo :: ( MonadReader env m
|
getDownloadInfo :: ( MonadReader env m
|
||||||
@@ -304,27 +318,25 @@ download :: ( MonadReader env m
|
|||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
-> Maybe T.Text -- ^ expected hash
|
-> Maybe T.Text -- ^ expected hash
|
||||||
-> FilePath -- ^ destination dir
|
-> FilePath -- ^ destination dir (ignored for file:// scheme)
|
||||||
-> Maybe FilePath -- ^ optional filename
|
-> Maybe FilePath -- ^ optional filename
|
||||||
-> Bool -- ^ whether to read an write etags
|
-> Bool -- ^ whether to read an write etags
|
||||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||||
download uri eDigest dest mfn etags
|
download uri eDigest dest mfn etags
|
||||||
| scheme == "https" = dl
|
| scheme == "https" = dl
|
||||||
| scheme == "http" = dl
|
| scheme == "http" = dl
|
||||||
| scheme == "file" = cp
|
| scheme == "file" = do
|
||||||
|
let destFile' = T.unpack . decUTF8Safe $ path
|
||||||
|
lift $ $(logDebug) [i|using local file: #{destFile'}|]
|
||||||
|
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||||
|
pure destFile'
|
||||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||||
|
|
||||||
where
|
where
|
||||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||||
cp = do
|
|
||||||
-- destination dir must exist
|
|
||||||
liftIO $ createDirRecursive' dest
|
|
||||||
let fromFile = T.unpack . decUTF8Safe $ path
|
|
||||||
liftIO $ copyFile fromFile destFile
|
|
||||||
pure destFile
|
|
||||||
dl = do
|
dl = do
|
||||||
let uri' = decUTF8Safe (serializeURIRef' uri)
|
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
|
||||||
lift $ $(logInfo) [i|downloading: #{uri'}|]
|
lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
|
||||||
|
|
||||||
-- destination dir must exist
|
-- destination dir must exist
|
||||||
liftIO $ createDirRecursive' dest
|
liftIO $ createDirRecursive' dest
|
||||||
@@ -366,7 +378,7 @@ download uri eDigest dest mfn etags
|
|||||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||||
:: V '[MalformedHeaders]))
|
:: V '[MalformedHeaders]))
|
||||||
|
|
||||||
writeEtags (parseEtags headers)
|
writeEtags destFile (parseEtags headers)
|
||||||
else
|
else
|
||||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||||
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
||||||
@@ -383,13 +395,13 @@ download uri eDigest dest mfn etags
|
|||||||
case _exitCode of
|
case _exitCode of
|
||||||
ExitSuccess -> do
|
ExitSuccess -> do
|
||||||
liftIO $ copyFile destFileTemp destFile
|
liftIO $ copyFile destFileTemp destFile
|
||||||
writeEtags (parseEtags (decUTF8Safe' _stdErr))
|
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||||
ExitFailure i'
|
ExitFailure i'
|
||||||
| i' == 8
|
| i' == 8
|
||||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||||
-> do
|
-> do
|
||||||
$logDebug "Not modified, skipping download"
|
$logDebug "Not modified, skipping download"
|
||||||
writeEtags (parseEtags (decUTF8Safe' _stdErr))
|
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||||
else do
|
else do
|
||||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||||
@@ -404,10 +416,10 @@ download uri eDigest dest mfn etags
|
|||||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||||
, E.encodeUtf8 etag)]) metag
|
, E.encodeUtf8 etag)]) metag
|
||||||
liftE
|
liftE
|
||||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags (pure $ Just etag))
|
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||||
$ do
|
$ do
|
||||||
r <- downloadToFile https host fullPath port destFile addHeaders
|
r <- downloadToFile https host fullPath port destFile addHeaders
|
||||||
writeEtags (pure $ decUTF8Safe <$> getHeader r "etag")
|
writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||||
else void $ liftE $ catchE @HTTPNotModified
|
else void $ liftE $ catchE @HTTPNotModified
|
||||||
@'[DownloadFailed]
|
@'[DownloadFailed]
|
||||||
(\e@(HTTPNotModified _) ->
|
(\e@(HTTPNotModified _) ->
|
||||||
@@ -420,12 +432,18 @@ download uri eDigest dest mfn etags
|
|||||||
|
|
||||||
|
|
||||||
-- Manage to find a file we can write the body into.
|
-- Manage to find a file we can write the body into.
|
||||||
destFile :: FilePath
|
getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
|
||||||
destFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
|
getDestFile =
|
||||||
(dest </>)
|
case mfn of
|
||||||
mfn
|
Just fn -> pure (dest </> fn)
|
||||||
|
Nothing
|
||||||
|
| let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
|
||||||
|
, not (null urlBase) -> pure (dest </> urlBase)
|
||||||
|
-- TODO: remove this once we use hpath again
|
||||||
|
| otherwise -> throwE $ NoUrlBase uri'
|
||||||
|
|
||||||
path = view pathL' uri
|
path = view pathL' uri
|
||||||
|
uri' = decUTF8Safe (serializeURIRef' uri)
|
||||||
|
|
||||||
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
|
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
|
||||||
parseEtags stderr = do
|
parseEtags stderr = do
|
||||||
@@ -444,8 +462,8 @@ download uri eDigest dest mfn etags
|
|||||||
$logDebug "No etags header found"
|
$logDebug "No etags header found"
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => m (Maybe T.Text) -> m ()
|
writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
|
||||||
writeEtags getTags = do
|
writeEtags destFile getTags = do
|
||||||
getTags >>= \case
|
getTags >>= \case
|
||||||
Just t -> do
|
Just t -> do
|
||||||
$logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]
|
$logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]
|
||||||
|
|||||||
@@ -134,6 +134,13 @@ instance Pretty AlreadyInstalled where
|
|||||||
pPrint (AlreadyInstalled tool ver') =
|
pPrint (AlreadyInstalled tool ver') =
|
||||||
text [i|#{tool}-#{prettyShow ver'} is already installed|]
|
text [i|#{tool}-#{prettyShow ver'} is already installed|]
|
||||||
|
|
||||||
|
-- | The Directory is supposed to be empty, but wasn't.
|
||||||
|
data DirNotEmpty = DirNotEmpty {path :: FilePath}
|
||||||
|
|
||||||
|
instance Pretty DirNotEmpty where
|
||||||
|
pPrint (DirNotEmpty path) = do
|
||||||
|
text [i|The directory was expected to be empty, but isn't: #{path}|]
|
||||||
|
|
||||||
-- | The tool is not installed. Some operations rely on a tool
|
-- | The tool is not installed. Some operations rely on a tool
|
||||||
-- to be installed (such as setting the current GHC version).
|
-- to be installed (such as setting the current GHC version).
|
||||||
data NotInstalled = NotInstalled Tool GHCTargetVersion
|
data NotInstalled = NotInstalled Tool GHCTargetVersion
|
||||||
@@ -168,6 +175,16 @@ instance Pretty FileDoesNotExistError where
|
|||||||
pPrint (FileDoesNotExistError file) =
|
pPrint (FileDoesNotExistError file) =
|
||||||
text [i|File "#{file}" does not exist.|]
|
text [i|File "#{file}" does not exist.|]
|
||||||
|
|
||||||
|
-- | The file already exists
|
||||||
|
-- (e.g. when we use isolated installs with the same path).
|
||||||
|
-- (e.g. This is done to prevent any overwriting)
|
||||||
|
data FileAlreadyExistsError = FileAlreadyExistsError FilePath
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Pretty FileAlreadyExistsError where
|
||||||
|
pPrint (FileAlreadyExistsError file) =
|
||||||
|
text [i|File "#{file}" Already exists.|]
|
||||||
|
|
||||||
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
|
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
@@ -327,6 +344,15 @@ instance Pretty UnexpectedListLength where
|
|||||||
|
|
||||||
instance Exception UnexpectedListLength
|
instance Exception UnexpectedListLength
|
||||||
|
|
||||||
|
data NoUrlBase = NoUrlBase Text
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Pretty NoUrlBase where
|
||||||
|
pPrint (NoUrlBase url) =
|
||||||
|
text [i|Couldn't get a base filename from url #{url}|]
|
||||||
|
|
||||||
|
instance Exception NoUrlBase
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
|
|||||||
@@ -304,6 +304,41 @@ data UserSettings = UserSettings
|
|||||||
defaultUserSettings :: UserSettings
|
defaultUserSettings :: UserSettings
|
||||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
|
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
||||||
|
fromSettings Settings{..} Nothing =
|
||||||
|
UserSettings {
|
||||||
|
uCache = Just cache
|
||||||
|
, uNoVerify = Just noVerify
|
||||||
|
, uVerbose = Just verbose
|
||||||
|
, uKeepDirs = Just keepDirs
|
||||||
|
, uDownloader = Just downloader
|
||||||
|
, uNoNetwork = Just noNetwork
|
||||||
|
, uKeyBindings = Nothing
|
||||||
|
, uUrlSource = Just urlSource
|
||||||
|
}
|
||||||
|
fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||||
|
let ukb = UserKeyBindings
|
||||||
|
{ kUp = Just bUp
|
||||||
|
, kDown = Just bDown
|
||||||
|
, kQuit = Just bQuit
|
||||||
|
, kInstall = Just bInstall
|
||||||
|
, kUninstall = Just bUninstall
|
||||||
|
, kSet = Just bSet
|
||||||
|
, kChangelog = Just bChangelog
|
||||||
|
, kShowAll = Just bShowAllVersions
|
||||||
|
, kShowAllTools = Just bShowAllTools
|
||||||
|
}
|
||||||
|
in UserSettings {
|
||||||
|
uCache = Just cache
|
||||||
|
, uNoVerify = Just noVerify
|
||||||
|
, uVerbose = Just verbose
|
||||||
|
, uKeepDirs = Just keepDirs
|
||||||
|
, uDownloader = Just downloader
|
||||||
|
, uNoNetwork = Just noNetwork
|
||||||
|
, uKeyBindings = Just ukb
|
||||||
|
, uUrlSource = Just urlSource
|
||||||
|
}
|
||||||
|
|
||||||
data UserKeyBindings = UserKeyBindings
|
data UserKeyBindings = UserKeyBindings
|
||||||
{ kUp :: Maybe Key
|
{ kUp :: Maybe Key
|
||||||
, kDown :: Maybe Key
|
, kDown :: Maybe Key
|
||||||
|
|||||||
@@ -316,3 +316,6 @@ deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
|||||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||||
|
|
||||||
|
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||||
|
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||||
|
|||||||
Reference in New Issue
Block a user