never executed always true always false

    1 module PureClaw.Channels.CLI
    2   ( -- * CLI channel
    3     mkCLIChannelHandle
    4   ) where
    5 
    6 import Control.Exception (bracket, bracket_)
    7 import Data.IORef
    8 import Data.Text (Text)
    9 import Data.Text qualified as T
   10 import Data.Text.IO qualified as TIO
   11 import System.IO
   12 
   13 import PureClaw.Core.Types
   14 import PureClaw.Handles.Channel
   15 
   16 -- | Create a channel handle that reads from stdin and writes to stdout.
   17 -- Receive prints a @>@ prompt and reads a line. EOF (Ctrl-D) causes
   18 -- an 'IOError' which the agent loop catches to exit cleanly.
   19 mkCLIChannelHandle :: ChannelHandle
   20 mkCLIChannelHandle = ChannelHandle
   21   { _ch_receive = do
   22       putStr "> "
   23       hFlush stdout
   24       line <- readUnbufferedLine
   25       pure IncomingMessage
   26         { _im_userId  = UserId "cli-user"
   27         , _im_content = line
   28         }
   29   , _ch_send = \msg -> do
   30       TIO.putStrLn ""
   31       TIO.putStrLn (_om_content msg)
   32       TIO.putStrLn ""
   33   , _ch_sendError = \err ->
   34       TIO.hPutStrLn stderr $ "Error: " <> T.pack (show err)
   35   , _ch_sendChunk = \case
   36       ChunkText t -> do
   37         TIO.putStr t
   38         hFlush stdout
   39       ChunkDone -> TIO.putStrLn ""
   40   , _ch_streaming = True
   41   , _ch_readSecret = bracket_
   42       (hSetEcho stdin False)
   43       (hSetEcho stdin True)
   44       readUnbufferedLine
   45   , _ch_prompt = \promptText -> do
   46       TIO.putStr promptText
   47       hFlush stdout
   48       readUnbufferedLine
   49   , _ch_promptSecret = \promptText -> do
   50       TIO.putStr promptText
   51       hFlush stdout
   52       bracket_ (hSetEcho stdin False) (hSetEcho stdin True) $ do
   53         line <- readUnbufferedLine
   54         TIO.putStrLn ""  -- newline after hidden input
   55         pure line
   56   }
   57 
   58 -- | Read a line from stdin bypassing the terminal's canonical mode line
   59 -- buffer (which is limited to ~1024 bytes on macOS). Temporarily switches
   60 -- stdin to 'NoBuffering' and reads character-by-character until newline.
   61 readUnbufferedLine :: IO Text
   62 readUnbufferedLine = do
   63   origBuf <- hGetBuffering stdin
   64   bracket
   65     (hSetBuffering stdin NoBuffering)
   66     (\_ -> hSetBuffering stdin origBuf)
   67     (\_ -> do
   68       ref <- newIORef []
   69       let go = do
   70             c <- getChar
   71             if c == '\n'
   72               then pure ()
   73               else modifyIORef ref (c :) >> go
   74       go
   75       chars <- readIORef ref
   76       pure (T.pack (reverse chars))
   77     )