packages feed

plexus-synapse-0.3.0.0: src/Synapse/CLI/Help.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}

-- | IR-based help rendering for CLI
--
-- Renders method and parameter help directly from the IR, providing
-- structured type information including discriminated union expansion.
--
-- = Design
--
-- Instead of parsing JSON Schema ad-hoc, we use the pre-built IR:
--
-- @
-- IR (types, methods)
--   |
--   +-> renderMethodHelp  -> full method documentation
--   +-> renderParamHelp   -> parameter with type expansion
--   +-> expandType        -> discriminated union variants
--   +-> renderTypeRef     -> type signature string
-- @
--
-- = Example Output
--
-- @
-- cone.chat - Chat with a cone
--
-- Parameters:
--   --identifier <ConeIdentifier>  (required)
--       Cone name or UUID
--       Either:
--         --identifier.type by_name --identifier.name <string>
--         --identifier.type by_id --identifier.id <uuid>
--
--   --prompt <string>  (required)
--       User message / prompt to send
--
--   --ephemeral <boolean>  (optional)
--       If true, doesn't advance head
-- @
module Synapse.CLI.Help
  ( -- * Method Help
    renderMethodHelp
  , renderMethodHelpWith

    -- * Parameter Help
  , renderParamHelp
  , renderParamHelpWith

    -- * Type Rendering
  , renderTypeRef
  , expandType

    -- * Configuration
  , HelpStyle(..)
  , defaultHelpStyle
  ) where

import Data.List (intersperse)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, maybeToList)
import Data.Text (Text)
import qualified Data.Text as T

import Synapse.IR.Types

-- ============================================================================
-- Configuration
-- ============================================================================

-- | Style configuration for help rendering
data HelpStyle = HelpStyle
  { hsIndent      :: !Int       -- ^ Spaces per indent level
  , hsParamWidth  :: !Int       -- ^ Width for parameter column
  , hsShowFormats :: !Bool      -- ^ Show format hints (uuid, int64, etc.)
  , hsExpandEnums :: !Bool      -- ^ Expand enum variants inline
  }
  deriving stock (Show, Eq)

-- | Default help style
defaultHelpStyle :: HelpStyle
defaultHelpStyle = HelpStyle
  { hsIndent      = 2
  , hsParamWidth  = 30
  , hsShowFormats = True
  , hsExpandEnums = True
  }

-- ============================================================================
-- Method Help
-- ============================================================================

-- | Render complete help for a method
renderMethodHelp :: IR -> MethodDef -> Text
renderMethodHelp = renderMethodHelpWith defaultHelpStyle

-- | Render method help with custom style
renderMethodHelpWith :: HelpStyle -> IR -> MethodDef -> Text
renderMethodHelpWith style ir method = T.unlines $
  [ header
  , ""
  ] ++ descSection ++ paramSection
  where
    header = mdFullPath method <> streamingIndicator

    streamingIndicator
      | mdStreaming method = " [streaming]"
      | otherwise = ""

    descSection = case mdDescription method of
      Just desc -> [desc, ""]
      Nothing -> []

    paramSection
      | null (mdParams method) = ["(no parameters)"]
      | otherwise =
          ["Parameters:"] ++
          concatMap (renderParamBlock style ir) (mdParams method)

-- | Render a parameter as a block (may be multi-line for complex types)
renderParamBlock :: HelpStyle -> IR -> ParamDef -> [Text]
renderParamBlock style ir param =
  let indent' = T.replicate (hsIndent style) " "
      indent2 = T.replicate (hsIndent style * 2) " "

      -- Parameter header line
      flagName = "--" <> T.replace "_" "-" (pdName param)  -- Display as kebab-case
      typeStr = renderTypeRef ir (pdType param)
      reqText = if pdRequired param then "(required)" else "(optional)"
      headerLine = indent' <> flagName <> " <" <> typeStr <> ">  " <> reqText

      -- Description line
      descLines = case pdDescription param of
        Just desc -> [indent2 <> desc]
        Nothing -> []

      -- Type expansion (for enums/unions)
      expansionLines = if hsExpandEnums style
        then map (indent2 <>) (expandType ir (pdName param) (pdType param))
        else []

  in [""] ++ [headerLine] ++ descLines ++ expansionLines

-- ============================================================================
-- Parameter Help
-- ============================================================================

-- | Render help for a single parameter
renderParamHelp :: IR -> ParamDef -> [Text]
renderParamHelp = renderParamHelpWith defaultHelpStyle

-- | Render parameter help with custom style
renderParamHelpWith :: HelpStyle -> IR -> ParamDef -> [Text]
renderParamHelpWith style ir param = renderParamBlock style ir param

