never executed always true always false

    1 module PureClaw.Handles.Harness
    2   ( -- * Types
    3     HarnessStatus (..)
    4   , HarnessHandle (..)
    5   , HarnessError (..)
    6     -- * Implementations
    7   , mkNoOpHarnessHandle
    8     -- * Output formatting
    9   , prefixHarnessOutput
   10   , sanitizeHarnessOutput
   11   ) where
   12 
   13 import Data.ByteString (ByteString)
   14 import Data.Char qualified as Char
   15 import Data.Text (Text)
   16 import Data.Text qualified as T
   17 import System.Exit
   18 
   19 import PureClaw.Security.Command
   20 
   21 -- | Status of a harness process.
   22 data HarnessStatus
   23   = HarnessRunning
   24   | HarnessExited ExitCode
   25   deriving stock (Show, Eq)
   26 
   27 -- | Errors that can occur during harness operations.
   28 data HarnessError
   29   = HarnessNotAuthorized CommandError
   30   | HarnessBinaryNotFound Text
   31   | HarnessTmuxNotAvailable Text  -- ^ detail message (stderr from tmux, or "not found")
   32   deriving stock (Show, Eq)
   33 
   34 -- | Capability handle for interacting with a harness (e.g. Claude Code in tmux).
   35 data HarnessHandle = HarnessHandle
   36   { _hh_send    :: ByteString -> IO ()   -- ^ Write to harness input
   37   , _hh_receive :: IO ByteString         -- ^ Read harness output (scrollback capture)
   38   , _hh_name    :: Text                  -- ^ Human-readable name
   39   , _hh_session :: Text                  -- ^ tmux session name
   40   , _hh_status  :: IO HarnessStatus      -- ^ Check if running
   41   , _hh_stop    :: IO ()                 -- ^ Kill and cleanup
   42   }
   43 
   44 -- | No-op harness handle for testing.
   45 mkNoOpHarnessHandle :: HarnessHandle
   46 mkNoOpHarnessHandle = HarnessHandle
   47   { _hh_send    = \_ -> pure ()
   48   , _hh_receive = pure ""
   49   , _hh_name    = ""
   50   , _hh_session = ""
   51   , _hh_status  = pure HarnessRunning
   52   , _hh_stop    = pure ()
   53   }
   54 
   55 -- | Prefix harness output with the origin name on the first line only.
   56 -- e.g. @"claude-code-0\> line1\\nline2\\nline3"@.
   57 -- This is the single abstraction for displaying messages from a harness\/model.
   58 prefixHarnessOutput :: Text -> Text -> Text
   59 prefixHarnessOutput name output = name <> "> " <> output
   60 
   61 -- | Sanitize harness output for display in a TUI.
   62 -- Strips ANSI escape sequences (CSI, OSC, DCS, etc.), C0\/C1 control
   63 -- characters, and decorative Unicode (box drawing, block elements,
   64 -- Private Use Area, etc.) that TUI applications use for rendering.
   65 -- Also trims leading and trailing blank lines from tmux capture output.
   66 sanitizeHarnessOutput :: Text -> Text
   67 sanitizeHarnessOutput =
   68     trimBlankLines . T.pack . go . T.unpack
   69   where
   70     trimBlankLines =
   71       T.intercalate "\n"
   72       . dropWhileEnd isBlankLine
   73       . dropWhile isBlankLine
   74       . T.splitOn "\n"
   75 
   76     isBlankLine = T.all Char.isSpace
   77 
   78     dropWhileEnd _ [] = []
   79     dropWhileEnd p xs = reverse (dropWhile p (reverse xs))
   80 
   81     go [] = []
   82     go ('\ESC' : rest) = skipEscape rest
   83     -- Keep newlines and tabs
   84     go ('\n' : cs) = '\n' : go cs
   85     go ('\t' : cs) = '\t' : go cs
   86     -- Replace carriage return with newline (handles \r\n and bare \r)
   87     go ('\r' : '\n' : cs) = '\n' : go cs
   88     go ('\r' : cs) = '\n' : go cs
   89     -- Drop control characters, then decorative Unicode
   90     go (c : cs)
   91       | Char.isControl c  = go cs
   92       | isDecorativeChar c = go cs
   93       | otherwise          = c : go cs
   94 
   95     -- Skip ESC [ ... (final byte) — CSI sequences
   96     skipEscape ('[' : cs) = skipCsi cs
   97     -- Skip ESC ] ... ST — OSC sequences (terminated by BEL or ESC \)
   98     skipEscape (']' : cs) = skipOsc cs
   99     -- Skip ESC P ... ST — DCS sequences
  100     skipEscape ('P' : cs) = skipOsc cs
  101     -- Skip ESC ( X, ESC ) X — charset designators
  102     skipEscape ('(' : _ : cs) = go cs
  103     skipEscape (')' : _ : cs) = go cs
  104     -- Skip ESC followed by any single character (SS2, SS3, etc.)
  105     skipEscape (_ : cs) = go cs
  106     skipEscape [] = []
  107 
  108     -- CSI: skip parameter bytes (0x30-0x3F) and intermediate bytes (0x20-0x2F)
  109     -- until a final byte (0x40-0x7E)
  110     skipCsi [] = []
  111     skipCsi (c : cs)
  112       | c >= '@' && c <= '~' = go cs  -- final byte, done
  113       | otherwise             = skipCsi cs
  114 
  115     -- OSC / DCS: skip until BEL (0x07) or ST (ESC \)
  116     skipOsc [] = []
  117     skipOsc ('\BEL' : cs) = go cs
  118     skipOsc ('\ESC' : '\\' : cs) = go cs
  119     skipOsc (_ : cs) = skipOsc cs
  120 
  121 -- | Characters used by TUI applications for rendering decorative elements.
  122 -- These are valid Unicode but produce visual garbage when displayed outside
  123 -- the originating terminal application.
  124 isDecorativeChar :: Char -> Bool
  125 isDecorativeChar c = let cp = Char.ord c in
  126   -- Box Drawing (U+2500–U+257F)
  127      (cp >= 0x2500 && cp <= 0x257F)
  128   -- Block Elements (U+2580–U+259F)
  129   || (cp >= 0x2580 && cp <= 0x259F)
  130   -- Geometric Shapes (U+25A0–U+25FF) — squares, circles, triangles
  131   || (cp >= 0x25A0 && cp <= 0x25FF)
  132   -- Braille Patterns (U+2800–U+28FF) — used for sparklines/graphs
  133   || (cp >= 0x2800 && cp <= 0x28FF)
  134   -- Private Use Area (U+E000–U+F8FF) — Powerline, Nerd Font icons
  135   || (cp >= 0xE000 && cp <= 0xF8FF)
  136   -- Supplementary Private Use Areas (U+F0000–U+10FFFF)
  137   || cp >= 0xF0000