Add stack support

2021-05-15 00:31:36 +02:00 · 2021-05-15 00:31:36 +02:00 · 734916728c
parent 5f6ed1292d
commit 734916728c
10 changed files with 19221 additions and 18464 deletions
--- a/.gitlab/script/ghcup_version.sh
+++ b/.gitlab/script/ghcup_version.sh
@ -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

--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -5,6 +5,7 @@
 * 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

--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@ -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)
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@ -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
--- a/config.yaml
+++ b/config.yaml
@ -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.
--- a/ghcup-0.0.4.yaml
+++ b/ghcup-0.0.4.yaml
@ -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
+
--- a/golden/GHCupInfo.json
+++ b/golden/GHCupInfo.json
--- a/lib/GHCup.hs
+++ b/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|])
+


    ------------------
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -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
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@ -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