A-gent 0.11.0.18 → 0.11.0.19
raw patch · 9 files changed
+806/−322 lines, 9 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Agent.LLM: [uuid] :: Context a -> !UUID
+ Agent.Control.Concurrent: terr :: Task a -> IO (Maybe String)
+ Agent.Control.Concurrent: tkil :: Task a -> IO String
+ Agent.Control.Concurrent: tmax :: IO Int
+ Agent.Control.Concurrent: tnum :: Task a -> String
+ Agent.Control.Concurrent: ttid :: Task a -> ThreadId
+ Agent.Control.Concurrent: tval :: Task a -> IO (Maybe a)
+ Agent.Control.Concurrent: tvar :: Task a -> IO Bool
+ Agent.LLM: [jobs] :: Context a -> !Maybe (Jobs (Context a))
- Agent.LLM: Context :: !UUID -> !Mode -> !Load a -> !History -> !Maybe Filter -> !Maybe FilePaths -> !Maybe Files -> Context a
+ Agent.LLM: Context :: !Mode -> !Load a -> !History -> !Maybe Filter -> !Maybe FilePaths -> !Maybe Files -> !Maybe (Jobs (Context a)) -> Context a
Files
- A-gent.cabal +2/−2
- CHANGELOG.md +16/−0
- LICENSE.md +14/−4
- README.md +65/−49
- src/Agent/Control/Concurrent.hs +124/−6
- src/Agent/LLM.hs +517/−258
- src/Internal/LLM.hs +8/−0
- src/Internal/LLM/Action.hs +4/−0
- src/Internal/RIO.hs +56/−3
A-gent.cabal view
@@ -9,7 +9,7 @@ build-type: Simple name: A-gent-version: 0.11.0.18+version: 0.11.0.19 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@@ -34,7 +34,7 @@ GHC == 9.6.7 GHC == 9.8.4 GHC == 9.10.3- GHC == 9.12.2+ GHC == 9.12.4 source-repository head type:
CHANGELOG.md view
@@ -1,5 +1,21 @@ # Revision history for Λ-gent +## 0.11.0.19 -- 2026-07-11++* Feature branch descriptions prefix tags for `Λ-gent` mode on success as done+ for failures with `[FAIL]`.++* Updated `GHC` from `9.12.2` to `9.12.4`.++* Added a commercial source-available & non-copyleft license `SPISE MISU+ License, v2 (SML-2.0)`. For more info, have a look at:+ + * https://a-gent.org/about.html#licenses++* Added a dummy OpenAI API mockup, to ease and increase development pace.++* Added support for multitasking/batching of LLM prompt requests.+ ## 0.11.0.18 -- 2026-05-18 * Added the `/drop` command to remove end-user provided `load` will help clear
LICENSE.md view
@@ -1,8 +1,8 @@-License-=======+Licenses+======== -Source code in this repository is ONLY covered by a [**Server Side Public-License, v1 (SSPL-1.0)**][spdx-sspl-1].+Source code in the [repository][gitlab-agent] is ONLY covered by a [**Server+Side Public License, v1 (SSPL-1.0)**][spdx-sspl-1]. However, as `SSPL-1.0` is not approved by the [Free Software Foundation (FSF)][fsf] nor the [Open Source Initiative (OSI)][osi] as an open source@@ -18,12 +18,22 @@ * [**GNU Affero General Public License v3.0 only (AGPL-3.0-only)**][local-agpl-3o] +For organizations that can't use any of the mentioned open-source & copyleft+licenses, a commercial source-available & non-copyleft license, heavily inspired+by [Elastic License 2.0 (ELv2)][elastic-el-2], is provided:++* [**SPISE MISU License, v2 (SML-2.0)**][local-sml-2]++[gitlab-agent]: https://gitlab.com/a-gent/a-gent/+ [spdx-sspl-1]: https://spdx.org/licenses/SSPL-1.0 [spdx-agpl-3o]: https://spdx.org/licenses/AGPL-3.0-only [hackage-osl]: https://hackage.haskell.org/upload+[elastic-el-2]: https://www.elastic.co/blog/elastic-license-v2 [fsf]: https://www.fsf.org/ [osi]: https://opensource.org/ [local-sspl-1]: ./LICENSE_SSPL-1.0.txt [local-agpl-3o]: ./LICENSE_AGPL-3.0-only.txt+[local-sml-2]: ./LICENSE_SML-2.0.txt
README.md view
@@ -30,58 +30,64 @@ ================= ```sh-├── doc-│ └── TODO.md-├── src-│ ├── Agent-│ │ ├── Control-│ │ │ ├── Concurrent.hs-│ │ │ ├── IFC.hs-│ │ │ └── MAC.hs-│ │ ├── Data-│ │ │ ├── ANSI-│ │ │ │ └── EscapeCode.hs-│ │ │ └── JSON.hs-│ │ ├── IO-│ │ │ ├── Effects.hs-│ │ │ └── Restricted.hs-│ │ └── LLM.hs-│ └── Internal-│ ├── GaloisInc-│ │ └── Text-│ │ ├── JSON-│ │ │ ├── Generic.hs-│ │ │ ├── String.hs-│ │ │ └── Types.hs-│ │ ├── JSON.hs-│ │ ├── LICENSE-│ │ └── NOTES.md-│ ├── GlasgowUniversity-│ │ ├── Data-│ │ │ └── Generics-│ │ │ └── Aliases.hs-│ │ ├── LICENSE-│ │ └── NOTES.md-│ ├── LLM.hs-│ ├── RIO.hs-│ └── Utils.hs-├── uat-│ └── TODO.md-├── A-gent.cabal-├── CHANGELOG.md-├── LICENSE.md-├── LICENSE_AGPL-3.0-only.txt-├── LICENSE_SSPL-1.0.txt-├── README.md-├── Setup.hs-└── todo.org+|-- doc+|-- src+| |-- Agent+| | |-- Control+| | | |-- Concurrent.hs+| | | |-- IFC.hs+| | | `-- MAC.hs+| | |-- Data+| | | |-- ANSI+| | | | `-- EscapeCode.hs+| | | `-- JSON.hs+| | |-- IO+| | | |-- Effects.hs+| | | `-- Restricted.hs+| | |-- LLM+| | | |-- Action.hs+| | | `-- Message.hs+| | `-- LLM.hs+| |-- Internal+| | |-- GaloisInc+| | | `-- Text+| | | |-- JSON+| | | | |-- Generic.hs+| | | | |-- String.hs+| | | | `-- Types.hs+| | | |-- JSON.hs+| | | |-- LICENSE+| | | `-- NOTES.md+| | |-- GlasgowUniversity+| | | |-- Data+| | | | `-- Generics+| | | | `-- Aliases.hs+| | | |-- LICENSE+| | | `-- NOTES.md+| | |-- LLM+| | | `-- Action.hs+| | |-- LLM.hs+| | |-- RIO.hs+| | `-- Utils.hs+| `-- demo.hs+|-- uat+| `-- TODO.md+|-- A-gent.cabal+|-- CHANGELOG.md+|-- LICENSE.md+|-- LICENSE_AGPL-3.0-only.txt+|-- LICENSE_SML-2.0.txt+|-- LICENSE_SSPL-1.0.txt+|-- README.md+|-- Setup.hs+`-- todo.org ``` -License-=======+Licenses+======== -Source code in this repository is ONLY covered by a [**Server Side Public-License, v1 (SSPL-1.0)**][spdx-sspl-1].+Source code in the [repository][gitlab-agent] is ONLY covered by a [**Server+Side Public License, v1 (SSPL-1.0)**][spdx-sspl-1]. However, as `SSPL-1.0` is not approved by the [Free Software Foundation (FSF)][fsf] nor the [Open Source Initiative (OSI)][osi] as an open source@@ -97,12 +103,22 @@ * [**GNU Affero General Public License v3.0 only (AGPL-3.0-only)**][local-agpl-3o] +For organizations that can't use any of the mentioned open-source & copyleft+licenses, a commercial source-available & non-copyleft license, heavily inspired+by [Elastic License 2.0 (ELv2)][elastic-el-2], is provided:++* [**SPISE MISU License, v2 (SML-2.0)**][local-sml-2]++[gitlab-agent]: https://gitlab.com/a-gent/a-gent/+ [spdx-sspl-1]: https://spdx.org/licenses/SSPL-1.0 [spdx-agpl-3o]: https://spdx.org/licenses/AGPL-3.0-only [hackage-osl]: https://hackage.haskell.org/upload+[elastic-el-2]: https://www.elastic.co/blog/elastic-license-v2 [fsf]: https://www.fsf.org/ [osi]: https://opensource.org/ [local-sspl-1]: ./LICENSE_SSPL-1.0.txt [local-agpl-3o]: ./LICENSE_AGPL-3.0-only.txt+[local-sml-2]: ./LICENSE_SML-2.0.txt
src/Agent/Control/Concurrent.hs view
@@ -21,26 +21,139 @@ , fork , wait , join+ , tmax+ , ttid+ , tkil+ , tnum+ , tvar+ , tval+ , terr ) where -------------------------------------------------------------------------------- -import Control.Concurrent ( ThreadId, forkFinally )+{- DEBUG++import Control.Concurrent+ ( ThreadId+ , forkFinally+ , getNumCapabilities+ , killThread+ , threadDelay+ )+ import Control.Concurrent.MVar ( MVar , newEmptyMVar , putMVar , readMVar+ , tryReadMVar )++import GHC.Exception+ ( SomeException+ , errorCallException+ , throw+ )++-}++{-++-}++import Control.Concurrent+ ( ThreadId+ , forkFinally+ , getNumCapabilities+ , killThread+ )++import Control.Concurrent.MVar+ ( MVar+ , newEmptyMVar+ , putMVar+ , readMVar+ , tryReadMVar+ )+ import GHC.Exception ( SomeException, throw ) --------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -data Task a = Task !ThreadId (IO (Either SomeException a))+type Wrap a = Either SomeException a+data Task a = Task !ThreadId !(MVar (Wrap a)) !(IO (Wrap a)) -------------------------------------------------------------------------------- +tmax :: IO Int+tmax =+ getNumCapabilities++ttid+ :: Task a+ -> ThreadId+ttid (Task uid _ _) =+ uid++tkil+ :: Task a+ -> IO String+tkil t@(Task uid _ _) =+ killThread uid >>+ pure n+ where+ n = tnum t++tnum+ :: Task a+ -> String+tnum (Task uid _ _) =+ -- NOTE: Sample of `show uid` is `ThreadId 42` and+ -- > cat /proc/sys/kernel/threads-max+ -- > 509_390+ (lpad 6 '0' . drop 1 . dropWhile (/= ' ') . show) uid+ where+ lpad n c x =+ replicate (n - l) c ++ x+ where+ l = length x++tvar+ :: Task a+ -> IO Bool+tvar (Task _ mvar _) =+ ( \case+ Nothing -> False+ Just __ -> True+ )+ <$> tryReadMVar mvar++tval+ :: Task a+ -> IO (Maybe a)+tval (Task _ _ mval) =+ ( \case+ Right a -> Just a+ Left _ -> Nothing+ )+ <$> mval++terr+ :: Task a+ -> IO (Maybe String)+terr (Task _ _ mval) =+ ( \case+ Right _ -> Nothing+ Left e -> Just $ show e+ )+ <$> mval++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------+ -- | -- To prevent the users from adding instances of `Async`, we -- provide a middle-layer (`Proxy`) between the `Monad` instance and the `Proxy`@@ -72,14 +185,19 @@ fork compute = new >>= \ var -> forkFinally compute (finally var) >>= \ tid ->- pure $ Task tid $ get var+ pure $ Task tid var $ get var where- finally v r = put v r- wait (Task _ mvar) =+ finally v r =+ -- DEBUG: sleep for 9 million microseconds, or 9 seconds+ --threadDelay 9000000 >>+ -- DEBUG: Force an exception+ --put v (Left $ errorCallException "DEBUG")+ put v r+ wait (Task _ _ mval) = ( \case Right v -> v Left e -> throw e )- <$> mvar+ <$> mval join = mapM_ wait
src/Agent/LLM.hs view
@@ -47,8 +47,7 @@ -------------------------------------------------------------------------------- -import Prelude hiding ( head, mod, print, read )-+import Prelude hiding ( head, print, read ) import Data.Char ( toLower, toUpper ) import Data.Maybe ( fromMaybe )@@ -81,6 +80,7 @@ , Files , Filter , History (..)+ , Jobs , Mask , Mode (..) , Root@@ -90,7 +90,19 @@ ) import qualified Internal.LLM as INT import Internal.LLM.Action ( Action (..) )-import Internal.RIO ( RIO (..), input, output )+import Internal.RIO+ ( RIO (..)+ , fork+ , input+ , output+ , terr+ , timestampUTC+ , tkil+ , tnum+ , tval+ , tvar+ , wait+ ) import qualified Internal.Utils as UTL import qualified Agent.Data.ANSI.EscapeCode as AEC@@ -99,7 +111,6 @@ import Agent.Data.JSON ( Data ) import Agent.LLM.Message ( Message ) - -------------------------------------------------------------------------------- type Load a =@@ -110,13 +121,13 @@ data Context a = Context- { uuid :: !UUID- , mode :: !Mode+ { mode :: !Mode , load :: !(Load a) , hist :: !History , list :: !(Maybe Filter) , pile :: !(Maybe FilePaths) , ruck :: !(Maybe Files)+ , jobs :: !(Maybe (Jobs (Context a))) } type Eval a =@@ -136,7 +147,7 @@ :: INT.Mode -> Eval a -> IO ()-replWithMode mod proc =+replWithMode mode' proc = do constraint <- integrity case constraint of@@ -150,14 +161,13 @@ -- NOTE: No default output when typing hSetEcho stdin False putStrLn head >> hFlush stdout- run $ loop ctx proc+ run $ loop ctx proc >> pure () Left err -> putStrLn err >> hFlush stdout where ctx = Context- { uuid = INT.UUID []- , mode = mod+ { mode = mode' , load = Nothing , hist = History@@ -171,6 +181,7 @@ , list = Nothing , pile = Just $ INT.FilePaths [] , ruck = Just $ INT.Files []+ , jobs = Just $ INT.Jobs [] } --------------------------------------------------------------------------------@@ -178,11 +189,11 @@ -- HELPERS (private) {- NOTE: Doesn't seem to work-ctrlC :: IO () -> IO ()+-- ctrlC :: IO () -> IO () ctrlC task = -- NOTE: Catch CTRL+C -- https://neilmitchell.blogspot.com/2015/05/handling-control-c-in-haskell.html- sync . (:[]) <$> fork task+ join . (:[]) <$> fork task -} head :: String@@ -199,84 +210,131 @@ , "/w or /wipe | Wipe screen" , "/d or /drop | Drop end-user data load" , ds- , "/m m or /mode m | Change to {" ++ ms ++ "}. Ex: /m plan"+ , "/m m or /mode m | Change to {" ++ ms ++ "}. Ex: /mode plan" , ds- , "/h or /hist | View history (input and output)"+ , "/h or /hist | View history (input & output)" , " /chit | View history (only input) " , " /chat | View history (only output)" , ds- , "/l f or /list f | List of files, limited by mode, file masks and filter"- , "/p or /pile | Show stored list of files. See /list above"- , "/f i or /file i | Show file with the given index. See /pile above"- , "/n i or /nums i | Show file with line numbers. See /file above"+ , "/l f or /list f | List of files, limited by mode, file masks & filter"+ , "/p or /pile | Show stored list of files in pile. See /list above"+ , "/f i or /file i | Show file with the provided index. See /pile above"+ , "/n i or /nums i | Show file (idx) with line numbers. See /file above" , ds , "/s m or /send m | Sending /pile to LLM as context to the message"- , "/r o or /ruck o | View files (opt index) from LLM response. See /send"+ , "/r o or /ruck o | View files (opt index) from LLM response. See /send above" , "/a d or /atom d | Atomically save /ruck files to a GIT branch (+ description)"- , " /repo | List GIT branches (+ description). See /atom above"+ , " /repo | List GIT branches, including description. See /atom above" , ds+ , "/t m or /task m | Fork /send m jobs for files. See /pile above"+ , "/j or /jobs | Show info for executed jobs. See /task above"+ , " /sync | Join contexts, if no errors. See /jobs above"+ , " /stop | Kill or abort, current jobs. See /jobs above"+ , ds+ , " /exec | Execute the automated mode. See /mode auto"+ , " /halt | Bring automation to a halt. See /mode auto"+ , ds ] where ds = replicate 80 '-' ms = foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes +--------------------------------------------------------------------------------+ loop :: Context a -> Eval a- -> RIO ()+ -> RIO (Context a) loop ctx eval = print prompt >>- read hps hns >>= \ txt ->+ read hps hns >>= \ txt -> printLn [ ] >>- case txt2act txt of+ timestampUTC >>= \ outs ->+ loopHelper (prv txt ctx) eval (action ctx txt) outs+ where+ -- TODO: Refactoring needed+ his = hist ctx+ chi = chit his+ hps = prev chi+ hns = next chi + -- TODO: Refactoring needed+ prv p c =+ c+ { hist =+ h+ { chit =+ (chit $ hist c)+ { prev = p : hps+ }+ }+ }+ where+ h = hist c++ -- TODO: Refactoring needed+ prompt =+ (show . AEC.bold . AEC.sgr)+ ("Λ-" ++ (map toLower . show . mode) ctx ++ "> ")+ read = input++loopHelper+ :: Context a+ -> Eval a+ -> Action+ -> Maybe String+ -> RIO (Context a)+loopHelper ctx eval act_ outs =+ case act_ of+ -- TODO: Refactoring needed+ -- Nested -- Start None ->- loop (nxt txt ctx Nothing) eval+ loop ctx eval File _ ->- loop (nxt txt ctx Nothing) eval+ loop ctx eval Template _ _ _ _ ->- loop (nxt txt ctx Nothing) eval+ loop ctx eval -- Nested -- Stop Exit -> caseExit- Help -> caseHelp txt- Drop -> caseDrop txt- Hist (chits, chats) -> caseHist txt chits chats- Mode c cs -> caseMode txt c cs- Paths (INT.FilePaths fps) -> casePaths txt fps- Pile -> casePile txt- Ruck mdix -> caseRuck txt mdix- Wipe -> caseWipe txt- UnknownCmd cmd -> caseUnknownCmd txt cmd+ Help -> caseHelp+ Drop -> caseDrop+ Hist (chits, chats) -> caseHist chits chats+ Mode c cs -> caseMode c cs+ Paths (INT.FilePaths fps) -> casePaths fps+ Pile -> casePile+ Ruck mdix -> caseRuck mdix+ Wipe -> caseWipe+ UnknownCmd cmd -> caseUnknownCmd cmd Branch msg fs ->- eval ctx (MSG.Atom msg fs) >>= \ (upd, action) ->- case action of+ eval ctx (MSG.Atom msg fs) >>= \ (upd, act) ->+ case act of Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval Prompt msg -> - eval ctx (MSG.Tmpl afps) >>= \ (upd0, action0) ->- case action0 of- Template f is es fs ->+ eval ctx (MSG.Tmpl afps) >>= \ (upd0, act0) ->+ case act0 of+ Template p is es fs -> - eval ctx (MSG.Send xml) >>= \ (upd1, action1) ->- case action1 of+ eval upd0 (MSG.Send xml) >>= \ (upd1, act1) ->+ case act1 of Message (MSG.Text cs) -> printLn cs >> loop- ( nxt txt+ ( nxt ( upd1 { ruck = Just $ pfs } ) ( Just cs@@ -284,15 +342,15 @@ ) eval where pfs =- case (map INT.File . f) cs of+ case (map INT.File . p) cs of [] -> INT.Files [] xs -> INT.Files xs None ->- loop (nxt txt upd1 Nothing) eval+ loop (nxt upd1 Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd1 (Just [])) eval+ loop (nxt upd1 (Just [])) eval where ils = map ( \ (INT.File (_, ls)) -> unlines ls) is els = map ( \ (INT.File (_, ls)) -> unlines ls) es@@ -301,262 +359,296 @@ Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd0 (Just cs)) eval+ loop (nxt upd0 (Just cs)) eval None ->- loop (nxt txt upd0 Nothing) eval+ loop (nxt upd0 Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd0 (Just [])) eval+ loop (nxt upd0 (Just [])) eval where afps = ( \ (INT.FilePaths fps) -> map INT.AbsoluteFilePath fps ) <$> pile ctx + Batch msg ->+ case (null ejs, outs) of+ ( True, Just uts) ->+ ( eval ctx (MSG.Tmpl aps) >>= \ (upd0, act0) ->+ case act0 of+ Template p is es fs ->+ let+ ils = map ( \ (INT.File (_, ls)) -> unlines ls) is+ els = map ( \ (INT.File (_, ls)) -> unlines ls) es+ in+ mapM+ ( \ f ->+ let+ tpl = INT.Template msg ils els [f]+ xml = INT.tpl2xmls tpl+ in+ fork+ ( eval upd0 ( MSG.Send xml ) >>= \ (upd1, act1) ->+ case act1 of+ Message (MSG.Text cs) ->+ pure+ ( nxt+ ( upd1+ { ruck = Just $ pfs+ }+ )+ ( Just cs+ )+ )+ where+ pfs =+ case (map INT.File . p) cs of+ [] -> INT.Files []+ xs -> INT.Files xs+ _____________________ ->+ pure upd1+ )+ )+ fs+ ___________________ ->+ pure []+ ) >>= \ js ->+ printLn ("Batched tasks unique identifier: " ++ uts) >>+ loop ctx { jobs = Just (njs (INT.UUID uts) js) } eval+ ( False, _) ->+ printLn "Current batch is unsynchronized. See /help for info" >>+ loop ctx eval+ ( _, Nothing) ->+ printLn "Missing unique identifier UTC-timestamp." >>+ loop ctx eval+ where++ aps =+ ( \ (INT.FilePaths fps) -> map INT.AbsoluteFilePath fps+ )+ <$> pile ctx++ ojs = jobs ctx+ ejs =+ case ojs of+ Nothing -> []+ Just (INT.Jobs js) -> js++ njs uuid js =+ INT.Jobs $ zip (repeat uuid) js++ Status ->+ mapM+ ( \ (INT.UUID uid, j) ->+ tnum j >>= \ num ->+ tvar j >>= \ var ->+ if not var then+ pure (uid, num, "RUNNING")+ else+ tval j >>= \ val ->+ case val of+ Nothing ->+ terr j >>= \ err ->+ pure (uid, num, "FAILURE" ++ " | " ++ (fromMaybe [] err))+ Just __ ->+ pure (uid, num, "STOPPED")+ ) njs >>= \ logs ->+ mapM_+ ( \ (uid, tid, status) ->+ printLn $ uid ++ " | " ++ tid ++ " | " ++ status+ ) logs >>+ loop ctx eval+ where+ njs =+ case jobs ctx of+ Nothing -> []+ Just (INT.Jobs js) -> js++ Sync ->+ mapM+ ( \ (_, j) ->+ tvar j >>= \ var ->+ if not var then+ pure var+ else+ tval j >>= \ val ->+ case val of+ Nothing -> pure $ var && False+ Just __ -> pure $ var && True+ ) njs >>= \ succeeded ->+ if all id succeeded then+ mapM (wait . snd) njs >>= \ ctxs ->+ let+ (skipped, merged) =+ foldl+ ( \ (bs, a) x ->+ let+ ars =+ case ruck a of+ Just (INT.Files rs) -> rs+ Nothing -> []+ xrs =+ case ruck x of+ Just (INT.Files rs) -> rs+ Nothing -> []+ in+ ( bs ++ [null xrs]+ , a { ruck = Just $ INT.Files $ ars ++ xrs}+ )+ )+ ( []+ , ctx { jobs = Just $ INT.Jobs [] }+ )+ ctxs+ in+ mapM+ ( \ ((INT.UUID uid, j), skip) ->+ tnum j >>= \ num ->+ if skip then+ pure (uid, num, "SKIPPED")+ else+ pure (uid, num, "BLENDED")+ ) (zip njs skipped) >>= \ logs ->+ mapM_+ ( \ (uid, tid, status) ->+ printLn $ uid ++ " | " ++ tid ++ " | " ++ status+ ) logs >>+ loop merged eval+ else+ loopHelper ctx eval Status outs+ where+ njs =+ case jobs ctx of+ Nothing -> []+ Just (INT.Jobs js) -> js++ Stop ->+ mapM+ ( \ (INT.UUID uid, j) ->+ tvar j >>= \ var ->+ if not var then+ tkil j >>= \ num ->+ pure (uid, num, "STOPPED")+ else+ tnum j >>= \ num ->+ pure (uid, num, "SKIPPED")+ ) njs >>= \ logs ->+ mapM_+ ( \ (uid, tid, status) ->+ printLn $ uid ++ " | " ++ tid ++ " | " ++ status+ ) logs >>+ loop ctx { jobs = Just $ INT.Jobs [] } eval+ where+ njs =+ case jobs ctx of+ Nothing -> []+ Just (INT.Jobs js) -> js+ Message (MSG.Path ns afp) ->- eval ctx (MSG.Path ns afp) >>= \ (upd, action) ->- case action of+ eval ctx (MSG.Path ns afp) >>= \ (upd, act) ->+ case act of File (INT.File (_,ls)) ->- caseFile txt ns ls+ caseFile ns ls Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval Message (MSG.List fil) ->- eval ctx (MSG.List fil) >>= \ (upd, action) ->- case action of+ eval ctx (MSG.List fil) >>= \ (upd, act) ->+ case act of Paths (INT.FilePaths fps) ->- casePaths txt fps+ casePaths fps Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval Message MSG.Repo ->- eval ctx MSG.Repo >>= \ (upd, action) ->- case action of+ eval ctx MSG.Repo >>= \ (upd, act) ->+ case act of Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval Message msg ->- eval ctx msg >>= \ (upd, action) ->- case action of+ eval ctx msg >>= \ (upd, act) ->+ case act of Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval where -- TODO: Refactoring needed- txt2act txt =- -- TODO: Refactoring needed- case txt of-- '/':'m':'o':'d':'e':' ':c:cs -> Mode c cs- '/':'m' :' ':c:cs -> Mode c cs-- '/':'l':'i':'s':'t' :mfil ->- -- TODO: DRY- Message (MSG.List fil)- where- fil =- case mfil of- [ ] -> Just $ INT.Filter mfil- ' ':cs -> Just $ INT.Filter cs- ______ -> Nothing- '/':'l' :mfil ->- -- TODO: DRY- Message (MSG.List fil)- where- fil =- case mfil of- [ ] -> Just $ INT.Filter mfil- ' ':cs -> Just $ INT.Filter cs- ______ -> Nothing-- '/':'f':'i':'l':'e':' ':midx ->- -- TODO: DRY- case oidx of- Nothing ->- Message (MSG.Path False Nothing)- Just idx ->- if 0 <= idx && idx < length pfs then- Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))- else- Message (MSG.Path False Nothing)- where- pfs = concatMap INT.filePaths $ pile ctx- where- oidx =- case midx of- [] -> Nothing- cs -> readMaybe cs :: Maybe Int- '/':'f' :' ':midx ->- -- TODO: DRY- case oidx of- Nothing ->- Message (MSG.Path False Nothing)- Just idx ->- if 0 <= idx && idx < length pfs then- Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))- else- Message (MSG.Path False Nothing)- where- pfs = concatMap INT.filePaths $ pile ctx- where- oidx =- case midx of- [] -> Nothing- cs -> readMaybe cs :: Maybe Int- '/':'n':'u':'m':'s':' ':midx ->- -- TODO: DRY- case oidx of- Nothing ->- Message (MSG.Path True Nothing)- Just idx ->- if 0 <= idx && idx < length pfs then- Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))- else- Message (MSG.Path True Nothing)- where- pfs = concatMap INT.filePaths $ pile ctx- where- oidx =- case midx of- [] -> Nothing- cs -> readMaybe cs :: Maybe Int- '/':'n' :' ':midx ->- -- TODO: DRY- case oidx of- Nothing ->- Message (MSG.Path True Nothing)- Just idx ->- if 0 <= idx && idx < length pfs then- Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))- else- Message (MSG.Path True Nothing)- where- pfs = concatMap INT.filePaths $ pile ctx- where- oidx =- case midx of- [] -> Nothing- cs -> readMaybe cs :: Maybe Int-- '/':'s':'e':'n':'d':' ':mesg -> Prompt mesg- '/':'s' :' ':mesg -> Prompt mesg-- '/':'a':'t':'o':'m':' ':mesg ->- -- TODO: DRY- Branch mesg fs- where- fs = fromMaybe (INT.Files []) (ruck ctx)- '/':'a' :' ':mesg ->- -- TODO: DRY- Branch mesg fs- where- fs = fromMaybe (INT.Files []) (ruck ctx)-- '/':'r':'e':'p':'o' :[ ] -> Message MSG.Repo-- '/':'r':'u':'c':'k' :midx -> Ruck midx- '/':'r' :midx -> Ruck midx-- "/exit" -> Exit- "/e" -> Exit- "/help" -> Help- "/?" -> Help- "/drop" -> Drop- "/d" -> Drop- "/hist" -> Hist ( True, True )- "/h" -> Hist ( True, True )- "/chit" -> Hist ( True, False )- "/chat" -> Hist ( False, True )- "/pile" -> Pile- "/p" -> Pile- "/wipe" -> Wipe- "/w" -> Wipe-- '/':cmd -> UnknownCmd cmd- ____________________________ -> Message (MSG.Text txt)-- -- TODO: Refactoring needed- his = hist ctx- chi = chit his- hps = prev chi- hns = next chi- nxt p c o =+ nxt c o = c { hist =- (hist c)- { chit =- (chit $ hist c)- { prev = p : hps- }- , chat =+ h+ { chat = case o of Nothing -> chat $ hist c Just r -> (r:) $ chat $ hist c } }+ where+ h = hist c caseExit = printLn "Λ-gent will shutdown" >>- return ()+ return ctx - caseDrop txt =+ caseDrop = printLn ("Dropping end-user data load") >> loop- ( (nxt txt ctx Nothing)+ ( ctx { load = Nothing } ) eval -- TODO: Refactoring needed- caseMode txt c cs =+ caseMode c cs = case mmod of- Just mod ->+ Just mode' -> printLn ("Changed to " ++ low ++ "-mode") >> loop- ( (nxt txt ctx Nothing)- { mode = mod+ ( ctx+ { mode = mode' , pile = Just $ INT.FilePaths [] , ruck = Just $ INT.Files [] } ) eval where- low = map toLower $ show mod+ low = map toLower $ show mode' Nothing -> printLn ("Invalid mode: " ++ c:cs) >> loop ctx eval where mmod = readMaybe (toUpper c : map toLower cs) :: Maybe INT.Mode - caseHist txt chits chats =+ caseHist chits chats = ( if chits then printLn "* Chits:" >> ( mapM_ printLn . UTL.combine . UTL.chits True . prev . chit . hist@@ -571,21 +663,21 @@ else pure () ) >>- loop (nxt txt ctx Nothing) eval+ loop ctx eval - caseFile txt ns ls =+ caseFile ns ls = ( mapM_ printLn . UTL.combine . UTL.file ns ) (unlines ls) >>- loop (nxt txt ctx Nothing) eval- caseHelp txt =+ loop ctx eval+ caseHelp = printLn help >>- loop (nxt txt ctx Nothing) eval+ loop ctx eval - casePaths txt fps =- eval ctx MSG.Root >>= \ (upd, action) ->- case action of+ casePaths fps =+ eval ctx MSG.Root >>= \ (upd, act) ->+ case act of Paths (INT.FilePaths rfps) -> ( case rfps of [cwd] ->@@ -599,23 +691,23 @@ printLn "Missing root path" ) >> loop- ( (nxt txt upd Nothing)+ ( (nxt upd Nothing) { pile = Just $ INT.FilePaths fps } ) eval Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval - casePile txt =- eval ctx MSG.Root >>= \ (upd, action) ->- case action of+ casePile =+ eval ctx MSG.Root >>= \ (upd, act) ->+ case act of Paths (INT.FilePaths fps) -> ( case fps of [cwd] ->@@ -630,18 +722,18 @@ _____ -> printLn "Missing root path" ) >>- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval Message (MSG.Text cs) -> printLn cs >>- loop (nxt txt upd (Just cs)) eval+ loop (nxt upd (Just cs)) eval None ->- loop (nxt txt upd Nothing) eval+ loop (nxt upd Nothing) eval _________________________ -> -- NOTE: Unexpected error printLn "Unexpected error" >>- loop (nxt txt upd (Just [])) eval+ loop (nxt upd (Just [])) eval - caseRuck txt midx =+ caseRuck midx = ( if null midx then -- NOTE: If no optional index provided, show only paths ( mapM_ printLn .@@ -674,7 +766,7 @@ printLn "Invalid use of /ruck. Use space between cmd and index" ) ) >>- loop (nxt txt ctx Nothing) eval+ loop ctx eval where idx = case midx of@@ -688,24 +780,191 @@ fps (INT.Files fs) = map ( \ (INT.File (p,_)) -> p) fs - caseWipe txt =+ caseWipe = printLn clear >>- loop (nxt txt ctx Nothing) eval+ loop ctx eval - caseUnknownCmd txt cmd =+ caseUnknownCmd cmd = printLn msg >>- loop (nxt txt ctx Nothing) eval+ loop ctx eval where msg = "Command not recognized: " ++ cmd -- NOTE: Clear screen & Move top-left clear = "\^[[H\^[[2J" -- NOTE: See `infocmp -x`- prompt =- (show . AEC.bold . AEC.sgr)- ("Λ-" ++ (map toLower . show . mode) ctx ++ "> ")- read = input- print = output . show . AEC.faint . AEC.sgr- printLn x = print $ x ++ "\n"++print+ :: String+ -> RIO ()+print =+ output . show . AEC.faint . AEC.sgr++printLn+ :: String+ -> RIO ()+printLn x =+ print $ x ++ "\n"++{-+printLn+ :: Bool+ -> String+ -> RIO ()+printLn n x =+ if not n then+ print $ x ++ "\n"+ else+ pure ()+-}++action+ :: Context a+ -> String+ -> Action+action ctx txt =+ -- TODO: Refactoring needed+ case txt of++ '/':'m':'o':'d':'e':' ':c:cs -> Mode c cs+ '/':'m' :' ':c:cs -> Mode c cs++ '/':'l':'i':'s':'t' :mfil ->+ -- TODO: DRY+ Message (MSG.List fil)+ where+ fil =+ case mfil of+ [ ] -> Just $ INT.Filter mfil+ ' ':cs -> Just $ INT.Filter cs+ ______ -> Nothing+ '/':'l' :mfil ->+ -- TODO: DRY+ Message (MSG.List fil)+ where+ fil =+ case mfil of+ [ ] -> Just $ INT.Filter mfil+ ' ':cs -> Just $ INT.Filter cs+ ______ -> Nothing++ '/':'f':'i':'l':'e':' ':midx ->+ -- TODO: DRY+ case oidx of+ Nothing ->+ Message (MSG.Path False Nothing)+ Just idx ->+ if 0 <= idx && idx < length pfs then+ Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))+ else+ Message (MSG.Path False Nothing)+ where+ pfs = concatMap INT.filePaths $ pile ctx+ where+ oidx =+ case midx of+ [] -> Nothing+ cs -> readMaybe cs :: Maybe Int+ '/':'f' :' ':midx ->+ -- TODO: DRY+ case oidx of+ Nothing ->+ Message (MSG.Path False Nothing)+ Just idx ->+ if 0 <= idx && idx < length pfs then+ Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))+ else+ Message (MSG.Path False Nothing)+ where+ pfs = concatMap INT.filePaths $ pile ctx+ where+ oidx =+ case midx of+ [] -> Nothing+ cs -> readMaybe cs :: Maybe Int+ '/':'n':'u':'m':'s':' ':midx ->+ -- TODO: DRY+ case oidx of+ Nothing ->+ Message (MSG.Path True Nothing)+ Just idx ->+ if 0 <= idx && idx < length pfs then+ Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))+ else+ Message (MSG.Path True Nothing)+ where+ pfs = concatMap INT.filePaths $ pile ctx+ where+ oidx =+ case midx of+ [] -> Nothing+ cs -> readMaybe cs :: Maybe Int+ '/':'n' :' ':midx ->+ -- TODO: DRY+ case oidx of+ Nothing ->+ Message (MSG.Path True Nothing)+ Just idx ->+ if 0 <= idx && idx < length pfs then+ Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))+ else+ Message (MSG.Path True Nothing)+ where+ pfs = concatMap INT.filePaths $ pile ctx+ where+ oidx =+ case midx of+ [] -> Nothing+ cs -> readMaybe cs :: Maybe Int++ '/':'s':'e':'n':'d':' ':mesg -> Prompt mesg+ '/':'s' :' ':mesg -> Prompt mesg++ '/':'t':'a':'s':'k':' ':mesg -> Batch mesg+ '/':'t' :' ':mesg -> Batch mesg++ '/':'j':'o':'b':'s':[ ] -> Status+ '/':'j' :[ ] -> Status++ '/':'s':'y':'n':'c':[ ] -> Sync++ '/':'s':'t':'o':'p':[ ] -> Stop++ '/':'a':'t':'o':'m':' ':mesg ->+ -- TODO: DRY+ Branch mesg fs+ where+ fs = fromMaybe (INT.Files []) (ruck ctx)+ '/':'a' :' ':mesg ->+ -- TODO: DRY+ Branch mesg fs+ where+ fs = fromMaybe (INT.Files []) (ruck ctx)++ '/':'r':'e':'p':'o' :[ ] -> Message MSG.Repo++ '/':'r':'u':'c':'k' :midx -> Ruck midx+ '/':'r' :midx -> Ruck midx++ "/exit" -> Exit+ "/e" -> Exit+ "/help" -> Help+ "/?" -> Help+ "/drop" -> Drop+ "/d" -> Drop+ "/hist" -> Hist ( True, True )+ "/h" -> Hist ( True, True )+ "/chit" -> Hist ( True, False )+ "/chat" -> Hist ( False, True )+ "/pile" -> Pile+ "/p" -> Pile+ "/wipe" -> Wipe+ "/w" -> Wipe++ '/':cmd -> UnknownCmd cmd+ ____________________________ -> Message (MSG.Text txt)+++-------------------------------------------------------------------------------- integrity :: IO (Either String ()) integrity =
src/Internal/LLM.hs view
@@ -26,6 +26,7 @@ , Files (..) , FileLine , FilePaths (..)+ , Jobs (..) , AbsoluteFilePath (..) , Template (..) , modes@@ -34,6 +35,9 @@ where --------------------------------------------------------------------------------++import Agent.Control.Concurrent ( Task )+ -------------------------------------------------------------------------------- newtype UUID = UUID String@@ -107,6 +111,10 @@ instance Monoid FilePaths where mempty = FilePaths []++--------------------------------------------------------------------------------++newtype Jobs a = Jobs [(UUID, Task a)] --------------------------------------------------------------------------------
src/Internal/LLM/Action.hs view
@@ -42,6 +42,10 @@ | Paths !INT.FilePaths | Pile | Prompt !String+ | Batch !String+ | Status+ | Sync+ | Stop | Ruck !String | Template !TextToFile ![INT.File] ![INT.File] ![INT.File] | UnknownCmd !String
src/Internal/RIO.hs view
@@ -50,6 +50,19 @@ -- * Read/Print , input , output+ -- * Timestamps+ , timestampUTC+ -- * MultiThreading+ , fork+ , wait+ , join+ , tmax+ , ttid+ , tkil+ , tnum+ , tvar+ , tval+ , terr -- * LLM (Config) , llmPathCWD -- * LLM (Chat)@@ -74,6 +87,10 @@ -------------------------------------------------------------------------------- +import Prelude hiding ( mod )++import Control.Concurrent ( ThreadId )+ import Control.Exception ( SomeException, try ) import Data.Char ( isDigit ) import Data.Either ( fromLeft, partitionEithers )@@ -108,6 +125,9 @@ import qualified Agent.IO.Effects as EFF +import Agent.Control.Concurrent ( Task )+import qualified Agent.Control.Concurrent as CON+ -------------------------------------------------------------------------------- newtype RIO a = RestrictedIO { run :: IO a }@@ -167,6 +187,37 @@ -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- +class MultiThreading m where+ fork :: m a -> m (Task a)+ wait :: Task a -> m a+ join :: [ Task a ] -> m ( )+ --+ tmax :: m Int+ ttid :: Task a -> m ThreadId+ tkil :: Task a -> m String+ tnum :: Task a -> m String+ tvar :: Task a -> m Bool+ tval :: Task a -> m (Maybe a)+ terr :: Task a -> m (Maybe String)++--------------------------------------------------------------------------------++instance MultiThreading RIO where+ fork (RestrictedIO io) = RestrictedIO $ CON.fork io+ wait = RestrictedIO . CON.wait+ join = RestrictedIO . CON.join+ --+ tmax = RestrictedIO $ CON.tmax+ ttid = pure . CON.ttid+ tkil = RestrictedIO . CON.tkil+ tnum = pure . CON.tnum+ tvar = RestrictedIO . CON.tvar+ tval = RestrictedIO . CON.tval+ terr = RestrictedIO . CON.terr++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------+ class StdIn m where input :: [ String ]@@ -1006,7 +1057,7 @@ , Right wcf , Right wrf ) ->- gitUpdateBranchDesc root ts txt >>= \ ewtb ->+ gitUpdateBranchDesc root ts mod >>= \ ewtb -> case ewtb of Right _ -> pure $ Right $ unlines@@ -1021,6 +1072,8 @@ , wrf ] Left e -> pure $ Left e+ where+ mod = "[CODE] " ++ txt ( _, (es,__), _, _, _) -> gitUpdateBranchDesc root ts err >>= \ ewtb -> case ewtb of@@ -1032,7 +1085,7 @@ , "## Adding description:" , fromLeft "No error" ewtb , "## Saving files:"- , concat es+ , concat $ map (++ "\n") es , "## Adding files:" , fromLeft "No error" ewaf , "## Committing:"@@ -1042,7 +1095,7 @@ ] Left e -> pure $ Left e where- err = "[ERROR]: " ++ txt+ err = "[FAIL] " ++ txt where tap = tmp ++ "/" ++ ts dir = tap ++ "/" ++ cdir