Merge pull request #21 from vst/13-make-server-list-output-csv-format

feat: add CSV format to server list output options

.hlint.yaml

@@ -33,6 +33,7 @@
         - DeriveGeneric
         - DerivingVia
         - FlexibleContexts
+        - LambdaCase
         - OverloadedRecordDot
         - OverloadedStrings
         - QuasiQuotes

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:

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 "<unknown>" _serverName
-          , Types.stateCode _serverState
-          , maybe "<unknown>" formatIntegral _serverCpu
-          , maybe "<unknown>" formatIntegral _serverRam
-          , maybe "<unknown>" formatIntegral _serverDisk
-          , fromMaybe "<unknown>" _serverType
-          , maybe "<unknown>" Z.Text.tshow _serverCreatedAt
+          , _serverListItemProfile
+          , Types.providerCode _serverListItemProvider
+          , _serverListItemRegion
+          , _serverListItemId
+          , fromMaybe "<unknown>" _serverListItemName
+          , Types.stateCode _serverListItemState
+          , maybe "<unknown>" formatIntegral _serverListItemCpu
+          , maybe "<unknown>" formatIntegral _serverListItemRam
+          , maybe "<unknown>" formatIntegral _serverListItemDisk
+          , fromMaybe "<unknown>" _serverListItemType
+          , maybe "<unknown>" 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
 
 

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
+        }