Allow to hide old versions of tools in TUI

This commit is contained in:
Julian Ospald 2020-10-09 22:55:33 +02:00
parent 73d1d97f1f
commit 57c34a07f2
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
6 changed files with 159 additions and 52 deletions

View File

@ -122,6 +122,7 @@ validate dls = do
where where
isUniqueTag Latest = True isUniqueTag Latest = True
isUniqueTag Recommended = True isUniqueTag Recommended = True
isUniqueTag Old = False
isUniqueTag Prerelease = False isUniqueTag Prerelease = False
isUniqueTag (Base _) = False isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False isUniqueTag (UnknownTag _) = False

View File

@ -4,6 +4,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module BrickMain where module BrickMain where
@ -48,31 +49,60 @@ import qualified Data.Vector as V
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
data AppState = AppState { data AppData = AppData {
lr :: LR lr :: LR
, dls :: GHCupDownloads , dls :: GHCupDownloads
, pfreq :: PlatformRequest , pfreq :: PlatformRequest
} } deriving Show
data AppSettings = AppSettings {
showAll :: Bool
} deriving Show
data AppState = AppState {
appData :: AppData
, appSettings :: AppSettings
} deriving Show
type LR = GenericList String Vector ListResult type LR = GenericList String Vector ListResult
keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))] keyHandlers :: [ ( Char
, AppSettings -> String
, AppState -> EventM n (Next AppState)
)
]
keyHandlers = keyHandlers =
[ ('q', "Quit" , halt) [ ('q', const "Quit" , halt)
, ('i', "Install" , withIOAction install') , ('i', const "Install" , withIOAction install')
, ('u', "Uninstall", withIOAction del') , ('u', const "Uninstall", withIOAction del')
, ('s', "Set" , withIOAction set') , ('s', const "Set" , withIOAction set')
, ('c', "ChangeLog", withIOAction changelog') , ('c', const "ChangeLog", withIOAction changelog')
, ( 'a'
, (\AppSettings {..} ->
if showAll then "Hide old versions" else "Show all versions"
)
, (\AppState {..} ->
let newAppSettings =
appSettings { showAll = not . showAll $ appSettings }
in continue (AppState appData newAppSettings)
)
)
] ]
ui :: AppState -> Widget String ui :: AppState -> Widget String
ui AppState {..} = ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
( padBottom Max ( padBottom Max
$ ( withBorderStyle unicode $ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup") $ borderWithLabel (str "GHCup")
$ (center $ (header <=> hBorder <=> renderList renderItem True (L.listReverse lr))) $ ( center
$ (header <=> hBorder <=> renderList
renderItem
True
(L.listReverse lr)
)
)
) )
) )
<=> footer <=> footer
@ -84,7 +114,7 @@ ui AppState {..} =
. T.pack . T.pack
. foldr1 (\x y -> x <> " " <> y) . foldr1 (\x y -> x <> " " <> y)
. (++ ["↑↓:Navigation"]) . (++ ["↑↓:Navigation"])
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers) $ (fmap (\(c, s, _) -> (c : ':' : s as)) keyHandlers)
header = header =
(minHSize 2 $ emptyWidget) (minHSize 2 $ emptyWidget)
<+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool") <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
@ -112,11 +142,11 @@ ui AppState {..} =
) )
) )
<+> (minHSize 15 $ active $ (str ver)) <+> (minHSize 15 $ active $ (str ver))
<+> (padLeft (Pad 1) $ minHSize 25 $ if null lTag <+> (let l = catMaybes . fmap printTag $ sort lTag
then emptyWidget in padLeft (Pad 1) $ minHSize 25 $
else if null l
foldr1 (\x y -> x <+> str "," <+> y) then emptyWidget
$ (fmap printTag $ sort lTag) else foldr1 (\x y -> x <+> str "," <+> y) l
) )
<+> ( padLeft (Pad 5) <+> ( padLeft (Pad 5)
$ let notes = printNotes listResult $ let notes = printNotes listResult
@ -126,11 +156,12 @@ ui AppState {..} =
) )
) )
printTag Recommended = withAttr "recommended" $ str "recommended" printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
printTag Latest = withAttr "latest" $ str "latest" printTag Latest = Just $ withAttr "latest" $ str "latest"
printTag Prerelease = withAttr "prerelease" $ str "prerelease" printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag (UnknownTag t ) = str t printTag Old = Nothing
printTag (UnknownTag t ) = Just $ str t
printNotes ListResult {..} = printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
@ -182,31 +213,64 @@ eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) = eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KUp) _))
continue (AppState (listMoveUp lr) dls pfreq) = continue (AppState (AppData (listMoveUp lr) dls pfreq) appSettings)
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) = eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KDown) _))
continue (AppState (listMoveDown lr) dls pfreq) = continue (AppState (AppData (listMoveDown lr) dls pfreq) appSettings)
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) = eventHandler as@(AppState appD appS) (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
case find (\(c', _, _) -> c' == c) keyHandlers of case find (\(c', _, _) -> c' == c) keyHandlers of
Nothing -> continue as Nothing -> continue as
Just ('a', _, handler) ->
if (not $ showAll appS) -- it's not swapped to `showAll` yet, but it will in the handler
then do
newAppData <- liftIO $ replaceLR (\_ -> True) appD
handler (AppState (selectLatest newAppData) appS)
else do -- hide old versions
newAppData <- liftIO $ replaceLR (filterVisible (not $ showAll appS)) appD
handler (AppState (selectLatest newAppData) appS)
Just (_, _, handler) -> handler as Just (_, _, handler) -> handler as
eventHandler st _ = continue st eventHandler st _ = continue st
replaceLR :: (ListResult -> Bool) -> AppData -> IO AppData
replaceLR filterF (AppData {..}) = do
settings <- liftIO $ readIORef settings'
l <- liftIO $ readIORef logger'
let runLogger = myLoggerT l
lV <- runLogger
. flip runReaderT settings
. fmap (V.fromList . filter filterF)
. listVersions dls Nothing Nothing
$ pfreq
pure $ AppData { lr = L.listReplace lV Nothing $ lr, .. }
filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e
| lInstalled e = True
| showAll = True
| otherwise = not (elem Old (lTag e))
-- | Suspend the current UI and run an IO action in terminal. If the -- | Suspend the current UI and run an IO action in terminal. If the
-- IO action returns a Left value, then it's thrown as userError. -- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a)) withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
-> AppState -> AppState
-> EventM n (Next AppState) -> EventM n (Next AppState)
withIOAction action as = case listSelectedElement (lr as) of withIOAction action as = case listSelectedElement (lr . appData $ as) of
Nothing -> continue as Nothing -> continue as
Just (ix, e) -> suspendAndResume $ do Just (ix, e) -> suspendAndResume $ do
action as (ix, e) >>= \case action as (ix, e) >>= \case
Left err -> putStrLn $ ("Error: " <> err) Left err -> putStrLn $ ("Error: " <> err)
Right _ -> putStrLn "Success" Right _ -> putStrLn "Success"
apps <- (fmap . fmap) apps <-
(\AppState {..} -> AppState { lr = listMoveTo ix lr, .. }) (fmap . fmap)
$ getAppState Nothing (pfreq as) (\AppData {..} -> AppState
{ appData = AppData { lr = listMoveTo ix lr, .. }
, appSettings = (appSettings as)
}
)
$ getAppData Nothing (pfreq . appData $ as)
case apps of case apps of
Right nas -> do Right nas -> do
putStrLn "Press enter to continue" putStrLn "Press enter to continue"
@ -216,7 +280,7 @@ withIOAction action as = case listSelectedElement (lr as) of
install' :: AppState -> (Int, ListResult) -> IO (Either String ()) install' :: AppState -> (Int, ListResult) -> IO (Either String ())
install' AppState {..} (_, ListResult {..}) = do install' AppState { appData = AppData {..}} (_, ListResult {..}) = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
let runLogger = myLoggerT l let runLogger = myLoggerT l
@ -307,7 +371,7 @@ del' _ (_, ListResult {..}) = do
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ()) changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState {..} (_, ListResult {..}) = do changelog' AppState { appData = AppData {..}} (_, ListResult {..}) = do
case getChangeLog dls lTool (Left lVer) of case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left Nothing -> pure $ Left
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|] [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
@ -357,23 +421,30 @@ brickMain s muri l av pfreq' = do
writeIORef logger' l writeIORef logger' l
let runLogger = myLoggerT l let runLogger = myLoggerT l
eApps <- getAppState (Just av) pfreq' eAppData <- getAppData (Just av) pfreq'
case eApps of case eAppData of
Right as -> defaultMain app (selectLatest as) $> () Right ad -> defaultMain app (AppState (selectLatest ad) defaultAppSettings) $> ()
Left e -> do Left e -> do
runLogger ($(logError) [i|Error building app state: #{show e}|]) runLogger ($(logError) [i|Error building app state: #{show e}|])
exitWith $ ExitFailure 2 exitWith $ ExitFailure 2
where
selectLatest :: AppState -> AppState
selectLatest AppState {..} =
(\ix -> AppState { lr = listMoveTo ix lr, .. })
. fromJust
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
$ (listElements lr)
getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState) selectLatest :: AppData -> AppData
getAppState mg pfreq' = do selectLatest (AppData {..}) =
(\ix -> AppData { lr = listMoveTo ix lr, .. } )
. fromJust
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
$ (listElements lr)
defaultAppSettings :: AppSettings
defaultAppSettings = AppSettings {
showAll = False
}
getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do
muri <- readIORef uri' muri <- readIORef uri'
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
@ -384,12 +455,27 @@ getAppState mg pfreq' = do
. flip runReaderT settings . flip runReaderT settings
. runE . runE
@'[JSONError, DownloadFailed, FileDoesNotExistError] @'[JSONError, DownloadFailed, FileDoesNotExistError]
$ do $ fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)
dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
lV <- lift $ listVersions dls Nothing Nothing pfreq'
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq')
case r of case r of
VRight a -> pure $ Right a VRight a -> pure $ Right a
VLeft e -> pure $ Left [i|#{e}|] VLeft e -> pure $ Left [i|#{e}|]
getAppData :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppData)
getAppData mg pfreq' = do
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
r <- maybe getDownloads' (pure . Right) mg
runLogger
. flip runReaderT settings
$ do
case r of
Right dls -> do
lV <- listVersions dls Nothing Nothing pfreq'
pure $ Right $ (AppData (list "Tool versions"
(V.fromList . filter (filterVisible (showAll defaultAppSettings)) $ lV) 1) dls pfreq')
Left e -> pure $ Left [i|#{e}|]

View File

@ -1480,7 +1480,7 @@ printListResult raw lr = do
, case lCross of , case lCross of
Nothing -> T.unpack . prettyVer $ lVer Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer) Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," $ (fmap printTag $ sort lTag) , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
, intercalate "," , intercalate ","
$ (if hlsPowered $ (if hlsPowered
then [color' Green "hls-powered"] then [color' Green "hls-powered"]
@ -1507,6 +1507,7 @@ printListResult raw lr = do
printTag Prerelease = color' Red "prerelease" printTag Prerelease = color' Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t printTag (UnknownTag t ) = t
printTag Old = ""
color' = case raw of color' = case raw of
True -> flip const True -> flip const

View File

@ -95,6 +95,7 @@ ghcupDownloads:
7.10.3: 7.10.3:
viTags: viTags:
- base-4.8.2.0 - base-4.8.2.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html viChangeLog: https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz
@ -157,6 +158,7 @@ ghcupDownloads:
8.0.2: 8.0.2:
viTags: viTags:
- base-4.9.1.0 - base-4.9.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz
@ -214,6 +216,7 @@ ghcupDownloads:
8.2.2: 8.2.2:
viTags: viTags:
- base-4.10.1.0 - base-4.10.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz
@ -280,6 +283,7 @@ ghcupDownloads:
8.4.1: 8.4.1:
viTags: viTags:
- base-4.11.0.0 - base-4.11.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz
@ -328,6 +332,7 @@ ghcupDownloads:
8.4.2: 8.4.2:
viTags: viTags:
- base-4.11.1.0 - base-4.11.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz
@ -382,6 +387,7 @@ ghcupDownloads:
8.4.3: 8.4.3:
viTags: viTags:
- base-4.11.1.0 - base-4.11.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz
@ -504,6 +510,7 @@ ghcupDownloads:
8.6.1: 8.6.1:
viTags: viTags:
- base-4.12.0.0 - base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz
@ -558,6 +565,7 @@ ghcupDownloads:
8.6.2: 8.6.2:
viTags: viTags:
- base-4.12.0.0 - base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz
@ -603,6 +611,7 @@ ghcupDownloads:
8.6.3: 8.6.3:
viTags: viTags:
- base-4.12.0.0 - base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz
@ -666,6 +675,7 @@ ghcupDownloads:
8.6.4: 8.6.4:
viTags: viTags:
- base-4.12.0.0 - base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz
@ -788,6 +798,7 @@ ghcupDownloads:
8.8.1: 8.8.1:
viTags: viTags:
- base-4.13.0.0 - base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz
@ -846,6 +857,7 @@ ghcupDownloads:
8.8.2: 8.8.2:
viTags: viTags:
- base-4.13.0.0 - base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz
@ -904,6 +916,7 @@ ghcupDownloads:
8.8.3: 8.8.3:
viTags: viTags:
- base-4.13.0.0 - base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz
@ -1041,6 +1054,7 @@ ghcupDownloads:
8.10.1: 8.10.1:
viTags: viTags:
- base-4.14.0.0 - base-4.14.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html
viSourceDL: viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz
@ -1267,7 +1281,8 @@ ghcupDownloads:
unknown_versioning: *ghc-901a1-32-deb9 unknown_versioning: *ghc-901a1-32-deb9
Cabal: Cabal:
2.4.1.0: 2.4.1.0:
viTags: [] viTags:
- old
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog
viArch: viArch:
A_64: A_64:
@ -1298,7 +1313,8 @@ ghcupDownloads:
dlSubdir: dlSubdir:
dlHash: b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198 dlHash: b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198
3.0.0.0: 3.0.0.0:
viTags: [] viTags:
- old
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog
viArch: viArch:
A_64: A_64:

View File

@ -96,6 +96,7 @@ data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| Base PVP | Base PVP
| Old -- ^ old version are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance

View File

@ -55,6 +55,7 @@ instance ToJSON Tag where
toJSON Latest = String "Latest" toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended" toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease" toJSON Prerelease = String "Prerelease"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'') toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x ) = String (T.pack x) toJSON (UnknownTag x ) = String (T.pack x)
@ -63,6 +64,7 @@ instance FromJSON Tag where
"Latest" -> pure Latest "Latest" -> pure Latest
"Recommended" -> pure Recommended "Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease "Prerelease" -> pure Prerelease
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x Right x -> pure $ Base x
Left e -> fail . show $ e Left e -> fail . show $ e