A-gent 0.11.0.2 → 0.11.0.3
raw patch · 4 files changed
+161/−8 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- A-gent.cabal +3/−2
- CHANGELOG.md +17/−0
- src/Agent/IO/Restricted.hs +119/−1
- src/Agent/LLM.hs +22/−5
A-gent.cabal view
@@ -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
CHANGELOG.md view
@@ -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
src/Agent/IO/Restricted.hs view
@@ -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 $
src/Agent/LLM.hs view
@@ -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 =