From 785fb895b4cc7e2612a8fe9ee42d2c9275f7947d Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 21 Feb 2023 22:22:11 +0800 Subject: [PATCH] Implement 'latest-prerelease' tag wrt #788 --- app/ghcup/BrickMain.hs | 16 +++++++++++----- app/ghcup/GHCup/OptParse/Common.hs | 10 +++++++--- app/ghcup/GHCup/OptParse/List.hs | 1 + lib/GHCup/Types.hs | 3 +++ lib/GHCup/Types/JSON.hs | 2 ++ lib/GHCup/Utils.hs | 3 +++ 6 files changed, 27 insertions(+), 8 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 2f97fdd..b23350e 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} module BrickMain where @@ -154,8 +155,11 @@ 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 - renderItem _ b listResult@ListResult{..} = + renderList' bis@BrickInternalState{..} = + let getMinLength = length . intercalate "," . fmap tagToString + minLength = V.maximum $ V.map (getMinLength . lTag) clr + in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis + renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} = let marks = if | lSet -> (withAttr (attrName "set") $ str "✔✔") | lInstalled -> (withAttr (attrName "installed") $ str "✓ ") @@ -170,7 +174,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..} = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist") | otherwise = id hooray - | elem Latest lTag && not lInstalled = + | elem Latest lTag' && not lInstalled = withAttr (attrName "hooray") | otherwise = id active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id @@ -181,8 +185,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..} (printTool lTool) ) <+> minHSize 15 (str ver) - <+> (let l = catMaybes . fmap printTag $ sort lTag - in padLeft (Pad 1) $ minHSize 25 $ if null l + <+> (let l = catMaybes . fmap printTag $ sort lTag' + in padLeft (Pad 1) $ minHSize minTagSize $ if null l then emptyWidget else foldr1 (\x y -> x <+> str "," <+> y) l ) @@ -200,6 +204,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..} printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease" printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag Old = Nothing + printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease" printTag (UnknownTag t) = Just $ str t printTool Cabal = str "cabal" @@ -274,6 +279,7 @@ defaultAttributes no_color = attrMap , (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green) , (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green) , (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow) + , (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue) diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index e035cc5..4d0e5f3 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -246,8 +246,9 @@ toolVersionTagEither s' = tagEither :: String -> Either String Tag tagEither s' = case fmap toLower s' of - "recommended" -> Right Recommended - "latest" -> Right Latest + "recommended" -> Right Recommended + "latest" -> Right Latest + "latest-prerelease" -> Right LatestPrerelease ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of Right x -> Right (Base x) Left _ -> Left $ "Invalid PVP version for base " <> ver' @@ -452,7 +453,7 @@ tagCompleter tool add = listIOCompleter $ do let allTags = filter (/= Old) $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool) pure $ nub $ (add ++) $ fmap tagToString allTags - VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add) + VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add) versionCompleter :: Maybe ListCriteria -> Tool -> Completer versionCompleter criteria tool = versionCompleter' criteria tool (const True) @@ -706,6 +707,9 @@ fromVersion' (SetToolVersion v) tool = do fromVersion' (SetToolTag Latest) tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool +fromVersion' (SetToolTag LatestPrerelease) tool = do + GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo + bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool fromVersion' (SetToolTag Recommended) tool = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool diff --git a/app/ghcup/GHCup/OptParse/List.hs b/app/ghcup/GHCup/OptParse/List.hs index 72cd2bb..09f914f 100644 --- a/app/ghcup/GHCup/OptParse/List.hs +++ b/app/ghcup/GHCup/OptParse/List.hs @@ -107,6 +107,7 @@ printListResult no_color raw lr = do printTag Prerelease = color Red "prerelease" printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (UnknownTag t ) = t + printTag LatestPrerelease = color Red "latest-prerelease" printTag Old = "" let diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index bdd58d4..06705a6 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -154,6 +154,7 @@ instance NFData VersionInfo data Tag = Latest | Recommended | Prerelease + | LatestPrerelease | Base PVP | Old -- ^ old versions are hidden by default in TUI | UnknownTag String -- ^ used for upwardscompat @@ -167,6 +168,7 @@ tagToString Latest = "latest" tagToString Prerelease = "prerelease" tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') tagToString (UnknownTag t ) = t +tagToString LatestPrerelease = "latest-prerelease" tagToString Old = "" instance Pretty Tag where @@ -175,6 +177,7 @@ instance Pretty Tag where pPrint Prerelease = text "prerelease" pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp'')) pPrint (UnknownTag t ) = text t + pPrint LatestPrerelease = text "latest-prerelease" pPrint Old = mempty data Architecture = A_64 diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index 9a0f3b3..53b2fc3 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -66,6 +66,7 @@ instance ToJSON Tag where toJSON Prerelease = String "Prerelease" toJSON Old = String "old" toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'') + toJSON LatestPrerelease = String "LatestPrerelease" toJSON (UnknownTag x ) = String (T.pack x) instance FromJSON Tag where @@ -73,6 +74,7 @@ instance FromJSON Tag where "Latest" -> pure Latest "Recommended" -> pure Recommended "Prerelease" -> pure Prerelease + "LatestPrerelease" -> pure LatestPrerelease "old" -> pure Old ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of Right x -> pure $ Base x diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index a940552..37c109c 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -892,6 +892,9 @@ getTagged tag = getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatest av tool = headOf (ix tool % getTagged Latest) av +getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av + getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getRecommended av tool = headOf (ix tool % getTagged Recommended) av