Drop use of table-layout, thanks to Simon
This commit is contained in:
parent
4c2d4ee6bd
commit
40a1cc98c6
@ -64,7 +64,6 @@ import System.Environment
|
|||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO hiding ( appendFile )
|
import System.IO hiding ( appendFile )
|
||||||
import Text.Read hiding ( lift )
|
import Text.Read hiding ( lift )
|
||||||
import Text.Layout.Table
|
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
import qualified Data.ByteString as B
|
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.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1523,50 +1523,144 @@ printListResult raw lr = do
|
|||||||
setLocaleEncoding utf8
|
setLocaleEncoding utf8
|
||||||
|
|
||||||
let
|
let
|
||||||
formatted =
|
rows =
|
||||||
gridString
|
(\x -> if raw
|
||||||
( (if raw then [] else [column expand left def def])
|
then x
|
||||||
++ [ column expand left def def
|
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
|
||||||
, column expand left def def
|
)
|
||||||
, column expand left def def
|
. fmap
|
||||||
, column expand left def def
|
|
||||||
]
|
|
||||||
)
|
|
||||||
. (\x -> if raw
|
|
||||||
then x
|
|
||||||
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
|
|
||||||
)
|
|
||||||
$ fmap
|
|
||||||
(\ListResult {..} ->
|
(\ListResult {..} ->
|
||||||
let marks = if
|
let marks = if
|
||||||
| lSet -> (color Green "✔✔")
|
| lSet -> (color Green "✔✔")
|
||||||
| lInstalled -> (color Green "✓")
|
| lInstalled -> (color Green "✓ ")
|
||||||
| otherwise -> (color Red "✗")
|
| otherwise -> (color Red "✗ ")
|
||||||
in (if raw then [] else [marks])
|
in
|
||||||
++ [ fmap toLower . show $ lTool
|
(if raw then [] else [marks])
|
||||||
, case lCross of
|
++ [ fmap toLower . show $ lTool
|
||||||
Nothing -> T.unpack . prettyVer $ lVer
|
, case lCross of
|
||||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
Nothing -> T.unpack . prettyVer $ lVer
|
||||||
, intercalate "," $ (fmap printTag $ sort lTag)
|
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||||
, intercalate ","
|
, intercalate "," $ (fmap printTag $ sort lTag)
|
||||||
$ (if hlsPowered then [color' Green "hls-powered"] else mempty)
|
, intercalate ","
|
||||||
++ (if fromSrc then [color' Blue "compiled"] else mempty)
|
$ (if hlsPowered
|
||||||
++ (if lStray then [color' Yellow "stray"] else mempty)
|
then [color' Green "hls-powered"]
|
||||||
++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
|
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
|
$ lr
|
||||||
putStrLn $ formatted
|
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
|
where
|
||||||
printTag Recommended = color' Green "recommended"
|
printTag Recommended = color' Green "recommended"
|
||||||
printTag Latest = color' Yellow "latest"
|
printTag Latest = color' Yellow "latest"
|
||||||
printTag Prerelease = color' Red "prerelease"
|
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
|
printTag (UnknownTag t ) = t
|
||||||
|
|
||||||
color' = case raw of
|
color' = case raw of
|
||||||
True -> flip const
|
True -> flip const
|
||||||
False -> color
|
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)
|
checkForUpdates :: (MonadReader Settings m, MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
|
||||||
=> GHCupDownloads
|
=> GHCupDownloads
|
||||||
-> PlatformRequest
|
-> PlatformRequest
|
||||||
|
@ -180,9 +180,6 @@ common strict-base
|
|||||||
common string-interpolate
|
common string-interpolate
|
||||||
build-depends: string-interpolate >=0.2.0.0
|
build-depends: string-interpolate >=0.2.0.0
|
||||||
|
|
||||||
common table-layout
|
|
||||||
build-depends: table-layout >=0.8
|
|
||||||
|
|
||||||
common template-haskell
|
common template-haskell
|
||||||
build-depends: template-haskell >=2.7
|
build-depends: template-haskell >=2.7
|
||||||
|
|
||||||
@ -378,7 +375,6 @@ executable ghcup
|
|||||||
, safe
|
, safe
|
||||||
, safe-exceptions
|
, safe-exceptions
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, text
|
, text
|
||||||
, uri-bytestring
|
, uri-bytestring
|
||||||
@ -433,7 +429,6 @@ executable ghcup-gen
|
|||||||
, resourcet
|
, resourcet
|
||||||
, safe-exceptions
|
, safe-exceptions
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, table-layout
|
|
||||||
, text
|
, text
|
||||||
, transformers
|
, transformers
|
||||||
, uri-bytestring
|
, uri-bytestring
|
||||||
|
Loading…
Reference in New Issue
Block a user