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.6 +version: 0.11.0.7 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 diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,26 @@ # Revision history for Λ-gent +## 0.11.0.7 -- 2026-03-30 + +* We seem to have fixed multi-line issues. I guess we can say that we are + probably as good as `GHCi`. + + > **NOTE:** A thorough refactoring needs to be done to enforce `DRY`. + +* Added support for: + + * `CTRL + L` clear screen. + + * `CTRL + U` clear text from current position to start of input. + + * `CTRL + K` clear text from current position to end of input. + + * `CTRL + A` equivalent to `HOME`. + + * `CTRL + E` equivalent to `END`. + + * `CTRL + D` equivalent to `DELETE`. + ## 0.11.0.6 -- 2026-03-20 * Added a `todo.org` file in the root folder of the project. This will allow to 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 @@ -67,8 +67,6 @@ , llmPlanSeq, llmPlanGet , llmPlanKey, llmPlanAPI , llmPlanWeb - -- * Temporary - , readFileStrict ) where @@ -76,7 +74,7 @@ import Data.Either ( partitionEithers ) import Data.List ( isInfixOf ) -import Data.Maybe ( fromMaybe ) +import Data.Maybe ( fromMaybe, maybeToList ) import qualified System.Environment.Blank as ENV import System.Exit ( ExitCode (ExitFailure, ExitSuccess) @@ -88,9 +86,12 @@ , readCreateProcessWithExitCode , readProcessWithExitCode ) +import Text.Read ( readMaybe ) import qualified Agent.IO.Effects as EFF +import qualified Agent.Utils.Common as COM + -------------------------------------------------------------------------------- newtype RIO a = RestrictedIO { run :: IO a } @@ -108,6 +109,48 @@ -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- +data Position = + Position Int Int + deriving (Eq, Show) + +instance Ord Position where + (<=) (Position y1 x1) (Position y2 x2) = + case compare y1 y2 of + GT -> False + EQ -> x1 <= x2 + LT -> True + +instance Read Position where + readsPrec _ str = + -- NOTE: + -- "\ESC[#;#R" => "\ESC" and "[#;#R" (only parse last) + maybeToList + ( readMaybe (f str) >>= \ y -> + readMaybe (g str) >>= \ x -> + Just + ( Position y x + , h str + ) + ) + where + f = takeWhile (/= ';') . drop 1 . dropWhile (/= '[') + g = takeWhile (/= 'R') . drop 1 . dropWhile (/= ';') + h = drop 1 . dropWhile (/= 'R') . dropWhile (/= ';') . dropWhile (/= '[') + +-------------------------------------------------------------------------------- + +data MultiLine = + MultiLine + { stx :: Maybe Position + , cur :: Maybe Position + , etx :: Maybe Position + , col :: Int + } + deriving Show + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + class StdIn m where input :: [ String ] @@ -124,165 +167,502 @@ instance StdIn RIO where -- BUG: Issue with multiline text input prev next = - -- TODO: CTRL+U (erase from cursor to start of line) and CTRL+K (erase from - -- cursor to end of line - RestrictedIO $ aux prev next [] [] + -- NOTE: "\ESC7" - save cursor position (SCO) + -- - https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797#cursor-controls + RestrictedIO $ putStr "\ESC7" >> aux gen prev next [] [] where - aux hps hns bcs acs = + msv = 32767 :: Int + gen = + MultiLine + { stx = Nothing + , cur = Nothing + , etx = Nothing + , col = 0 + } + aux mlp hps hns bcs acs = key >>= \ k -> - case (k < [ '\32' ], k) of - -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER) - (True , '\008':[]) -> + case (k < ['\32'], k) of + (True , ['\^H']) -> case bcs of - -- NOTE: Backspace (remove char if any and re-write after chars) - [ ] -> aux hps hns bcs acs + -- NOTE: CTRL + H or Backspace (remove char if any and re-write + -- after chars) + [ ] -> aux mlp hps hns 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 hps hns cs acs - where - la = [ '\ESC', '[', 'D' ] - lc = length acs - es = concatMap id $ take lc $ repeat sp - rm = concatMap id $ take lc $ repeat la - sp = [ ' ' ] - (True , '\010':[]) -> - -- NOTE: ENTER (only if something is typed) + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Remove char + putChar '\^H' >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr acs >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns cs acs + (True , ['\^J']) -> + -- NOTE: ENTER (line feed) only if something is typed case (bcs, acs) of ([], []) -> - aux hps hns bcs acs + aux mlp hps hns bcs acs ________ -> pure $ (++ acs) $ reverse $ bcs - (True , '\012':[]) -> - -- NOTE: Form Feed becomes "/w" (clear screen) - pure $ "/w" - (True , '\ESC':'[':'A':[]) -> + (True , ['\^L']) -> + -- NOTE: CTRL + L (form feed) becomes "/w" (clear screen) + pure $ "/wipe" + (True , ['\^U']) -> + -- NOTE: CTRL + U cut text to start + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Go back to start of line + putStr hom >> hFlush stdout >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr acs >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns [] acs + where + hom = + case mlp of + MultiLine { stx = Just (Position y x) } -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + _______________________________________ -> + "\ESC8" + (True , ['\^K']) -> + -- NOTE: CTRL + K cut text to end + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns bcs [] + (True , ['\ESC','[','H']) -> + -- NOTE: HOME + -- + -- NOTE: Move to start of text + putStr hom >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mln hps hns [] (reverse bcs ++ acs) + where + (mln, hom) = + case mlp of + MultiLine { stx = Just (Position y x) } -> + ( mlp { cur = Just (Position y x) } + , "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + ) + _______________________________________ -> + ( mlp + , "\ESC8" + ) + (True , ['\ESC','[','F']) -> + -- NOTE: END + -- + -- NOTE: Move to end of text + hFlush stdout >> + putStr hom >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mln hps hns ((++ bcs) $ reverse $ acs) [] + where + (mln, hom) = + case mlp of + MultiLine { etx = Just (Position y x) } -> + ( mlp { cur = Just (Position y x) } + , "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + ) + _______________________________________ -> + ( mlp + , "\ESC8" + ) + (True , ['\^A']) -> + -- NOTE: CTRL + A to move to start of text + -- + -- TODO: DRY as equal to HOME + -- NOTE: Move to start of text + hFlush stdout >> + putStr hom >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mln hps hns [] ((reverse bcs) ++ acs) + where + (mln, hom) = + case mlp of + MultiLine { stx = Just (Position y x) } -> + ( mlp { cur = Just (Position y x) } + , "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + ) + _______________________________________ -> + ( mlp + , "\ESC8" + ) + (True , ['\^E']) -> + -- NOTE: CTRL + E to move to end of text + -- + -- TODO: DRY as equal to END + -- NOTE: Move to end of text + hFlush stdout >> + putStr hom >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mln hps hns ((++ bcs) $ reverse acs) [] + where + (mln, hom) = + case mlp of + MultiLine { etx = Just (Position y x) } -> + ( mlp { cur = Just (Position y x) } + , "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + ) + _______________________________________ -> + ( mlp + , "\ESC8" + ) + (True , ['\ESC','[','A']) -> -- NOTE: Allowed escaped sequences: Arrow "↑" - case (txt, hps, hns) of - (_, [ ], _) -> aux hps hns bcs acs - (_, p:ps, _) -> - putStr rm >> hFlush stdout >> - putStr es >> hFlush stdout >> - putStr rm >> hFlush stdout >> - putStr p >> hFlush stdout >> - aux ps (p:hns) rev [] + case (hps, hns) of + ([ ], _) -> aux mlp hps hns bcs acs + (p:ps, _) -> + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Move to start of text + putStr hom >> + -- NOTE: Print previous line + putStr p >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr [] >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp ps (p:hns) rev [] where rev = reverse p - where - sp = [ ' ' ] - la = [ '\ESC', '[', 'D' ] - lc = length txt - es = concatMap id $ take lc $ repeat sp - rm = concatMap id $ take lc $ repeat la - txt = (++ acs) $ reverse $ bcs - (True , '\ESC':'[':'B':[]) -> + hom = + case mlp of + MultiLine { stx = Just (Position y x) } -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + _______________________________________ -> + "\ESC8" + (True , ['\ESC','[','B']) -> -- NOTE: Allowed escaped sequences: Arrow "↓" - case (txt, hps, hns) of - (_, _, [ ]) -> aux hps hns bcs acs - (_, _, p:ps) -> - putStr rm >> hFlush stdout >> - putStr es >> hFlush stdout >> - putStr rm >> hFlush stdout >> - putStr p >> hFlush stdout >> - aux (p:hps) ps rev [] + case (hps, hns) of + (_, [ ]) -> aux mlp hps hns bcs acs + (_, p:ps) -> + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Move to start of text + putStr hom >> + -- NOTE: Print previous line + putStr p >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr [] >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp (p:hps) ps rev [] where rev = reverse p - where - sp = [ ' ' ] - la = [ '\ESC', '[', 'D' ] - lc = length txt - es = concatMap id $ take lc $ repeat sp - rm = concatMap id $ take lc $ repeat la - txt = (++ acs) $ reverse $ bcs - (True , '\ESC':'[':'C':[]) -> + hom = + case mlp of + MultiLine { stx = Just (Position y x) } -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + _______________________________________ -> + "\ESC8" + (True , ['\ESC','[','C']) -> -- NOTE: Allowed escaped sequences: Arrow "→" case (bcs, acs) of (_, [ ]) -> - aux hps hns bcs acs + aux mlp hps hns bcs acs (_, c:cs) -> - putStr k >> hFlush stdout >> - aux hps hns (c:bcs) cs - (True , '\ESC':'[':'D':[ ]) -> + hFlush stdout >> + ( if pl then + putStr ("\ESC[" ++ "1" ++ "E") + else + putStr k + ) >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns (c:bcs) cs + where + pl = + case mlp of + MultiLine + { cur = Just (Position cy cx) + , etx = Just (Position ey __) + , col = cw + } -> cy <= ey && cx == cw + ___ -> False + (True , ['\ESC','[','D']) -> -- NOTE: Allowed escaped sequences: Arrow "←" case (bcs, acs) of ([ ], _) -> - aux hps hns bcs acs + aux mlp hps hns bcs acs (c:cs, _) -> - putStr k >> hFlush stdout >> - aux hps hns cs (c:acs) - (True , '\ESC':'[':'1':';':'5':'C':[]) -> + hFlush stdout >> + ( if pl then + putStr ("\ESC[" ++ "1" ++ "F") >> + putStr ("\ESC[" ++ show msv ++ "C") + else + putStr k + ) >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns cs (c:acs) + where + pl = + case mlp of + MultiLine + { stx = Just (Position sy __) + , cur = Just (Position cy 01) + } -> sy < cy + ___ -> False + + (True , ['\ESC','[','1',';','5','C']) -> -- NOTE: Allowed escaped sequences: CTRL + Arrow "→" - putStr rm >> hFlush stdout >> - (aux hps hns (ts ++ bcs) ds) + -- NOTE: Move to end of text + hFlush stdout >> + putStr np >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns (ts ++ bcs) ds where ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs ts = drop (length ds) $ reverse acs - la = [ '\ESC', '[', 'C' ] lc = length ts - rm = concatMap id $ take lc $ repeat la - (True , '\ESC':'[':'1':';':'5':'D':[]) -> + np = + case mlp of + MultiLine + { cur = Just (Position cy cx) + , etx = Just (Position ey _ ) + , col = cw + } -> + case (cy < ey, compare (cw - cx) lc) of + (True, LT) -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + where + y = cy + 1 + x = lc - (cw - cx) + __________ -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + where + y = cy + x = cx + lc + ___ -> [] + + (True , ['\ESC','[','1',';','5','D']) -> -- NOTE: Allowed escaped sequences: CTRL + Arrow "←" - putStr rm >> hFlush stdout >> - (aux hps hns ds (ts ++ acs)) + hFlush stdout >> + putStr np >> + -- NOTE: Update current position + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns ds (ts ++ acs) where ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs ts = drop (length ds) $ reverse bcs - la = [ '\ESC', '[', 'D' ] lc = length ts - rm = concatMap id $ take lc $ repeat la - (True , '\ESC':'[':'H':[]) -> - -- NOTE: HOME - -- HERE: - putStr rm >> hFlush stdout >> - (aux hps hns [] ((reverse bcs) ++ acs)) - where - la = [ '\ESC', '[', 'D' ] - lc = length bcs - rm = concatMap id $ take lc $ repeat la - (True , '\ESC':'[':'F':[]) -> - -- NOTE: END - putStr rm >> hFlush stdout >> - (aux hps hns ((++ bcs) $ reverse $ acs) []) - where - la = [ '\ESC', '[', 'C' ] - lc = length acs - rm = concatMap id $ take lc $ repeat la - (True , '\ESC':'[':'3':'~':[]) -> + np = + case mlp of + MultiLine + { stx = Just (Position sy _ ) + , cur = Just (Position cy cx) + , col = cw + } -> + case (sy < cy, compare cx lc) of + (True, LT) -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + where + y = cy - 1 + x = cw - (lc - cx) + __________ -> + "\ESC[" ++ show y ++ ";" ++ show x ++ "H" + where + y = cy + x = cx - lc + ___ -> [] + (True , ['\ESC','[','3','~']) -> + -- NOTE: CTRL + D behave as delete key + -- TODO: Use DRY case acs of -- NOTE: Delete (remove char if any and re-write after chars) - [ ] -> aux hps hns bcs acs + [ ] -> aux mlp hps hns bcs acs (_:cs) -> - putStr cs >> hFlush stdout >> - putChar ' ' >> hFlush stdout >> - putStr rm >> hFlush stdout >> - (aux hps hns bcs cs) - where - la = [ '\ESC', '[', 'D' ] - lc = length acs - rm = concatMap id $ take lc $ repeat la - (True , '\ESC':__) -> - -- NOTE: Other escaped sequences (skip) - aux hps hns bcs acs - (True , _) -> - -- NOTE: Skip all other unhandled control keys - aux hps hns bcs acs - (False, '\DEL':[]) -> + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr cs >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns bcs cs + (True , ['\^D']) -> + -- NOTE: CTRL + D behave as delete key + -- TODO: Use DRY + case acs of + -- NOTE: Delete (remove char if any and re-write after chars) + [ ] -> aux mlp hps hns bcs acs + (_:cs) -> + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr cs >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns bcs cs + (True , '\ESC':ps) -> + -- NOTE: Other escaped sequences (skip unless positions) + aux mln hps hns bcs acs + where + ops = map readMaybe $ COM.split '\ESC' ps :: [Maybe Position] + mln = + -- NOTE: 0) Print "\ESC[6n" position before action (unused) + -- NOTE: 1) Print "\ESC[6n" end position after action + -- NOTE: 2) Print "\ESC[6n" column witdh + -- NOTE: 3) Print "\ESC[6n" current position after action + case (mlp, ops) of + (___________________________, + [ ]) -> + mlp + (MultiLine { stx = Nothing }, + [Just (Position y x) ]) -> + mlp + { stx = Just sp + , cur = Just sp + , etx = Just sp + , col = x + } + where + sp = Position y x + (MultiLine { etx = Just ep }, + [Just cp ]) -> + if cp > ep then + mlp + { cur = Just cp + , etx = Just cp + } + else + mlp + { cur = Just cp + } + (MultiLine { stx = Nothing }, + [Just sp,Just ep,Just (Position _ w),Just cp]) -> + mlp + { stx = Just sp + , cur = Just cp + , etx = Just ep + , col = w + } + (___________________________, + [Just __,Just ep,Just (Position _ w),Just cp]) -> + mlp + { cur = Just cp + , etx = Just ep + , col = w + } + _______________________________________________ -> + mlp + (True , _) -> + aux mlp hps hns bcs acs + (False, ['\DEL']) -> -- NOTE: DELETE (skip) - aux hps hns bcs acs + aux mlp hps hns bcs acs (False, _) -> - putStr k >> hFlush stdout >> - putStr acs >> hFlush stdout >> - putStr rm >> hFlush stdout >> - (aux hps hns (reverse k ++ bcs) acs) - where - lc = length acs - rm = concatMap id $ take lc $ repeat la - la = ['\ESC','[','D'] + hFlush stdout >> + -- NOTE: 0) Print "\ESC[6n" position before action + putStr "\ESC[6n" >> + -- NOTE: Type key or text + putStr k >> + -- NOTE: Save position + putStr "\ESC7" >> + -- NOTE: Clear rest of screen from position + putStr "\ESC[0J" >> + -- NOTE: Print after chars + putStr acs >> + -- NOTE: 1) Print "\ESC[6n" end position after action + putStr "\ESC[6n" >> + -- NOTE: 2) Print "\ESC[6n" column witdh + putStr ("\ESC[" ++ show msv ++ "C") >> + putStr "\ESC[6n" >> + -- NOTE: Go back to saved position + putStr "\ESC8" >> + -- NOTE: 3) Print "\ESC[6n" current position after action + putStr "\ESC[6n" >> hFlush stdout >> + aux mlp hps hns (reverse k ++ bcs) acs key = -- NOTE: https://stackoverflow.com/a/38553473 reverse <$> nxt [] @@ -539,7 +919,7 @@ realPath (fromMaybe [] ocwd ++ "/" ++ pdir) >>= \ efrp -> case efrp of Right rp -> - if isInfixOf rp path then + if rp `isInfixOf` path then Right <$> readFileStrict path else pure $ Left $ "File: " ++ path ++ " is not in: " ++ rp @@ -626,8 +1006,8 @@ ( \case Right str -> Right - $ map (filter (/= '\NUL')) - $ map (drop (length path)) -- NOTE: Relative paths instead of full + -- NOTE: Relative paths instead of full + $ map (filter (/= '\NUL') . drop (length path)) $ lines str Left err -> Left err @@ -696,8 +1076,8 @@ -- -- - http://woshub.com/too-many-open-files-error-linux/ RestrictedIO $ - readFile path >>= \bs -> - length bs `seq` pure bs + readFile path >>= \cs -> + length cs `seq` pure cs realPath :: String diff --git a/src/Agent/LLM.hs b/src/Agent/LLM.hs --- a/src/Agent/LLM.hs +++ b/src/Agent/LLM.hs @@ -47,7 +47,7 @@ import Data.Char ( toLower, toUpper ) import GHC.IO.Encoding ( setLocaleEncoding ) import System.IO - ( BufferMode (NoBuffering) + ( BufferMode (LineBuffering, NoBuffering) , hFlush , hSetBuffering , hSetEcho @@ -65,6 +65,7 @@ , input , output ) +import qualified Agent.Utils.Common as COM -------------------------------------------------------------------------------- @@ -79,14 +80,31 @@ deriving (Bounded, Enum, Eq, Read, Show) type Load a = - Data a + ( Data a + , Show a + ) => Maybe a +data View + = None + | Both + | Chit' + | Chat' + +data Chit = + Chit + { prev :: [String] + -- TODO: add: yank :: Maybe String to store cutted text? + , next :: [String] + } + +type Chat = [String] + data History = History - { view :: Bool - , prev :: [String] - , next :: [String] + { view :: View + , chit :: Chit + , chat :: Chat } type Index = Int @@ -128,7 +146,7 @@ setLocaleEncoding utf8 hSetBuffering stderr NoBuffering hSetBuffering stdin NoBuffering - hSetBuffering stdout NoBuffering + hSetBuffering stdout LineBuffering -- NOTE: logic based on `hFlush stdout` -- NOTE: No default output when typing hSetEcho stdin False putStrLn head >> hFlush stdout @@ -141,9 +159,13 @@ , load = Nothing , hist = History - { view = False - , prev = [] - , next = [] + { view = None + , chit = + Chit + { prev = [] + , next = [] + } + , chat = [] } , list = Nothing , safe = Nothing @@ -170,10 +192,20 @@ case ctx of Context { exit = True } -> return () - Context { hist = History { view = True } } -> - eval ctx [ ] >>= \ (upd, res) -> - printLn res >> - loop (upd { hist = ((hist ctx) { view = False }) }) eval + Context { hist = History { view = Both } } -> + printLn "* Chits:" >> + (mapM_ printLn $ COM.chits True $ prev $ chit $ hist ctx) >> + printLn "* Chats:" >> + (mapM_ printLn $ COM.chats True $ chat $ hist ctx) >> + loop (ctx { hist = ((hist ctx) { view = None }) }) eval + Context { hist = History { view = Chit' } } -> + printLn "* Chits:" >> + (mapM_ printLn $ COM.chits True $ prev $ chit $ hist ctx) >> + loop (ctx { hist = ((hist ctx) { view = None }) }) eval + Context { hist = History { view = Chat' } } -> + printLn "* Chats:" >> + (mapM_ printLn $ COM.chats True $ chat $ hist ctx) >> + loop (ctx { hist = ((hist ctx) { view = None }) }) eval Context { list = Just _ } -> eval ctx [ ] >>= \ (upd, res) -> printLn res >> @@ -197,8 +229,10 @@ '/':'l' :mfil -> caseList txt mfil "/safe" -> caseSafe txt "/s" -> caseSafe txt - "/hist" -> caseHist txt - "/h" -> caseHist txt + "/hist" -> caseHist txt Both + "/h" -> caseHist txt Both + "/chit" -> caseHist txt Chit' + "/chat" -> caseHist txt Chat' "/wipe" -> caseWipe txt "/w" -> caseWipe txt "/help" -> caseHelp txt @@ -207,38 +241,52 @@ "/e" -> caseExit txt '/':cmd -> printLn msg >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval where msg = "Command not recognized: " ++ cmd ____________________________ -> eval ctx txt >>= \ (upd, res) -> printLn res >> - loop (nxt txt upd) eval + loop (nxt txt upd (Just res)) eval where - his = hist ctx - hps = prev his - hns = next his - nxt p c = c { hist = (hist c) { prev = p : hps } } + his = hist ctx + chi = chit his + hps = prev chi + hns = next chi + nxt p c o = + c + { hist = + (hist c) + { chit = + (chit $ hist c) + { prev = p : hps + } + , chat = + case o of + Nothing -> ( chat $ hist c) + Just r -> ((r:) $ chat $ hist c) + } + } -- NOTE: Enforce DRY in cases caseMode txt c cs = case mmod of Just mod -> printLn ("Changed to " ++ low ++ "-mode") >> - loop (nxt txt (ctx { mode = mod, safe = Nothing })) eval + loop (nxt txt (ctx { mode = mod, safe = Nothing }) Nothing) eval where low = map toLower $ show mod Nothing -> printLn ("Invalid mode: " ++ c:cs) >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval where mmod = readMaybe (toUpper c : map toLower cs) :: Maybe Mode caseFile txt midx = case lst of Just _ -> - loop (nxt txt (ctx { file = (, False) <$> idx })) eval + loop (nxt txt (ctx { file = (, False) <$> idx }) Nothing) eval Nothing -> printLn ("Invalid index") >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval where lst = safe ctx idx = @@ -249,10 +297,10 @@ caseNums txt midx = case lst of Just _ -> - loop (nxt txt (ctx { file = (, True) <$> idx })) eval + loop (nxt txt (ctx { file = (, True) <$> idx }) Nothing) eval Nothing -> printLn ("Invalid index") >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval where lst = safe ctx idx = @@ -261,7 +309,7 @@ ' ':cs -> readMaybe cs :: Maybe Int ______ -> Nothing caseList txt mfil = - loop (nxt txt (ctx { list = fil })) eval + loop (nxt txt (ctx { list = fil }) Nothing) eval where fil = case mfil of @@ -269,20 +317,20 @@ ' ':cs -> Just cs ______ -> Nothing caseSafe txt = - loop (nxt txt (ctx { list = safe ctx })) eval - caseHist txt = - loop (nxt txt (ctx { hist = his { view = True } })) eval + loop (nxt txt (ctx { list = safe ctx }) Nothing) eval + caseHist txt v = + loop (nxt txt (ctx { hist = his { view = v } }) Nothing) eval caseWipe txt = - -- NOTE: Clear screen & Move top-left printLn clear >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval caseHelp txt = printLn help >> - loop (nxt txt ctx) eval + loop (nxt txt ctx Nothing) eval caseExit txt = printLn "Λ-gent will shutdown" >> - loop (nxt txt (ctx { exit = True })) eval + loop (nxt txt (ctx { exit = True }) Nothing) eval where + -- NOTE: Clear screen & Move top-left clear = "\ESC[H\ESC[2J" -- NOTE: See `infocmp -x` prompt = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> " read = input @@ -303,8 +351,10 @@ "/? or /help | This message\n" ++ "/e or /exit | Exit Λ-gent\n" ++ "/w or /wipe | Clear screen\n" ++ - "/m or /mode | Change to {" ++ ms ++ "}. Ex: /m code\n" ++ - "/h or /hist | View input history\n" ++ + "/m m or /mode m | Change to {" ++ ms ++ "}. Ex: /m code\n" ++ + "/h or /hist | View chit-chat (input and output) history\n" ++ + " /chit | View chit (input) history\n" ++ + " /chat | View chat (output) history\n" ++ "/s or /safe | Show stored list of files. See /list below\n" ++ "/l f or /list f | List of files, limited by mode, file masks and filter\n" ++ "/f i or /file i | Show file with the given index. See, /safe above\n" ++ diff --git a/src/Agent/Utils/Code.hs b/src/Agent/Utils/Code.hs --- a/src/Agent/Utils/Code.hs +++ b/src/Agent/Utils/Code.hs @@ -43,7 +43,7 @@ => Maybe String -> Int -> Bool - -> rio (Either String String) + -> rio (Either String [String]) file mfilter index nums = filesHelper mfilter False >>= \ fs -> if length fs > index && index >= 0 then diff --git a/src/Agent/Utils/Common.hs b/src/Agent/Utils/Common.hs --- a/src/Agent/Utils/Common.hs +++ b/src/Agent/Utils/Common.hs @@ -17,9 +17,13 @@ ( -- * Files files , file + -- * History + , chits + , chats -- * Helpers , leftpad , index + , split ) where @@ -42,39 +46,68 @@ index rep idx = leftpad '0' rep $ show idx +split + :: Char + -> String + -> [String] +split sep str = + case dropWhile (== sep) str of + [] -> [] + cs -> + b : split sep bs + where + (b, bs) = break (== sep) cs + +-------------------------------------------------------------------------------- + files :: Bool -> [ String ] -> [ String ] files nums fs = - if null fs then - [] - else - map (\ (idx, rel) -> f idx rel) - $ zip [0..] fs - where - len = length $ show $ length fs - f i x = - if nums then - index len i ++ ": " ++ x - else - x + linesOptNums nums 0 fs file - :: Bool - -> String - -> String + :: Bool + -> String + -> [String] file nums f = - if null f then + linesOptNums nums 1 $ lines f + +-------------------------------------------------------------------------------- + +chits + :: Bool + -> [ String ] + -> [ String ] +chits nums fs = + linesOptNums nums 0 $ reverse fs + +chats + :: Bool + -> [ String ] + -> [ String ] +chats nums fs = + linesOptNums nums 0 $ reverse fs + +-------------------------------------------------------------------------------- + +-- HELPERS (private) + +linesOptNums + :: Bool + -> Int + -> [ String ] + -> [ String ] +linesOptNums nums origo xs = + if null xs then [] else - unlines - $ map (\ (idx, rel) -> g idx rel) - $ zip [1..] ls + map (\ (idx, rel) -> f idx rel) + $ zip [origo..] xs where - ls = lines f - len = length $ show $ length ls - g i x = + len = length $ show $ length xs + f i x = if nums then index len i ++ ": " ++ x else diff --git a/src/Agent/Utils/Plan.hs b/src/Agent/Utils/Plan.hs --- a/src/Agent/Utils/Plan.hs +++ b/src/Agent/Utils/Plan.hs @@ -43,7 +43,7 @@ => Maybe String -> Int -> Bool - -> rio (Either String String) + -> rio (Either String [String]) file mfilter index nums = filesHelper mfilter False >>= \ fs -> if length fs > index && index >= 0 then