Implement 'latest-prerelease' tag wrt #788
This commit is contained in:
parent
75e801e9e6
commit
785fb895b4
GPG Key ID:
3786C5262ECB4A3F
@ -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)
|
||||
|
||||
@ -248,6 +248,7 @@ tagEither :: String -> Either String Tag
|
||||
tagEither s' = case fmap toLower s' of
|
||||
"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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user