Merge branch 'stack-support'
This commit is contained in:
commit
8ef1c8b5d4
@ -10,8 +10,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./gh
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
exit 0
|
||||
|
@ -12,8 +12,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > .
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
exit 0
|
||||
|
@ -28,8 +28,8 @@ else
|
||||
fi
|
||||
chmod +x ghcup-bin
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
# utils
|
||||
apk add --no-cache \
|
||||
|
@ -13,7 +13,7 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
|
||||
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
|
@ -96,14 +96,19 @@ eghcup set ${GHC_VERSION}
|
||||
eghcup rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
# install hls
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
eghcup install hls
|
||||
haskell-language-server-wrapper --version
|
||||
|
||||
eghcup install stack
|
||||
stack --version
|
||||
elif [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup install hls
|
||||
haskell-language-server-wrapper --version
|
||||
|
||||
eghcup install stack
|
||||
stack --version
|
||||
fi
|
||||
fi
|
||||
|
||||
|
@ -5,6 +5,11 @@
|
||||
* 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
|
||||
|
||||
|
@ -66,7 +66,8 @@ data BrickData = BrickData
|
||||
deriving Show
|
||||
|
||||
data BrickSettings = BrickSettings
|
||||
{ showAll :: Bool
|
||||
{ showAllVersions :: Bool
|
||||
, showAllTools :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@ -97,17 +98,22 @@ keyHandlers KeyBindings {..} =
|
||||
, (bUninstall, const "Uninstall", withIOAction del')
|
||||
, (bSet, const "Set" , withIOAction set')
|
||||
, (bChangelog, const "ChangeLog", withIOAction changelog')
|
||||
, ( bShowAll
|
||||
, ( bShowAllVersions
|
||||
, \BrickSettings {..} ->
|
||||
if showAll then "Hide old versions" else "Show all versions"
|
||||
, hideShowHandler
|
||||
if showAllVersions then "Don't show all versions" else "Show all versions"
|
||||
, 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, .. })
|
||||
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
|
||||
]
|
||||
where
|
||||
hideShowHandler BrickState{..} =
|
||||
let newAppSettings = appSettings { showAll = not . showAll $ appSettings }
|
||||
hideShowHandler f p BrickState{..} =
|
||||
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
|
||||
newInternalState = constructList appData newAppSettings (Just appState)
|
||||
in continue (BrickState appData newAppSettings newInternalState appKeys)
|
||||
|
||||
@ -142,7 +148,12 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
<+> minHSize 15 (str "Version")
|
||||
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
||||
<+> 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{..} =
|
||||
let marks = if
|
||||
| lSet -> (withAttr "set" $ str "✔✔")
|
||||
@ -194,6 +205,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
printTool GHC = str "GHC"
|
||||
printTool GHCup = str "GHCup"
|
||||
printTool HLS = str "HLS"
|
||||
printTool Stack = str "Stack"
|
||||
|
||||
printNotes ListResult {..} =
|
||||
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
|
||||
@ -351,7 +363,7 @@ constructList :: BrickData
|
||||
-> Maybe BrickInternalState
|
||||
-> BrickInternalState
|
||||
constructList appD appSettings =
|
||||
replaceLR (filterVisible (showAll appSettings)) (lr appD)
|
||||
replaceLR (filterVisible (showAllVersions appSettings)) (lr appD)
|
||||
|
||||
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
|
||||
listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
|
||||
@ -385,9 +397,9 @@ replaceLR filterF lr s =
|
||||
|
||||
|
||||
filterVisible :: Bool -> ListResult -> Bool
|
||||
filterVisible showAll e | lInstalled e = True
|
||||
| showAll = True
|
||||
| otherwise = not (elem Old (lTag e))
|
||||
filterVisible showAllVersions e | lInstalled e = True
|
||||
| showAllVersions = True
|
||||
| otherwise = not (elem Old (lTag e))
|
||||
|
||||
|
||||
install' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
||||
@ -432,6 +444,9 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin dls lVer pfreq $> vi
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
liftE $ installStackBin dls lVer pfreq $> vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@ -460,6 +475,7 @@ set' _ (_, ListResult {..}) = do
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer $> ()
|
||||
Stack -> liftE $ setStack lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
@ -481,6 +497,7 @@ del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
|
||||
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
|
||||
Cabal -> liftE $ rmCabalVer lVer $> vi
|
||||
HLS -> liftE $ rmHLSVer lVer $> vi
|
||||
Stack -> liftE $ rmStackVer lVer $> vi
|
||||
GHCup -> pure Nothing
|
||||
)
|
||||
>>= \case
|
||||
@ -564,7 +581,7 @@ brickMain s l av pfreq' = do
|
||||
|
||||
|
||||
defaultAppSettings :: BrickSettings
|
||||
defaultAppSettings = BrickSettings { showAll = False }
|
||||
defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
|
||||
|
||||
|
||||
getDownloads' :: IO (Either String GHCupDownloads)
|
||||
|
@ -126,6 +126,7 @@ toSetToolVer Nothing = SetRecommended
|
||||
data InstallCommand = InstallGHC InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
| InstallHLS InstallOptions
|
||||
| InstallStack InstallOptions
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instVer :: Maybe ToolVersion
|
||||
@ -137,6 +138,7 @@ data InstallOptions = InstallOptions
|
||||
data SetCommand = SetGHC SetOptions
|
||||
| SetCabal SetOptions
|
||||
| SetHLS SetOptions
|
||||
| SetStack SetOptions
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetToolVersion GHCTargetVersion
|
||||
@ -157,6 +159,7 @@ data ListOptions = ListOptions
|
||||
data RmCommand = RmGHC RmOptions
|
||||
| RmCabal Version
|
||||
| RmHLS Version
|
||||
| RmStack Version
|
||||
|
||||
data RmOptions = RmOptions
|
||||
{ ghcVer :: GHCTargetVersion
|
||||
@ -432,6 +435,15 @@ installParser =
|
||||
<> footerDoc (Just $ text installHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( InstallStack
|
||||
<$> info
|
||||
(installOpts (Just Stack) <**> helper)
|
||||
( progDesc "Install stack"
|
||||
<> footerDoc (Just $ text installStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts Nothing)
|
||||
@ -442,9 +454,17 @@ installParser =
|
||||
into "~/.ghcup/bin"
|
||||
|
||||
Examples:
|
||||
# install recommended GHC
|
||||
# install recommended 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 = [s|Discussion:
|
||||
Installs the specified GHC version (or a recommended default one) into
|
||||
@ -528,6 +548,15 @@ setParser =
|
||||
<> footerDoc (Just $ text setHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( SetStack
|
||||
<$> info
|
||||
(setOpts (Just Stack) <**> helper)
|
||||
( progDesc "Set stack version"
|
||||
<> footerDoc (Just $ text setStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> setOpts Nothing)
|
||||
@ -542,6 +571,10 @@ setParser =
|
||||
setCabalFooter = [s|Discussion:
|
||||
Sets the the current Cabal version.|]
|
||||
|
||||
setStackFooter :: String
|
||||
setStackFooter = [s|Discussion:
|
||||
Sets the the current Stack version.|]
|
||||
|
||||
setHLSFooter :: String
|
||||
setHLSFooter = [s|Discussion:
|
||||
Sets the the current haskell-language-server version.|]
|
||||
@ -594,6 +627,12 @@ rmParser =
|
||||
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
|
||||
(progDesc "Remove haskell-language-server version")
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( RmStack
|
||||
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
|
||||
(progDesc "Remove stack version")
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> rmOpts Nothing)
|
||||
@ -615,6 +654,7 @@ changelogP =
|
||||
"ghc" -> Right GHC
|
||||
"cabal" -> Right Cabal
|
||||
"ghcup" -> Right GHCup
|
||||
"stack" -> Right Stack
|
||||
e -> Left e
|
||||
)
|
||||
)
|
||||
@ -986,7 +1026,8 @@ toSettings options = do
|
||||
, bUninstall = fromMaybe bUninstall kUninstall
|
||||
, bSet = fromMaybe bSet kSet
|
||||
, bChangelog = fromMaybe bChangelog kChangelog
|
||||
, bShowAll = fromMaybe bShowAll kShowAll
|
||||
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll
|
||||
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
|
||||
}
|
||||
|
||||
|
||||
@ -1325,6 +1366,36 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
$(logError) [i|Also check the logs in #{logsDir}|]
|
||||
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{..} =
|
||||
runSetGHC (do
|
||||
@ -1373,6 +1444,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
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{..} =
|
||||
runRm (do
|
||||
liftE $
|
||||
@ -1418,6 +1505,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
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
|
||||
#if defined(BRICK)
|
||||
@ -1429,6 +1530,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
||||
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
||||
Install (Left (InstallHLS iopts)) -> installHLS iopts
|
||||
Install (Left (InstallStack iopts)) -> installStack iopts
|
||||
InstallCabalLegacy iopts -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
|
||||
installCabal iopts
|
||||
@ -1439,6 +1541,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Set (Left (SetGHC sopts)) -> setGHC' sopts
|
||||
Set (Left (SetCabal sopts)) -> setCabal' sopts
|
||||
Set (Left (SetHLS sopts)) -> setHLS' sopts
|
||||
Set (Left (SetStack sopts)) -> setStack' sopts
|
||||
|
||||
List ListOptions {..} ->
|
||||
runListGHC (do
|
||||
@ -1453,6 +1556,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
|
||||
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
|
||||
Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts
|
||||
Rm (Left (RmStack rmopts)) -> rmStack' rmopts
|
||||
|
||||
DInfo ->
|
||||
do runDebugInfo $ liftE getDebugInfo
|
||||
@ -1654,6 +1758,16 @@ fromVersion' av SetNext tool = do
|
||||
. cycle
|
||||
. sort
|
||||
$ 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"
|
||||
let vi = getVersionInfo (_tvVersion next) tool av
|
||||
pure (next, vi)
|
||||
@ -1852,6 +1966,13 @@ checkForUpdates dls pfreq = do
|
||||
$ $(logWarn)
|
||||
[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 {..} = [i|Debug Info
|
||||
|
@ -29,6 +29,8 @@ key-bindings:
|
||||
KChar: 'c'
|
||||
show-all:
|
||||
KChar: 'a'
|
||||
show-all-tools:
|
||||
KChar: 't'
|
||||
|
||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
||||
# check the 'URLSource' type in the code.
|
||||
|
@ -1835,3 +1835,45 @@ ghcupDownloads:
|
||||
dlHash: 4e89b192e2f49637d772e974f2c17b16da067ecd5912575eaa542551de97681b
|
||||
Linux_Alpine:
|
||||
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
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.14.1
|
||||
version: 0.1.14.2
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@ -85,7 +85,6 @@ library
|
||||
|
||||
build-depends:
|
||||
, aeson >=1.4 && <1.6
|
||||
, ascii-string ^>=1.0
|
||||
, async >=0.8 && <2.3
|
||||
, base >=4.13 && <5
|
||||
, base16-bytestring >=0.1.1.6 && <1.1
|
||||
|
37184
golden/GHCupInfo.json
37184
golden/GHCupInfo.json
File diff suppressed because it is too large
Load Diff
227
lib/GHCup.hs
227
lib/GHCup.hs
@ -503,6 +503,115 @@ installHLSBin bDls ver pfreq = do
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
@ -681,6 +790,35 @@ setHLS ver = do
|
||||
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 ()
|
||||
|
||||
|
||||
|
||||
@ -738,15 +876,17 @@ listVersions av lt' criteria pfreq = do
|
||||
cabals <- getInstalledCabals' cSet
|
||||
hlsSet' <- hlsSet
|
||||
hlses <- getInstalledHLSs
|
||||
sSet <- stackSet
|
||||
stacks <- getInstalledStacks
|
||||
|
||||
go lt' cSet cabals hlsSet' hlses
|
||||
go lt' cSet cabals hlsSet' hlses sSet stacks
|
||||
where
|
||||
go lt cSet cabals hlsSet' hlses = do
|
||||
go lt cSet cabals hlsSet' hlses sSet stacks = do
|
||||
case lt of
|
||||
Just t -> do
|
||||
-- get versions from GHCupDownloads
|
||||
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
|
||||
GHC -> do
|
||||
@ -758,13 +898,17 @@ listVersions av lt' criteria pfreq = do
|
||||
HLS -> do
|
||||
slr <- strayHLS avTools
|
||||
pure (sort (slr ++ lr))
|
||||
Stack -> do
|
||||
slr <- strayStacks avTools
|
||||
pure (sort (slr ++ lr))
|
||||
GHCup -> pure lr
|
||||
Nothing -> do
|
||||
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses
|
||||
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses
|
||||
hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses
|
||||
ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses
|
||||
pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers)
|
||||
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
|
||||
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
|
||||
hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses sSet stacks
|
||||
ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks
|
||||
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)
|
||||
=> Map.Map Version [Tag]
|
||||
-> m [ListResult]
|
||||
@ -864,6 +1008,34 @@ listVersions av lt' criteria pfreq = do
|
||||
[i|Could not parse version of stray directory #{toFilePath e}|]
|
||||
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
|
||||
toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
|
||||
=> Tool
|
||||
@ -871,9 +1043,11 @@ listVersions av lt' criteria pfreq = do
|
||||
-> [Either (Path Rel) Version]
|
||||
-> Maybe Version
|
||||
-> [Either (Path Rel) Version]
|
||||
-> Maybe Version
|
||||
-> [Either (Path Rel) Version]
|
||||
-> (Version, [Tag])
|
||||
-> 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
|
||||
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
|
||||
let tver = mkTVer v
|
||||
@ -921,6 +1095,19 @@ listVersions av lt' criteria pfreq = do
|
||||
, 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]
|
||||
@ -1038,6 +1225,28 @@ rmHLSVer ver = do
|
||||
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|])
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
|
@ -85,6 +85,7 @@ data Tool = GHC
|
||||
| Cabal
|
||||
| GHCup
|
||||
| HLS
|
||||
| Stack
|
||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
||||
|
||||
|
||||
@ -257,6 +258,7 @@ data UserKeyBindings = UserKeyBindings
|
||||
, kSet :: Maybe Vty.Key
|
||||
, kChangelog :: Maybe Vty.Key
|
||||
, kShowAll :: Maybe Vty.Key
|
||||
, kShowAllTools :: Maybe Vty.Key
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@ -268,7 +270,8 @@ data KeyBindings = KeyBindings
|
||||
, bUninstall :: Vty.Key
|
||||
, bSet :: Vty.Key
|
||||
, bChangelog :: Vty.Key
|
||||
, bShowAll :: Vty.Key
|
||||
, bShowAllVersions :: Vty.Key
|
||||
, bShowAllTools :: Vty.Key
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@ -281,7 +284,8 @@ defaultKeyBindings = KeyBindings
|
||||
, bUninstall = Vty.KChar 'u'
|
||||
, bSet = Vty.KChar 's'
|
||||
, bChangelog = Vty.KChar 'c'
|
||||
, bShowAll = Vty.KChar 'a'
|
||||
, bShowAllVersions = Vty.KChar 'a'
|
||||
, bShowAllTools = Vty.KChar 't'
|
||||
}
|
||||
|
||||
data AppState = AppState
|
||||
|
@ -359,6 +359,54 @@ getInstalledHLSs = do
|
||||
Just (Left _) -> 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.
|
||||
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
|
||||
|
Loading…
Reference in New Issue
Block a user