packages feed

kiroku-cli-0.1.0.0: src/Kiroku/Cli/Standalone.hs

module Kiroku.Cli.Standalone (
    StandaloneOptions (..),
    StandaloneRuntime (..),
    standaloneOptionsParser,
    standaloneParserInfo,
    resolveStandaloneOptions,
    runStandaloneCommand,
) where

import Control.Applicative (optional, (<|>))
import Control.Lens ((&), (.~))
import Data.Generics.Labels ()
import Data.Text (Text)
import Data.Text qualified as T
import Kiroku.Cli.Command (KirokuCommand (..), OutputFormat (..), StatusOptions (..), SubscriptionCommand (..))
import Kiroku.Cli.Parser (kirokuCommandParser)
import Kiroku.Cli.Subscription.Status (renderSubscriptionStatusRows, subscriptionStatusRows)
import Kiroku.Store (ConnectionSettings, KirokuStore, defaultConnectionSettings, withStore)
import Kiroku.Store.Subscription (subscriptionStates)
import Options.Applicative (
    Parser,
    ParserInfo,
    auto,
    fullDesc,
    header,
    help,
    helper,
    info,
    long,
    metavar,
    option,
    progDesc,
    strOption,
    value,
    (<**>),
 )

data StandaloneOptions = StandaloneOptions
    { databaseUrl :: !(Maybe Text)
    , schema :: !Text
    , poolSize :: !Int
    , standaloneCommand :: !KirokuCommand
    }
    deriving stock (Eq, Show)

data StandaloneRuntime = StandaloneRuntime
    { settings :: !ConnectionSettings
    , runtimeCommand :: !KirokuCommand
    }

standaloneParserInfo :: ParserInfo StandaloneOptions
standaloneParserInfo =
    info
        (standaloneOptionsParser <**> helper)
        ( fullDesc
            <> progDesc "Run Kiroku operator commands against a store opened by this process. Subscription status reads this process-local live registry."
            <> header "kiroku - operator commands for Kiroku event stores"
        )

standaloneOptionsParser :: Parser StandaloneOptions
standaloneOptionsParser =
    StandaloneOptions
        <$> optional
            ( strOption
                ( long "database-url"
                    <> metavar "URL"
                    <> help "PostgreSQL connection string. Defaults to KIROKU_DATABASE_URL."
                )
            )
        <*> strOption
            ( long "schema"
                <> metavar "SCHEMA"
                <> value "kiroku"
                <> help "PostgreSQL schema that owns Kiroku objects."
            )
        <*> option
            auto
            ( long "pool-size"
                <> metavar "INT"
                <> value 2
                <> help "Connection pool size for this operator command."
            )
        <*> kirokuCommandParser

resolveStandaloneOptions :: [(String, String)] -> StandaloneOptions -> Either Text StandaloneRuntime
resolveStandaloneOptions env opts
    | poolSize opts <= 0 = Left "kiroku: --pool-size must be greater than zero"
    | otherwise = do
        conn <- case databaseUrl opts <|> (T.pack <$> lookup "KIROKU_DATABASE_URL" env) of
            Just connString | not (T.null connString) -> Right connString
            _ -> Left "kiroku: missing database connection string; pass --database-url or set KIROKU_DATABASE_URL"
        pure
            StandaloneRuntime
                { settings =
                    defaultConnectionSettings conn
                        & #schema .~ schema opts
                        & #poolSize .~ poolSize opts
                , runtimeCommand = standaloneCommand opts
                }

runStandaloneCommand :: StandaloneRuntime -> IO Text
runStandaloneCommand runtime =
    withStore (settings runtime) $ \store ->
        renderStandaloneCommand store (runtimeCommand runtime)

renderStandaloneCommand :: KirokuStore -> KirokuCommand -> IO Text
renderStandaloneCommand _ KirokuNoCommand =
    pure "No Kiroku operator command was selected."
renderStandaloneCommand store (KirokuSubscriptions (SubscriptionStatus (StatusOptions format))) = do
    snapshot <- subscriptionStates store
    let rows = subscriptionStatusRows snapshot
        rendered = renderSubscriptionStatusRows format rows
    pure $
        case (format, rows) of
            (OutputTable, []) ->
                rendered
                    <> "No live subscriptions in this process-local registry. Standalone status cannot inspect subscriptions running in another service process."
            _ -> rendered