Compare commits

...

28 Commits

Author SHA1 Message Date
132d331e7c Fix CI 2021-05-15 14:01:00 +02:00
734916728c Add stack support 2021-05-15 14:01:00 +02:00
5f6ed1292d Remove dead dependency on ascii-string
This hopefull fixes nix packaging.
2021-05-12 13:42:27 +02:00
a7dc03af50 Merge branch 'PR/issue-126' 2021-05-11 14:42:22 +02:00
5a86a28d67 Smarter logging 2021-04-29 14:47:30 +02:00
a905c6322c Fix spelling 2021-04-29 14:47:22 +02:00
49ccadd470 Warn when overwriting current GHC due to compile 2021-04-29 14:46:45 +02:00
9f0ac0ee19 Allow to compile from git repo 2021-04-28 21:17:57 +02:00
7e0f839ff8 Fix cabal bindist on 32bit
See https://github.com/haskell/cabal/issues/7313
2021-04-25 22:44:41 +02:00
1e9ee260e7 Raise minSpace to 5GB 2021-04-25 21:32:58 +02:00
0b7d447aaf Satisfy hlint 2021-04-25 18:00:32 +02:00
16a9336d31 Fix missing pretty instance 2021-04-25 17:59:15 +02:00
7d13836fea Warn when /tmp doesn't have 2500 or more of disk space 2021-04-25 17:25:40 +02:00
b645c4d57e Add date to GHC bindist names created by ghcup 2021-04-24 21:51:43 +02:00
5db43cd908 Improve error printing in ghcup-gen 2021-04-24 21:51:06 +02:00
93cd421ca3 Add 9.1.1 alpha2 2021-04-23 09:43:45 +02:00
ec7130dac6 Add post-install msg to ghc-7.10.3 wrt no-pie, fixes #123 2021-04-17 19:53:18 +02:00
f2b8cc530c Fix download URL 2021-04-13 23:58:49 +02:00
de765088d1 Merge remote-tracking branch 'origin/merge-requests/83' 2021-04-13 23:47:16 +02:00
jneira
e11188aa99 Update haskell-language-server to 1.1.0 2021-04-13 23:38:27 +02:00
0c6699c3c6 Allow to check ghcup binaries in validate-tarballs 2021-04-11 22:15:43 +02:00
c5858be6b8 Update ghcup binaries 2021-04-11 22:10:44 +02:00
ffe00c7b1f Fix travis 2021-04-11 19:16:45 +02:00
43114959fd Fix release job 2021-04-11 19:12:55 +02:00
b1c3ffd729 Update ghcup.cabal 2021-04-11 18:14:52 +02:00
4f1a9e95a2 Add stuff to extra-doc-files 2021-04-11 18:08:31 +02:00
f6a4f55384 Release 0.1.14.1 2021-04-11 18:01:31 +02:00
672b179446 Merge branch 'lzma-static' 2021-04-11 17:58:03 +02:00
25 changed files with 19615 additions and 18678 deletions

View File

@@ -10,8 +10,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./gh
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin upgrade -i -f ./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION} ./ghcup-bin set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION} ./ghcup-bin install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -12,8 +12,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > .
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin upgrade -i -f ./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION} ./ghcup-bin set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION} ./ghcup-bin install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -28,8 +28,8 @@ else
fi fi
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin upgrade -i -f ./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION} ./ghcup-bin install-cabal ${CABAL_VERSION}
# utils # utils
apk add --no-cache \ apk add --no-cache \

View File

@@ -13,7 +13,7 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin upgrade -i -f ./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION} ./ghcup-bin set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION} ./ghcup-bin install-cabal ${CABAL_VERSION}

View File

@@ -15,6 +15,11 @@ git describe
# build # build
ecabal update ecabal update
(
cd /tmp
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
)
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then if [ "${ARCH}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar

View File

@@ -96,14 +96,19 @@ eghcup set ${GHC_VERSION}
eghcup rm 8.10.3 eghcup rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
# install hls
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls eghcup install hls
haskell-language-server-wrapper --version haskell-language-server-wrapper --version
eghcup install stack
stack --version
elif [ "${OS}" = "LINUX" ] ; then elif [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "64" ] ; then if [ "${ARCH}" = "64" ] ; then
eghcup install hls eghcup install hls
haskell-language-server-wrapper --version haskell-language-server-wrapper --version
eghcup install stack
stack --version
fi fi
fi fi

View File

@@ -16,6 +16,12 @@ ghcup set 8.10.4
## install ghcup ## install ghcup
cabal update cabal update
(
cd /tmp
cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
)
cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" . cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
strip ./ghcup strip ./ghcup

View File

@@ -1,5 +1,21 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.15 -- ????-??-??
* Add date to GHC bindist names created by ghcup
* Warn when /tmp doesn't have 5GB or more of disk space
* Allow to compile GHC from git repo wrt [#126](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/126)
* Add stack support
## 0.1.14.2 -- 2021-05-12
* Remove dead dependency on ascii-string
## 0.1.14.1 -- 2021-04-11
* Make internal symlink target parser more lax, fixes [#119](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119)
* Prepare for hackage release
## 0.1.14 -- 2021-03-07 ## 0.1.14 -- 2021-03-07
* Major bugfix: fix handling of stray versions wrt [#116](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116) * Major bugfix: fix handling of stray versions wrt [#116](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116)

View File

@@ -37,7 +37,7 @@ import Data.IORef
import Data.List import Data.List
import Data.String.Interpolate import Data.String.Interpolate
import Data.Versions import Data.Versions
import HPath ( toFilePath ) import HPath ( toFilePath, rel )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
import System.Exit import System.Exit
@@ -202,6 +202,7 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
%& indices (matchTest versionRegex . T.unpack . prettyVer) %& indices (matchTest versionRegex . T.unpack . prettyVer)
% (viSourceDL % _Just `summing` viArch % each % each % each) % (viSourceDL % _Just `summing` viArch % each % each % each)
when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError
forM_ dlis downloadAll forM_ dlis downloadAll
-- exit -- exit
@@ -235,13 +236,21 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
#endif #endif
] ]
$ do $ do
p <- liftE $ downloadCached dli Nothing case tool of
fmap (head . splitDirectories . head) Just GHCup -> do
. liftE let fn = [rel|ghcup|]
. getArchiveFiles dir <- liftIO ghcupCacheDir
$ p p <- liftE $ download dli dir (Just fn)
liftE $ checkDigest dli p
pure Nothing
_ -> do
p <- liftE $ downloadCached dli Nothing
fmap (Just . head . splitDirectories . head)
. liftE
. getArchiveFiles
$ p
case r of case r of
VRight basePath -> do VRight (Just basePath) -> do
case _dlSubdir dli of case _dlSubdir dli of
Just (RealDir (toFilePath -> prel)) -> do Just (RealDir (toFilePath -> prel)) -> do
lift $ $(logInfo) lift $ $(logInfo)
@@ -262,7 +271,8 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
[i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|] [i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|]
addError addError
Nothing -> pure () Nothing -> pure ()
VRight Nothing -> pure ()
VLeft e -> do VLeft e -> do
lift $ $(logError) lift $ $(logError)
[i|Could not download (or verify hash) of #{dli}, Error was: #{e}|] [i|Could not download (or verify hash) of #{dli}, Error was: #{prettyShow e}|]
addError addError

View File

@@ -66,7 +66,8 @@ data BrickData = BrickData
deriving Show deriving Show
data BrickSettings = BrickSettings data BrickSettings = BrickSettings
{ showAll :: Bool { showAllVersions :: Bool
, showAllTools :: Bool
} }
deriving Show deriving Show
@@ -97,17 +98,22 @@ keyHandlers KeyBindings {..} =
, (bUninstall, const "Uninstall", withIOAction del') , (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set') , (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog') , (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAll , ( bShowAllVersions
, \BrickSettings {..} -> , \BrickSettings {..} ->
if showAll then "Hide old versions" else "Show all versions" if showAllVersions then "Don't show all versions" else "Show all versions"
, hideShowHandler , hideShowHandler (not . showAllVersions) showAllTools
)
, ( bShowAllTools
, \BrickSettings {..} ->
if showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler showAllVersions (not . showAllTools)
) )
, (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. }) , (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. }) , (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
] ]
where where
hideShowHandler BrickState{..} = hideShowHandler f p BrickState{..} =
let newAppSettings = appSettings { showAll = not . showAll $ appSettings } let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState) newInternalState = constructList appData newAppSettings (Just appState)
in continue (BrickState appData newAppSettings newInternalState appKeys) in continue (BrickState appData newAppSettings newInternalState appKeys)
@@ -142,7 +148,12 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> minHSize 15 (str "Version") <+> minHSize 15 (str "Version")
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags") <+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
<+> padLeft (Pad 5) (str "Notes") <+> padLeft (Pad 5) (str "Notes")
renderList' = withDefAttr listAttr . drawListElements renderItem True renderList' = withDefAttr listAttr . drawListElements renderItem True . filterStack
filterStack appState'
| showAllTools as = appState'
| let v = clr appState'
nv = V.filter (\ListResult{..} -> lTool /= Stack) v
, otherwise = BrickInternalState { clr = nv, ix = ix appState' }
renderItem _ b listResult@ListResult{..} = renderItem _ b listResult@ListResult{..} =
let marks = if let marks = if
| lSet -> (withAttr "set" $ str "✔✔") | lSet -> (withAttr "set" $ str "✔✔")
@@ -194,6 +205,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTool GHC = str "GHC" printTool GHC = str "GHC"
printTool GHCup = str "GHCup" printTool GHCup = str "GHCup"
printTool HLS = str "HLS" printTool HLS = str "HLS"
printTool Stack = str "Stack"
printNotes ListResult {..} = printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
@@ -351,7 +363,7 @@ constructList :: BrickData
-> Maybe BrickInternalState -> Maybe BrickInternalState
-> BrickInternalState -> BrickInternalState
constructList appD appSettings = constructList appD appSettings =
replaceLR (filterVisible (showAll appSettings)) (lr appD) replaceLR (filterVisible (showAllVersions appSettings)) (lr appD)
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult) listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
@@ -385,9 +397,9 @@ replaceLR filterF lr s =
filterVisible :: Bool -> ListResult -> Bool filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e | lInstalled e = True filterVisible showAllVersions e | lInstalled e = True
| showAll = True | showAllVersions = True
| otherwise = not (elem Old (lTag e)) | otherwise = not (elem Old (lTag e))
install' :: BrickState -> (Int, ListResult) -> IO (Either String ()) install' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -432,6 +444,9 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin dls lVer pfreq $> vi liftE $ installHLSBin dls lVer pfreq $> vi
Stack -> do
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin dls lVer pfreq $> vi
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -460,6 +475,7 @@ set' _ (_, ListResult {..}) = do
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 $> ()
Stack -> liftE $ setStack lVer $> ()
GHCup -> pure () GHCup -> pure ()
) )
>>= \case >>= \case
@@ -481,6 +497,7 @@ del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi Cabal -> liftE $ rmCabalVer lVer $> vi
HLS -> liftE $ rmHLSVer lVer $> vi HLS -> liftE $ rmHLSVer lVer $> vi
Stack -> liftE $ rmStackVer lVer $> vi
GHCup -> pure Nothing GHCup -> pure Nothing
) )
>>= \case >>= \case
@@ -564,7 +581,7 @@ brickMain s l av pfreq' = do
defaultAppSettings :: BrickSettings defaultAppSettings :: BrickSettings
defaultAppSettings = BrickSettings { showAll = False } defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
getDownloads' :: IO (Either String GHCupDownloads) getDownloads' :: IO (Either String GHCupDownloads)

