From 40a1cc98c6ea7eb06eeca7a37915a5075451420b Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 22 Sep 2020 21:05:59 +0200 Subject: [PATCH] Drop use of table-layout, thanks to Simon --- app/ghcup/Main.hs | 158 ++++++++++++++++++++++++++++++++++++---------- ghcup.cabal | 5 -- 2 files changed, 126 insertions(+), 37 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index bb1a585..c79d82f 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -64,7 +64,6 @@ import System.Environment import System.Exit import System.IO hiding ( appendFile ) import Text.Read hiding ( lift ) -import Text.Layout.Table import URI.ByteString import qualified Data.ByteString as B @@ -73,6 +72,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Encoding as E import qualified Text.Megaparsec as MP +import qualified Text.Megaparsec.Char as MPC @@ -1523,50 +1523,144 @@ printListResult raw lr = do setLocaleEncoding utf8 let - formatted = - gridString - ( (if raw then [] else [column expand left def def]) - ++ [ column expand left def def - , column expand left def def - , column expand left def def - , column expand left def def - ] - ) - . (\x -> if raw - then x - else [color Green "", "Tool", "Version", "Tags", "Notes"] : x - ) - $ fmap + rows = + (\x -> if raw + then x + else [color Green "", "Tool", "Version", "Tags", "Notes"] : x + ) + . fmap (\ListResult {..} -> let marks = if | lSet -> (color Green "✔✔") - | lInstalled -> (color Green "✓") - | otherwise -> (color Red "✗") - in (if raw then [] else [marks]) - ++ [ fmap toLower . show $ lTool - , case lCross of - Nothing -> T.unpack . prettyVer $ lVer - Just c -> T.unpack (c <> "-" <> prettyVer lVer) - , intercalate "," $ (fmap printTag $ sort lTag) - , intercalate "," - $ (if hlsPowered then [color' Green "hls-powered"] else mempty) - ++ (if fromSrc then [color' Blue "compiled"] else mempty) - ++ (if lStray then [color' Yellow "stray"] else mempty) - ++ (if lNoBindist then [color' Red "no-bindist"] else mempty) - ] + | lInstalled -> (color Green "✓ ") + | otherwise -> (color Red "✗ ") + in + (if raw then [] else [marks]) + ++ [ fmap toLower . show $ lTool + , case lCross of + Nothing -> T.unpack . prettyVer $ lVer + Just c -> T.unpack (c <> "-" <> prettyVer lVer) + , intercalate "," $ (fmap printTag $ sort lTag) + , intercalate "," + $ (if hlsPowered + then [color' Green "hls-powered"] + else mempty + ) + ++ (if fromSrc then [color' Blue "compiled"] else mempty) + ++ (if lStray then [color' Yellow "stray"] else mempty) + ++ (if lNoBindist + then [color' Red "no-bindist"] + else mempty + ) + ] ) - lr - putStrLn $ formatted + $ lr + let cols = + foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows + lengths = fmap maximum . (fmap . fmap) strWidth $ cols + padded = fmap (\xs -> zipWith padTo xs lengths) rows + + forM_ padded $ \row -> putStrLn $ intercalate " " row where printTag Recommended = color' Green "recommended" printTag Latest = color' Yellow "latest" printTag Prerelease = color' Red "prerelease" - printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') + printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (UnknownTag t ) = t + color' = case raw of True -> flip const False -> color + padTo str' x = + let lstr = strWidth str' + 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 + + checkForUpdates :: (MonadReader Settings m, MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m) => GHCupDownloads -> PlatformRequest diff --git a/ghcup.cabal b/ghcup.cabal index bf67f5e..92bf1e7 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -180,9 +180,6 @@ common strict-base common string-interpolate build-depends: string-interpolate >=0.2.0.0 -common table-layout - build-depends: table-layout >=0.8 - common template-haskell build-depends: template-haskell >=2.7 @@ -378,7 +375,6 @@ executable ghcup , safe , safe-exceptions , string-interpolate - , table-layout , template-haskell , text , uri-bytestring @@ -433,7 +429,6 @@ executable ghcup-gen , resourcet , safe-exceptions , string-interpolate - , table-layout , text , transformers , uri-bytestring