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

1
cabal.project
View File

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

1
lib/GHCup/Types.hs
View File

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