ghcup 0.2.3.0 → 0.2.5.0

raw patch · 21 files changed

+242/−136 lines, 21 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• app/ghcup/Main.hs +1/−0
• ghcup.cabal +1/−1
• lib-opt/GHCup/OptParse/Config.hs +1/−0
• lib-opt/GHCup/OptParse/Install.hs +3/−2
• lib-opt/GHCup/OptParse/List.hs +11/−10
• lib-tui/GHCup/Brick/Actions.hs +8/−8
• lib-tui/GHCup/Brick/App.hs +3/−3
• lib-tui/GHCup/Brick/Common.hs +3/−0
• lib-tui/GHCup/Brick/Widgets/KeyInfo.hs +5/−1
• lib-tui/GHCup/Brick/Widgets/Navigation.hs +29/−17
• lib/GHCup/Command/Whereis.hs +5/−5
• lib/GHCup/Errors.hs +2/−0
• lib/GHCup/Input/Parsers.hs +45/−17
• lib/GHCup/Query/DB/HLS.hs +18/−5
• lib/GHCup/Query/Metadata.hs +31/−13
• lib/GHCup/Types.hs +15/−2
• lib/GHCup/Types/Dhall.hs +4/−35
• lib/GHCup/Types/JSON.hs +42/−15
• scripts/bootstrap/bootstrap-haskell +1/−2
• test/ghcup-test/GHCup/Types/JSONSpec.hs +1/−0

@@ -1,5 +1,18 @@ # Version history for ghcup +## 0.2.5.0 -- 2026-05-26++* Fix broken `ghcup whereis` on non-installed tools wrt [#1347](https://github.com/haskell/ghcup-hs/issues/1347)+* Fix HLS compatibility check on windows wrt [#1342](https://github.com/haskell/ghcup-hs/issues/1342)++## 0.2.4.0 -- 2026-05-25++* Add GHC compatibility to metadata format+  - this shows which GHC is supported by a particular HLS even if it's not installed+  - it also allows to install HLS such as `ghcup install hls ghc-9.14.1`+* Fix up/down/right/left/tab not changable wrt [#1343](https://github.com/haskell/ghcup-hs/issues/1343)+* fix bug when installing via `--url` and specifying a version that doesn't exist in the metadata wrt [#1339](https://github.com/haskell/ghcup-hs/issues/1339)+ ## 0.2.3.0 -- 2026-05-22  * [fix bug](https://github.com/haskell/ghcup-hs/pull/1338) when passing `--install-targets` causes failure

@@ -114,6 +114,7 @@      in KeyBindings {            bUp = fromMaybe bUp kUp          , bDown = fromMaybe bDown kDown+         , bHelp = fromMaybe bHelp kHelp          , bQuit = fromMaybe bQuit kQuit          , bLeft = fromMaybe bLeft kLeft          , bRight = fromMaybe bRight kRight

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               ghcup-version:            0.2.3.0+version:            0.2.5.0 license:            LGPL-3.0-only license-file:       LICENSE copyright:          Julian Ospald 2024

@@ -187,6 +187,7 @@        Just $ UserKeyBindings {            kUp = kUp kbl <|> kUp kbr          , kDown = kDown kbl <|> kDown kbr+         , kHelp = kHelp kbl <|> kHelp kbr          , kQuit = kQuit kbl <|> kQuit kbr          , kLeft = kLeft kbl <|> kLeft kbr          , kRight = kRight kbl <|> kRight kbr

@@ -39,6 +39,7 @@ import Control.Monad.Trans.Resource import Data.Functor import Data.Maybe+import Data.Either import Data.Variant.Excepts import Options.Applicative             hiding ( style ) import Options.Applicative.Pretty.Shim ( text )@@ -392,12 +393,12 @@                "...waiting for 5 seconds, you can still abort..."              liftIO $ threadDelay 5000000 -- give the user a sec to intervene            liftE $ runBothE' (do-                     (rev, _) <- liftE $ getDownloadInfoE' instTool (TargetVersionReq tver Nothing)+                     rev <- fmap (fmap fst . veitherToEither) $ runE $ getDownloadInfoE' instTool (TargetVersionReq tver Nothing)                      installBindist                        instTool                        Nothing                        (DownloadInfo ((decUTF8Safe . serializeURIRef') uri) regexDir "" Nothing Nothing Nothing (toInstallationInputSpec <$> defaultToolInstallSpec instTool pfreq tver))-                       (TargetVersionRev tver rev)+                       (TargetVersionRev tver (fromRight 0 rev))                        (maybe GHCupInternal IsolateDir isolateDir)                        forceInstall                        addConfArgs

