hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'TUI-improvements' into master

Browse Source
This commit is contained in:
Julian Ospald 2020-10-12 23:40:26 +02:00
commit a4e4080a1b
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
6 changed files with 15377 additions and 9863 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitlab-ci.yml
View File

@ -61,6 +61,11 @@ variables:
- ./.gitlab/script/ghcup_version.sh - ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.3" JSON_VERSION: "0.0.3"
artifacts:
expire_in: 2 week
paths:
- golden
when: on_failure
.test_ghcup_version:linux: .test_ghcup_version:linux:
extends: extends:

388
app/ghcup/BrickMain.hs
View File

@ -1,10 +1,11 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module BrickMain where module BrickMain where
@ -20,7 +21,10 @@ import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
import Brick.Widgets.Center import Brick.Widgets.Center
import Brick.Widgets.List import Brick.Widgets.List ( listSelectedFocusedAttr
, listSelectedAttr
, listAttr
)
#if !defined(TAR) #if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif #endif
@ -35,7 +39,9 @@ import Data.Maybe
import Data.Char import Data.Char
import Data.IORef import Data.IORef
import Data.String.Interpolate import Data.String.Interpolate
import Data.Vector ( Vector ) import Data.Vector ( Vector
, (!?)
)
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
@ -46,25 +52,33 @@ import URI.ByteString
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Brick.Widgets.List as L
data AppData = AppData {
lr :: LR data AppData = AppData
, dls :: GHCupDownloads { lr :: [ListResult]
, dls :: GHCupDownloads
, pfreq :: PlatformRequest , pfreq :: PlatformRequest
} deriving Show }
deriving Show
data AppSettings = AppSettings { data AppSettings = AppSettings
showAll :: Bool { showAll :: Bool
} deriving Show }
deriving Show
data AppState = AppState { data AppInternalState = AppInternalState
appData :: AppData { clr :: Vector ListResult
, ix :: Int
}
deriving Show
data AppState = AppState
{ appData :: AppData
, appSettings :: AppSettings , appSettings :: AppSettings
} deriving Show , appState :: AppInternalState
}
type LR = GenericList String Vector ListResult deriving Show
keyHandlers :: [ ( Char keyHandlers :: [ ( Char
@ -82,27 +96,22 @@ keyHandlers =
, (\AppSettings {..} -> , (\AppSettings {..} ->
if showAll then "Hide old versions" else "Show all versions" if showAll then "Hide old versions" else "Show all versions"
) )
, (\AppState {..} -> , hideShowHandler
let newAppSettings =
appSettings { showAll = not . showAll $ appSettings }
in continue (AppState appData newAppSettings)
)
) )
] ]
where
hideShowHandler (AppState {..}) =
let newAppSettings = appSettings { showAll = not . showAll $ appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in continue (AppState appData newAppSettings newInternalState)
ui :: AppState -> Widget String ui :: AppState -> Widget String
ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } = ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}), ..}
( padBottom Max = ( padBottom Max
$ ( withBorderStyle unicode $ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup") $ borderWithLabel (str "GHCup")
$ ( center $ (center $ (header <=> hBorder <=> renderList' appState))
$ (header <=> hBorder <=> renderList
renderItem
True
(L.listReverse lr)
)
)
) )
) )
<=> footer <=> footer
@ -121,7 +130,8 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
<+> (minHSize 15 $ str "Version") <+> (minHSize 15 $ str "Version")
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags") <+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
<+> (padLeft (Pad 5) $ str "Notes") <+> (padLeft (Pad 5) $ str "Notes")
renderItem b listResult@(ListResult {..}) = renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@(ListResult {..}) =
let marks = if let marks = if
| lSet -> (withAttr "set" $ str "✔✔") | lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "✓ ") | lInstalled -> (withAttr "installed" $ str "✓ ")
@ -132,21 +142,23 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
dim = if lNoBindist dim = if lNoBindist
then updateAttrMap (const dimAttributes) . withAttr "no-bindist" then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
else id else id
active = if b then withAttr "active" else id hooray
in dim | elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then forceAttr "active" else id
in hooray $ active $ dim
( marks ( marks
<+> (( padLeft (Pad 2) <+> (( padLeft (Pad 2)
$ active
$ minHSize 6 $ minHSize 6
$ (str (fmap toLower . show $ lTool)) $ (printTool lTool)
) )
) )
<+> (minHSize 15 $ active $ (str ver)) <+> (minHSize 15 $ (str ver))
<+> (let l = catMaybes . fmap printTag $ sort lTag <+> (let l = catMaybes . fmap printTag $ sort lTag
in padLeft (Pad 1) $ minHSize 25 $ in padLeft (Pad 1) $ minHSize 25 $ if null l
if null l then emptyWidget
then emptyWidget else foldr1 (\x y -> x <+> str "," <+> y) l
else foldr1 (\x y -> x <+> str "," <+> y) l
) )
<+> ( padLeft (Pad 5) <+> ( padLeft (Pad 5)
$ let notes = printNotes listResult $ let notes = printNotes listResult
@ -154,14 +166,20 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
then emptyWidget then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) $ notes else foldr1 (\x y -> x <+> str "," <+> y) $ notes
) )
<+> (vLimit 1 $ fill ' ')
) )
printTag Recommended = Just $ withAttr "recommended" $ str "recommended" printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
printTag Latest = Just $ withAttr "latest" $ str "latest" printTag Latest = Just $ withAttr "latest" $ str "latest"
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease" printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing printTag Old = Nothing
printTag (UnknownTag t ) = Just $ str t printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
printTool GHC = str "GHC"
printTool GHCup = str "GHCup"
printTool HLS = str "HLS"
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
@ -169,6 +187,41 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty) ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty) ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
-- | Draws the list elements.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
drawListElements :: (Int -> Bool -> ListResult -> Widget String)
-> Bool
-> AppInternalState
-> Widget String
drawListElements drawElem foc is@(AppInternalState clr _) =
Widget Greedy Greedy $
let
es = clr
listSelected = fmap fst $ listSelectedElement' is
drawnElements = flip V.imap es $ \i' e ->
let addSeparator w = case es !? (i' - 1) of
Just e' | lTool e' /= lTool e ->
hBorder <=> w
_ -> w
isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget
in render
$ viewport "GHCup" Vertical
$ vBox
$ V.toList drawnElements
minHSize :: Int -> Widget n -> Widget n minHSize :: Int -> Widget n -> Widget n
@ -197,6 +250,7 @@ defaultAttributes = attrMap
, ("compiled" , Vty.defAttr `Vty.withForeColor` Vty.blue) , ("compiled" , Vty.defAttr `Vty.withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `Vty.withForeColor` Vty.blue) , ("stray" , Vty.defAttr `Vty.withForeColor` Vty.blue)
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic) , ("help" , Vty.defAttr `Vty.withStyle` Vty.italic)
, ("hooray" , Vty.defAttr `Vty.withForeColor` Vty.brightWhite)
] ]
@ -207,49 +261,27 @@ dimAttributes = attrMap
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim) , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
] ]
eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState) 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 { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
= continue (AppState (AppData (listMoveUp lr) dls pfreq) appSettings) continue (AppState { appState = (moveCursor appState Up), .. })
eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
= continue (AppState (AppData (listMoveDown lr) dls pfreq) appSettings) continue (AppState { appState = (moveCursor appState Down), .. })
eventHandler as@(AppState appD appS) (VtyEvent (Vty.EvKey (Vty.KChar c) _)) = eventHandler as (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 moveCursor :: AppInternalState -> Direction -> AppInternalState
replaceLR filterF (AppData {..}) = do moveCursor ais@(AppInternalState {..}) direction =
settings <- liftIO $ readIORef settings' let newIx = if direction == Down then ix + 1 else ix - 1
l <- liftIO $ readIORef logger' in case clr !? newIx of
let runLogger = myLoggerT l Just _ -> AppInternalState { ix = newIx, .. }
lV <- runLogger Nothing -> ais
. 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
@ -257,56 +289,103 @@ filterVisible showAll e
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 . appData $ as) of withIOAction action as = case listSelectedElement' (appState 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 <- getAppData Nothing (pfreq . appData $ as) >>= \case
(fmap . fmap) Right data' -> do
(\AppData {..} -> AppState
{ appData = AppData { lr = listMoveTo ix lr, .. }
, appSettings = (appSettings as)
}
)
$ getAppData Nothing (pfreq . appData $ as)
case apps of
Right nas -> do
putStrLn "Press enter to continue" putStrLn "Press enter to continue"
_ <- getLine _ <- getLine
pure nas pure (updateList data' as)
Left err -> throwIO $ userError err Left err -> throwIO $ userError err
-- | Update app data and list internal state based on new evidence.
-- This synchronises @AppInternalState@ with @AppData@
-- and @AppSettings@.
updateList :: AppData -> AppState -> AppState
updateList appD (AppState {..}) =
let newInternalState = constructList appD appSettings (Just appState)
in AppState { appState = newInternalState
, appData = appD
, appSettings = appSettings
}
constructList :: AppData
-> AppSettings
-> Maybe AppInternalState
-> AppInternalState
constructList appD appSettings mapp =
replaceLR (filterVisible (showAll appSettings)) (lr appD) mapp
listSelectedElement' :: AppInternalState -> Maybe (Int, ListResult)
listSelectedElement' (AppInternalState {..}) = fmap (ix, ) $ clr !? ix
selectLatest :: Vector ListResult -> Int
selectLatest v =
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
Just ix -> ix
Nothing -> 0
-- | Replace the @appState@ or construct it based on a filter function
-- and a new @[ListResult]@ evidence.
-- When passed an existing @appState@, tries to keep the selected element.
replaceLR :: (ListResult -> Bool)
-> [ListResult]
-> Maybe AppInternalState
-> AppInternalState
replaceLR filterF lr s =
let oldElem = s >>= listSelectedElement'
newVec = V.fromList . filter filterF $ lr
newSelected =
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
Just ix -> ix
Nothing -> selectLatest newVec
in AppInternalState newVec newSelected
where
toolEqual e1 e2 =
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e | lInstalled e = True
| showAll = True
| otherwise = not (elem Old (lTag e))
install' :: AppState -> (Int, ListResult) -> IO (Either String ()) install' :: AppState -> (Int, ListResult) -> IO (Either String ())
install' AppState { appData = AppData {..}} (_, 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
let let run =
run = runLogger
runLogger . flip runReaderT settings
. flip runReaderT settings . runResourceT
. runResourceT . runE
. runE @'[ AlreadyInstalled
@'[AlreadyInstalled
, UnknownArchive
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileDoesNotExistError , UnknownArchive
, CopyError , FileDoesNotExistError
, NoDownload , CopyError
, NotInstalled , NoDownload
, BuildFailed , NotInstalled
, TagNotFound , BuildFailed
, DigestError , TagNotFound
, DownloadFailed , DigestError
, NoUpdate , DownloadFailed
, TarDirDoesNotExist , NoUpdate
] , TarDirDoesNotExist
]
(run $ do (run $ do
case lTool of case lTool of
@ -336,7 +415,7 @@ set' _ (_, ListResult {..}) = do
let run = let run =
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE @'[FileDoesNotExistError, NotInstalled, TagNotFound] . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
(run $ do (run $ do
case lTool of case lTool of
@ -371,15 +450,15 @@ del' _ (_, ListResult {..}) = do
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ()) changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState { appData = AppData {..}} (_, 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}|]
Just uri -> do Just uri -> do
let cmd = case _rPlatform pfreq of let cmd = case _rPlatform pfreq of
Darwin -> "open" Darwin -> "open"
Linux _ -> "xdg-open" Linux _ -> "xdg-open"
FreeBSD -> "xdg-open" FreeBSD -> "xdg-open"
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
Right _ -> pure $ Right () Right _ -> pure $ Right ()
Left e -> pure $ Left [i|#{e}|] Left e -> pure $ Left [i|#{e}|]
@ -395,12 +474,12 @@ settings' :: IORef Settings
settings' = unsafePerformIO $ do settings' = unsafePerformIO $ do
dirs <- getDirs dirs <- getDirs
newIORef Settings { cache = True newIORef Settings { cache = True
, noVerify = False , noVerify = False
, keepDirs = Never , keepDirs = Never
, downloader = Curl , downloader = Curl
, verbose = False , verbose = False
, .. , ..
} }
logger' :: IORef LoggerConfig logger' :: IORef LoggerConfig
@ -413,7 +492,12 @@ logger' = unsafePerformIO
) )
brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO () brickMain :: Settings
-> Maybe URI
-> LoggerConfig
-> GHCupDownloads
-> PlatformRequest
-> IO ()
brickMain s muri l av pfreq' = do brickMain s muri l av pfreq' = do
writeIORef uri' muri writeIORef uri' muri
writeIORef settings' s writeIORef settings' s
@ -423,24 +507,21 @@ brickMain s muri l av pfreq' = do
eAppData <- getAppData (Just av) pfreq' eAppData <- getAppData (Just av) pfreq'
case eAppData of case eAppData of
Right ad -> defaultMain app (AppState (selectLatest ad) defaultAppSettings) $> () Right ad ->
Left e -> do defaultMain
app
(AppState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
)
$> ()
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
selectLatest :: AppData -> AppData
selectLatest (AppData {..}) =
(\ix -> AppData { lr = listMoveTo ix lr, .. } )
. fromJust
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
$ (listElements lr)
defaultAppSettings :: AppSettings defaultAppSettings :: AppSettings
defaultAppSettings = AppSettings { defaultAppSettings = AppSettings { showAll = False }
showAll = False
}
getDownloads' :: IO (Either String GHCupDownloads) getDownloads' :: IO (Either String GHCupDownloads)
@ -453,16 +534,19 @@ getDownloads' = do
r <- r <-
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
@'[JSONError, DownloadFailed, FileDoesNotExistError] $ fmap _ghcupDownloads
$ fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri) $ liftE
$ getDownloadsF (maybe GHCupURL OwnSource muri)
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 :: Maybe GHCupDownloads
-> PlatformRequest
-> IO (Either String AppData)
getAppData mg pfreq' = do getAppData mg pfreq' = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
@ -470,12 +554,10 @@ getAppData mg pfreq' = do
r <- maybe getDownloads' (pure . Right) mg r <- maybe getDownloads' (pure . Right) mg
runLogger runLogger . flip runReaderT settings $ do
. flip runReaderT settings case r of
$ do Right dls -> do
case r of lV <- listVersions dls Nothing Nothing pfreq'
Right dls -> do pure $ Right $ (AppData (reverse lV) dls pfreq')
lV <- listVersions dls Nothing Nothing pfreq' Left e -> pure $ Left [i|#{e}|]
pure $ Right $ (AppData (list "Tool versions"
(V.fromList . filter (filterVisible (showAll defaultAppSettings)) $ lV) 1) dls pfreq')
Left e -> pure $ Left [i|#{e}|]

6
cabal.project
View File

@ -20,12 +20,6 @@ source-repository-package
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2 tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory subdir: hpath-directory
-- https://github.com/cjdev/text-conversions/pull/10
source-repository-package
type: git
location: https://github.com/hasufell/text-conversions.git
tag: 9abf0e5e5664a3178367597c32db19880477a53c
optimization: 2 optimization: 2
package streamly package streamly

24812
golden/GHCupInfo.json
View File

File diff suppressed because it is too large Load Diff

19
hie.yaml
View File

@ -1,6 +1,19 @@
cradle: cradle:
cabal: cabal:
- path: "." - path: "./lib"
component: "ghcup:lib:ghcup" component: "lib:ghcup"
- path: "."
- path: "./app/ghcup/Main.hs"
component: "ghcup:exe:ghcup" component: "ghcup:exe:ghcup"
- path: "./app/ghcup/BrickMain.hs"
component: "ghcup:exe:ghcup"
- path: "./app/ghcup-gen/Main.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./app/ghcup-gen/Validate.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./test"
component: "ghcup:test:ghcup-test"

10
stack.yaml
View File

@ -26,6 +26,7 @@ extra-deps:
- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 - QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582 - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base64-bytestring-1.1.0.0@sha256:190264fef9e65d9085f00ccda419137096d1dc94777c58272bc96821dc7f37c3,2334 - base64-bytestring-1.1.0.0@sha256:190264fef9e65d9085f00ccda419137096d1dc94777c58272bc96821dc7f37c3,2334
- brick-0.55@sha256:f98736eca0cd694837062e06da4655eed969d53b789dfd919716e9b6f5b4c5ce,15858
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964 - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331 - brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153 - chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
@ -46,9 +47,9 @@ extra-deps:
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138 - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- tar-bytestring-0.6.3.2@sha256:88f29bed56b688c543a4cb3986402d64b360f76b3fd9b88ac618b8344f8da712,5715 - tar-bytestring-0.6.3.2@sha256:88f29bed56b688c543a4cb3986402d64b360f76b3fd9b88ac618b8344f8da712,5715
- vty-5.30@sha256:4af3938d7b9e6096e222bf52d0ea5d39873bc6fe19febd34106906306af13730,20857
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
flags: flags:
http-io-streams: http-io-streams:
brotli: false brotli: false
@ -56,6 +57,13 @@ flags:
libarchive: libarchive:
system-libarchive: false system-libarchive: false
ghcup:
tui: true
system-ghc: true
compiler: ghc-8.8.4
compiler-check: match-exact
ghc-options: ghc-options:
"$locals": -O2 "$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16