packages feed

keiro-ops-0.12.0.0: src/Keiro/Ops/Render.hs

module Keiro.Ops.Render
  ( OpsOutcome (..),
    OpsResult (..),
    emptyResult,
    jsonText,
    messageResult,
    renderHuman,
    renderResult,
    truncateCell,
  )
where

import Data.Aeson (Value, object, (.=))
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LazyByteString.Raw
import Data.ByteString.Lazy.Char8 qualified as LazyByteString
import Data.List (transpose)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encoding
import Data.Text.IO qualified as Text.IO
import Keiro.Ops.Env (OpsEnv (..), OutputMode (..))
import System.Exit (ExitCode)

data OpsResult = OpsResult
  { headers :: ![Text],
    rows :: ![[Text]],
    jsonValue :: !Value
  }
  deriving stock (Eq, Show)

data OpsOutcome
  = Succeeded !OpsResult
  | SucceededWithExit !OpsResult !ExitCode
  | PreviewRequired !OpsResult !Text
  | Failed !Text
  deriving stock (Eq, Show)

emptyResult :: OpsResult
emptyResult = OpsResult [] [] (Aeson.Array mempty)

messageResult :: Text -> OpsResult
messageResult message =
  OpsResult
    { headers = ["message"],
      rows = [[message]],
      jsonValue = object ["message" .= message]
    }

jsonText :: Value -> Text
jsonText = Text.Encoding.decodeUtf8 . LazyByteString.Raw.toStrict . Aeson.encode

truncateCell :: Int -> Text -> Text
truncateCell limit value
  | Text.length value <= limit = value
  | limit <= 1 = Text.take limit value
  | otherwise = Text.take (limit - 1) value <> "…"

renderResult :: OpsEnv -> OpsResult -> IO ()
renderResult env result =
  case env.outputMode of
    HumanTable -> Text.IO.putStrLn (renderHuman result)
    Json -> LazyByteString.putStrLn (Aeson.encode result.jsonValue)

renderHuman :: OpsResult -> Text
renderHuman OpsResult {headers, rows}
  | null headers = ""
  | otherwise =
      Text.unlines
        ( renderRow widths headers
            : renderSeparator widths
            : map (renderRow widths . normalizeRow (length headers)) rows
        )
  where
    normalizedRows = map (normalizeRow (length headers)) rows
    columns = transpose (headers : normalizedRows)
    widths = map (maximum . map Text.length) columns

normalizeRow :: Int -> [Text] -> [Text]
normalizeRow width row = take width (row <> repeat "")

renderRow :: [Int] -> [Text] -> Text
renderRow widths cells =
  Text.intercalate "  " (zipWith pad widths cells)
  where
    pad width cell = cell <> Text.replicate (width - Text.length cell) " "

renderSeparator :: [Int] -> Text
renderSeparator = Text.intercalate "  " . map (`Text.replicate` "-")