Re-add --format-raw to list subcommand

This commit is contained in:
Julian Ospald 2020-04-22 12:30:02 +02:00
parent 6c12eb16eb
commit 7f5cb64b18
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 43 additions and 28 deletions

View File

@ -32,7 +32,7 @@ import Data.Bifunctor
import Data.Char import Data.Char
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.List ( intercalate ) import Data.List ( intercalate, sortBy )
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
@ -103,8 +103,9 @@ data SetGHCOptions = SetGHCOptions
} }
data ListOptions = ListOptions data ListOptions = ListOptions
{ lTool :: Maybe Tool { lTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria , lCriteria :: Maybe ListCriteria
, lRawFormat :: Bool
} }
data RmOptions = RmOptions data RmOptions = RmOptions
@ -309,6 +310,9 @@ listOpts =
) )
) )
) )
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
rmOpts :: Parser RmOptions rmOpts :: Parser RmOptions
rmOpts = RmOptions <$> versionArgument rmOpts = RmOptions <$> versionArgument
@ -830,7 +834,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
) )
>>= \case >>= \case
VRight r -> do VRight r -> do
liftIO $ printListResult r liftIO $ printListResult lRawFormat r
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
@ -1006,42 +1010,53 @@ fromVersion _ (Just (ToolTag t')) tool =
throwE $ TagNotFound t' tool throwE $ TagNotFound t' tool
printListResult :: [ListResult] -> IO () printListResult :: Bool -> [ListResult] -> IO ()
printListResult lr = do printListResult raw lr = do
-- https://gitlab.haskell.org/ghc/ghc/issues/8118 -- https://gitlab.haskell.org/ghc/ghc/issues/8118
setLocaleEncoding utf8 setLocaleEncoding utf8
let let
formatted = formatted =
gridString gridString
[ column expand left def def ( (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
, 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 $ fmap
(\ListResult {..} -> (\ListResult {..} ->
[ if let marks = if
| lSet -> (color Green "✔✔") | lSet -> (color Green "✔✔")
| lInstalled -> (color Green "") | lInstalled -> (color Green "")
| otherwise -> (color Red "") | otherwise -> (color Red "")
, fmap toLower . show $ lTool in (if raw then [] else [marks])
, T.unpack . prettyVer $ lVer ++ [ fmap toLower . show $ lTool
, intercalate "," $ (fmap printTag $ lTag) , T.unpack . prettyVer $ lVer
, intercalate "," $ , intercalate "," $ (fmap printTag $ sortBy tagOrd lTag)
(if fromSrc then [color Blue "compiled"] else mempty) , intercalate ","
++ (if lStray then [color Blue "stray"] else mempty) $ (if fromSrc then [color' Blue "compiled"] else mempty)
] ++ (if lStray then [color' Blue "stray"] else mempty)
]
) )
lr lr
putStrLn $ formatted putStrLn $ formatted
where where
printTag Recommended = color Green "recommended" printTag Recommended = color' Green "recommended"
printTag Latest = color Yellow "latest" printTag Latest = color' Yellow "latest"
printTag (Base pvp'') = color Blue ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = color' Blue ("base-" ++ T.unpack (prettyPVP pvp''))
printTag (UnknownTag t) = t printTag (UnknownTag t ) = t
color' = case raw of
True -> flip const
False -> color
tagOrd (Base _) _ = LT
tagOrd _ (Base _) = GT
tagOrd a b = compare a b
checkForUpdates :: (MonadThrow m, MonadIO m, MonadFail m, MonadLogger m) checkForUpdates :: (MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
=> GHCupDownloads => GHCupDownloads