packages feed

seihou-core-0.4.0.0: src/Seihou/Interaction/Prompt.hs

module Seihou.Interaction.Prompt
  ( runPrompts,
    promptForVar,
  )
where

import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Seihou.Core.Expr (evalExpr)
import Seihou.Core.Types
import Seihou.Core.Variable (coerceValue, validateVarValue)
import Seihou.Effect.Console (Console, getLine, putText)
import Seihou.Prelude
import Prelude hiding (getLine)

-- | Run prompts for unresolved variables.
--
-- For each prompt whose variable is in the unresolved set:
-- 1. Evaluate the prompt's @condition@ against current bindings.
-- 2. If the condition is false, skip.
-- 3. Display the prompt text and read input (or show choice menu).
-- 4. Coerce and validate the input.
-- 5. On failure, retry up to 3 times.
--
-- Returns a map of newly resolved variables with 'FromPrompt' source.
runPrompts ::
  (Console :> es) =>
  [Prompt] ->
  [VarDecl] ->
  Map VarName VarValue ->
  Eff es (Map VarName ResolvedVar)
runPrompts prompts unresolvedDecls currentBindings =
  go prompts Map.empty
  where
    declMap = Map.fromList [(d.name, d) | d <- unresolvedDecls]

    go :: (Console :> es) => [Prompt] -> Map VarName ResolvedVar -> Eff es (Map VarName ResolvedVar)
    go [] acc = pure acc
    go (p : ps) acc = do
      let vn = p.var
      -- Skip if variable is not in the unresolved set
      case Map.lookup vn declMap of
        Nothing -> go ps acc
        Just decl -> do
          -- Skip if already resolved by an earlier prompt
          if Map.member vn acc
            then go ps acc
            else do
              -- Evaluate when condition
              let allBindings = Map.union (Map.map (.value) acc) currentBindings
              if shouldPrompt p allBindings
                then do
                  result <- promptForVar p decl allBindings
                  case result of
                    Left _err -> go ps acc
                    Right rv -> go ps (Map.insert vn rv acc)
                else go ps acc

-- | Check if a prompt should be displayed based on its @when@ condition.
shouldPrompt :: Prompt -> Map VarName VarValue -> Bool
shouldPrompt p bindings =
  case p.condition of
    Nothing -> True
    Just expr -> evalExpr bindings expr

-- | Prompt for a single variable value.
-- Displays the prompt text, reads input, coerces to the declared type,
-- and validates. Retries up to 3 times on failure.
promptForVar ::
  (Console :> es) =>
  Prompt ->
  VarDecl ->
  Map VarName VarValue ->
  Eff es (Either VarError ResolvedVar)
promptForVar prompt decl _bindings =
  case prompt.choices of
    Just choices -> promptWithChoices prompt decl choices
    Nothing -> promptFreeText prompt decl 3

-- | Prompt with free text input. Retries up to @maxRetries@ times.
--
-- When the variable has a default value, it is shown in brackets after the
-- prompt text (e.g., @Project version [0.1.0.0]:@). Empty input accepts the
-- default. For optional variables without a default, empty input skips.
promptFreeText ::
  (Console :> es) =>
  Prompt ->
  VarDecl ->
  Int ->
  Eff es (Either VarError ResolvedVar)
promptFreeText prompt decl retriesLeft = do
  putText (formatPromptText prompt decl)
  raw <- getLine
  if T.null (T.strip raw)
    then case decl.default_ of
      Just defVal ->
        -- Accept the default value
        pure
          ( Right
              ResolvedVar
                { value = defVal,
                  source = FromPrompt,
                  decl = decl
                }
          )
      Nothing
        | not decl.required ->
            -- Optional variable with no default — skip
            pure (Left (MissingRequiredVar decl.name))
        | retriesLeft > 1 -> do
            putText "Value cannot be empty. Please try again."
            promptFreeText prompt decl (retriesLeft - 1)
        | otherwise ->
            pure (Left (MissingRequiredVar decl.name))
    else case coerceAndValidate decl raw of
      Left err ->
        if retriesLeft > 1
          then do
            putText ("Invalid input: " <> formatCoercionError err <> ". Please try again.")
            promptFreeText prompt decl (retriesLeft - 1)
          else pure (Left err)
      Right rv -> pure (Right rv)

-- | Prompt with a numbered choice menu.
promptWithChoices ::
  (Console :> es) =>
  Prompt ->
  VarDecl ->
  [Text] ->
  Eff es (Either VarError ResolvedVar)
promptWithChoices prompt decl choices = do
  putText prompt.text
  mapM_ (\(i, c) -> putText ("  " <> T.pack (show i) <> ") " <> c)) (zip [1 :: Int ..] choices)
  putText "Enter selection number:"
  raw <- getLine
  case reads (T.unpack (T.strip raw)) of
    [(n, "")]
      | n >= 1 && n <= length choices ->
          let chosen = choices !! (n - 1)
           in case coerceAndValidate decl chosen of
                Left err -> pure (Left err)
                Right rv -> pure (Right rv)
    _ -> do
      putText ("Please enter a number between 1 and " <> T.pack (show (length choices)) <> ".")
      -- Retry once
      raw2 <- getLine
      case reads (T.unpack (T.strip raw2)) of
        [(n, "")]
          | n >= 1 && n <= length choices ->
              let chosen = choices !! (n - 1)
               in case coerceAndValidate decl chosen of
                    Left err -> pure (Left err)
                    Right rv -> pure (Right rv)
        _ -> pure (Left (MissingRequiredVar decl.name))

-- | Coerce raw text to the variable's type and validate.
coerceAndValidate :: VarDecl -> Text -> Either VarError ResolvedVar
coerceAndValidate decl raw = do
  val <- coerceValue decl.name decl.type_ raw
  validateVarValue decl val
  pure
    ResolvedVar
      { value = val,
        source = FromPrompt,
        decl = decl
      }

-- | Format a VarError for display during retry prompts.
formatCoercionError :: VarError -> Text
formatCoercionError (CoercionFailed _ ty raw) =
  "cannot convert '" <> raw <> "' to " <> showType ty
formatCoercionError (ValidationFailed _ msg) = msg
formatCoercionError (MissingRequiredVar (VarName n)) = "missing value for " <> n
formatCoercionError (TypeMismatch (VarName n) _ _) = "type mismatch for " <> n

showType :: VarType -> Text
showType VTText = "text"
showType VTBool = "bool"
showType VTInt = "int"
showType (VTList _) = "list"
showType (VTChoice _) = "choice"

-- | Format the prompt text, appending a default value hint in brackets
-- when the variable has one (e.g., @"Project version [0.1.0.0]:"@).
-- For optional variables without a default, appends @[skip]@.
formatPromptText :: Prompt -> VarDecl -> Text
formatPromptText prompt decl =
  case decl.default_ of
    Just defVal -> prompt.text <> " [" <> showDefaultValue defVal <> "]:"
    Nothing
      | not decl.required -> prompt.text <> " [skip]:"
      | otherwise -> prompt.text

-- | Render a VarValue for display in a prompt's default hint.
showDefaultValue :: VarValue -> Text
showDefaultValue (VText t) = t
showDefaultValue (VBool True) = "yes"
showDefaultValue (VBool False) = "no"
showDefaultValue (VInt n) = T.pack (show n)
showDefaultValue (VList vs) = T.intercalate ", " (map showDefaultValue vs)