diff --git a/A-gent.cabal b/A-gent.cabal --- a/A-gent.cabal +++ b/A-gent.cabal @@ -9,7 +9,7 @@ build-type: Simple name: A-gent -version: 0.11.0.2 +version: 0.11.0.3 synopsis: Polite & well educated LLM agent with excellent manners that always behaves well description: Polite and well educated LLM agent with excellent manners that always behaves well @@ -55,8 +55,10 @@ build-depends: -- Prelude base >= 4 && < 5 + -- Process , process >= 1.6.25.0 && < 2 , containers >= 0.8 && < 1 + -- JSON , mtl >= 2.3.1 && < 3 ghc-options: -------------------------------------------------------------------------- @@ -130,7 +132,6 @@ ghc-options: -- Base -- NOTE: Issue with Hackage that builds with 9.8.4. 9.10.x requies this: - -- -trust=ghc-internal -trust=ghc-internal library diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Revision history for Λ-gent +## 0.11.0.3 -- 2026-03-06 + +* Made `read` usable by providing support for: + + * `BACKSPACE` and `DELETE` to remove characters. + + * Move back and forth with `←` & `→` (single characters) and `CTRL + ←` & + `CTRL + →` (words). + + * Move to start and end of the text with `HOME` and `END`. + ## 0.11.0.2 -- 2026-03-05 * Fixed issue with Hackage. The project now builds for: @@ -27,3 +38,9 @@ ## 0 -- 2026-02-25 * First version. Released on an unsuspecting world. + +## References + +* Use of a fourth component [Version scheme][haskell-stack-ver]. + +[haskell-stack-ver]: https://docs.haskellstack.org/en/v3.5.1/maintainers/version_scheme/#use-of-a-fourth-component diff --git a/src/Agent/IO/Restricted.hs b/src/Agent/IO/Restricted.hs --- a/src/Agent/IO/Restricted.hs +++ b/src/Agent/IO/Restricted.hs @@ -70,6 +70,7 @@ ) -} ( hFlush, stdout + , hReady, stdin ) import System.Exit ( ExitCode @@ -106,7 +107,124 @@ output :: String -> m () instance StdIn RIO where - input = RestrictedIO getLine + input = + RestrictedIO $ aux [] [] + where + aux bcs acs = + key >>= \ k -> + case k of + -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER) + '\008':[] -> + case bcs of + -- NOTE: Backspace (remove char if any and re-write after chars) + [ ] -> aux bcs acs + (_:cs) -> + putChar '\008' >> hFlush stdout >> + putChar '\032' >> hFlush stdout >> + putStr es >> hFlush stdout >> + putStr rm >> hFlush stdout >> + putChar '\008' >> hFlush stdout >> + putStr acs >> hFlush stdout >> + putStr rm >> hFlush stdout >> + aux cs acs + where + lc = length acs + es = concatMap id $ take lc $ repeat sp + rm = concatMap id $ take lc $ repeat la + sp = [ ' ' ] + la = [ '\ESC', '[', 'D' ] + '\010':[] -> + -- NOTE: Enter + pure $ (++ acs) $ reverse $ bcs + '\ESC':'[':'C':[] -> + -- NOTE: Allowed escaped sequences: Arrow "->" + case (bcs, acs) of + (_, [ ]) -> + aux bcs acs + (_, c:cs) -> + putStr k >> hFlush stdout >> + aux (c:bcs) cs + '\ESC':'[':'D':[ ] -> + -- NOTE: Allowed escaped sequences: Arrow "<-" + case (bcs, acs) of + ([ ], _) -> + aux bcs acs + (c:cs, _) -> + putStr k >> hFlush stdout >> + aux cs (c:acs) + '\ESC':'[':'H':[] -> + -- NOTE: HOME + putStr rm >> hFlush stdout >> + (aux [] ((reverse bcs) ++ acs)) + where + lc = length bcs + rm = concatMap id $ take lc $ repeat la + la = [ '\ESC', '[', 'D' ] + '\ESC':'[':'1':';':'5':'C':[] -> + -- NOTE: Allowed escaped sequences: CTRL + Arrow "->" + putStr rm >> hFlush stdout >> + (aux (ts ++ bcs) ds) + where + ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs + ts = drop (length ds) $ reverse acs + lc = length ts + rm = concatMap id $ take lc $ repeat la + la = [ '\ESC', '[', 'C' ] + '\ESC':'[':'1':';':'5':'D':[] -> + -- NOTE: Allowed escaped sequences: CTRL + Arrow "<-" + putStr rm >> hFlush stdout >> + (aux ds (ts ++ acs)) + where + ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs + ts = drop (length ds) $ reverse bcs + lc = length ts + rm = concatMap id $ take lc $ repeat la + la = [ '\ESC', '[', 'D' ] + '\ESC':'[':'F':[] -> + -- NOTE: END + putStr rm >> hFlush stdout >> + (aux ((++ bcs) $ reverse $ acs) []) + where + lc = length acs + rm = concatMap id $ take lc $ repeat la + la = [ '\ESC', '[', 'C' ] + '\ESC':'[':'3':'~':[] -> + case acs of + -- NOTE: Delete (remove char if any and re-write after chars) + [ ] -> aux bcs acs + (_:cs) -> + putStr cs >> hFlush stdout >> + putChar ' ' >> hFlush stdout >> + putStr rm >> hFlush stdout >> + (aux bcs cs) + where + lc = length acs + rm = concatMap id $ take lc $ repeat la + la = [ '\ESC', '[', 'D' ] + '\ESC':__ -> + -- NOTE: Other escaped sequences (skip) + aux bcs acs + '\DEL':[] -> + -- NOTE: DELETE (skip) + aux bcs acs + _________ -> + putStr k >> hFlush stdout >> + putStr acs >> hFlush stdout >> + putStr rm >> hFlush stdout >> + (aux (reverse k ++ bcs) acs) + where + lc = length acs + rm = concatMap id $ take lc $ repeat la + la = ['\ESC','[','D'] + key = + -- NOTE: https://stackoverflow.com/a/38553473 + reverse <$> nxt [] + where + nxt cs = + do + c <- getChar + m <- hReady stdin + (if m then nxt else pure) (c:cs) instance StdOut RIO where output x = RestrictedIO $ diff --git a/src/Agent/LLM.hs b/src/Agent/LLM.hs --- a/src/Agent/LLM.hs +++ b/src/Agent/LLM.hs @@ -41,7 +41,7 @@ ) import System.IO ( BufferMode(NoBuffering) - , hFlush, hSetBuffering, hSetEncoding + , hFlush, hSetBuffering, hSetEcho, hSetEncoding , stderr, stdin, stdout , utf8 ) @@ -63,6 +63,15 @@ | Test deriving (Bounded, Enum, Eq, Show) +{- TODO: Use ↑ and ↓ to see previous and current input text +data Text = + Text + { prev :: [String] + , curr :: String + , next :: [String] + } +-} + type Load a = Data a => Maybe a @@ -71,6 +80,7 @@ Context { exit :: Bool , mode :: Mode + -- , text :: Text , load :: Load a } @@ -99,6 +109,7 @@ hSetEncoding stderr utf8 hSetEncoding stdin utf8 hSetEncoding stdout utf8 + hSetEcho stdin False -- NOTE: No default output when typing putStrLn head >> hFlush stdout run $ loop ctx proc where @@ -125,29 +136,35 @@ read >>= \ txt -> case txt of "/exit" -> + printLn [] >> printLn "Λ-gent will shutdown" >> loop (ctx { exit = True }) eval "/help" -> + printLn [ ] >> printLn help >> loop ctx eval "/mode chat" -> + printLn [ ] >> printLn "Changed to chat-mode" >> loop (ctx { mode = Chat }) eval "/mode code" -> + printLn [ ] >> printLn "Changed to code-mode" >> loop (ctx { mode = Code }) eval "/mode echo" -> + printLn [ ] >> printLn "Changed to echo-mode" >> loop (ctx { mode = Echo }) eval ____________ -> eval ctx txt >>= \ (upd, res) -> + printLn [ ] >> printLn res >> loop upd eval where - prompt = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> " - read = input - print = output - printLn = output . (++ "\n") + prompt = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> " + read = input + print = output + printLn x = print $ x ++ "\n" modes :: [Mode] modes =