-- ============================================================================
-- Type Rendering
-- ============================================================================

-- | Render a type reference as a type signature string
--
-- Examples:
--   RefPrimitive "string" Nothing  -> "string"
--   RefPrimitive "string" (Just "uuid") -> "uuid"
--   RefArray (RefPrimitive "string" Nothing) -> "string[]"
--   RefOptional (RefNamed "Foo") -> "Foo?"
--   RefNamed "ConeIdentifier" -> "ConeIdentifier"
renderTypeRef :: IR -> TypeRef -> Text
renderTypeRef ir = \case
  RefNamed qn -> qualifiedNameFull qn

  RefPrimitive typ mFormat
    | Just fmt <- mFormat -> fmt  -- Use format as type (uuid, int64, etc.)
    | otherwise -> typ

  RefArray inner -> renderTypeRef ir inner <> "[]"

  RefOptional inner -> renderTypeRef ir inner <> "?"

  RefAny -> "any"

  RefUnknown -> "unknown"

-- | Expand a type into CLI flag examples
--
-- For discriminated unions, shows each variant with its fields.
-- Returns empty list for simple types.
--
-- Example for ConeIdentifier:
-- @
--   ["Either:"
--   ,"  --identifier.type by_name --identifier.name <string>"
--   ,"  --identifier.type by_id --identifier.id <uuid>"
--   ]
-- @
expandType :: IR -> Text -> TypeRef -> [Text]
expandType ir prefix = \case
  RefNamed qn -> expandNamedType ir prefix (qualifiedNameFull qn)
  RefOptional inner -> expandType ir prefix inner
  _ -> []  -- Primitives and arrays don't expand

-- | Expand a named type by looking it up in the IR
expandNamedType :: IR -> Text -> Text -> [Text]
expandNamedType ir prefix typeName =
  case Map.lookup typeName (irTypes ir) of
    Nothing -> []  -- Type not found, no expansion
    Just typeDef -> expandTypeDef ir prefix typeDef

-- | Expand a type definition
expandTypeDef :: IR -> Text -> TypeDef -> [Text]
expandTypeDef ir prefix TypeDef{..} = case tdKind of
  -- Discriminated union: show each variant
  KindEnum discriminator variants
    | length variants > 1 -> expandEnum ir prefix discriminator variants
    | otherwise -> []

  -- Struct: could expand fields, but typically too verbose
  KindStruct _fields -> []

  -- Alias: expand the target
  KindAlias target -> expandType ir prefix target

  -- Primitives don't expand
  KindPrimitive _ _ -> []

  -- String enums don't expand (just string literals)
  KindStringEnum _ -> []

-- | Expand an enum (discriminated union) into variant examples
expandEnum :: IR -> Text -> Text -> [VariantDef] -> [Text]
expandEnum ir prefix discriminator variants =
  ["Either:"] ++ map (("  " <>) . renderVariantExample ir prefix discriminator) variants

-- | Render a single variant as a CLI example
--
-- Example: "--identifier.type by_name --identifier.name <string>"
renderVariantExample :: IR -> Text -> Text -> VariantDef -> Text
renderVariantExample ir prefix discriminator VariantDef{..} =
  let prefix' = T.replace "_" "-" prefix  -- Display as kebab-case
      disc' = T.replace "_" "-" discriminator  -- Display as kebab-case
      discFlag = "--" <> prefix' <> "." <> disc' <> " " <> vdName
      fieldFlags = map (renderFieldFlag ir prefix') vdFields
  in T.intercalate " " (discFlag : fieldFlags)

-- | Render a field as a CLI flag
--
-- Example: "--identifier.name <string>"
renderFieldFlag :: IR -> Text -> FieldDef -> Text
renderFieldFlag ir prefix FieldDef{..} =
  let name' = T.replace "_" "-" fdName  -- Display as kebab-case
  in "--" <> prefix <> "." <> name' <> " <" <> renderTypeRef ir fdType <> ">"

-- ============================================================================
-- String Enum Helpers
-- ============================================================================

-- | Check if a type is a string enum and get its values
getStringEnumValues :: IR -> TypeRef -> Maybe [Text]
getStringEnumValues ir (RefNamed qn) =
  let name = qualifiedNameFull qn
  in case Map.lookup name (irTypes ir) of
    Just TypeDef{tdKind = KindEnum "value" variants} ->
      Just $ map vdName variants
    _ -> Nothing
getStringEnumValues _ _ = Nothing

-- | Render string enum values inline
-- Example: "One of: pending, in_progress, completed"
renderStringEnumHint :: [Text] -> Text
renderStringEnumHint values = "One of: " <> T.intercalate ", " values