From fff2599c2cbe5bd4b9e7e9136a7213c0a7f362f2 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 6 Dec 2022 23:06:18 +0800 Subject: [PATCH] More --- app/ghcup/AnsiMain.hs | 83 +++++++++++++++------------- app/ghcup/GHCup/OptParse/List.hs | 84 +---------------------------- ghcup.cabal | 1 + lib/GHCup/Prelude/Ansi.hs | 92 ++++++++++++++++++++++++++++++++ 4 files changed, 139 insertions(+), 121 deletions(-) create mode 100644 lib/GHCup/Prelude/Ansi.hs diff --git a/app/ghcup/AnsiMain.hs b/app/ghcup/AnsiMain.hs index 2aa12a1..f4649ca 100644 --- a/app/ghcup/AnsiMain.hs +++ b/app/ghcup/AnsiMain.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/List.hs b/app/ghcup/GHCup/OptParse/List.hs index 72cd2bb..099eda9 100644 --- a/app/ghcup/GHCup/OptParse/List.hs +++ b/app/ghcup/GHCup/OptParse/List.hs @@ -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 - diff --git a/ghcup.cabal b/ghcup.cabal index ff0172c..29d7f5b 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -70,6 +70,7 @@ library GHCup.List GHCup.Platform GHCup.Prelude + GHCup.Prelude.Ansi GHCup.Prelude.File GHCup.Prelude.File.Search GHCup.Prelude.Internal diff --git a/lib/GHCup/Prelude/Ansi.hs b/lib/GHCup/Prelude/Ansi.hs new file mode 100644 index 0000000..3d40a4d --- /dev/null +++ b/lib/GHCup/Prelude/Ansi.hs @@ -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