@@ -175,16 +175,16 @@           | otherwise       = Pretty.color    let-    printTag Recommended        = color Green "recommended"-    printTag Latest             = color Yellow "latest"-    printTag Prerelease         = color Red "prerelease"-    printTag Nightly            = color Red "nightly"-    printTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')-    printTag (UnknownTag t    ) = t-    printTag LatestPrerelease   = color Red "latest-prerelease"-    printTag LatestNightly      = color Red "latest-nightly"-    printTag Experimental       = color Red "experimental"-    printTag Old                = ""+    printTag t@Recommended        = color Green $ tagToString t+    printTag t@Latest             = color Yellow $ tagToString t+    printTag t@Prerelease         = color Red $ tagToString t+    printTag t@Nightly            = color Red $ tagToString t+    printTag t@LatestPrerelease   = color Red $ tagToString t+    printTag t@LatestNightly      = color Red $ tagToString t+    printTag t@Experimental       = color Red $ tagToString t+    printTag Old                  = ""+    printTag (GHCCompat _)        = ""+    printTag t                    = tagToString t    let     rows =@@ -228,6 +228,7 @@                           then [color Red "no-bindist"]                           else mempty                         )+                     ++ (tagToString <$> filter isCompat lTag)                      ]             )         $ M.toList lr

@@ -739,11 +739,11 @@        if _showAllVersions then "Don't show all versions" else "Show all versions"     , hideShowHandler' (not . _showAllVersions)     )-  , (KeyCombination (Vty.KChar 'h') [], Just $ const "help", mode .= KeyInfo)+  , (bHelp, Just $ const "help", mode .= KeyInfo)   , (KeyCombination Vty.KEnter [], Just $ const "Show tool details", mode .= Common.ToolInfo )-  , (KeyCombination KLeft [], Nothing, versionFocus .= False)-  , (KeyCombination KRight [], Nothing, versionFocus .= True)-  , (KeyCombination (Vty.KChar '\t') [], Nothing, versionFocus %= not)+  , (bLeft, Nothing, versionFocus .= False)+  , (bRight, Nothing, versionFocus .= True)+  , (bTab, Nothing, versionFocus %= not)   ]  keyHandlersVersionList :: KeyBindings@@ -763,11 +763,11 @@        if _showAllVersions then "Don't show all versions" else "Show all versions"     , hideShowHandler' (not . _showAllVersions)     )-  , (KeyCombination (Vty.KChar 'h') [], Just $ const "Help", mode .= KeyInfo)+  , (bHelp, Just $ const "Help", mode .= KeyInfo)   , (KeyCombination Vty.KEnter [], Just $ const "Advanced options", createMenuforTool )-  , (KeyCombination KLeft [], Nothing, versionFocus .= False)-  , (KeyCombination KRight [], Nothing, versionFocus .= True)-  , (KeyCombination (Vty.KChar '\t') [], Nothing, versionFocus %= not)+  , (bLeft, Nothing, versionFocus .= False)+  , (bRight, Nothing, versionFocus .= True)+  , (bTab, Nothing, versionFocus %= not)   ]  where   createMenuforTool = do

