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

More

Browse Source
This commit is contained in:
Julian Ospald 2022-12-06 23:06:18 +08:00
parent efb81e4bac
commit fff2599c2c
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
4 changed files with 139 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
app/ghcup/AnsiMain.hs
View File

@ -141,20 +141,34 @@ ghcupGame bs = Game 13
drawFun :: BrickState -> GEnv -> Plane
drawFun (BrickState {..}) GEnv{..} =
blankPlane mw mh
& (1, 1) % box 1 1 '┌'
& (2, 1) % box 1 (mh - 3) '│'
& (1, 2) % box (mw - 2) 1 '─'
& (2, mw) % box 1 (mh - 3) '│'
& (1, mw) % box 1 1 '┐'
& (mh-1, 2) % box (mw - 2) 1 '─'
& (mh-1, 1) % box 1 1 '└'
& (mh-1, mw) % box 1 1 '┘'
& (2, 2) % box (mw - 2) (mh - 3) ' '
& (2, 2) % (header === box (mw - 2) 1 '─' === renderItems)
let focus pl = maybe pl
(\ix -> V.update pl (V.singleton (ix + 1, fmap invert $ pl V.! (ix + 1))))
mix
rows = V.fromList [header, [box (mw - 2) 1 '=']] V.++ renderItems
cols = V.foldr (\xs ys -> zipWith (:) xs ys) (repeat []) $ V.filter ((==5) . length) rows
padded = focus $ V.map (\xs -> zipWith padTo xs lengths) rows
lengths :: [Int]
lengths = fmap (maximum . fmap (fst . planeSize)) cols
in blankPlane mw mh
& (1, 1) % box 1 1 'X' -- '┌'
& (2, 1) % box 1 (mh - 3) '|' -- '│'
& (1, 2) % box (mw - 2) 1 '=' -- '─'
& (2, mw) % box 1 (mh - 3) '|' -- '│'
& (1, mw) % box 1 1 'X' -- '┐'
& (mh-1, 2) % box (mw - 2) 1 '=' -- '─'
& (mh-1, 1) % box 1 1 'X' -- '└'
& (mh-1, mw) % box 1 1 'X' -- '┘'
& (2, 2) % box (mw - 2) (mh - 3) ' ' -- ' '
& (2, 2) % vcat (hcat <$> V.toList padded)
& (mh, 1) % footer
& (1, mw `div` 2 - 2) % stringPlane "GHCup"
where
padTo :: Plane -> Int -> Plane
padTo plane x =
let lstr = fst $ planeSize plane
add' = x - lstr + 1
in if add' < 0 then plane else plane ||| stringPlane (replicate add' ' ')
mh :: Height
mw :: Width
(mh, mw) = T.swap eTermDims
@ -162,16 +176,13 @@ drawFun (BrickState {..}) GEnv{..} =
. intersperse (stringPlane " ")
. fmap stringPlane
$ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"]
header = hcat
. intersperse space
. fmap stringPlane
$ ["Tool", "Version", "Tags", "Notes"]
renderItems = drawListElements renderItem True appState
header = fmap stringPlane ["Tool", "Version", "Tags", "Notes"]
(renderItems, mix) = drawListElements renderItem appState
renderItem _ b listResult@ListResult{..} =
let marks = if
| lSet -> color Green Vivid (stringPlane "✔✔")
| lInstalled -> color Green Dull (stringPlane "✓ ")
| otherwise -> color Red Vivid (stringPlane "✗ ")
| lSet -> color Green Vivid $ stringPlane "IS"
| lInstalled -> color Green Vivid $ stringPlane "I "
| otherwise -> color Red Vivid $ stringPlane "X "
ver = case lCross of
Nothing -> stringPlane . Tx.unpack . prettyVer $ lVer
Just c -> stringPlane . Tx.unpack $ (c <> "-" <> prettyVer lVer)
@ -183,7 +194,7 @@ drawFun (BrickState {..}) GEnv{..} =
then blankPlane 1 1
else foldr1 (\x y -> x ||| stringPlane "," ||| y) n
in hcat [marks, space, space, tool, space, ver, space, tag, space, notes]
in [marks ||| space, tool, ver, tag, notes]
printTag Recommended = Just $ color Green Dull $ stringPlane "recommended"
printTag Latest = Just $ color Yellow Dull $ stringPlane "latest"
@ -213,40 +224,40 @@ drawFun (BrickState {..}) GEnv{..} =
-- 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 -> Plane)
-> Bool
drawListElements :: (Int -> Bool -> ListResult -> [Plane])
-> BrickInternalState
-> Plane
drawListElements drawElem foc is@(BrickInternalState clr _) =
-> (V.Vector [Plane], Maybe Int)
drawListElements drawElem is@(BrickInternalState clr _) =
let es = clr
listSelected = fmap fst $ listSelectedElement' is
(drawnElements, selIx) = runST $ do
ref <- newSTRef (Nothing :: Maybe Int)
vec <- newSTRef (mempty :: V.Vector [Plane])
elem' <- newSTRef 0
arr <- fmap join $ flip V.imapM es $ \i' e -> do
void $ flip V.imapM es $ \i' e -> do
let isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
selItemAttr = if foc
then listSelectedFocusedAttr
else listSelectedAttr
markSelected = if isSelected then selItemAttr else id
case es V.!? (i' - 1) of
Just e' | lTool e' /= lTool e -> do
modifySTRef elem' (+2)
i <- readSTRef elem'
when isSelected $ writeSTRef ref (Just i)
pure $ V.fromList [hBorder, markSelected elemWidget] -- add separator
modifySTRef vec (`V.snoc` [hBorder])
modifySTRef vec (`V.snoc` elemWidget)
pure ()
_ -> do
modifySTRef elem' (+1)
i <- readSTRef elem'
when isSelected $ writeSTRef ref (Just i)
pure $ V.fromList [markSelected elemWidget]
modifySTRef vec (`V.snoc` elemWidget)
pure ()
i <- readSTRef ref
arr <- readSTRef vec
pure (arr, i)
in vcat $ V.toList (makeVisible drawnElements (mh - 5) selIx)
in (makeVisible drawnElements (mh - 5) selIx, selIx)
where
makeVisible :: V.Vector Plane -> Height -> Maybe Int -> V.Vector Plane
makeVisible :: V.Vector [Plane] -> Height -> Maybe Int -> V.Vector [Plane]
makeVisible listElements drawableHeight (Just ix) =
let listHeight = V.length listElements
in if | listHeight <= 0 -> listElements
@ -256,11 +267,7 @@ drawFun (BrickState {..}) GEnv{..} =
| otherwise -> listElements
makeVisible listElements _ Nothing = listElements
listSelectedFocusedAttr = invert
listSelectedAttr = invert
hBorder = box (mw - 2) 1 '─'
hBorder = box (mw - 2) 1 '='
logicFun :: GEnv -> BrickState -> Event -> IO BrickState

84
app/ghcup/GHCup/OptParse/List.hs
View File

@ -12,6 +12,7 @@ module GHCup.OptParse.List where
import GHCup
import GHCup.Prelude
import GHCup.Prelude.Ansi
import GHCup.Types
import GHCup.OptParse.Common
@ -155,89 +156,6 @@ printListResult no_color raw lr = do
add' = x - lstr
in if add' < 0 then str' else str' ++ replicate add' ' '
-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth =
maximum
. (0 :)
. map (foldr (\a b -> charWidth a + b) 0)
. lines
. stripAnsi
-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi s' =
case
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
of
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
Just xs -> concat xs
where
-- This parses lots of invalid ANSI escape codes, but that should be fine
ansi =
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
Void
String
Char
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth c = case c of
_ | c < '\x0300' -> 1
| c >= '\x0300' && c <= '\x036F' -> 0
| -- combining
c >= '\x0370' && c <= '\x10FC' -> 1
| c >= '\x1100' && c <= '\x115F' -> 2
| c >= '\x1160' && c <= '\x11A2' -> 1
| c >= '\x11A3' && c <= '\x11A7' -> 2
| c >= '\x11A8' && c <= '\x11F9' -> 1
| c >= '\x11FA' && c <= '\x11FF' -> 2
| c >= '\x1200' && c <= '\x2328' -> 1
| c >= '\x2329' && c <= '\x232A' -> 2
| c >= '\x232B' && c <= '\x2E31' -> 1
| c >= '\x2E80' && c <= '\x303E' -> 2
| c == '\x303F' -> 1
| c >= '\x3041' && c <= '\x3247' -> 2
| c >= '\x3248' && c <= '\x324F' -> 1
| -- ambiguous
c >= '\x3250' && c <= '\x4DBF' -> 2
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
| c >= '\x4E00' && c <= '\xA4C6' -> 2
| c >= '\xA4D0' && c <= '\xA95F' -> 1
| c >= '\xA960' && c <= '\xA97C' -> 2
| c >= '\xA980' && c <= '\xABF9' -> 1
| c >= '\xAC00' && c <= '\xD7FB' -> 2
| c >= '\xD800' && c <= '\xDFFF' -> 1
| c >= '\xE000' && c <= '\xF8FF' -> 1
| -- ambiguous
c >= '\xF900' && c <= '\xFAFF' -> 2
| c >= '\xFB00' && c <= '\xFDFD' -> 1
| c >= '\xFE00' && c <= '\xFE0F' -> 1
| -- ambiguous
c >= '\xFE10' && c <= '\xFE19' -> 2
| c >= '\xFE20' && c <= '\xFE26' -> 1
| c >= '\xFE30' && c <= '\xFE6B' -> 2
| c >= '\xFE70' && c <= '\xFEFF' -> 1
| c >= '\xFF01' && c <= '\xFF60' -> 2
| c >= '\xFF61' && c <= '\x16A38' -> 1
| c >= '\x1B000' && c <= '\x1B001' -> 2
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
| c >= '\x1F200' && c <= '\x1F251' -> 2
| c >= '\x1F300' && c <= '\x1F773' -> 1
| c >= '\x20000' && c <= '\x3FFFD' -> 2
| otherwise -> 1

1
ghcup.cabal
View File

@ -70,6 +70,7 @@ library
GHCup.List
GHCup.Platform
GHCup.Prelude
GHCup.Prelude.Ansi
GHCup.Prelude.File
GHCup.Prelude.File.Search
GHCup.Prelude.Internal

92
lib/GHCup/Prelude/Ansi.hs Normal file
View File

@ -0,0 +1,92 @@
module GHCup.Prelude.Ansi where
import Control.Applicative
import Data.Char
import Data.Void
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth =
maximum
. (0 :)
. map (foldr (\a b -> charWidth a + b) 0)
. lines
. stripAnsi
-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi s' =
case
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
of
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
Just xs -> concat xs
where
-- This parses lots of invalid ANSI escape codes, but that should be fine
ansi =
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
Void
String
Char
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth c = case c of
_ | c < '\x0300' -> 1
| c >= '\x0300' && c <= '\x036F' -> 0
| -- combining
c >= '\x0370' && c <= '\x10FC' -> 1
| c >= '\x1100' && c <= '\x115F' -> 2
| c >= '\x1160' && c <= '\x11A2' -> 1
| c >= '\x11A3' && c <= '\x11A7' -> 2
| c >= '\x11A8' && c <= '\x11F9' -> 1
| c >= '\x11FA' && c <= '\x11FF' -> 2
| c >= '\x1200' && c <= '\x2328' -> 1
| c >= '\x2329' && c <= '\x232A' -> 2
| c >= '\x232B' && c <= '\x2E31' -> 1
| c >= '\x2E80' && c <= '\x303E' -> 2
| c == '\x303F' -> 1
| c >= '\x3041' && c <= '\x3247' -> 2
| c >= '\x3248' && c <= '\x324F' -> 1
| -- ambiguous
c >= '\x3250' && c <= '\x4DBF' -> 2
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
| c >= '\x4E00' && c <= '\xA4C6' -> 2
| c >= '\xA4D0' && c <= '\xA95F' -> 1
| c >= '\xA960' && c <= '\xA97C' -> 2
| c >= '\xA980' && c <= '\xABF9' -> 1
| c >= '\xAC00' && c <= '\xD7FB' -> 2
| c >= '\xD800' && c <= '\xDFFF' -> 1
| c >= '\xE000' && c <= '\xF8FF' -> 1
| -- ambiguous
c >= '\xF900' && c <= '\xFAFF' -> 2
| c >= '\xFB00' && c <= '\xFDFD' -> 1
| c >= '\xFE00' && c <= '\xFE0F' -> 1
| -- ambiguous
c >= '\xFE10' && c <= '\xFE19' -> 2
| c >= '\xFE20' && c <= '\xFE26' -> 1
| c >= '\xFE30' && c <= '\xFE6B' -> 2
| c >= '\xFE70' && c <= '\xFEFF' -> 1
| c >= '\xFF01' && c <= '\xFF60' -> 2
| c >= '\xFF61' && c <= '\x16A38' -> 1
| c >= '\x1B000' && c <= '\x1B001' -> 2
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
| c >= '\x1F200' && c <= '\x1F251' -> 2
| c >= '\x1F300' && c <= '\x1F773' -> 1
| c >= '\x20000' && c <= '\x3FFFD' -> 2
| otherwise -> 1