View File

@@ -126,6 +126,7 @@ toSetToolVer Nothing = SetRecommended
data InstallCommand = InstallGHC InstallOptions data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions | InstallCabal InstallOptions
| InstallHLS InstallOptions | InstallHLS InstallOptions
| InstallStack InstallOptions
data InstallOptions = InstallOptions data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion { instVer :: Maybe ToolVersion
@@ -137,6 +138,7 @@ data InstallOptions = InstallOptions
data SetCommand = SetGHC SetOptions data SetCommand = SetGHC SetOptions
| SetCabal SetOptions | SetCabal SetOptions
| SetHLS SetOptions | SetHLS SetOptions
| SetStack SetOptions
-- a superset of ToolVersion -- a superset of ToolVersion
data SetToolVersion = SetToolVersion GHCTargetVersion data SetToolVersion = SetToolVersion GHCTargetVersion
@@ -157,6 +159,7 @@ data ListOptions = ListOptions
data RmCommand = RmGHC RmOptions data RmCommand = RmGHC RmOptions
| RmCabal Version | RmCabal Version
| RmHLS Version | RmHLS Version
| RmStack Version
data RmOptions = RmOptions data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion { ghcVer :: GHCTargetVersion
@@ -165,9 +168,8 @@ data RmOptions = RmOptions
data CompileCommand = CompileGHC GHCCompileOptions data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions data GHCCompileOptions = GHCCompileOptions
{ targetVer :: Version { targetGhc :: Either Version GitBranch
, bootstrapGhc :: Either Version (Path Abs) , bootstrapGhc :: Either Version (Path Abs)
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe (Path Abs) , buildConfig :: Maybe (Path Abs)
@@ -177,14 +179,6 @@ data GHCCompileOptions = GHCCompileOptions
, setCompile :: Bool , setCompile :: Bool
} }
data CabalCompileOptions = CabalCompileOptions
{ targetVer :: Version
, bootstrapGhc :: Either Version (Path Abs)
, jobs :: Maybe Int
, buildConfig :: Maybe (Path Abs)
, patchDir :: Maybe (Path Abs)
}
data UpgradeOpts = UpgradeInplace data UpgradeOpts = UpgradeInplace
| UpgradeAt (Path Abs) | UpgradeAt (Path Abs)
| UpgradeGHCupDir | UpgradeGHCupDir
@@ -441,6 +435,15 @@ installParser =
<> footerDoc (Just $ text installHLSFooter) <> footerDoc (Just $ text installHLSFooter)
) )
) )
<> command
"stack"
( InstallStack
<$> info
(installOpts (Just Stack) <**> helper)
( progDesc "Install stack"
<> footerDoc (Just $ text installStackFooter)
)
)
) )
) )
<|> (Right <$> installOpts Nothing) <|> (Right <$> installOpts Nothing)
@@ -451,9 +454,17 @@ installParser =
into "~/.ghcup/bin" into "~/.ghcup/bin"
Examples: Examples:
# install recommended GHC # install recommended HLS
ghcup install hls|] ghcup install hls|]
installStackFooter :: String
installStackFooter = [s|Discussion:
Installs stack binaries into "~/.ghcup/bin"
Examples:
# install recommended Stack
ghcup install stack|]
installGHCFooter :: String installGHCFooter :: String
installGHCFooter = [s|Discussion: installGHCFooter = [s|Discussion:
Installs the specified GHC version (or a recommended default one) into Installs the specified GHC version (or a recommended default one) into
@@ -537,6 +548,15 @@ setParser =
<> footerDoc (Just $ text setHLSFooter) <> footerDoc (Just $ text setHLSFooter)
) )
) )
<> command
"stack"
( SetStack
<$> info
(setOpts (Just Stack) <**> helper)
( progDesc "Set stack version"
<> footerDoc (Just $ text setStackFooter)
)
)
) )
) )
<|> (Right <$> setOpts Nothing) <|> (Right <$> setOpts Nothing)
@@ -551,6 +571,10 @@ setParser =
setCabalFooter = [s|Discussion: setCabalFooter = [s|Discussion:
Sets the the current Cabal version.|] Sets the the current Cabal version.|]
setStackFooter :: String
setStackFooter = [s|Discussion:
Sets the the current Stack version.|]
setHLSFooter :: String setHLSFooter :: String
setHLSFooter = [s|Discussion: setHLSFooter = [s|Discussion:
Sets the the current haskell-language-server version.|] Sets the the current haskell-language-server version.|]
@@ -603,6 +627,12 @@ rmParser =
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper) <$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version") (progDesc "Remove haskell-language-server version")
) )
<> command
"stack"
( RmStack
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
(progDesc "Remove stack version")
)
) )
) )
<|> (Right <$> rmOpts Nothing) <|> (Right <$> rmOpts Nothing)
@@ -624,6 +654,7 @@ changelogP =
"ghc" -> Right GHC "ghc" -> Right GHC
"cabal" -> Right Cabal "cabal" -> Right Cabal
"ghcup" -> Right GHCup "ghcup" -> Right GHCup
"stack" -> Right Stack
e -> Left e e -> Left e
) )
) )
@@ -659,7 +690,10 @@ ENV variables:
such as: CC, LD, OBJDUMP, NM, AR, RANLIB. such as: CC, LD, OBJDUMP, NM, AR, RANLIB.
Examples: Examples:
# compile from known version
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
# compile from git commit/reference
ghcup compile ghc -j 4 -g master -b 8.2.2
# specify path to bootstrap ghc # specify path to bootstrap ghc
ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2 ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
# build cross compiler # build cross compiler
@@ -668,34 +702,22 @@ Examples:
ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts :: Parser GHCCompileOptions
ghcCompileOpts = ghcCompileOpts =
(\CabalCompileOptions {..} crossTarget addConfArgs setCompile -> GHCCompileOptions { .. } GHCCompileOptions
) <$> ((Left <$> option
<$> cabalCompileOpts
<*> optional
(option
str
(short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
"Build cross-compiler for this platform"
)
)
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
cabalCompileOpts :: Parser CabalCompileOptions
cabalCompileOpts =
CabalCompileOptions
<$> option
(eitherReader (eitherReader
(first (const "Not a valid version") . version . T.pack) (first (const "Not a valid version") . version . T.pack)
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
) )
) <|>
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from"
) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
)))
<*> option <*> option
(eitherReader (eitherReader
(\x -> (\x ->
@@ -742,6 +764,20 @@ cabalCompileOpts =
"Absolute path to patch directory (applied in order, uses -p1)" "Absolute path to patch directory (applied in order, uses -p1)"
) )
) )
<*> optional
(option
str
(short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
"Build cross-compiler for this platform"
)
)
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
toolVersionParser :: Parser ToolVersion toolVersionParser :: Parser ToolVersion
@@ -990,7 +1026,8 @@ toSettings options = do
, bUninstall = fromMaybe bUninstall kUninstall , bUninstall = fromMaybe bUninstall kUninstall
, bSet = fromMaybe bSet kSet , bSet = fromMaybe bSet kSet
, bChangelog = fromMaybe bChangelog kChangelog , bChangelog = fromMaybe bChangelog kChangelog
, bShowAll = fromMaybe bShowAll kShowAll , bShowAllVersions = fromMaybe bShowAllVersions kShowAll
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
} }
@@ -1073,7 +1110,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
createDirRecursive' baseDir createDirRecursive' baseDir
-- logger interpreter -- logger interpreter
logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|] logfile <- flip runReaderT appstate $ initGHCupFileLogging
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = verbose settings { lcPrintDebug = verbose settings
, colorOutter = B.hPut stderr , colorOutter = B.hPut stderr
@@ -1329,6 +1366,36 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
$(logError) [i|Also check the logs in #{logsDir}|] $(logError) [i|Also check the logs in #{logsDir}|]
pure $ ExitFailure 4 pure $ ExitFailure 4
let installStack InstallOptions{..} =
(case instBindist of
Nothing -> runInstTool $ do
(v, vi) <- liftE $ fromVersion dls instVer Stack
liftE $ installStackBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
pure vi
Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion dls instVer Stack
liftE $ installStackBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
(fromMaybe pfreq instPlatform)
pure vi
)
>>= \case
VRight vi -> do
runLogger $ $(logInfo) "Stack installation successful"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn)
[i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|]
pure ExitSuccess
VLeft e -> do
runLogger $ do
$(logError) $ T.pack $ prettyShow e
$(logError) [i|Also check the logs in #{logsDir}|]
pure $ ExitFailure 4
let setGHC' SetOptions{..} = let setGHC' SetOptions{..} =
runSetGHC (do runSetGHC (do
@@ -1377,6 +1444,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
let setStack' SetOptions{..} =
runSetCabal (do
v <- liftE $ fst <$> fromVersion' dls sToolVer Stack
liftE $ setStack (_tvVersion v)
pure v
)
>>= \case
VRight GHCTargetVersion{..} -> do
runLogger
$ $(logInfo)
[i|Stack #{prettyVer _tvVersion} successfully set as default version|]
pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 14
let rmGHC' RmOptions{..} = let rmGHC' RmOptions{..} =
runRm (do runRm (do
liftE $ liftE $
@@ -1422,6 +1505,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
let rmStack' tv =
runRm (do
liftE $
rmStackVer tv
pure (getVersionInfo tv Stack dls)
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 15
res <- case optCommand of res <- case optCommand of
#if defined(BRICK) #if defined(BRICK)
@@ -1433,6 +1530,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Install (Left (InstallGHC iopts)) -> installGHC iopts Install (Left (InstallGHC iopts)) -> installGHC iopts
Install (Left (InstallCabal iopts)) -> installCabal iopts Install (Left (InstallCabal iopts)) -> installCabal iopts
Install (Left (InstallHLS iopts)) -> installHLS iopts Install (Left (InstallHLS iopts)) -> installHLS iopts
Install (Left (InstallStack iopts)) -> installStack iopts
InstallCabalLegacy iopts -> do InstallCabalLegacy iopts -> do
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|]) runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
installCabal iopts installCabal iopts
@@ -1443,6 +1541,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Set (Left (SetGHC sopts)) -> setGHC' sopts Set (Left (SetGHC sopts)) -> setGHC' sopts
Set (Left (SetCabal sopts)) -> setCabal' sopts Set (Left (SetCabal sopts)) -> setCabal' sopts
Set (Left (SetHLS sopts)) -> setHLS' sopts Set (Left (SetHLS sopts)) -> setHLS' sopts
Set (Left (SetStack sopts)) -> setStack' sopts
List ListOptions {..} -> List ListOptions {..} ->
runListGHC (do runListGHC (do
@@ -1457,6 +1556,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts
Rm (Left (RmStack rmopts)) -> rmStack' rmopts
DInfo -> DInfo ->
do runDebugInfo $ liftE getDebugInfo do runDebugInfo $ liftE getDebugInfo
@@ -1470,22 +1570,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Compile (CompileGHC GHCCompileOptions {..}) -> Compile (CompileGHC GHCCompileOptions {..}) ->
runCompileGHC (do runCompileGHC (do
let vi = getVersionInfo targetVer GHC dls case targetGhc of
forM_ (_viPreCompile =<< vi) $ \msg -> do Left targetVer -> do
lift $ $(logInfo) msg let vi = getVersionInfo targetVer GHC dls
lift $ $(logInfo) forM_ (_viPreCompile =<< vi) $ \msg -> do
"...waiting for 5 seconds, you can still abort..." lift $ $(logInfo) msg
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene lift $ $(logInfo)
liftE $ compileGHC dls "...waiting for 5 seconds, you can still abort..."
(GHCTargetVersion crossTarget targetVer) liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
Right _ -> pure ()
targetVer <- liftE $ compileGHC dls
(first (GHCTargetVersion crossTarget) targetGhc)
bootstrapGhc bootstrapGhc
jobs jobs
buildConfig buildConfig
patchDir patchDir
addConfArgs addConfArgs
pfreq pfreq
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setGHC (GHCTargetVersion crossTarget targetVer) SetGHCOnly setGHC targetVer SetGHCOnly
pure vi pure vi
) )
>>= \case >>= \case
@@ -1654,6 +1758,16 @@ fromVersion' av SetNext tool = do
. cycle . cycle
. sort . sort
$ hlses) ?? NoToolVersionSet tool $ hlses) ?? NoToolVersionSet tool
Stack -> do
set <- stackSet !? NoToolVersionSet tool
stacks <- rights <$> lift getInstalledStacks
(fmap (GHCTargetVersion Nothing)
. headMay
. tail
. dropWhile (/= set)
. cycle
. sort
$ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set" GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo (_tvVersion next) tool av let vi = getVersionInfo (_tvVersion next) tool av
pure (next, vi) pure (next, vi)
@@ -1852,6 +1966,13 @@ checkForUpdates dls pfreq = do
$ $(logWarn) $ $(logWarn)
[i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|] [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver ->
when (l > stack_ver)
$ $(logWarn)
[i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|]
prettyDebugInfo :: DebugInfo -> String prettyDebugInfo :: DebugInfo -> String
prettyDebugInfo DebugInfo {..} = [i|Debug Info prettyDebugInfo DebugInfo {..} = [i|Debug Info

View File

@@ -69,7 +69,7 @@ _done() {
download_ghcup() { download_ghcup() {
_plat="$(uname -s)" _plat="$(uname -s)"
_arch=$(uname -m) _arch=$(uname -m)
_ghver="0.1.14" _ghver="0.1.14.1"
_base_url="https://downloads.haskell.org/~ghcup" _base_url="https://downloads.haskell.org/~ghcup"
case "${_plat}" in case "${_plat}" in

View File

@@ -29,6 +29,8 @@ key-bindings:
KChar: 'c' KChar: 'c'
show-all: show-all:
KChar: 'a' KChar: 'a'
show-all-tools:
KChar: 't'
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code. # check the 'URLSource' type in the code.

View File

@@ -139,6 +139,7 @@ ghcupDownloads:
dlSubdir: ghc-7.10.3 dlSubdir: ghc-7.10.3
dlHash: cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef dlHash: cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef
viPostRemove: &ghc-post-remove "After removing GHC you might also want to clean up your cabal store at: ~/.cabal/store/ghc-<ghcver>" viPostRemove: &ghc-post-remove "After removing GHC you might also want to clean up your cabal store at: ~/.cabal/store/ghc-<ghcver>"
viPostInstall: "GHC-7.10.3 may give linking errors on most modern distros. You may have to pass '--ghc-option=-optc-no-pie --ghc-option=-optl-no-pie' to cabal build/install. Also see https://gitlab.haskell.org/ghc/ghc/-/issues/18763"
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
@@ -1553,86 +1554,91 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-armv7-deb9-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-armv7-deb9-linux.tar.xz
dlSubdir: ghc-9.0.1 dlSubdir: ghc-9.0.1
dlHash: 6f404f9b88468407b3a9ec5800bcc2d01dd453ef3d63414853b4fbbd4d8df496 dlHash: 6f404f9b88468407b3a9ec5800bcc2d01dd453ef3d63414853b4fbbd4d8df496
9.2.0.20210331: 9.2.0.20210422:
viTags: viTags:
- Prerelease - Prerelease
- base-4.16.0.0 - base-4.16.0.0
viChangeLog: https://downloads.haskell.org/~ghc/9.2.1-alpha1/docs/html/users_guide/9.2.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/9.2.1-alpha2/docs/html/users_guide/index.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-src.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: 3ec8ec2fb77e14d68ac1c092f3e8605b6822e24f7e6dc7139dccf8feaf168699 dlHash: 69be189e6e7f8d51a9078ac8f177176bc5bff54edc8352974c50c1f0e110df27
viPostRemove: *ghc-post-remove viPostRemove: *ghc-post-remove
viArch: viArch:
A_64: A_64:
Linux_Debian: Linux_Debian:
'( >= 9 && < 10 )': &ghc-921-alpha1-64-deb9 '( >= 9 && < 10 )': &ghc-921-alpha2-64-deb9
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-deb9-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-deb9-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: c13613cb6285a689c5b89c93fad5c6c0e95d66c8936338c44d92a1312f507006 dlHash: 7262f3a230cd6945c588882e03941301877a9eb12e58c5975ad264596c2e12f2
'( >= 10 && < 11 )': &ghc-921-alpha1-64-deb10 '( >= 10 && < 11 )': &ghc-921-alpha2-64-deb10
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-deb10-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-deb10-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: 2b2a0e2bad54d1a41440c093a199207b58ff314bea7edf73387916e9952d6a53 dlHash: 6d36cd08576bdee7473fee66b4b8ceb72011983a7d5aa3ec587403815a73e37b
unknown_versioning: *ghc-921-alpha1-64-deb9 unknown_versioning: *ghc-921-alpha2-64-deb9
Linux_Ubuntu: Linux_Ubuntu:
unknown_versioning: &ghc-921-alpha1-64-fedora unknown_versioning: &ghc-921-alpha2-64-fedora
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-fedora27-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-fedora27-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: c7e648ac313c268aaa3a9651b00650da6eb293abfe14e44f44da22a758c233e7 dlHash: 95624192ff0982690bc9093632d6351fdc6f72e6df380b392449229c39a0354b
'( >= 16 && < 19 )': *ghc-921-alpha1-64-deb9 '( >= 16 && < 19 )': *ghc-921-alpha2-64-deb9
Linux_Mint: Linux_Mint:
unknown_versioning: *ghc-921-alpha1-64-deb10 unknown_versioning: *ghc-921-alpha2-64-deb10
Linux_Fedora: Linux_Fedora:
'( >= 27 && < 28 )': *ghc-921-alpha1-64-fedora '( >= 27 && < 28 )': *ghc-921-alpha2-64-fedora
unknown_versioning: *ghc-921-alpha1-64-fedora unknown_versioning: *ghc-921-alpha2-64-fedora
Linux_CentOS: Linux_CentOS:
'( >= 7 && < 8 )': &ghc-921-alpha1-64-centos '( >= 7 && < 8 )': &ghc-921-alpha2-64-centos
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-centos7-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-centos7-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: 50556cc42be665957f2bd8e5deeceb26e58e88badfa0c99a44117fda2d63200c dlHash: dee4f158f2d59bfe97ec3f5773b6b31aa911f9b128a5e56eeefa2dccc754d295
unknown_versioning: *ghc-921-alpha1-64-centos unknown_versioning: *ghc-921-alpha2-64-centos
Linux_RedHat: Linux_RedHat:
unknown_versioning: *ghc-921-alpha1-64-centos unknown_versioning: *ghc-921-alpha2-64-centos
Linux_Alpine: Linux_Alpine:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-alpine3.10-linux-integer-simple.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-9.2.0.20210331-x86_64-unknown-linux dlSubdir: ghc-9.2.0.20210422-x86_64-unknown-linux
dlHash: bab5f5d0ecd6522da372a9a0f0eeebbbecf0bd94788847aa3cd5bdb36682d48a dlHash: f61ae72925325ca7b316e40121e8d6bad94794016d3fa59bcbc8dbe116a7f13c
Linux_AmazonLinux: Linux_AmazonLinux:
unknown_versioning: *ghc-921-alpha1-64-centos unknown_versioning: *ghc-921-alpha2-64-centos
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: *ghc-921-alpha1-64-fedora unknown_versioning: *ghc-921-alpha2-64-fedora
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-unknown-freebsd.tar.xz
dlSubdir: ghc-9.2.0.20210422
dlHash: 195728e02398ea6154fe713b7782a0cae856eb0d9d90f5d09cd0cca610c985e2
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-apple-darwin.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-apple-darwin.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: cfd7d0479ce80607c11cf96fe25d4804783c6ebc623ca9adcb5436e3499c9c5b dlHash: 8884c059f2b76e4c4309ff6bd7a7dde37663f751fd26220e9a2bcabb4d69a401
A_32: A_32:
Linux_Debian: Linux_Debian:
'( >= 9 && < 10 )': &ghc-921-alpha1-32-deb9 '( >= 9 && < 10 )': &ghc-921-alpha2-32-deb9
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-i386-deb9-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-i386-deb9-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: 58ccac8e89e60b4261dfa8ca0e17d335b99f2a1fecb90322436cfea3bdce2240 dlHash: a378ec3fd31a9fa2a7134e98159e189362fe969f04031515616e9cc3182c861a
unknown_versioning: *ghc-921-alpha1-32-deb9 unknown_versioning: *ghc-921-alpha2-32-deb9
Linux_Ubuntu: Linux_Ubuntu:
unknown_versioning: *ghc-921-alpha1-32-deb9 unknown_versioning: *ghc-921-alpha2-32-deb9
Linux_Mint: Linux_Mint:
unknown_versioning: *ghc-921-alpha1-32-deb9 unknown_versioning: *ghc-921-alpha2-32-deb9
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: *ghc-921-alpha1-32-deb9 unknown_versioning: *ghc-921-alpha2-32-deb9
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-aarch64-deb10-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-aarch64-deb10-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: df355e1ed34cf0fef11444299020041f03d6c67f6c5c342db1f76b71fd31e6fe dlHash: fd2f4d0f6122f752aca396fe1a13e7d14d037dc45806bb0404a031eeeeb1994c
A_ARM: A_ARM:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-armv7-deb10-linux.tar.xz dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-armv7-deb10-linux.tar.xz
dlSubdir: ghc-9.2.0.20210331 dlSubdir: ghc-9.2.0.20210422
dlHash: 2c5133fb83943371ad8556328db4acb9081271b7c77ceaf2b74817dd0de3b486 dlHash: dab7d7785d6ccafb130526b666669fc974ba5c90fc9aaf2024f9c65bcbd097d3
Cabal: Cabal:
2.4.1.0: 2.4.1.0:
viTags: viTags:
@@ -1755,13 +1761,11 @@ ghcupDownloads:
dlHash: a1e2db664ec00e42a1e071a4181f6476f6e0bad321f1ddc0cf27831119f4c6d4 dlHash: a1e2db664ec00e42a1e071a4181f6476f6e0bad321f1ddc0cf27831119f4c6d4
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning: &cabal-3400-32
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-i386-debian-9.tar.xz dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-i386-unknown-linux.tar.xz
dlHash: ef3750644a53f7b1fad141b2ad02d4c7a3b239ec0cbfa7f0528fb02c1dfcebce dlHash: cc62a471e9e68a6a9933e54f75bf0cffae67a1d2220df1152ab887c38eb6bc8a
Linux_Alpine: Linux_Alpine:
unknown_versioning: unknown_versioning: *cabal-3400-32
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-i386-alpine-linux-musl.tar.gz
dlHash: 95adb65f3a72aa8d9ce83685bc06e1eee5b801f56e204e27e957e8a35abd9cf8
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
@@ -1773,7 +1777,7 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
GHCup: GHCup:
0.1.14: 0.1.14.1:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -1783,51 +1787,93 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/x86_64-linux-ghcup-0.1.14.1
dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd dlHash: 59e31b2ede3ed20f79dce0f8ba0a68b6fb25e5f00ba2d7243f6a8af68d979ff5
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/x86_64-apple-darwin-ghcup-0.1.14.1
dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919 dlHash: 3e1dd173b3e7b5d90dcdece423c3ddd3efb4c83e964967b0fb574c9b7b2c44e1
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/x86_64-portbld-freebsd-ghcup-0.1.14.1
dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9 dlHash: 89a70980d77888dae8b9fd0f05e7a7920f421bc3bb5192da8e73fd4e7b4cb86f
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/i386-linux-ghcup-0.1.14.1
dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa dlHash: 610aac7c3be3ba3874c07b9cae5b2ca0da9a92bf381afc2597bd2dc9c70aae0c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/aarch64-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/aarch64-linux-ghcup-0.1.14.1
dlHash: 78a15f8a03917a89b67536af0993d7526d2722248a3a5cd8c500adffd7cd7691 dlHash: e9ae07b7d41ea03e6af9c1f3587f61287827c4e29478b6a5d46ea1ce5af4cee5
A_ARM: A_ARM:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/armv7-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/armv7-linux-ghcup-0.1.14.1
dlHash: 5484dc9e16553c3d1707a9f83404c3c795dc01d01ef998cf173caf960abe793b dlHash: 646832030efbc0a848df24c08b5eb7507bd15d1c2eb95fea6d9d03890f3662be
HLS: HLS:
1.0.0: 1.1.0:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#100 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md" viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
viArch: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &hls-64 unknown_versioning: &hls-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.0.0/haskell-language-server-Linux-1.0.0.tar.gz dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-Linux-1.1.0.tar.gz
dlHash: 4fab18998c5f67118a26b75b059f3b3e2ad345b6325515a552d1a24cdf87ed3f dlHash: 0f0dadb0e9a08273658f565fd71c636801959b954be2737f38f2a1aac522208f
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.0.0/haskell-language-server-macOS-1.0.0.tar.gz dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-macOS-1.1.0.tar.gz
dlHash: 74e7624c889c0235f0b02d7e7f164d5eb95b611d584fc8602f0b3a099b73f8be dlHash: 4e89b192e2f49637d772e974f2c17b16da067ecd5912575eaa542551de97681b
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-64 unknown_versioning: *hls-64
Stack:
2.5.1:
viTags: []
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &stack-251-64
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-linux-x86_64.tar.gz
dlHash: c83b6c93d6541c0bce2175085a04062020f4160a86116e20f3b343b562f2d1e8
dlSubdir:
RegexDir: "stack-.*"
Darwin:
unknown_versioning:
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-osx-x86_64.tar.gz
dlHash: f4aedfa8fbe371f77286ee97ec5c3c553842e7ae15b2952a8b8442dccba04bf0
dlSubdir:
RegexDir: "stack-.*"
Linux_Alpine:
unknown_versioning: *stack-251-64
2.7.1:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v271
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &stack-64
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-linux-x86_64.tar.gz
dlHash: 2bc47749ee4be5eccb52a2d4a6a00b0f3b28b92517742b40c675836d7db2777d
dlSubdir:
RegexDir: "stack-.*"
Darwin:
unknown_versioning:
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-osx-x86_64.tar.gz
dlHash: 4248c6fbc87e8a2c06f39e867eb5ef28eae0d99470137cb415356c631c0dcbf2
dlSubdir:
RegexDir: "stack-.*"
Linux_Alpine:
unknown_versioning: *stack-64

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.14 version: 0.1.14.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
@@ -8,14 +8,20 @@ maintainer: hasufell@posteo.de
author: Julian Ospald author: Julian Ospald
homepage: https://gitlab.haskell.org/haskell/ghcup-hs homepage: https://gitlab.haskell.org/haskell/ghcup-hs
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
synopsis: ghc toolchain installer as an exe/library synopsis: ghc toolchain installer
description: description:
A rewrite of the shell script ghcup, for providing A rewrite of the shell script ghcup, for providing
a more stable user experience and exposing an API. a more stable user experience and exposing an API.
category: System category: System
build-type: Simple build-type: Simple
extra-doc-files: CHANGELOG.md extra-doc-files:
CHANGELOG.md
config.yaml
ghcup-0.0.4.yaml
HACKING.md
README.md
RELEASING.md
source-repository head source-repository head
type: git type: git
@@ -79,7 +85,6 @@ library
build-depends: build-depends:
, aeson >=1.4 && <1.6 , aeson >=1.4 && <1.6
, ascii-string ^>=1.0
, async >=0.8 && <2.3 , async >=0.8 && <2.3
, base >=4.13 && <5 , base >=4.13 && <5
, base16-bytestring >=0.1.1.6 && <1.1 , base16-bytestring >=0.1.1.6 && <1.1
@@ -91,6 +96,7 @@ library
, concurrent-output ^>=1.10.11 , concurrent-output ^>=1.10.11
, containers ^>=0.6 , containers ^>=0.6
, cryptohash-sha256 ^>=0.11.101.0 , cryptohash-sha256 ^>=0.11.101.0
, disk-free-space ^>=0.1.0.1
, generics-sop ^>=0.5 , generics-sop ^>=0.5
, haskus-utils-types ^>=1.5 , haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant >=3.0 && <3.2
@@ -125,6 +131,7 @@ library
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3 , unix-bytestring ^>=0.3
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0

File diff suppressed because it is too large Load Diff

View File

@@ -59,8 +59,11 @@ import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.String ( fromString )
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Clock
import Data.Time.Format.ISO8601
import Data.Versions import Data.Versions
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
@@ -77,6 +80,7 @@ import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment, getEnv ) import System.Posix.Env.ByteString ( getEnvironment, getEnv )
import System.Posix.FilePath ( getSearchPath, takeExtension ) import System.Posix.FilePath ( getSearchPath, takeExtension )
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix import Text.Regex.Posix
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
@@ -86,6 +90,9 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
import GHCup.Utils.MegaParsec
import Control.Concurrent (threadDelay)
@@ -103,6 +110,7 @@ installGHCBindist :: ( MonadFail m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
) )
=> DownloadInfo -- ^ where/how to download => DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install -> Version -- ^ the version to install
@@ -158,6 +166,7 @@ installPackedGHC :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
, MonadUnliftIO m
) )
=> Path Abs -- ^ Path to the packed GHC bindist => Path Abs -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
@@ -230,6 +239,7 @@ installGHCBin :: ( MonadFail m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
) )
=> GHCupDownloads -- ^ the download info to look up the tarball from => GHCupDownloads -- ^ the download info to look up the tarball from
-> Version -- ^ the version to install -> Version -- ^ the version to install
@@ -262,6 +272,7 @@ installCabalBindist :: ( MonadMask m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> DownloadInfo => DownloadInfo
@@ -342,6 +353,7 @@ installCabalBin :: ( MonadMask m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
@@ -375,6 +387,7 @@ installHLSBindist :: ( MonadMask m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> DownloadInfo => DownloadInfo
@@ -464,6 +477,7 @@ installHLSBin :: ( MonadMask m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
@@ -489,6 +503,115 @@ installHLSBin bDls ver pfreq = do
installHLSBindist dlinfo ver pfreq installHLSBindist dlinfo ver pfreq
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
-- creates a default @stack -> stack-x.y.z.q@ symlink for
-- the latest installed version.
installStackBin :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installStackBin bDls ver pfreq = do
dlinfo <- lE $ getDownloadInfo Stack ver pfreq bDls
installStackBindist dlinfo ver pfreq
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installStackBindist :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installStackBindist dlinfo ver PlatformRequest {..} = do
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
AppState {dirs = Dirs {..}} <- lift ask
whenM (lift (hlsInstalled ver))
(throwE $ AlreadyInstalled Stack ver)
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ installStack' workdir binDir
-- create symlink if this is the latest version
sVers <- lift $ fmap rights getInstalledStacks
let lInstStack = headMay . reverse . sort $ sVers
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
where
-- | Install an unpacked stack distribution.
installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked stack bindist (where the executable resides)
-> Path Abs -- ^ Path to install to
-> Excepts '[CopyError] m ()
installStack' path inst = do
lift $ $(logInfo) "Installing stack"
let stackFile = [rel|stack|]
liftIO $ createDirRecursive' inst
destFileName <- lift $ parseRel (toFilePath stackFile <> "-" <> verToBS ver)
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> stackFile)
destPath
Overwrite
lift $ chmod_755 destPath
--------------------- ---------------------
@@ -667,6 +790,35 @@ setHLS ver = do
pure () pure ()
-- | Set the @~\/.ghcup\/bin\/stack@ symlink.
setStack :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version
-> Excepts '[NotInstalled] m ()
setStack ver = do
let verBS = verToBS ver
targetFile <- parseRel ("stack-" <> verBS)
-- symlink destination
AppState {dirs = Dirs {..}} <- lift ask
liftIO $ createDirRecursive' binDir
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
$ throwE
$ NotInstalled Stack (GHCTargetVersion Nothing ver)
let stackbin = binDir </> [rel|stack|]
-- delete old file (may be binary or symlink)
lift $ $(logDebug) [i|rm -f #{toFilePath stackbin}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile
stackbin
-- create symlink
let destL = toFilePath targetFile
lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath stackbin}|]
liftIO $ createSymlink stackbin destL
pure ()
@@ -724,15 +876,17 @@ listVersions av lt' criteria pfreq = do
cabals <- getInstalledCabals' cSet cabals <- getInstalledCabals' cSet
hlsSet' <- hlsSet hlsSet' <- hlsSet
hlses <- getInstalledHLSs hlses <- getInstalledHLSs
sSet <- stackSet
stacks <- getInstalledStacks
go lt' cSet cabals hlsSet' hlses go lt' cSet cabals hlsSet' hlses sSet stacks
where where
go lt cSet cabals hlsSet' hlses = do go lt cSet cabals hlsSet' hlses sSet stacks = do
case lt of case lt of
Just t -> do Just t -> do
-- get versions from GHCupDownloads -- get versions from GHCupDownloads
let avTools = availableToolVersions av t let avTools = availableToolVersions av t
lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses) lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses sSet stacks)
case t of case t of
GHC -> do GHC -> do
@@ -744,13 +898,17 @@ listVersions av lt' criteria pfreq = do
HLS -> do HLS -> do
slr <- strayHLS avTools slr <- strayHLS avTools
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
Stack -> do
slr <- strayStacks avTools
pure (sort (slr ++ lr))
GHCup -> pure lr GHCup -> pure lr
Nothing -> do Nothing -> do
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses sSet stacks
ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks
pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers) stackvers <- go (Just Stack) cSet cabals hlsSet' hlses sSet stacks
pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m) strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version [Tag]
-> m [ListResult] -> m [ListResult]
@@ -850,6 +1008,34 @@ listVersions av lt' criteria pfreq = do
[i|Could not parse version of stray directory #{toFilePath e}|] [i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing pure Nothing
strayStacks :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayStacks avTools = do
stacks <- getInstalledStacks
fmap catMaybes $ forM stacks $ \case
Right ver ->
case Map.lookup ver avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (== Just ver) hlsSet
pure $ Just $ ListResult
{ lTool = Stack
, lVer = ver
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, ..
}
Left e -> do
$(logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing
-- NOTE: this are not cross ones, because no bindists -- NOTE: this are not cross ones, because no bindists
toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
=> Tool => Tool
@@ -857,9 +1043,11 @@ listVersions av lt' criteria pfreq = do
-> [Either (Path Rel) Version] -> [Either (Path Rel) Version]
-> Maybe Version -> Maybe Version
-> [Either (Path Rel) Version] -> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag]) -> (Version, [Tag])
-> m ListResult -> m ListResult
toListResult t cSet cabals hlsSet' hlses (v, tags) = case t of toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = case t of
GHC -> do GHC -> do
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
let tver = mkTVer v let tver = mkTVer v
@@ -907,6 +1095,19 @@ listVersions av lt' criteria pfreq = do
, hlsPowered = False , hlsPowered = False
, .. , ..
} }
Stack -> do
let lNoBindist = isLeft $ getDownloadInfo Stack v pfreq av
let lSet = stackSet' == Just v
let lInstalled = elem v $ rights stacks
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, ..
}
filter' :: [ListResult] -> [ListResult] filter' :: [ListResult] -> [ListResult]
@@ -1024,6 +1225,28 @@ rmHLSVer ver = do
Nothing -> pure () Nothing -> pure ()
-- | Delete a stack version. Will try to fix the @stack@ symlink
-- after removal (e.g. setting it to an older version).
rmStackVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
=> Version
-> Excepts '[NotInstalled] m ()
rmStackVer ver = do
whenM (lift $ fmap not $ stackInstalled ver) $ throwE (NotInstalled Stack (GHCTargetVersion Nothing ver))
sSet <- lift stackSet
AppState {dirs = Dirs {..}} <- lift ask
stackFile <- lift $ parseRel ("stack-" <> verToBS ver)
liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir </> stackFile)
when (Just ver == sSet) $ do
sVers <- lift $ fmap rights getInstalledStacks
case headMay . reverse . sort $ sVers of
Just latestver -> setStack latestver
Nothing -> liftIO $ hideError doesNotExistErrorType $ deleteFile
(binDir </> [rel|stack|])
------------------ ------------------
@@ -1062,10 +1285,11 @@ compileGHC :: ( MonadMask m
, MonadResource m , MonadResource m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
-> GHCTargetVersion -- ^ version to install -> Either GHCTargetVersion GitBranch -- ^ version to install
-> Either Version (Path Abs) -- ^ version to bootstrap with -> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
-> Maybe (Path Abs) -- ^ build config -> Maybe (Path Abs) -- ^ build config
@@ -1089,38 +1313,87 @@ compileGHC :: ( MonadMask m
#endif #endif
] ]
m m
() GHCTargetVersion
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@PlatformRequest{..} compileGHC dls targetGhc bstrap jobs mbuildConfig patchdir aargs pfreq@PlatformRequest{..}
= do = do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|] (workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball
Left tver -> do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
-- download source tarball
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tmpUnpack, tver)
-- clone from git
Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged [s|git|] True ("--no-pager":args) [rel|git|] (Just tmpUnpack) Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
lift $ $(logInfo) [i|Fetching git repo #{rep} at ref #{ref} (this may take a while)|]
lEM $ git [ "init" ]
lEM $ git [ "remote"
, "add"
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
lEM $ execLogged "./boot" False [] [rel|ghc-bootstrap|] (Just tmpUnpack) Nothing
lEM $ execLogged "./configure" False [] [rel|ghc-bootstrap|] (Just tmpUnpack) Nothing
CapturedProcess {..} <- liftIO $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just tmpUnpack)
case _exitCode of
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe $ _stdOut
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe _stdErr))
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|]
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
alreadyInstalled <- lift $ ghcInstalled tver alreadyInstalled <- lift $ ghcInstalled tver
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver) alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
when alreadyInstalled $ do
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
lift $ $(logWarn)
"...waiting for 10 seconds before continuing, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
-- download source tarball ghcdir <- lift $ ghcupGHCDir tver
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
bghc <- case bstrap of bghc <- case bstrap of
Right g -> pure $ Right g Right g -> pure $ Right g
Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver) Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
ghcdir <- lift $ ghcupGHCDir tver
(bindist, bmk) <- liftE $ runBuildAction (bindist, bmk) <- liftE $ runBuildAction
tmpUnpack tmpUnpack
Nothing Nothing
(do (do
b <- compileBindist bghc ghcdir workdir b <- compileBindist bghc tver workdir
bmk <- liftIO $ readFileStrict (build_mk workdir) bmk <- liftIO $ readFileStrict (build_mk workdir)
pure (b, bmk) pure (b, bmk)
) )
@@ -1129,7 +1402,7 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@PlatformReques
lift $ $(logInfo) [i|Deleting existing installation|] lift $ $(logInfo) [i|Deleting existing installation|]
liftE $ rmGHCVer tver liftE $ rmGHCVer tver
liftE $ installPackedGHC bindist liftE $ installPackedGHC bindist
(view dlSubdir dlInfo) (Just $ RegexDir "ghc-.*")
ghcdir ghcdir
(tver ^. tvVersion) (tver ^. tvVersion)
pfreq pfreq
@@ -1141,21 +1414,23 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@PlatformReques
-- restore -- restore
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
pure tver
where where
defaultConf = case _tvTarget tver of defaultConf = case targetGhc of
Nothing -> [s| Left (GHCTargetVersion (Just _) _) -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES|]
Just _ -> [s|
V=0 V=0
BUILD_MAN = NO BUILD_MAN = NO
BUILD_SPHINX_HTML = NO BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO HADDOCK_DOCS = NO
Stage1Only = YES|] Stage1Only = YES|]
_ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES|]
compileBindist :: ( MonadReader AppState m compileBindist :: ( MonadReader AppState m
, MonadThrow m , MonadThrow m
@@ -1165,13 +1440,13 @@ Stage1Only = YES|]
, MonadFail m , MonadFail m
) )
=> Either (Path Rel) (Path Abs) => Either (Path Rel) (Path Abs)
-> Path Abs -> GHCTargetVersion
-> Path Abs -> Path Abs
-> Excepts -> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError] '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m m
(Path Abs) -- ^ output path of bindist (Path Abs) -- ^ output path of bindist
compileBindist bghc ghcdir workdir = do compileBindist bghc tver workdir = do
lift $ $(logInfo) [i|configuring build|] lift $ $(logInfo) [i|configuring build|]
liftE checkBuildConfig liftE checkBuildConfig
@@ -1181,31 +1456,28 @@ Stage1Only = YES|]
cEnv <- liftIO getEnvironment cEnv <- liftIO getEnvironment
if if | _tvVersion tver >= [vver|8.8.0|] -> do
| _tvVersion tver >= [vver|8.8.0|] -> do bghcPath <- case bghc of
bghcPath <- case bghc of Right ghc' -> pure ghc'
Right ghc' -> pure ghc' Left bver -> do
Left bver -> do spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath liftIO (searchPath spaths bver) !? NotFoundInPATH bver
liftIO (searchPath spaths bver) !? NotFoundInPATH bver lEM $ execLogged
"./configure"
False
( maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|]
(Just workdir)
(Just (("GHC", toFilePath bghcPath) : cEnv))
| otherwise -> do
lEM $ execLogged lEM $ execLogged
"./configure" "./configure"
False False
( ["--prefix=" <> toFilePath ghcdir] ( [ "--with-ghc=" <> either toFilePath toFilePath bghc
++ maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|]
(Just workdir)
(Just (("GHC", toFilePath bghcPath) : cEnv))
| otherwise -> do
lEM $ execLogged
"./configure"
False
( [ "--prefix=" <> toFilePath ghcdir
, "--with-ghc=" <> either toFilePath toFilePath bghc
] ]
++ maybe mempty ++ maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x]) (\x -> ["--target=" <> E.encodeUtf8 x])
@@ -1244,9 +1516,10 @@ Stage1Only = YES|]
. B16.encode . B16.encode
. SHA256.hashlazy . SHA256.hashlazy
$ c $ c
cTime <- liftIO getCurrentTime
tarName <- tarName <-
parseRel parseRel
[i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|] [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
let tarPath = cacheDir </> tarName let tarPath = cacheDir </> tarName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
tarPath tarPath
@@ -1272,12 +1545,12 @@ Stage1Only = YES|]
let lines' = fmap T.strip . T.lines $ decUTF8Safe c let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only -- for cross, we need Stage1Only
case _tvTarget tver of case targetGhc of
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
(InvalidBuildConfig (InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
) )
Nothing -> pure () _ -> pure ()
@@ -1296,6 +1569,7 @@ upgradeGHCup :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m
) )
=> GHCupDownloads => GHCupDownloads
-> Maybe (Path Abs) -- ^ full file destination to write ghcup into -> Maybe (Path Abs) -- ^ full file destination to write ghcup into
@@ -1369,4 +1643,3 @@ postGHCInstall ver@GHCTargetVersion {..} = do
$ getMajorMinorV _tvVersion $ getMajorMinorV _tvVersion
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)