@@ -152,12 +152,12 @@       | _versionFocus -> do           case find (\(key', _, _) -> key' == KeyCombination key mods) (Actions.keyHandlersVersionList kb) of             Just (_, _, handler) -> handler-            Nothing -> void $ Common.zoom appState $ Navigation.handler _versionFocus inner_event+            Nothing -> void $ Common.zoom appState $ Navigation.handler _versionFocus kb inner_event       | otherwise -> do           case find (\(key', _, _) -> key' == KeyCombination key mods) (Actions.keyHandlersToolList kb) of             Just (_, _, handler) -> handler-            Nothing -> void $ Common.zoom appState $ Navigation.handler _versionFocus inner_event-    inner_event -> Common.zoom appState $ Navigation.handler _versionFocus inner_event+            Nothing -> void $ Common.zoom appState $ Navigation.handler _versionFocus kb inner_event+    inner_event -> Common.zoom appState $ Navigation.handler _versionFocus kb inner_event  contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState () contextMenuHandler ev = do

@@ -185,9 +185,12 @@   showKey :: Vty.Key -> String+showKey (Vty.KChar '\t') = "TAB" showKey (Vty.KChar c) = [c] showKey Vty.KUp = "↑" showKey Vty.KDown = "↓"+showKey Vty.KLeft = "←"+showKey Vty.KRight = "→" showKey key = tail (show key)  showMod :: Vty.Modifier -> String

@@ -44,7 +44,11 @@             ],             Brick.hBox [               Brick.txt "Press "-            , Brick.txt "← and → or TAB"+            , Common.keyToWidget bLeft+            , Brick.txt " and "+            , Common.keyToWidget bRight+            , Brick.txt " or "+            , Common.keyToWidget bTab             , Brick.txtWrap " to switch between tool and version list"             ]           , Brick.hBox [

@@ -17,7 +17,10 @@       Tool(..),       Tag(..),       tVerToText,-      tagToString, ToolDescription )+      tagToString, ToolDescription,+      isCompat,+      KeyBindings(..),+      KeyCombination(..)) import qualified GHCup.Brick.Common as Common import qualified GHCup.Brick.Attributes as Attributes import Brick@@ -35,7 +38,7 @@ import qualified Brick.Widgets.List as L import           Data.List ( intercalate, sort ) import           Data.Maybe ( mapMaybe )-import           Data.Versions ( prettyPVP, prettyVer )+import           Data.Versions ( prettyVer ) import           Prelude                 hiding ( appendFile ) import qualified Data.Text                     as T import qualified Data.Vector                   as V@@ -48,9 +51,14 @@ type BrickInternalState = BrickList (Tool, (Maybe ToolDescription, BrickList ListResult))  -- | How the navigation handler handle events-handler :: Bool -> BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()-handler False (Brick.VtyEvent e) = L.handleListEvent e-handler True (Brick.VtyEvent e) = do+handler :: Bool -> KeyBindings -> BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()+handler False KeyBindings{..} (Brick.VtyEvent e) = handleToolEvent e+ where+  handleToolEvent (Vty.EvKey key mod')+    | KeyCombination key mod' == bUp   = L.handleListEvent (Vty.EvKey Vty.KUp [])+    | KeyCombination key mod' == bDown = L.handleListEvent (Vty.EvKey Vty.KDown [])+  handleToolEvent e' = L.handleListEvent e'+handler True KeyBindings{..} (Brick.VtyEvent e) = do   bis :: BrickInternalState <- get   case L.listSelectedElement bis of     Nothing -> pure ()@@ -59,14 +67,17 @@       modify (L.listModify $ (fmap . fmap) (const updatedVlr))  where   -- need to reverse because we reversed the list+  handleVersionEvent (Vty.EvKey key mod')+    | KeyCombination key mod' == bUp   = L.handleListEvent (Vty.EvKey Vty.KDown [])+    | KeyCombination key mod' == bDown = L.handleListEvent (Vty.EvKey Vty.KUp [])   handleVersionEvent (Vty.EvKey Vty.KUp [])   = L.handleListEvent (Vty.EvKey Vty.KDown [])   handleVersionEvent (Vty.EvKey Vty.KDown []) = L.handleListEvent (Vty.EvKey Vty.KUp [])-  handleVersionEvent (Vty.EvKey Vty.KPageDown [])   = L.handleListEvent (Vty.EvKey Vty.KPageUp [])+  handleVersionEvent (Vty.EvKey Vty.KPageDown []) = L.handleListEvent (Vty.EvKey Vty.KPageUp [])   handleVersionEvent (Vty.EvKey Vty.KPageUp [])   = L.handleListEvent (Vty.EvKey Vty.KPageDown [])-  handleVersionEvent (Vty.EvKey Vty.KHome [])   = L.handleListEvent (Vty.EvKey Vty.KEnd [])-  handleVersionEvent (Vty.EvKey Vty.KEnd [])   = L.handleListEvent (Vty.EvKey Vty.KHome [])+  handleVersionEvent (Vty.EvKey Vty.KHome [])     = L.handleListEvent (Vty.EvKey Vty.KEnd [])+  handleVersionEvent (Vty.EvKey Vty.KEnd [])      = L.handleListEvent (Vty.EvKey Vty.KHome [])   handleVersionEvent e' = L.handleListEvent e'-handler _ _ = pure ()+handler _ _ _ = pure ()   -- | How to draw the navigation widget@@ -82,7 +93,7 @@   allElements = L.listElements bis   minToolSize = V.maximum $ V.map (length . prettyShow . fst) allElements   selectedTool = fmap snd $ L.listSelectedElement bis-  minTagSize = maybe 0 (\(t, (_, vlr)) -> V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) $ L.listElements vlr) selectedTool+  minTagSize = maybe 0 (\(t, (_, vlr)) -> V.maximum $ V.map (length . intercalate "," . fmap tagToString . filter (not . isCompat) .  lTag) $ L.listElements vlr) selectedTool   minVerSizeList = maybe 0 (\(t, (_, vlr)) ->  V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (TargetVersion lCross lVer)) $ L.listElements vlr) selectedTool   minVerHeaderSize = length $ maybe "Versions" (\(fst -> t) -> prettyShow t <> " versions") selectedTool   minVerSize = max minVerSizeList minVerHeaderSize@@ -153,16 +164,16 @@           <+> Brick.vLimit 1 (Brick.fill ' ')           ) -  printTag Recommended    = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"-  printTag Latest         = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"-  printTag Prerelease     = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"-  printTag Nightly        = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"-  printTag (Base pvp'')   = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp''))-  printTag Old            = Nothing+  printTag Recommended      = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"+  printTag Latest           = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"+  printTag Prerelease       = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"+  printTag Nightly          = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"   printTag LatestPrerelease = Just $ Brick.withAttr Attributes.latestPrereleaseAttr $ Brick.str "latest-prerelease"   printTag LatestNightly    = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "latest-nightly"   printTag Experimental     = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "experimental"-  printTag (UnknownTag t) = Just $ Brick.str t+  printTag (GHCCompat _)    = Nothing+  printTag Old              = Nothing+  printTag t                = Just $ Brick.str $ tagToString t    printTool (Tool "cabal") = Brick.str "cabal"   printTool (Tool "ghc") = Brick.str "GHC"@@ -178,4 +189,5 @@       ++ (case lReleaseDay of             Nothing -> mempty             Just d  -> [Brick.withAttr Attributes.dayAttr $ Brick.str (show d)])+      ++ (Brick.str . tagToString <$> filter isCompat lTag) 

