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.12 +version: 0.11.0.13 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 @@ -154,6 +154,7 @@ Internal.RIO -- Internal.LLM + Internal.LLM.Action -- Internal.Utils exposed-modules: @@ -168,6 +169,8 @@ Agent.IO.Restricted -- Agent.LLM + Agent.LLM.Action + Agent.LLM.Message -- Reference -- diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,23 @@ # Revision history for Λ-gent +## 0.11.0.13 -- 2026-05-14 + +* Updated scripts from website with changes from `0.11.0.12`. + + > **NOTE:** Due to changes in this release, we need to check and update once + > again. + +* Checked scripts on `macOS` with changes from `0.11.0.12`. + + > **NOTE:** As before, with changes from this release, we need to check once + > again. + +* Moved `Message` and `Action` to their own modules. For `Action`, we also add + an internal module to avoid exposing type constructors. + +* Ensured not to expose internal types. We import and re-export for type + signatures, but not the constructors. + ## 0.11.0.12 -- 2026-05-12 There have been made some **major changes** to this library and therefore there @@ -39,8 +57,9 @@ * Followed up on binary flags as we need to have the **least common** between `Linux` distros and `macOS`. -* Added the `/repo` command to help parse and store files received from LLM's - `atomically` with help of `git worktree`. +* Added the `/atom` and `/repo` commands to help parse and store files received + from LLM's `atomically` with help of `git worktree` as well as list the + produced `git branches`. * Added `message` and `action` types simplify and make more robust the interactions between user and `Λ-gent`. diff --git a/src/Agent/LLM.hs b/src/Agent/LLM.hs --- a/src/Agent/LLM.hs +++ b/src/Agent/LLM.hs @@ -5,8 +5,6 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE LambdaCase #-} - -------------------------------------------------------------------------------- -- | @@ -22,43 +20,33 @@ module Agent.LLM ( -- * Modes - INT.Mode(..) + Mode(..) -- * Context - , Load - , History(..) , Context(..) + , FilePaths + , Files + , Filter + , History + , Load + , UUID -- * Paramenters - , Action(..) - , Message(..) - , none - , exit - , file - , root - , text - , paths - , template , Eval -- * Methods , repl , replWithMode - -- * DEBUG ) where -------------------------------------------------------------------------------- -import Prelude hiding - ( head - , mod - , print - , read - ) +import Prelude hiding ( head, mod, print, read ) -import Data.Char ( toLower, toUpper ) -import Data.Maybe ( fromMaybe ) -import GHC.IO.Encoding ( setLocaleEncoding ) -import System.Environment ( getProgName ) -import qualified System.Environment.Blank as ENV + +import Data.Char ( toLower, toUpper ) +import Data.Maybe ( fromMaybe ) +import GHC.IO.Encoding ( setLocaleEncoding ) +import System.Environment ( getProgName ) +import qualified System.Environment.Blank as ENV import System.Exit ( ExitCode (ExitFailure, ExitSuccess) ) @@ -72,27 +60,32 @@ , stdout , utf8 ) -import System.Process - ( readProcessWithExitCode - ) -import Text.Read ( readMaybe ) +import System.Process ( readProcessWithExitCode ) +import Text.Read ( readMaybe ) -import Internal.GaloisInc.Text.JSON.Generic ( Data ) import Internal.LLM ( Chit (..) + , FilePaths + , Files + , Filter , History (..) + , Mode + , UUID , modes ) -import qualified Internal.LLM as INT -import Internal.RIO - ( RIO (..) - , input - , output - ) -import qualified Internal.Utils as UTL +import qualified Internal.LLM as INT +import Internal.LLM.Action ( Action (..) ) +import Internal.RIO ( RIO (..), input, output ) +import qualified Internal.Utils as UTL -import qualified Agent.Data.ANSI.EscapeCode as AEC +import qualified Agent.Data.ANSI.EscapeCode as AEC +import qualified Agent.LLM.Message as MSG + +import Agent.Data.JSON ( Data ) +import Agent.LLM.Message ( Message ) + + -------------------------------------------------------------------------------- type Load a = @@ -103,93 +96,15 @@ data Context a = Context - { uuid :: !INT.UUID - , mode :: !INT.Mode + { uuid :: !UUID + , mode :: !Mode , load :: !(Load a) - , hist :: !INT.History - , list :: !(Maybe INT.Filter) - , pile :: !(Maybe INT.FilePaths) - , ruck :: !(Maybe INT.Files) + , hist :: !History + , list :: !(Maybe Filter) + , pile :: !(Maybe FilePaths) + , ruck :: !(Maybe Files) } -data Message - = Path !Bool !(Maybe INT.AbsoluteFilePath) - | List !(Maybe INT.Filter) - | Text !String - | Send ![String] - | TemplateFiles !(Maybe [INT.AbsoluteFilePath]) - | Root - | Atom !String !INT.Files - | Repo - -instance Show Message where - show (Path _ _) = "Path" - show (List _) = "List" - show (Text _) = "Text" - show (Send _) = "Send" - -- DEBUG - show (TemplateFiles _) = "TemplateFiles" - -- DEBUG - show Root = "Root" - -- DEBUG - show (Atom _ _) = "Atom" - -- DEBUG - show Repo = "Repo" - -type TextToFile = String -> [(FilePath, [INT.FileLine])] - -data Action - = None - | Exit - | File !INT.File - | Hist !(Bool, Bool) - | Help - | Mode !Char !String - | Paths !INT.FilePaths - | Pile - | Branch !String !INT.Files - | Ruck !String - | Wipe - | UnknownCmd !String - | Message !Message - -- DEBUG - | Prompt !String - | Template !TextToFile ![INT.File] ![INT.File] ![INT.File] - --- DEBUG -none :: Action -none = - None - -exit :: Action -exit = - Exit - -file :: INT.File -> Action -file = - File - -root :: INT.Root -> Action -root (INT.Root afp) = - Paths $ INT.FilePaths [afp] - -text :: String -> Action -text = - Message . Text - -paths :: INT.FilePaths -> Action -paths = - Paths - -template - :: TextToFile - -> [INT.File] - -> [INT.File] - -> [INT.File] - -> Action -template = - Template - type Eval a = Context a -> Message @@ -322,9 +237,9 @@ UnknownCmd cmd -> caseUnknownCmd txt cmd Branch msg fs -> - eval ctx (Atom msg fs) >>= \ (upd, action) -> + eval ctx (MSG.Atom msg fs) >>= \ (upd, action) -> case action of - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -336,13 +251,13 @@ Prompt msg -> - eval ctx (TemplateFiles afps) >>= \ (upd0, action0) -> + eval ctx (MSG.Tmpl afps) >>= \ (upd0, action0) -> case action0 of Template f is es fs -> - eval ctx (Send xml) >>= \ (upd1, action1) -> + eval ctx (MSG.Send xml) >>= \ (upd1, action1) -> case action1 of - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop ( nxt txt @@ -368,7 +283,7 @@ tpl = INT.Template msg ils els fs xml = INT.tpl2xmls tpl - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd0 (Just cs)) eval None -> @@ -383,12 +298,12 @@ ) <$> pile ctx - Message (Path ns afp) -> - eval ctx (Path ns afp) >>= \ (upd, action) -> + Message (MSG.Path ns afp) -> + eval ctx (MSG.Path ns afp) >>= \ (upd, action) -> case action of File (INT.File (_,ls)) -> caseFile txt ns ls - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -398,12 +313,12 @@ printLn "Unexpected error" >> loop (nxt txt upd (Just [])) eval - Message (List fil) -> - eval ctx (List fil) >>= \ (upd, action) -> + Message (MSG.List fil) -> + eval ctx (MSG.List fil) >>= \ (upd, action) -> case action of Paths (INT.FilePaths fps) -> casePaths txt fps - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -413,10 +328,10 @@ printLn "Unexpected error" >> loop (nxt txt upd (Just [])) eval - Message Repo -> - eval ctx Repo >>= \ (upd, action) -> + Message MSG.Repo -> + eval ctx MSG.Repo >>= \ (upd, action) -> case action of - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -429,7 +344,7 @@ Message msg -> eval ctx msg >>= \ (upd, action) -> case action of - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -450,7 +365,7 @@ '/':'l':'i':'s':'t' :mfil -> -- TODO: DRY - Message (List fil) + Message (MSG.List fil) where fil = case mfil of @@ -459,7 +374,7 @@ ______ -> Nothing '/':'l' :mfil -> -- TODO: DRY - Message (List fil) + Message (MSG.List fil) where fil = case mfil of @@ -471,12 +386,12 @@ -- TODO: DRY case oidx of Nothing -> - Message (Path False Nothing) + Message (MSG.Path False Nothing) Just idx -> if 0 <= idx && idx < length pfs then - Message (Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx)) + Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx)) else - Message (Path False Nothing) + Message (MSG.Path False Nothing) where pfs = concatMap INT.filePaths $ pile ctx where @@ -488,12 +403,12 @@ -- TODO: DRY case oidx of Nothing -> - Message (Path False Nothing) + Message (MSG.Path False Nothing) Just idx -> if 0 <= idx && idx < length pfs then - Message (Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx)) + Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx)) else - Message (Path False Nothing) + Message (MSG.Path False Nothing) where pfs = concatMap INT.filePaths $ pile ctx where @@ -505,12 +420,12 @@ -- TODO: DRY case oidx of Nothing -> - Message (Path True Nothing) + Message (MSG.Path True Nothing) Just idx -> if 0 <= idx && idx < length pfs then - Message (Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx)) + Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx)) else - Message (Path True Nothing) + Message (MSG.Path True Nothing) where pfs = concatMap INT.filePaths $ pile ctx where @@ -522,12 +437,12 @@ -- TODO: DRY case oidx of Nothing -> - Message (Path True Nothing) + Message (MSG.Path True Nothing) Just idx -> if 0 <= idx && idx < length pfs then - Message (Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx)) + Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx)) else - Message (Path True Nothing) + Message (MSG.Path True Nothing) where pfs = concatMap INT.filePaths $ pile ctx where @@ -550,7 +465,7 @@ where fs = fromMaybe (INT.Files []) (ruck ctx) - '/':'r':'e':'p':'o' :[ ] -> Message Repo + '/':'r':'e':'p':'o' :[ ] -> Message MSG.Repo '/':'r':'u':'c':'k' :midx -> Ruck midx '/':'r' :midx -> Ruck midx @@ -569,7 +484,7 @@ "/w" -> Wipe '/':cmd -> UnknownCmd cmd - ____________________________ -> Message (Text txt) + ____________________________ -> Message (MSG.Text txt) -- TODO: Refactoring needed his = hist ctx @@ -642,7 +557,7 @@ loop (nxt txt ctx Nothing) eval casePaths txt fps = - eval ctx Root >>= \ (upd, action) -> + eval ctx MSG.Root >>= \ (upd, action) -> case action of Paths (INT.FilePaths rfps) -> ( case rfps of @@ -661,7 +576,7 @@ { pile = Just $ INT.FilePaths fps } ) eval - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> @@ -672,7 +587,7 @@ loop (nxt txt upd (Just [])) eval casePile txt = - eval ctx Root >>= \ (upd, action) -> + eval ctx MSG.Root >>= \ (upd, action) -> case action of Paths (INT.FilePaths fps) -> ( case fps of @@ -689,7 +604,7 @@ printLn "Missing root path" ) >> loop (nxt txt upd Nothing) eval - Message (Text cs) -> + Message (MSG.Text cs) -> printLn cs >> loop (nxt txt upd (Just cs)) eval None -> diff --git a/src/Agent/LLM/Action.hs b/src/Agent/LLM/Action.hs new file mode 100644 --- /dev/null +++ b/src/Agent/LLM/Action.hs @@ -0,0 +1,76 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +module Agent.LLM.Action + ( -- * Type signatures + Action + , TextToFile + , File + , FilePaths + , Root + -- * Methods + , none + , exit + , file + , paths + , root + , template + , text + ) +where + +-------------------------------------------------------------------------------- + +import Internal.LLM ( File, FilePaths, Root ) +import qualified Internal.LLM as INT +import Internal.LLM.Action ( Action, TextToFile ) +import qualified Internal.LLM.Action as ACT + +import qualified Agent.LLM.Message as MSG + +-------------------------------------------------------------------------------- + +none :: Action +none = + ACT.None + +exit :: Action +exit = + ACT.Exit + +file :: File -> Action +file = + ACT.File + +paths :: FilePaths -> Action +paths = + ACT.Paths + +root :: Root -> Action +root (INT.Root afp) = + ACT.Paths $ INT.FilePaths [afp] + +template + :: TextToFile + -> [File] + -> [File] + -> [File] + -> Action +template = + ACT.Template + +text :: String -> Action +text = + ACT.Message . MSG.Text diff --git a/src/Agent/LLM/Message.hs b/src/Agent/LLM/Message.hs new file mode 100644 --- /dev/null +++ b/src/Agent/LLM/Message.hs @@ -0,0 +1,48 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +module Agent.LLM.Message + ( Message(..) + , AbsoluteFilePath + , Files + , Filter + ) +where + +-------------------------------------------------------------------------------- + +import Internal.LLM ( AbsoluteFilePath, Files, Filter ) + +-------------------------------------------------------------------------------- + +data Message + = Atom !String !Files + | List !(Maybe Filter) + | Path !Bool !(Maybe AbsoluteFilePath) + | Repo + | Root + | Send ![String] + | Text !String + | Tmpl !(Maybe [AbsoluteFilePath]) + +instance Show Message where + show (Atom _ _) = "Atom" + show (List _) = "List" + show (Path _ _) = "Path" + show Repo = "Repo" + show Root = "Root" + show (Send _) = "Send" + show (Text _) = "Text" + show (Tmpl _) = "Tmpl" diff --git a/src/Internal/LLM/Action.hs b/src/Internal/LLM/Action.hs new file mode 100644 --- /dev/null +++ b/src/Internal/LLM/Action.hs @@ -0,0 +1,47 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +module Internal.LLM.Action + ( Action (..) + , TextToFile + ) +where + +-------------------------------------------------------------------------------- + +import qualified Internal.LLM as INT + +import qualified Agent.LLM.Message as MSG + +-------------------------------------------------------------------------------- + +type TextToFile = String -> [(FilePath, [INT.FileLine])] + +data Action + = None + | Branch !String !INT.Files + | Exit + | File !INT.File + | Help + | Hist !(Bool, Bool) + | Message !MSG.Message + | Mode !Char !String + | Paths !INT.FilePaths + | Pile + | Prompt !String + | Ruck !String + | Template !TextToFile ![INT.File] ![INT.File] ![INT.File] + | UnknownCmd !String + | Wipe diff --git a/src/Internal/RIO.hs b/src/Internal/RIO.hs --- a/src/Internal/RIO.hs +++ b/src/Internal/RIO.hs @@ -1581,8 +1581,10 @@ Right (exitcode, out, err) -> case exitcode of ExitSuccess -> - -- DEBUG: Add --verbose flag which is dispatched to stderr - -- pure $ Right (" DEBUG: " ++ err ++ out) + -- NOTE: When debugging, ex: `curl`, add the `--verbose` flag, + -- which uses `stderr`. Just combine `err` and `out` like this: + -- + -- pure $ Right ("[DEBUG]: " ++ err ++ "\n" ++ out) pure $ Right out ExitFailure _ -> pure $ Left $ err diff --git a/src/Internal/Utils.hs b/src/Internal/Utils.hs --- a/src/Internal/Utils.hs +++ b/src/Internal/Utils.hs @@ -3,8 +3,6 @@ {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -{-# LANGUAGE DeriveDataTypeable #-} - -------------------------------------------------------------------------------- -- |