View File

@@ -400,6 +400,7 @@ downloadCached :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
, MonadUnliftIO m
, MonadReader AppState m , MonadReader AppState m
) )
=> DownloadInfo => DownloadInfo

View File

@@ -24,6 +24,8 @@ import GHCup.Utils.Prelude
#if !defined(TAR) #if !defined(TAR)
import Codec.Archive import Codec.Archive
#else
import qualified Codec.Archive.Tar as Tar
#endif #endif
import Control.Exception.Safe import Control.Exception.Safe
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
@@ -339,4 +341,14 @@ instance Pretty ArchiveResult where
pPrint ArchiveRetry = text "Archive result: retry" pPrint ArchiveRetry = text "Archive result: retry"
pPrint ArchiveOk = text "Archive result: Ok" pPrint ArchiveOk = text "Archive result: Ok"
pPrint ArchiveEOF = text "Archive result: EOF" pPrint ArchiveEOF = text "Archive result: EOF"
#else
instance Pretty Tar.FormatError where
pPrint Tar.TruncatedArchive = text "Truncated archive"
pPrint Tar.ShortTrailer = text "Short trailer"
pPrint Tar.BadTrailer = text "Bad trailer"
pPrint Tar.TrailingJunk = text "Trailing junk"
pPrint Tar.ChecksumIncorrect = text "Checksum incorrect"
pPrint Tar.NotTarFormat = text "Not a tar format"
pPrint Tar.UnrecognisedTarFormat = text "Unrecognised tar format"
pPrint Tar.HeaderBadNumericEncoding = text "Header has bad numeric encoding"
#endif #endif