@@ -66,14 +66,15 @@                )             => Tool             -> TargetVersion-            -> Excepts '[NotInstalled, ParseError, NoInstallInfo] m FilePath+            -> Excepts '[NotInstalled] m FilePath whereIsTool tool ver@TargetVersion {..} = do   dirs <- lift getDirs-  sSpec <- lift $ getSymlinkSpecPortable tool ver   toolDir <- fromGHCupPath <$> lift (toolInstallDestination tool ver) +  sSpec <- runE $ getSymlinkSpec tool ver+   case sSpec of-    (SymlinkSpec{..}:_) ->+    (VRight (SymlinkSpec{..}:_)) ->       pure $ toolDir </> _slTarget     _ ->       case tool of@@ -102,6 +103,5 @@         Tool "ghcup" -> do           currentRunningExecPath <- liftIO getExecutablePath           liftIO $ canonicalizePath currentRunningExecPath-        -- TODO-        _ -> pure ""+        _ -> throwE (NotInstalled tool ver) 

@@ -436,6 +436,8 @@   eBase _ = 130   eDesc _ = "The required tool is not installed" +instance Exception NotInstalled+ data UninstallFailed = UninstallFailed FilePath [FilePath]   deriving (Show) 

@@ -46,8 +46,8 @@ import Safe import System.FilePath import URI.ByteString       hiding ( parseURI )-import Text.PrettyPrint.HughesPJClass (prettyShow) +import qualified Data.Set                   as Set import qualified Data.Attoparsec.ByteString as AP import qualified Data.ByteString.UTF8       as UTF8 import qualified Data.Text                  as T@@ -109,11 +109,6 @@   | SetNext   deriving (Eq, Show) -prettyToolVer :: ToolVersion -> String-prettyToolVer (GHCVersion v')  = prettyShow v'-prettyToolVer (ToolVersion v') = prettyShow v'-prettyToolVer (ToolTag t)      = show t-prettyToolVer (ToolDay day)    = show day  toSetToolVer :: Maybe ToolVersion -> SetToolVersion toSetToolVer (Just (GHCVersion v'))  = SetGHCVersion v'@@ -215,15 +210,25 @@   second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither' s')  tagEither :: String -> Either String Tag-tagEither s' = case fmap toLower s' of-  "recommended"              -> Right Recommended-  "latest"                   -> Right Latest-  "latest-prerelease"        -> Right LatestPrerelease-  "latest-nightly"           -> Right LatestNightly-  ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of-                                  Right x -> Right (Base x)-                                  Left  _ -> Left $ "Invalid PVP version for base " <> ver'-  other                      -> Left $ "Unknown tag " <> other+tagEither s' = case ls of+  "recommended"       -> Right Recommended+  "latest"            -> Right Latest+  "latest-prerelease" -> Right LatestPrerelease+  "latest-nightly"    -> Right LatestNightly+  _ -> case s' of+         ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of+                                         Right x -> Right (Base x)+                                         Left  _ -> Left $ "Invalid PVP version for base " <> ver'+         ('G':'H':'C':':':xs) -> do+                                   vers <- forM (splitOn "," xs)+                                     $ \ver' -> either (\_ -> Left $ "Invalid PVP version for GHC " <> ver') pure (pvp . T.pack $ ver')+                                   pure $ GHCCompat vers+         ('g':'h':'c':'-':ver') -> case pvp (T.pack ver') of+                                         Right x -> Right (GHCCompat [x])+                                         Left  _ -> Left $ "Invalid PVP version for GHC " <> ver'+         other                      -> Left $ "Unknown tag " <> other+ where+  ls = fmap toLower s'   ghcVersionEither :: String -> Either String TargetVersion@@ -399,10 +404,33 @@ resolveVersion' (SetToolTag Recommended) _ tool = do   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo   fmap (`TargetVersionReq` Nothing) $ getRecommended dls tool ?? TagNotFound Recommended tool-resolveVersion' (SetToolTag (Base pvp'')) _ t+resolveVersion' (SetToolTag tag@(Base _)) _ t   | t == ghc = do       GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo-      fmap (`TargetVersionReq` Nothing) $ getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') ghc+      fmap (`TargetVersionReq` Nothing)+        $ getLatestTagF+            (\tags -> Prerelease `notElem` tags+                    && LatestPrerelease `notElem` tags+                    && tag `elem` tags+            )+            dls ghc Nothing ?? TagNotFound tag hls+resolveVersion' (SetToolTag (GHCCompat ghcs)) _ t+  | t == hls = do+      GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo+      fmap (`TargetVersionReq` Nothing)+        $ getLatestTagF+            (\tags ->+              if | Prerelease `elem` tags -> False+                 | LatestPrerelease `elem` tags -> False+                 | otherwise -> any+                     (\case+                       GHCCompat (Set.fromList -> ghcs') -> Set.fromList ghcs `Set.isSubsetOf` ghcs'+                       _ -> False+                     )+                     tags+            )+            dls hls Nothing ?? TagNotFound (GHCCompat ghcs) hls+ resolveVersion' SetNext _ tool = do   set <- liftE $ getSetVersion tool Nothing !!? NoToolVersionSet tool Nothing -- TODO   vers <- lift $ getInstalledVersions tool Nothing

@@ -5,7 +5,7 @@ module GHCup.Query.DB.HLS where  import GHCup.Legacy.Utils-import GHCup.Prelude+import GHCup.Prelude (isWindows) import GHCup.Query.DB import GHCup.Types import GHCup.Types.Optics@@ -15,7 +15,6 @@ import Data.Maybe           ( catMaybes ) import Data.Variant.Excepts ( pattern VLeft, pattern VRight, runE ) import Data.Versions        ( Version, version )-import Safe                 ( headMay )  import qualified Data.Text as T @@ -33,13 +32,27 @@   vspec <- runE $ getSymlinkSpec hls (mkTVer hlsVer)   case vspec of     VRight (fmap (\SymlinkSpec{..} -> _slLinkName) -> bins) -> do-      let extractGHCVerFromBinary bin = do-            prefix <- headMay $ splitOn "~" bin+      let extractGHCVerFromBinary (stripExe -> bin) = do+            prefix <- splitIt '~' bin             s <- stripPrefix "haskell-language-server-" prefix-            either (const Nothing) pure . version . T.pack $ s+            -- stripExe here because we might have a binary of the form+            -- haskell-language-server-9.12.2.exe~2.14.0.0+            either (const Nothing) pure . version . T.pack . stripExe $ s           ghcs = catMaybes $ extractGHCVerFromBinary <$> bins       pure ghcs     -- legacy     VLeft _ -> do       hlsGHCVersions' hlsVer+ where+  splitIt ch = go []+   where+    go prefix (x:xs)+      | x == ch = Just prefix+      | otherwise = go (prefix <> [x]) xs+    go _ [] = Nothing +  stripExe f+    | isWindows = case reverse f of+                    ('e':'x':'e':'.':r) -> reverse r+                    _ -> f+    | otherwise = f

@@ -236,19 +236,37 @@ getTaggedL' :: Tag             -> Lens' a [Tag]             -> Fold (Map.Map TargetVersion a) (TargetVersion, a)-getTaggedL' tag getTags =-  to (Map.toDescList . Map.filter (\a -> tag `elem` fromMaybe [] (preview getTags a)))-  % folding id+getTaggedL' tag = getTaggedFL' (tag `elem`)  getTaggedL :: Tag            -> Fold ToolVersionSpec (TargetVersion, VersionMetadata)-getTaggedL tag = _ToolVersionSpec % getTaggedL' tag vmTags+getTaggedL tag = getTaggedFL (tag `elem`) -getFirstTag :: Tag -> GHCupDownloads -> Tool -> Maybe TargetVersion-getFirstTag tag av tool = do-  (tv, _) <- headOf (_GHCupDownloads % ix tool % toolVersions % getTaggedL tag) av-  pure tv+getFirstTag :: Tag -> GHCupDownloads -> Tool -> Maybe Text -> Maybe TargetVersion+getFirstTag tag = getFirstTagF (tag `elem`) +getLatestTag :: Tag -> GHCupDownloads -> Tool -> Maybe Text -> Maybe TargetVersion+getLatestTag tag = getLatestTagF (tag `elem`)++getTaggedFL' :: ([Tag] -> Bool)+             -> Lens' a [Tag]+             -> Fold (Map.Map TargetVersion a) (TargetVersion, a)+getTaggedFL' tagF getTags =+  to (Map.toDescList . Map.filter (\a -> tagF $ fromMaybe [] (preview getTags a)))+  % folding id++getTaggedFL :: ([Tag] -> Bool)+            -> Fold ToolVersionSpec (TargetVersion, VersionMetadata)+getTaggedFL tagF = _ToolVersionSpec % getTaggedFL' tagF vmTags++getFirstTagF :: ([Tag] -> Bool) -> GHCupDownloads -> Tool -> Maybe Text -> Maybe TargetVersion+getFirstTagF tagF av tool target = do+  headOf (_GHCupDownloads % ix tool % toolVersions % getTaggedFL tagF % _1 % filtered (\TargetVersion{..} -> _tvTarget == target)) av++getLatestTagF :: ([Tag] -> Bool) -> GHCupDownloads -> Tool -> Maybe Text -> Maybe TargetVersion+getLatestTagF tagF av tool target = do+  maximumOf (_GHCupDownloads % ix tool % toolVersions % getTaggedFL tagF % _1 % filtered (\TargetVersion{..} -> _tvTarget == target)) av+ getRev :: GHCupDownloads -> Tool -> TargetVersion -> Maybe Int -> Maybe (VersionMetadata, Int, VersionInfo) getRev av tool tv mRev = do   vm <- preview (_GHCupDownloads % ix tool % toolVersionsL % ix tv) av@@ -273,20 +291,20 @@ getByReleaseDayFold day = to (fmap fst . Map.toDescList . Map.filter (\VersionMetadata {..} -> Just day == _vmReleaseDay)) % folding id  getLatest :: GHCupDownloads -> Tool -> Maybe TargetVersion-getLatest = getFirstTag Latest+getLatest dls tool = getFirstTag Latest dls tool Nothing  getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe TargetVersion-getLatestPrerelease = getFirstTag LatestPrerelease+getLatestPrerelease dls tool = getFirstTag LatestPrerelease dls tool Nothing  getLatestNightly :: GHCupDownloads -> Tool -> Maybe TargetVersion-getLatestNightly = getFirstTag LatestNightly+getLatestNightly dls tool = getFirstTag LatestNightly dls tool Nothing  getRecommended :: GHCupDownloads -> Tool -> Maybe TargetVersion-getRecommended = getFirstTag Recommended+getRecommended dls tool = getFirstTag Recommended dls tool Nothing  -- | Gets the latest GHC with a given base version. getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe TargetVersion-getLatestBaseVersion g pvpVer = getFirstTag (Base pvpVer) g ghc+getLatestBaseVersion g pvpVer = getFirstTag (Base pvpVer) g ghc Nothing   getVersionMetadata :: TargetVersion

@@ -42,6 +42,7 @@ #if defined(DHALL) import Dhall ( FromDhall, ToDhall ) #endif+import Data.List                      ( intercalate ) import Data.List.NonEmpty             ( NonEmpty (..) ) import Data.Map.Strict                ( Map ) import Data.Text                      ( Text )@@ -61,6 +62,7 @@ import qualified GHC.Generics          as GHC import           System.FilePath       ( takeFileName, (<.>) ) import qualified System.FilePath.Posix as Posix+import Data.Functor ((<&>))       -------------------------@@ -321,12 +323,17 @@   --   (a version should either be 'Nightly' or   --   'LatestNightly', but not both)   | LatestNightly -- ^ the latest nightly (unique per tool)-  | Base PVP -- ^ the base version shipped with GHC+  | Base { base :: PVP } -- ^ the base version shipped with GHC   | Old -- ^ old versions are hidden by default in TUI   | Experimental -- ^ an experimental version/bindist-  | UnknownTag String -- ^ used for upwardscompat+  | GHCCompat { ghcCompat :: [PVP] }+  | UnknownTag { unknownTag :: String } -- ^ used for upwardscompat   deriving (Eq, GHC.Generic, Ord, Show) +isCompat :: Tag -> Bool+isCompat (GHCCompat _) = True+isCompat _ = False+ instance NFData Tag  tagToString :: Tag -> String@@ -335,6 +342,7 @@ tagToString Prerelease         = "prerelease" tagToString Nightly            = "nightly" tagToString (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')+tagToString (GHCCompat  ghcs)  = "GHC:[" <> intercalate "|" (ghcs <&> \ghc' -> T.unpack $ prettyPVP ghc') <> "]" tagToString (UnknownTag t    ) = t tagToString LatestPrerelease   = "latest-prerelease" tagToString LatestNightly      = "latest-nightly"@@ -347,6 +355,7 @@   pPrint Prerelease         = text "prerelease"   pPrint Nightly            = text "nightly"   pPrint (Base       pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))+  pPrint (GHCCompat  ghcs)  = text $ "GHC:[" <> intercalate "|" (ghcs <&> \ghc' -> T.unpack $ prettyPVP ghc') <> "]"   pPrint (UnknownTag t    ) = text t   pPrint LatestPrerelease   = text "latest-prerelease"   pPrint LatestNightly      = text "latest-prerelease"@@ -883,6 +892,7 @@             , kLeft         = Just bLeft             , kRight        = Just bRight             , kTab          = Just bTab+            , kHelp         = Just bHelp             , kQuit         = Just bQuit             , kInstall      = Just bInstall             , kUninstall    = Just bUninstall@@ -916,6 +926,7 @@   , kLeft :: Maybe KeyCombination   , kRight :: Maybe KeyCombination   , kTab :: Maybe KeyCombination+  , kHelp :: Maybe KeyCombination   , kQuit :: Maybe KeyCombination   , kInstall :: Maybe KeyCombination   , kUninstall :: Maybe KeyCombination@@ -931,6 +942,7 @@   , bLeft :: KeyCombination   , bRight :: KeyCombination   , bTab :: KeyCombination+  , bHelp :: KeyCombination   , bQuit :: KeyCombination   , bInstall :: KeyCombination   , bUninstall :: KeyCombination@@ -956,6 +968,7 @@   , bLeft            = KeyCombination { key = KLeft      , mods = [] }   , bRight           = KeyCombination { key = KRight     , mods = [] }   , bTab             = KeyCombination { key = KChar '\t' , mods = [] }+  , bHelp            = KeyCombination { key = KChar 'h'  , mods = [] }   , bQuit            = KeyCombination { key = KChar 'q'  , mods = [] }   , bInstall         = KeyCombination { key = KChar 'i'  , mods = [] }   , bUninstall       = KeyCombination { key = KChar 'u'  , mods = [] }

@@ -46,7 +46,7 @@ import           GHCup.Types.Stack     () -import           Data.Versions            ( PVP, Version, pvp', version', prettyPVP, prettyVer, pvp )+import           Data.Versions            ( PVP, Version, pvp', version', prettyPVP, prettyVer ) import           Data.Void                ( Void ) import           GHCup.Prelude.MegaParsec ( ghcTargetVerP, versionRangeP ) import qualified Text.Megaparsec          as MP@@ -66,9 +66,6 @@ import           GHCup.Input.Parsers.URI ( parseURI' ) import           URI.ByteString          ( URI, serializeURIRef' ) import Text.PrettyPrint.HughesPJClass (prettyShow)-import Text.Read (readMaybe)-import qualified Data.Map.Strict as M-import qualified Dhall.Map   pattern DhallString :: T.Text -> Expr s a@@ -93,7 +90,7 @@ instance ToDhall Architecture where   injectWith = genericToDhallWithInputNormalizer defaultInterpretOptions -instance {-# OVERLAPPING #-} FromDhall Platform where+instance FromDhall Platform where   autoWith _ =     Dhall.string       { extract = extractParser' parsePlatform@@ -199,38 +196,10 @@   first (DhallErrors . NE.singleton . ExtractError . T.pack . show) . parse . T.pack $ t  instance FromDhall Tag where-  autoWith _ = Dhall.string-    { extract = \case-        DhallString "Latest"                             -> pure Latest-        DhallString "Recommended"                        -> pure Recommended-        DhallString "Prerelease"                         -> pure Prerelease-        DhallString "Nightly"                            -> pure Nightly-        DhallString "LatestPrerelease"                   -> pure LatestPrerelease-        DhallString "LatestNightly"                      -> pure LatestNightly-        DhallString "Experimental"                       -> pure Experimental-        DhallString "old"                                -> pure Old-        e@(DhallString (T.unpack -> 'b' : 'a' : 's' : 'e' : '-' : ver')) -> case pvp (T.pack ver') of-          Right x -> pure $ Base x-          Left  _ -> Dhall.typeError (Dhall.expected Dhall.string) e-        DhallString x -> pure (UnknownTag $ T.unpack x)-        e -> Dhall.typeError (Dhall.expected Dhall.string) e-    }+  autoWith _ = genericAutoWith defaultInterpretOptions  instance ToDhall Tag where-  injectWith _ = Dhall.Encoder-    { embed = \case-        Latest             -> DhallString "Latest"-        Recommended        -> DhallString "Recommended"-        Prerelease         -> DhallString "Prerelease"-        Nightly            -> DhallString "Nightly"-        Old                -> DhallString "old"-        (Base       pvp'') -> DhallString ("base-" <> prettyPVP pvp'')-        LatestPrerelease   -> DhallString "LatestPrerelease"-        LatestNightly      -> DhallString "LatestNightly"-        Experimental       -> DhallString "Experimental"-        (UnknownTag x    ) -> DhallString (T.pack x)-    , declared = Dhall.Core.Text-    }+  injectWith = genericToDhallWithInputNormalizer defaultInterpretOptions  instance FromDhall URI where   autoWith _ =

@@ -34,6 +34,7 @@ import GHCup.Types.Stack                     ( SetupInfo )  import Control.Applicative ( (<|>) )+import Control.Exception (displayException) import Control.Monad import Data.Aeson          hiding ( Key ) import Data.Aeson.TH@@ -47,14 +48,15 @@ import System.FilePath     ( hasDrive, isAbsolute, splitPath ) import Text.Casing import URI.ByteString      hiding ( parseURI )+import Data.Functor.Contravariant (Contravariant(contramap)) +import qualified Data.Yaml.Aeson  as Y import qualified Data.Map.Strict          as M import qualified Data.List.NonEmpty       as NE import qualified Data.Text                as T import qualified Data.Text.Encoding.Error as E import qualified Text.Megaparsec          as MP import qualified Text.Megaparsec.Char.Lexer as L-import Data.Functor.Contravariant (Contravariant(contramap))  safePath :: FilePath -> Bool safePath fp@@ -194,27 +196,52 @@   toJSON Recommended        = String "Recommended"   toJSON Prerelease         = String "Prerelease"   toJSON Nightly            = String "Nightly"-  toJSON Old                = String "old"+  toJSON Old                = String "Old"   toJSON (Base       pvp'') = String ("base-" <> prettyPVP pvp'')+  toJSON (GHCCompat  ghcs)  = object ["GHCCompat" .= ghcs]   toJSON LatestPrerelease   = String "LatestPrerelease"   toJSON LatestNightly      = String "LatestNightly"   toJSON Experimental       = String "Experimental"   toJSON (UnknownTag x    ) = String (T.pack x)  instance FromJSON Tag where-  parseJSON = withText "Tag" $ \t -> case T.unpack t of-    "Latest"                             -> pure Latest-    "Recommended"                        -> pure Recommended-    "Prerelease"                         -> pure Prerelease-    "Nightly"                            -> pure Nightly-    "LatestPrerelease"                   -> pure LatestPrerelease-    "LatestNightly"                      -> pure LatestNightly-    "Experimental"                       -> pure Experimental-    "old"                                -> pure Old-    ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of-      Right x -> pure $ Base x-      Left  e -> fail . show $ e-    x -> pure (UnknownTag x)+  parseJSON v = textParser v <|> objectParser v <|> generic v <|> pure (UnknownTag "??")+   where+    textParser = withText "Tag" $ \t -> case T.unpack t of+      "Latest"                             -> pure Latest+      "Recommended"                        -> pure Recommended+      "Prerelease"                         -> pure Prerelease+      "Nightly"                            -> pure Nightly+      "LatestPrerelease"                   -> pure LatestPrerelease+      "LatestNightly"                      -> pure LatestNightly+      "Experimental"                       -> pure Experimental+      "old"                                -> pure Old+      "Old"                                -> pure Old+      ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of+        Right x -> pure $ Base x+        Left  e -> fail . show $ e+      x -> do+        case Y.decodeEither' @Value (E.encodeUtf8 $ T.pack x) of+          Right val -> objectParser val <|> pure (UnknownTag x)+          Left _ -> pure (UnknownTag x)+    objectParser = withObject "Tag" $ \o ->+      (do+         ghcs <- o .:: ["GHCCompat", "ghcCompat"]+         pure $ GHCCompat ghcs+      )+      <|>+      (do+         base <- o .:: ["Base", "base"]+         case pvp base of+           Right v' -> pure $ Base v'+           Left e -> fail (displayException e)+      )+      <|>+      (do+         tag <- o .:: ["UnknownTag", "unknownTag"]+         pure $ UnknownTag tag+      )+    generic = genericParseJSON defaultOptions { unwrapUnaryRecords = True }  instance ToJSON Tool where   toJSON (Tool t) = String (T.toLower . T.pack $ t)

@@ -41,7 +41,7 @@  plat="$(uname -s)" arch=$(uname -m)-ghver="0.2.3.0"+ghver="0.2.5.0" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"  export GHCUP_SKIP_UPDATE_CHECK=yes@@ -448,7 +448,6 @@             die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"             ;;     esac-    eghcup upgrade }  # Figures out the users login shell and sets

@@ -40,6 +40,7 @@   roundtripSpecs (Proxy @InstallationSpecInput)   roundtripSpecs (Proxy @Tool)   roundtripSpecs (Proxy @TargetVersion)+  roundtripSpecs (Proxy @Tag)   roundtripSpecs (Proxy @VersionInfo)   roundtripSpecs (Proxy @Architecture)   roundtripSpecs (Proxy @Platform)