From 2bc355c2af51dc6d6684284f9c8010f5346ddf56 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sun, 28 Apr 2024 10:36:19 +0800 Subject: [PATCH] feat: add CSV format to server list output options We now have three options: 1. Console (as an ASCII table) 2. CSV 3. JSON --- .hlint.yaml | 1 + package.yaml | 2 + src/Clompse/Cli.hs | 83 ++++++++++++++++-------- src/Clompse/Programs/ListServers.hs | 99 +++++++++++++++++++++++++++++ 4 files changed, 160 insertions(+), 25 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 0d60aef..3ee2bce 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -33,6 +33,7 @@ - DeriveGeneric - DerivingVia - FlexibleContexts + - LambdaCase - OverloadedRecordDot - OverloadedStrings - QuasiQuotes diff --git a/package.yaml b/package.yaml index 6cd8390..27e9226 100644 --- a/package.yaml +++ b/package.yaml @@ -26,6 +26,7 @@ library: - autodocodec - autodocodec-schema - bytestring + - cassava - conduit - format-numbers - githash @@ -42,6 +43,7 @@ library: - time - typed-process - unordered-containers + - vector - yaml executables: diff --git a/src/Clompse/Cli.hs b/src/Clompse/Cli.hs index 25e40cf..e24396f 100644 --- a/src/Clompse/Cli.hs +++ b/src/Clompse/Cli.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -- | This module provides top-level definitions for the CLI program. @@ -15,6 +15,7 @@ import Control.Applicative ((<**>), (<|>)) import Control.Monad (join) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.Csv as Cassava import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Format.Numbers as Fmt.Number @@ -116,6 +117,23 @@ commandServer = OA.hsubparser (OA.command "server" (OA.info parser infomod) <> O -- *** server list +-- | Output format for @server list@ CLI command. +data ServerListFormat + = ServerListFormatConsole + | ServerListFormatCsv + | ServerListFormatJson + deriving (Eq, Show) + + +-- | Parser for 'ServerListFormat'. +parseServerListFormat :: OA.ReadM ServerListFormat +parseServerListFormat = OA.eitherReader $ \case + "console" -> Right ServerListFormatConsole + "csv" -> Right ServerListFormatCsv + "json" -> Right ServerListFormatJson + x -> Left ("Unknown format: " <> x) + + -- | Definition for @server list@ CLI command. commandServerList :: OA.Parser (IO ExitCode) commandServerList = OA.hsubparser (OA.command "list" (OA.info parser infomod) <> OA.metavar "list") @@ -124,29 +142,46 @@ commandServerList = OA.hsubparser (OA.command "list" (OA.info parser infomod) <> parser = doServerList <$> OA.strOption (OA.short 'c' <> OA.long "config" <> OA.metavar "CONFIG" <> OA.help "Configuration file to use.") - <*> OA.switch (OA.short 'j' <> OA.long "json" <> OA.help "Format output in JSON.") + <*> OA.option + parseServerListFormat + ( OA.short 'f' + <> OA.long "format" + <> OA.value ServerListFormatConsole + <> OA.showDefault + <> OA.help "Output format (csv, json or console." + ) -- | @server list@ CLI command program. -doServerList :: FilePath -> Bool -> IO ExitCode -doServerList fp json = do +doServerList :: FilePath -> ServerListFormat -> IO ExitCode +doServerList fp fmt = do eCfg <- readConfigFile fp case eCfg of Left err -> TIO.putStrLn ("Error reading configuration: " <> err) >> pure (ExitFailure 1) Right cfg -> do - servers <- Programs.listServers cfg - (if json then doServerListPrintJson else doServerListTabulate) servers + servers <- concatMap Programs.toServerList <$> Programs.listServers cfg + case fmt of + ServerListFormatConsole -> doServerListConsole servers + ServerListFormatCsv -> doServerListCsv servers + ServerListFormatJson -> doServerListJson servers pure ExitSuccess -- | Prints list server results in JSON format. -doServerListPrintJson :: [Programs.ListServersResult] -> IO () -doServerListPrintJson = BLC.putStrLn . Aeson.encode +doServerListCsv :: Programs.ServerList -> IO () +doServerListCsv = + BLC.putStrLn . Cassava.encodeDefaultOrderedByName + + +-- | Prints list server results in JSON format. +doServerListJson :: Programs.ServerList -> IO () +doServerListJson = + BLC.putStrLn . Aeson.encode -- | Prints list server results in tabular format. -doServerListTabulate :: [Programs.ListServersResult] -> IO () -doServerListTabulate rs = +doServerListConsole :: Programs.ServerList -> IO () +doServerListConsole rs = let cs = [ Tab.numCol , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark @@ -176,24 +211,22 @@ doServerListTabulate rs = , "Type" , "Created" ] - mkRows i p Types.Server {..} = + mkRows i Programs.ServerListItem {..} = Tab.rowG . fmap T.unpack $ [ formatIntegral i - , p - , Types.providerCode _serverProvider - , _serverRegion - , _serverId - , fromMaybe "" _serverName - , Types.stateCode _serverState - , maybe "" formatIntegral _serverCpu - , maybe "" formatIntegral _serverRam - , maybe "" formatIntegral _serverDisk - , fromMaybe "" _serverType - , maybe "" Z.Text.tshow _serverCreatedAt + , _serverListItemProfile + , Types.providerCode _serverListItemProvider + , _serverListItemRegion + , _serverListItemId + , fromMaybe "" _serverListItemName + , Types.stateCode _serverListItemState + , maybe "" formatIntegral _serverListItemCpu + , maybe "" formatIntegral _serverListItemRam + , maybe "" formatIntegral _serverListItemDisk + , fromMaybe "" _serverListItemType + , maybe "" Z.Text.tshow _serverListItemCreatedAt ] - rows = - fmap (\(i, (p, s)) -> mkRows i p s) . zip [1 :: Int ..] $ - concatMap (\(Programs.ListServersResult p is) -> fmap (p,) is) rs + rows = fmap (uncurry mkRows) (zip [1 :: Int ..] rs) in putStrLn $ Tab.tableString cs Tab.unicodeS hs rows diff --git a/src/Clompse/Programs/ListServers.hs b/src/Clompse/Programs/ListServers.hs index dcbe320..9df3e0b 100644 --- a/src/Clompse/Programs/ListServers.hs +++ b/src/Clompse/Programs/ListServers.hs @@ -12,11 +12,16 @@ import qualified Clompse.Providers.Aws as Providers.Aws import qualified Clompse.Providers.Do as Providers.Do import qualified Clompse.Providers.Hetzner as Providers.Hetzner import Clompse.Types (Server) +import qualified Clompse.Types as Types import Control.Monad.Except (runExceptT) import Control.Monad.IO.Class (MonadIO (..)) import qualified Data.Aeson as Aeson +import qualified Data.Csv as Cassava +import Data.Int (Int16, Int32) import qualified Data.Text as T import qualified Data.Text.IO as TIO +import qualified Data.Time as Time +import qualified Data.Vector as V import GHC.Generics (Generic) import qualified System.IO import qualified Zamazingo.Text as Z.Text @@ -91,3 +96,97 @@ listServersForCloudConnection (CloudConnectionHetzner conn) = do _log :: MonadIO m => T.Text -> m () _log = liftIO . TIO.hPutStrLn System.IO.stderr + + +type ServerList = [ServerListItem] + + +data ServerListItem = ServerListItem + { _serverListItemProfile :: !T.Text + , _serverListItemProvider :: !Types.Provider + , _serverListItemRegion :: !T.Text + , _serverListItemId :: !T.Text + , _serverListItemName :: !(Maybe T.Text) + , _serverListItemState :: !Types.State + , _serverListItemCpu :: !(Maybe Int16) + , _serverListItemRam :: !(Maybe Int32) + , _serverListItemDisk :: !(Maybe Int32) + , _serverListItemType :: !(Maybe T.Text) + , _serverListItemCreatedAt :: !(Maybe Time.UTCTime) + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ServerListItem) + + +instance ADC.HasCodec ServerListItem where + codec = + _codec ADC. "Server List Item" + where + _codec = + ADC.object "ServerListItem" $ + ServerListItem + <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _serverListItemProfile + <*> ADC.requiredField "provider" "Provider of the server." ADC..= _serverListItemProvider + <*> ADC.requiredField "region" "Region of the server." ADC..= _serverListItemRegion + <*> ADC.requiredField "id" "ID of the server." ADC..= _serverListItemId + <*> ADC.optionalField "name" "Name of the server." ADC..= _serverListItemName + <*> ADC.requiredField "state" "State of the server." ADC..= _serverListItemState + <*> ADC.optionalField "cpu" "CPU of the server." ADC..= _serverListItemCpu + <*> ADC.optionalField "ram" "RAM of the server." ADC..= _serverListItemRam + <*> ADC.optionalField "disk" "Disk of the server." ADC..= _serverListItemDisk + <*> ADC.optionalField "type" "Type of the server." ADC..= _serverListItemType + <*> ADC.optionalField "created_at" "Creation time of the server." ADC..= _serverListItemCreatedAt + + +instance Cassava.ToNamedRecord ServerListItem where + toNamedRecord ServerListItem {..} = + Cassava.namedRecord + [ "profile" Cassava..= _serverListItemProfile + , "provider" Cassava..= Types.providerCode _serverListItemProvider + , "region" Cassava..= _serverListItemRegion + , "id" Cassava..= _serverListItemId + , "name" Cassava..= _serverListItemName + , "state" Cassava..= Types.stateCode _serverListItemState + , "cpu" Cassava..= _serverListItemCpu + , "ram" Cassava..= _serverListItemRam + , "disk" Cassava..= _serverListItemDisk + , "type" Cassava..= _serverListItemType + , "created_at" Cassava..= fmap Z.Text.tshow _serverListItemCreatedAt + ] + + +instance Cassava.DefaultOrdered ServerListItem where + headerOrder _ = + V.fromList + [ "profile" + , "provider" + , "region" + , "id" + , "name" + , "state" + , "cpu" + , "ram" + , "disk" + , "type" + , "created_at" + ] + + +toServerList :: ListServersResult -> ServerList +toServerList ListServersResult {..} = + fmap (go _listServersResultProfile) _listServersResultServers + where + go p Types.Server {..} = + ServerListItem + { _serverListItemProfile = p + , _serverListItemProvider = _serverProvider + , _serverListItemRegion = _serverRegion + , _serverListItemId = _serverId + , _serverListItemName = _serverName + , _serverListItemState = _serverState + , _serverListItemCpu = _serverCpu + , _serverListItemRam = _serverRam + , _serverListItemDisk = _serverDisk + , _serverListItemType = _serverType + , _serverListItemCreatedAt = _serverCreatedAt + }