{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Clod.Output
-- Description : User interface and output formatting
-- Copyright   : (c) Fuzz Leonard, 2025
-- License     : MIT
-- Maintainer  : cyborg@bionicfuzz.com
-- Stability   : experimental
--
-- This module provides functions for user interaction and output formatting.
-- It handles terminal output with consistent styling, user prompts, and
-- guidance for next steps after file processing.
--
-- The module uses ANSI color codes to provide a clear, color-coded interface:
--
-- * Green for success messages
-- * Red for error messages
-- * Yellow for warnings and headers
--
-- It also provides interactive prompts for users to make decisions
-- and displays next steps for using the processed files with Claude AI.

module Clod.Output
  ( -- * Terminal output
    printHeader
  , printSuccess
  , printError
  , printWarning
  
    -- * User interaction
  , promptUser
  , promptYesNo
  
    -- * Next steps
  , showNextSteps
  ) where

import Control.Monad (unless)
import System.IO (hFlush, stdout)

import Clod.Types

-- | ANSI color codes for pretty printing
red, green, yellow, noColor :: String
red :: [Char]
red = [Char]
"\ESC[0;31m"
green :: [Char]
green = [Char]
"\ESC[0;32m"
yellow :: [Char]
yellow = [Char]
"\ESC[1;33m"
noColor :: [Char]
noColor = [Char]
"\ESC[0m"

-- | Print a header message in yellow
printHeader :: String -> ClodM ()
printHeader :: [Char] -> ClodM ()
printHeader [Char]
msg = IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
yellow [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
noColor

-- | Print a success message in green
printSuccess :: String -> ClodM ()
printSuccess :: [Char] -> ClodM ()
printSuccess [Char]
msg = IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
green [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"✓ " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
noColor

-- | Print an error message in red
printError :: String -> ClodM ()
printError :: [Char] -> ClodM ()
printError [Char]
msg = IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
red [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"✗ " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
noColor

-- | Print a warning message in yellow
printWarning :: String -> ClodM ()
printWarning :: [Char] -> ClodM ()
printWarning [Char]
msg = IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
yellow [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"! " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
noColor

-- | Prompt the user for input with a default value
--
-- This function displays a prompt with a default value in brackets.
-- If the user presses Enter without typing anything, the default value is used.
--
-- @
-- -- Prompt for staging directory with default
-- stagingDir <- promptUser "Staging directory" "/home/user/Claude"
-- @
promptUser :: String  -- ^ The prompt to display
           -> String  -- ^ Default value to use if user input is empty
           -> ClodM String  -- ^ The user's input or default value
promptUser :: [Char] -> [Char] -> ClodM [Char]
promptUser [Char]
prompt [Char]
defaultValue = do
  IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
prompt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
defaultValue [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]: "
  IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
  response <- IO [Char] -> ClodM [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getLine
  return $ if null response then defaultValue else response

-- | Prompt the user for a yes/no response
promptYesNo :: String -> Bool -> ClodM Bool
promptYesNo :: [Char] -> Bool -> ClodM Bool
promptYesNo [Char]
prompt Bool
defaultYes = do
  let defaultStr :: [Char]
defaultStr = if Bool
defaultYes then [Char]
"Y/n" else [Char]
"y/N"
  IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
prompt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
defaultStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]: "
  IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
  response <- IO [Char] -> ClodM [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getLine
  return $ case response of
    [Char]
"" -> Bool
defaultYes
    [Char]
r  -> ([Char]
r [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"y", [Char]
"Y", [Char]
"yes", [Char]
"Yes", [Char]
"YES"])

-- | Show next steps for using the processed files with Claude AI
--
-- This function displays guidance on how to use the processed files
-- with Claude AI's Project Knowledge feature. It's shown after successful
-- file processing, unless in test mode.
--
-- The instructions cover:
--
-- * Navigating to Project Knowledge in Claude
-- * Uploading files from the staging folder
-- * Using the path manifest to understand file origins
-- * Adding project instructions
-- * Managing file versions
--
-- @
-- -- Show next steps after processing files
-- showNextSteps config stagingDir
-- @
showNextSteps :: ClodConfig  -- ^ Program configuration
              -> FilePath    -- ^ Path to the staging directory
              -> ClodM ()
showNextSteps :: ClodConfig -> [Char] -> ClodM ()
showNextSteps ClodConfig
config [Char]
_ = Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ClodConfig -> Bool
testMode ClodConfig
config) (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ 
  ([Char] -> ClodM ()) -> [[Char]] -> ClodM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> ([Char] -> IO ()) -> [Char] -> ClodM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn) ([[Char]] -> ClodM ()) -> [[Char]] -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [[Char]
""] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
steps [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
""] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
notes
  where
    -- Numbered steps for Claude integration
    steps :: [[Char]]
steps = (Int -> [Char] -> [Char]) -> [Int] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Char] -> [Char]
formatStep [Int
1..] 
      [ [Char]
"Navigate to Project Knowledge in your Claude Project (Pro or Team account required)"
      , [Char]
"Drag files from the staging folder to Project Knowledge"
      , [Char]
"Don't forget _path_manifest.dhall which maps optimized names back to original paths"
      , [Char]
"Paste the contents of project-instructions.md into the Project Instructions section"
      , [Char]
"IMPORTANT: You must manually delete previous versions of these files from Project Knowledge\n   before starting a new conversation to ensure Claude uses the most recent files"
      , [Char]
"Start a new conversation to see changes"
      ]
      
    -- Notes about staging directory
    notes :: [[Char]]
notes = 
      [ [Char]
"Note: The staging directory is temporary"
      , [Char]
"      and will be cleaned up on your next run of clod (or system reboot)."
      ]
      
    -- Helper function to format numbered steps
    formatStep :: Int -> String -> String
    formatStep :: Int -> [Char] -> [Char]
formatStep Int
1 [Char]
text = [Char]
"Next steps:\n1. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
text
    formatStep Int
n [Char]
text = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
text