View File

@@ -85,6 +85,7 @@ data Tool = GHC
| Cabal | Cabal
| GHCup | GHCup
| HLS | HLS
| Stack
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded) deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
@@ -257,6 +258,7 @@ data UserKeyBindings = UserKeyBindings
, kSet :: Maybe Vty.Key , kSet :: Maybe Vty.Key
, kChangelog :: Maybe Vty.Key , kChangelog :: Maybe Vty.Key
, kShowAll :: Maybe Vty.Key , kShowAll :: Maybe Vty.Key
, kShowAllTools :: Maybe Vty.Key
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
@@ -268,7 +270,8 @@ data KeyBindings = KeyBindings
, bUninstall :: Vty.Key , bUninstall :: Vty.Key
, bSet :: Vty.Key , bSet :: Vty.Key
, bChangelog :: Vty.Key , bChangelog :: Vty.Key
, bShowAll :: Vty.Key , bShowAllVersions :: Vty.Key
, bShowAllTools :: Vty.Key
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
@@ -281,7 +284,8 @@ defaultKeyBindings = KeyBindings
, bUninstall = Vty.KChar 'u' , bUninstall = Vty.KChar 'u'
, bSet = Vty.KChar 's' , bSet = Vty.KChar 's'
, bChangelog = Vty.KChar 'c' , bChangelog = Vty.KChar 'c'
, bShowAll = Vty.KChar 'a' , bShowAllVersions = Vty.KChar 'a'
, bShowAllTools = Vty.KChar 't'
} }
data AppState = AppState data AppState = AppState
@@ -379,6 +383,11 @@ data GHCTargetVersion = GHCTargetVersion
} }
deriving (Ord, Eq, Show) deriving (Ord, Eq, Show)
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
mkTVer :: Version -> GHCTargetVersion mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing mkTVer = GHCTargetVersion Nothing

