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

Update dependencies and make buildable with GHC-9.4.4

Browse Source
This commit is contained in:
Julian Ospald 2023-01-12 13:52:08 +08:00
parent a16bcddeaa
commit a427146de5
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
5 changed files with 58 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
app/ghcup/BrickMain.hs
View File

@ -95,11 +95,11 @@ data BrickState = BrickState
keyHandlers :: KeyBindings keyHandlers :: KeyBindings
-> [ ( Vty.Key -> [ ( Vty.Key
, BrickSettings -> String , BrickSettings -> String
, BrickState -> EventM n (Next BrickState) , BrickState -> EventM String BrickState ()
) )
] ]
keyHandlers KeyBindings {..} = keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt) [ (bQuit, const "Quit" , \_ -> halt)
, (bInstall, const "Install" , withIOAction install') , (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del') , (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set') , (bSet, const "Set" , withIOAction set')
@ -114,14 +114,14 @@ keyHandlers KeyBindings {..} =
if showAllTools then "Don't show all tools" else "Show all tools" if showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler showAllVersions (not . showAllTools) , hideShowHandler showAllVersions (not . showAllTools)
) )
, (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. }) , (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. }) , (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
] ]
where where
hideShowHandler f p BrickState{..} = hideShowHandler f p BrickState{..} =
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings } let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState) newInternalState = constructList appData newAppSettings (Just appState)
in continue (BrickState appData newAppSettings newInternalState appKeys) in put (BrickState appData newAppSettings newInternalState appKeys)
showKey :: Vty.Key -> String showKey :: Vty.Key -> String
@ -142,7 +142,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
where where
footer = footer =
withAttr "help" withAttr (attrName "help")
. txtWrap . txtWrap
. T.pack . T.pack
. foldr1 (\x y -> x <> " " <> y) . foldr1 (\x y -> x <> " " <> y)
@ -157,9 +157,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
renderList' = withDefAttr listAttr . drawListElements renderItem True renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@ListResult{..} = renderItem _ b listResult@ListResult{..} =
let marks = if let marks = if
| lSet -> (withAttr "set" $ str "✔✔") | lSet -> (withAttr (attrName "set") $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "✓ ") | lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
| otherwise -> (withAttr "not-installed" $ str "✗ ") | otherwise -> (withAttr (attrName "not-installed") $ str "✗ ")
ver = case lCross of ver = 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)
@ -167,13 +167,13 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
| lNoBindist && not lInstalled | lNoBindist && not lInstalled
&& not b -- TODO: overloading dim and active ignores active && not b -- TODO: overloading dim and active ignores active
-- so we hack around it here -- so we hack around it here
= updateAttrMap (const dimAttrs) . withAttr "no-bindist" = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
| otherwise = id | otherwise = id
hooray hooray
| elem Latest lTag && not lInstalled = | elem Latest lTag && not lInstalled =
withAttr "hooray" withAttr (attrName "hooray")
| otherwise = id | otherwise = id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
in hooray $ active $ dim in hooray $ active $ dim
( marks ( marks
<+> padLeft (Pad 2) <+> padLeft (Pad 2)
@ -195,9 +195,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> vLimit 1 (fill ' ') <+> vLimit 1 (fill ' ')
) )
printTag Recommended = Just $ withAttr "recommended" $ str "recommended" printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
printTag Latest = Just $ withAttr "latest" $ str "latest" printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease" printTag Prerelease = Just $ withAttr (attrName "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
@ -209,10 +209,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTool Stack = str "Stack" printTool Stack = str "Stack"
printNotes ListResult {..} = printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty (if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
) )
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty) ++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty) ++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
-- | Draws the list elements. -- | Draws the list elements.
-- --
@ -242,8 +242,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
selItemAttr = if foc selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr else withDefAttr listSelectedAttr
makeVisible = if isSelected then visible . selItemAttr else id makeVisible' = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget in addSeparator $ makeVisible' elemWidget
in render in render
$ viewport "GHCup" Vertical $ viewport "GHCup" Vertical
@ -258,8 +258,8 @@ minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
app :: AttrMap -> AttrMap -> App BrickState e String app :: AttrMap -> AttrMap -> App BrickState e String
app attrs dimAttrs = app attrs dimAttrs =
App { appDraw = \st -> [ui dimAttrs st] App { appDraw = \st -> [ui dimAttrs st]
, appHandleEvent = eventHandler , appHandleEvent = \be -> get >>= \s -> eventHandler s be
, appStartEvent = return , appStartEvent = return ()
, appAttrMap = const attrs , appAttrMap = const attrs
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
} }
@ -267,18 +267,18 @@ app attrs dimAttrs =
defaultAttributes :: Bool -> AttrMap defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap defaultAttributes no_color = attrMap
Vty.defAttr Vty.defAttr
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) [ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, ("not-installed", Vty.defAttr `withForeColor` Vty.red) , (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
, ("set" , Vty.defAttr `withForeColor` Vty.green) , (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, ("installed" , Vty.defAttr `withForeColor` Vty.green) , (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `withForeColor` Vty.green) , (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, ("hls-powered" , Vty.defAttr `withForeColor` Vty.green) , (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, ("latest" , Vty.defAttr `withForeColor` Vty.yellow) , (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, ("compiled" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, ("help" , Vty.defAttr `withStyle` Vty.italic) , (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite) , (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
] ]
where where
withForeColor | no_color = const withForeColor | no_color = const
@ -292,31 +292,31 @@ defaultAttributes no_color = attrMap
dimAttributes :: Bool -> AttrMap dimAttributes :: Bool -> AttrMap
dimAttributes no_color = attrMap dimAttributes no_color = attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim) (Vty.defAttr `Vty.withStyle` Vty.dim)
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ?? [ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim) , (attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
] ]
where where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor | otherwise = Vty.withBackColor
eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState) eventHandler :: BrickState -> BrickEvent String e -> EventM String BrickState ()
eventHandler st@BrickState{..} ev = do eventHandler st@BrickState{..} ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings' AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of case ev of
(MouseDown _ Vty.BScrollUp _ _) -> (MouseDown _ Vty.BScrollUp _ _) ->
continue (BrickState { appState = moveCursor 1 appState Up, .. }) put (BrickState { appState = moveCursor 1 appState Up, .. })
(MouseDown _ Vty.BScrollDown _ _) -> (MouseDown _ Vty.BScrollDown _ _) ->
continue (BrickState { appState = moveCursor 1 appState Down, .. }) put (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> continue st (VtyEvent (Vty.EvResize _ _)) -> put st
(VtyEvent (Vty.EvKey Vty.KUp _)) -> (VtyEvent (Vty.EvKey Vty.KUp _)) ->
continue BrickState{ appState = moveCursor 1 appState Up, .. } put BrickState{ appState = moveCursor 1 appState Up, .. }
(VtyEvent (Vty.EvKey Vty.KDown _)) -> (VtyEvent (Vty.EvKey Vty.KDown _)) ->
continue BrickState{ appState = moveCursor 1 appState Down, .. } put BrickState{ appState = moveCursor 1 appState Down, .. }
(VtyEvent (Vty.EvKey key _)) -> (VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
Nothing -> continue st Nothing -> put st
Just (_, _, handler) -> handler st Just (_, _, handler) -> handler st
_ -> continue st _ -> put st
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
@ -329,13 +329,14 @@ moveCursor steps ais@BrickInternalState{..} direction =
-- | 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 :: (BrickState withIOAction :: Ord n
=> (BrickState
-> (Int, ListResult) -> (Int, ListResult)
-> ReaderT AppState IO (Either String a)) -> ReaderT AppState IO (Either String a))
-> BrickState -> BrickState
-> EventM n (Next BrickState) -> EventM n BrickState ()
withIOAction action as = case listSelectedElement' (appState as) of withIOAction action as = case listSelectedElement' (appState as) of
Nothing -> continue as Nothing -> put as
Just (ix, e) -> do Just (ix, e) -> do
suspendAndResume $ do suspendAndResume $ do
settings <- readIORef settings' settings <- readIORef settings'

1
cabal.project
View File

@ -25,4 +25,3 @@ package aeson
package streamly package streamly
flags: +use-unliftio flags: +use-unliftio
allow-newer: base, ghc-prim, template-haskell, language-c

2
cabal.project.freeze
View File

@ -1,2 +1,2 @@
-- windows picks weird version -- windows picks weird version
constraints: any.hsc2hs ==0.68.7 constraints: any.hsc2hs ==0.68.8

18
ghcup.cabal
View File

@ -143,9 +143,9 @@ library
, split ^>=0.2.3.4 , split ^>=0.2.3.4
, streamly ^>=0.8.2 , streamly ^>=0.8.2
, strict-base ^>=0.4 , strict-base ^>=0.4
, template-haskell >=2.7 && <2.18 , template-haskell >=2.7 && <2.20
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=1.2.4.0 , text ^>=2.0
, time ^>=1.9.3 , time ^>=1.9.3
, transformers ^>=0.5 , transformers ^>=0.5
, unliftio-core ^>=0.2.0.1 , unliftio-core ^>=0.2.0.1
@ -161,7 +161,7 @@ library
exposed-modules: GHCup.Download.IOStreams exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
build-depends: build-depends:
, HsOpenSSL >=0.11.4.18 , HsOpenSSL >=0.11.7.2
, http-io-streams >=0.1.2.0 , http-io-streams >=0.1.2.0
, io-streams >=1.5.2.1 , io-streams >=1.5.2.1
, terminal-progress-bar >=0.4.1 , terminal-progress-bar >=0.4.1
@ -200,7 +200,7 @@ library
if (flag(tui) && !os(windows)) if (flag(tui) && !os(windows))
cpp-options: -DBRICK cpp-options: -DBRICK
build-depends: vty >=5.28.2 && <5.34 build-depends: vty ^>=5.37
executable ghcup executable ghcup
main-is: Main.hs main-is: Main.hs
@ -267,9 +267,9 @@ executable ghcup
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, tagsoup ^>=0.14 , tagsoup ^>=0.14
, template-haskell >=2.7 && <2.18 , template-haskell >=2.7 && <2.20
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=1.2.4.0 , text ^>=2.0
, unordered-containers ^>=0.2 , unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
@ -284,10 +284,10 @@ executable ghcup
cpp-options: -DBRICK cpp-options: -DBRICK
other-modules: BrickMain other-modules: BrickMain
build-depends: build-depends:
, brick ^>=0.64 , brick ^>=1.5
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7 , unix ^>=2.7
, vty >=5.28.2 && <5.34 , vty ^>=5.37
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@ -336,7 +336,7 @@ test-suite ghcup-test
, QuickCheck ^>=2.14.1 , QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0 , quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2 , streamly ^>=0.8.2
, text ^>=1.2.4.0 , text ^>=2.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1

1
lib/GHCup/Types.hs
View File

@ -414,7 +414,6 @@ data KeyBindings = KeyBindings
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
instance NFData KeyBindings instance NFData KeyBindings
instance NFData Key
defaultKeyBindings :: KeyBindings defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings defaultKeyBindings = KeyBindings