View File

@@ -187,7 +187,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
----------------------------------- -----------------------------------
-- | Whethe the given GHC versin is installed. -- | Whether the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
@@ -359,6 +359,54 @@ getInstalledHLSs = do
Just (Left _) -> pure $ Left f Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f Nothing -> pure $ Left f
-- | Get all installed stacks, by matching on
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledStacks = do
AppState { dirs = Dirs {..} } <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^stack-.*$|] :: ByteString)
)
forM bins $ \f ->
case
fmap (version . decUTF8Safe) . B.stripPrefix "stack-" . toFilePath $ f
of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f
-- Return the currently set stack version, if any.
-- TODO: there's a lot of code duplication here :>
stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
stackSet = do
AppState {dirs = Dirs {..}} <- ask
let stackBin = binDir </> [rel|stack|]
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- isBrokenSymlink stackBin
if broken
then pure Nothing
else do
link <- readSymbolicLink $ toFilePath stackBin
Just <$> linkVersion link
where
linkVersion :: MonadThrow m => ByteString -> m Version
linkVersion bs = do
t <- throwEither $ E.decodeUtf8' bs
throwEither $ MP.parse parser "" t
where
parser =
MP.chunk "stack-" *> version'
-- | Whether the given Stack version is installed.
stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
stackInstalled ver = do
vers <- fmap rights getInstalledStacks
pure $ elem ver vers
-- | Whether the given HLS version is installed. -- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
@@ -770,6 +818,15 @@ make args workdir = do
let mymake = if has_gmake then "gmake" else "make" let mymake = if has_gmake then "gmake" else "make"
execLogged mymake True args [rel|ghc-make|] workdir Nothing execLogged mymake True args [rel|ghc-make|] workdir Nothing
makeOut :: [ByteString]
-> Maybe (Path Abs)
-> IO CapturedProcess
makeOut args workdir = do
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
has_gmake <- isJust <$> liftIO (searchPath spaths [rel|gmake|])
let mymake = if has_gmake then [rel|gmake|] else [rel|make|]
liftIO $ executeOut mymake args workdir
-- | Try to apply patches in order. Fails with 'PatchFailed' -- | Try to apply patches in order. Fails with 'PatchFailed'
-- on first failure. -- on first failure.

View File

@@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-| {-|
Module : GHCup.Utils.Dirs Module : GHCup.Utils.Dirs
@@ -16,6 +17,7 @@ Portability : POSIX
module GHCup.Utils.Dirs module GHCup.Utils.Dirs
( getDirs ( getDirs
, ghcupConfigFile , ghcupConfigFile
, ghcupCacheDir
, ghcupGHCBaseDir , ghcupGHCBaseDir
, ghcupGHCDir , ghcupGHCDir
, mkGhcupTmpDir , mkGhcupTmpDir
@@ -35,11 +37,14 @@ import GHCup.Utils.Prelude
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource hiding (throwM)
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Maybe import Data.Maybe
import Data.String.Interpolate
import GHC.IO.Exception ( IOErrorType(NoSuchThing) ) import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import HPath import HPath
@@ -49,6 +54,7 @@ import Prelude hiding ( abs
, readFile , readFile
, writeFile , writeFile
) )
import System.DiskSpace
import System.Posix.Env.ByteString ( getEnv import System.Posix.Env.ByteString ( getEnv
, getEnvDefault , getEnvDefault
) )
@@ -57,11 +63,13 @@ import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text 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 as Y
import qualified System.Posix.FilePath as FP import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU import qualified System.Posix.User as PU
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import Control.Concurrent (threadDelay)
@@ -225,15 +233,31 @@ parseGHCupGHCDir (toFilePath -> f) = do
throwEither $ MP.parse ghcTargetVerP "" fp throwEither $ MP.parse ghcTargetVerP "" fp
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs) mkGhcupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir = do mkGhcupTmpDir = do
tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp" tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp"
tmp <- liftIO $ mkdtemp (tmpdir FP.</> "ghcup-") let fp = T.unpack $ decUTF8Safe tmpdir
let minSpace = 5000 -- a rough guess, aight?
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace fp
when (maybe False (toBytes minSpace >) space) $ do
$(logWarn) [i|Possibly insufficient disk space on #{fp}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
$(logWarn)
"...waiting for 10 seconds before continuing anyway, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
tmp <- liftIO $ mkdtemp (tmpdir FP.</> "ghcup-")
parseAbs tmp parseAbs tmp
where
toBytes mb = mb * 1024 * 1024
toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
truncate' :: Double -> Int -> Double
truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
where t = 10^n
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs) withGHCupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir) deleteDirRecursive)
@@ -269,5 +293,3 @@ relativeSymlink (toFilePath -> p1) (toFilePath -> p2) =
<> joinPath ("/" : drop (length common) d2) <> joinPath ("/" : drop (length common) d2)

View File

@@ -50,7 +50,7 @@ import System.Posix.Directory.ByteString
import System.Posix.FD as FD import System.Posix.FD as FD
import System.Posix.FilePath hiding ( (</>) ) import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import System.Posix.Foreign ( oExcl ) import System.Posix.Foreign ( oExcl, oAppend )
import "unix" System.Posix.IO.ByteString import "unix" System.Posix.IO.ByteString
hiding ( openFd ) hiding ( openFd )
import System.Posix.Process ( ProcessStatus(..) ) import System.Posix.Process ( ProcessStatus(..) )
@@ -133,14 +133,14 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
=> ByteString -- ^ thing to execute => ByteString -- ^ thing to execute
-> Bool -- ^ whether to search PATH for the thing -> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing -> [ByteString] -- ^ args for the thing
-> Path Rel -- ^ log filename -> Path Rel -- ^ log filename (opened in append mode)
-> Maybe (Path Abs) -- ^ optionally chdir into this -> Maybe (Path Abs) -- ^ optionally chdir into this
-> Maybe [(ByteString, ByteString)] -- ^ optional environment -> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> m (Either ProcessError ()) -> m (Either ProcessError ())
execLogged exe spath args lfile chdir env = do execLogged exe spath args lfile chdir env = do
AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
logfile <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log") logfile <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log")
liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) liftIO $ bracket (openFd (toFilePath logfile) WriteOnly [oAppend] (Just newFilePerms))
closeFd closeFd
(action verbose) (action verbose)
where where

View File

@@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-| {-|
Module : GHCup.Utils.Logger Module : GHCup.Utils.Logger
@@ -15,6 +16,8 @@ module GHCup.Utils.Logger where
import GHCup.Types import GHCup.Types
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.String.QQ
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
@@ -25,6 +28,7 @@ import HPath.IO
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Console.Pretty import System.Console.Pretty
import System.IO.Error import System.IO.Error
import Text.Regex.Posix
import qualified Data.ByteString as B import qualified Data.ByteString as B
@@ -64,12 +68,19 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
rawOutter outr rawOutter outr
initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs) initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => m (Path Abs)
initGHCupFileLogging context = do initGHCupFileLogging = do
AppState {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
let logfile = logsDir </> context let logfile = logsDir </> [rel|ghcup.log|]
liftIO $ do liftIO $ do
createDirRecursive' logsDir createDirRecursive' logsDir
hideError doesNotExistErrorType $ deleteFile logfile logFiles <- findFiles
logsDir
(makeRegexOpts compExtended
execBlank
([s|^.*\.log$|] :: B.ByteString)
)
forM_ logFiles $ hideError doesNotExistErrorType . deleteFile . (logsDir </>)
createRegularFile newFilePerms logfile createRegularFile newFilePerms logfile
pure logfile pure logfile

View File

@@ -67,6 +67,15 @@ ghcTargetBinP t =
<*> (MP.chunk t <* MP.eof) <*> (MP.chunk t <* MP.eof)
-- | Extracts the version from @ProjectVersion="8.10.5"@.
ghcProjectVersion :: MP.Parsec Void Text Version
ghcProjectVersion = do
_ <- MP.chunk "ProjectVersion=\""
ver <- parseUntil1 $ MP.chunk "\""
MP.setInput ver
version'
-- | Extracts target triple and version from e.g. -- | Extracts target triple and version from e.g.
-- * armv7-unknown-linux-gnueabihf-8.8.3 -- * armv7-unknown-linux-gnueabihf-8.8.3
-- * armv7-unknown-linux-gnueabihf-8.8.3 -- * armv7-unknown-linux-gnueabihf-8.8.3