A-gent 0.11.0.11 → 0.11.0.12

raw patch · 11 files changed

+1530/−606 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• A-gent.cabal +3/−3
• CHANGELOG.md +51/−2
• README.md +51/−0
• src/Agent/Data/ANSI/EscapeCode.hs +1/−0
• src/Agent/IO/Effects.hs +42/−5
• src/Agent/IO/Restricted.hs +12/−2
• src/Agent/LLM.hs +667/−329
• src/Agent/Utils/Common.hs +0/−133
• src/Internal/LLM.hs +72/−43
• src/Internal/RIO.hs +498/−89
• src/Internal/Utils.hs +133/−0

@@ -9,7 +9,7 @@ build-type: Simple                                                name: A-gent-version: 0.11.0.11+version: 0.11.0.12  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,8 @@       Internal.RIO       --       Internal.LLM+      --+      Internal.Utils   exposed-modules:       Agent.Control.Concurrent       Agent.Control.IFC@@ -164,8 +166,6 @@       --       Agent.IO.Effects       Agent.IO.Restricted-      ---      Agent.Utils.Common       --       Agent.LLM 

@@ -1,15 +1,64 @@ # Revision history for Λ-gent +## 0.11.0.12 -- 2026-05-12++There have been made some **major changes** to this library and therefore there+is no backwards compatibility with previous versions:++* Added support for `Code` mode, as in `read` and `write` files back and forth+  to the `git` repository. A new tab will be added to the website with a script+  explaining usage.++* Added support for script integrity as known from `HTML`:++  ```+  <script integrity="sha256-YBbjT3uJjnS6ofC6HIal+4vNvgA9vZBfC/KMVN51URc=" …></script>+  ```+  +  If the `LLM_SIGN_SHA` environment variable is provided on execution, the+  script will check it's own file `SHA-256` hash and compare to the provided:+  +  ```+  # Λ-gent integrity failed:+  > 2d3c326e2991da5876b820fe128c3840d3c0664c43907ce725f3f3f26f2fbabc (expected)+  > 8f89a79f891ce329a6142c68962fcad0b438e7d0b80c9410f0141cc6c02437d0 (observed)+  ```++* Adding `uuid` to main context future purposes.++* Due to refactoring, the context lost a few properties (ex: `exit`, `hist`,+  `root`, …) and some of the internals have changed. Still same output, but,+  less chaotic. Furthermore, `rootPath` is no longer needed.++* Due to refactoring, some of the exposed utils are no longer+  relevant. Therefore, they are moved to an internal module.++* Removed quotes from `curl` headers as some `LLM` API's would parse them, but+  others would not.++* 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 `message` and `action` types simplify and make more robust the+  interactions between user and `Λ-gent`.++* Wrapped `withExitCode…` functions in `try` (`Control.Exception`) to ensure the+  `Λ-gents` don't crash and burn. Also wrapped `read` and `write` files as well+  with `try`.+ ## 0.11.0.11 -- 2026-04-19  * Fixed a few misspells.  * Refactored `Files` to `FilePaths`. -* Refactored `Document(s)` to already existing `File(s)` for simplicity+* Refactored `Document(s)` to already existing `File(s)` for simplicity.  * Excluding non-files (symbolic links) from search as this could bypass the-  limitation of the current working directory+  limitation of the current working directory.  ## 0.11.0.10 -- 2026-04-17 

@@ -26,6 +26,57 @@ [oxford-gentleman]:     https://www.oxfordlearnersdictionaries.com/definition/english/gentleman [llm-wiki]:             https://en.wikipedia.org/wiki/Large_language_model +Project structure+=================++```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+```+ License ======= 

@@ -161,6 +161,7 @@   -> SelectGraphicRendition  --------------------------------------------------------------------------------+ sgr =   SGR bg fg bo fa it un bl   where

@@ -22,8 +22,11 @@   , -- * LLM (Code)     LlmCodeRoot(llmCodeDir)   , LlmCodeMask(llmCodeMsk)-  , LlmCodeRead(llmCodeSeq, llmCodeGet)+  , LlmCodeTmpl(llmCodeIns, llmCodeExa)+  , LlmCodeRead(llmCodeSeq, llmCodeGet, llmCodeGit)   , LlmCodeSave(llmCodePut)+  , LlmCodeConf(llmCodeKey, llmCodeAPI)+  , LlmCodePost(llmCodeWeb)   , -- * LLM (Plan)     LlmPlanRoot(llmPlanDir)   , LlmPlanMask(llmPlanMsk)@@ -35,7 +38,6 @@  -------------------------------------------------------------------------------- - import qualified Internal.LLM as LLM  --------------------------------------------------------------------------------@@ -91,6 +93,17 @@ --------------------------------------------------------------------------------  class+  Monad m+  => LlmCodeTmpl m+  where+    llmCodeIns+      :: m [LLM.File]+    llmCodeExa+      :: m [LLM.File]++--------------------------------------------------------------------------------++class   ( LlmConf m   , LlmCodeRoot m   , LlmCodeMask m@@ -101,8 +114,10 @@       :: Maybe LLM.Filter       -> m (Either [String] LLM.FilePaths)     llmCodeGet-      :: String+      :: LLM.AbsoluteFilePath       -> m (Either String LLM.File)+    llmCodeGit+      :: m (Either String String)  -------------------------------------------------------------------------------- @@ -113,8 +128,30 @@   => LlmCodeSave m   where     llmCodePut-      :: m [ (String, String) ]-      -> m [ (Either String ()) ]+      :: String+      -> LLM.Files+      -> m (Either String String)++--------------------------------------------------------------------------------++class+  Monad m+  => LlmCodeConf m+  where+    llmCodeAPI+      :: m (Maybe String)+    llmCodeKey+      :: m (Maybe String)++--------------------------------------------------------------------------------++class+  LlmCodeConf m+  => LlmCodePost m+  where+    llmCodeWeb+      :: String+      -> m (Either String String)  -------------------------------------------------------------------------------- --------------------------------------------------------------------------------

@@ -39,7 +39,6 @@  module Agent.IO.Restricted   ( RIO-  -- , run     -- * Environment   , getEnvVar     -- * LLM (Config)@@ -50,7 +49,11 @@     -- * LLM (Code)   , llmCodeDir   , llmCodeMsk-  , llmCodeSeq, llmCodeGet+  , llmCodeIns, llmCodeExa+  , llmCodeSeq, llmCodeGet, llmCodeGit+  , llmCodePut+  , llmCodeKey, llmCodeAPI+  , llmCodeWeb     -- * LLM (Plan)   , llmPlanDir   , llmPlanMsk@@ -70,10 +73,17 @@   ( llmChatAPI   , llmChatKey   , llmChatWeb+  , llmCodeAPI   , llmCodeDir+  , llmCodeExa   , llmCodeGet+  , llmCodeGit+  , llmCodeIns+  , llmCodeKey   , llmCodeMsk+  , llmCodePut   , llmCodeSeq+  , llmCodeWeb   , llmPathCWD   , llmPlanAPI   , llmPlanDir

@@ -28,14 +28,20 @@   , History(..)   , Context(..)     -- * Paramenters+  , Action(..)+  , Message(..)+  , none+  , exit+  , file+  , root+  , text+  , paths+  , template   , Eval     -- * Methods   , repl   , replWithMode-  , rootPath-    -- * Helpers-  , combineFiles-  , getFile+    -- * DEBUG   ) where @@ -49,7 +55,13 @@   )  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)+  ) import           System.IO   ( BufferMode (LineBuffering, NoBuffering)   , hFlush@@ -60,28 +72,26 @@   , stdout   , utf8   )+import           System.Process+  ( readProcessWithExitCode+  ) import           Text.Read                            ( readMaybe )  import           Internal.GaloisInc.Text.JSON.Generic ( Data ) import           Internal.LLM   ( Chit (..)   , History (..)-  , Template (..)-  , View (..)   , modes   ) import qualified Internal.LLM                         as INT import           Internal.RIO   ( RIO (..)-  , findFiles   , input   , output-  , readFileStrict   )+import qualified Internal.Utils                       as UTL  import qualified Agent.Data.ANSI.EscapeCode           as AEC-import qualified Agent.Data.JSON                      as JSON-import qualified Agent.Utils.Common                   as COM  -------------------------------------------------------------------------------- @@ -93,32 +103,102 @@  data Context a =   Context-    { exit :: !INT.Exit-    , root :: !(Maybe INT.Root)+    { uuid :: !INT.UUID     , mode :: !INT.Mode     , load :: !(Load a)     , hist :: !INT.History     , list :: !(Maybe INT.Filter)     , pile :: !(Maybe INT.FilePaths)-    , file :: !(Maybe INT.File)+    , ruck :: !(Maybe INT.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-  -> String-  -> RIO (Context a, String)+  -> Message+  -> RIO (Context a, Action)  -------------------------------------------------------------------------------- -rootPath-  :: RIO (Maybe INT.Root)-  -> IO  (Maybe INT.Root)-rootPath =-  run- repl   :: Eval a-  -> Maybe INT.Root   -> IO () repl =   replWithMode INT.Chat@@ -126,56 +206,43 @@ replWithMode   :: INT.Mode   -> Eval a-  -> Maybe INT.Root   -> IO ()-replWithMode mod proc mroot =+replWithMode mod proc =   do-    setLocaleEncoding utf8-    hSetBuffering stderr NoBuffering-    hSetBuffering stdin  NoBuffering-    hSetBuffering stdout LineBuffering -- NOTE: logic based on `hFlush stdout`-    -- NOTE: No default output when typing-    hSetEcho      stdin  False-    putStrLn head >> hFlush stdout-    run $ loop ctx proc-    where-      ctx =-        Context-          { exit = INT.Exit False-          , root = mroot-          , mode = mod-          , load = Nothing-          , hist =-            History-              { view = []-              , chit =+    constraint <- integrity+    case constraint of+      Right __ ->+        do+          setLocaleEncoding utf8+          hSetBuffering stderr NoBuffering+          hSetBuffering stdin  NoBuffering+          -- NOTE: logic based on `hFlush stdout`+          hSetBuffering stdout LineBuffering+          -- NOTE: No default output when typing+          hSetEcho      stdin  False+          putStrLn head >> hFlush stdout+          run $ loop ctx proc+      Left err ->+        putStrLn err >> hFlush stdout+  where+    ctx =+      Context+        { uuid = INT.UUID []+        , mode = mod+        , load = Nothing+        , hist =+          History+            { chit =                 Chit                   { prev = []                   , next = []                   }-              , chat = []-              }-          , list = Nothing-          , pile = Just $ INT.FilePaths []-          , file = Nothing-          }-------------------------------------------------------------------------------------- HELPERS (public)--combineFiles-  :: INT.FilePaths-  -> INT.FilePaths-  -> INT.FilePaths-combineFiles (INT.FilePaths xs) (INT.FilePaths ys) =-  INT.FilePaths $ xs ++ ys--getFile-  :: INT.File-  -> (FilePath, [INT.FileLine])-getFile (INT.File f) =-  f+            , chat = []+            }+        , list = Nothing+        , pile = Just $ INT.FilePaths []+        , ruck = Just $ INT.Files []+        }  -------------------------------------------------------------------------------- @@ -189,292 +256,563 @@   sync . (:[]) <$> fork task -} +head :: String+head =+  "# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."++help :: String+help =+  unlines+    [ "# Supported commands:"+    , ds+    , "/?   or /help   | This message"+    , "/e   or /exit   | Exit Λ-gent"+    , "/w   or /wipe   | Clear screen"+    , ds+    , "/m m or /mode m | Change to {" ++ ms ++ "}. Ex: /m plan"+    , ds+    , "/h   or /hist   | View history (input and 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"+    , 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"+    , "/a d or /atom d | Atomically save /ruck files to a GIT branch (+ description)"+    , "        /repo   | List GIT branches (+ description). See /atom above"+    , ds+    ]+  where+    ds = replicate 80 '-'+    ms =+      foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes+ loop   :: Context a   -> Eval a   -> RIO () loop ctx eval =-  case ctx of-    Context { exit = INT.Exit True }                    ->-      return ()-    Context { hist = History { view = [ Chits, Chats ] } } ->-      printLn "* Chits:" >>-      ( mapM_ printLn . COM.combine . COM.chits True . prev . chit . hist-      ) ctx >>-      printLn "* Chats:" >>-      ( mapM_ printLn . COM.combine . COM.chats True .        chat . hist-      ) ctx >>-      loop (ctx { hist = ((hist ctx) { view = [] }) }) eval-    Context { hist = History { view = [ Chits ] } } ->-      printLn "* Chits:" >>-      ( mapM_ printLn . COM.combine . COM.chits True . prev . chit . hist-      ) ctx >>-      loop (ctx { hist = ((hist ctx) { view = [] }) }) eval-    Context { hist = History { view = [ Chats ] } } ->-      printLn "* Chats:" >>-      ( mapM_ printLn . COM.combine . COM.chats True .        chat . hist-      ) ctx >>-      loop (ctx { hist = ((hist ctx) { view = [] }) }) eval-    Context { list = Just _, pile = Just _ } ->-      eval ctx [ ] >>= \ (upd, _) ->-      ( mapM_ printLn .-        COM.combine .-        COM.files [] True .-        -- NOTE: Show relative paths-        map (drop (length cwd)) .-        concatMap INT.filePaths .-        pile-      ) upd >>-      loop (upd { list = Nothing }) eval+  print prompt >>+  read hps hns >>= \ txt ->+  printLn [ ]  >>+  case txt2act txt of+    -- TODO: Refactoring needed++    -- Nested -- Start+    None                      ->+      loop (nxt txt ctx Nothing) eval+    File _                    ->+      loop (nxt txt ctx Nothing) eval+    Template _ _ _ _         ->+      loop (nxt txt ctx Nothing) eval+    -- Nested -- Stop++    Exit                      -> caseExit+    Help                      -> caseHelp       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++    Branch msg fs             ->+      eval ctx (Atom msg fs) >>= \ (upd, action) ->+      case action of+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    Prompt msg                ->++      eval ctx (TemplateFiles afps) >>= \ (upd0, action0) ->+      case action0 of+        Template f is es fs ->++          eval ctx (Send xml) >>= \ (upd1, action1) ->+          case action1 of+            Message (Text cs)         ->+              printLn cs >>+              loop+                ( nxt txt+                    ( upd1 { ruck = Just $ pfs }+                    )+                    ( Just cs+                    )+                ) eval+              where+                pfs =+                  case (map INT.File . f) cs of+                    [] -> INT.Files []+                    xs -> INT.Files xs+            None                      ->+              loop (nxt txt upd1 Nothing) eval+            _________________________ ->+              -- NOTE: Unexpected error+              printLn "Unexpected error" >>+              loop (nxt txt upd1 (Just [])) eval+          where+            ils = map ( \ (INT.File (_, ls)) -> unlines ls) is+            els = map ( \ (INT.File (_, ls)) -> unlines ls) es+            tpl = INT.Template msg ils els fs+            xml = INT.tpl2xmls tpl++        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd0 (Just cs)) eval+        None                      ->+          loop (nxt txt upd0 Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd0 (Just [])) eval       where-        cwd =-          case root ctx of-            Just (INT.Root cs) -> cs-            Nothing            -> []-    Context { file = Just _ }   ->-      eval    ctx [ ] >>= \ (upd, res) ->-      printLn res     >>-      loop (upd { file = Nothing }) eval-    __________________________________________ ->-      print prompt >>-      read hps hns >>= \ txt ->-      printLn [ ]  >>+        afps =+          ( \ (INT.FilePaths fps) -> map INT.AbsoluteFilePath fps+          )+          <$> pile ctx++    Message (Path ns afp)     ->+      eval ctx (Path ns afp) >>= \ (upd, action) ->+      case action of+        File (INT.File (_,ls)) ->+          caseFile txt ns ls+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    Message (List fil)        ->+      eval ctx (List fil) >>= \ (upd, action) ->+      case action of+        Paths (INT.FilePaths fps) ->+          casePaths txt fps+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    Message  Repo             ->+      eval ctx Repo >>= \ (upd, action) ->+      case action of+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    Message       msg  ->+      eval ctx msg >>= \ (upd, action) ->+      case action of+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval+  where++    -- TODO: Refactoring needed+    txt2act txt =+      -- TODO: Refactoring needed       case txt of-        '/':'m':'o':'d':'e':' ':c:cs -> caseMode txt c cs-        '/':'m'            :' ':c:cs -> caseMode txt c cs-        '/':'s':'e':'n':'d':' ':mesg -> caseSend txt mesg-        '/':'s'            :' ':mesg -> caseSend txt mesg-        '/':'f':'i':'l':'e'    :midx -> caseFile txt midx False-        '/':'f'                :midx -> caseFile txt midx False-        '/':'n':'u':'m':'s'    :midx -> caseFile txt midx True-        '/':'n'                :midx -> caseFile txt midx True-        '/':'l':'i':'s':'t'    :mfil -> caseList txt mfil-        '/':'l'                :mfil -> caseList txt mfil-        "/pile"                      -> casePile txt-        "/p"                         -> casePile txt-        "/hist"                      -> caseHist txt [ Chits, Chats ]-        "/h"                         -> caseHist txt [ Chits, Chats ]-        "/chit"                      -> caseHist txt [ Chits        ]-        "/chat"                      -> caseHist txt [        Chats ]-        "/wipe"                      -> caseWipe txt-        "/w"                         -> caseWipe txt-        "/help"                      -> caseHelp txt-        "/?"                         -> caseHelp txt-        "/exit"                      -> caseExit txt-        "/e"                         -> caseExit txt-        '/':cmd                      ->-          printLn msg >>-          loop (nxt txt ctx Nothing) eval++        '/':'m':'o':'d':'e':' ':c:cs -> Mode c cs+        '/':'m'            :' ':c:cs -> Mode c cs++        '/':'l':'i':'s':'t'    :mfil ->+          -- TODO: DRY+          Message (List fil)           where-            msg = "Command not recognized: " ++ cmd-        ____________________________ ->-          eval    ctx xml >>= \ (upd, res) ->-          printLn res     >>-          loop (nxt txt upd (Just res)) eval+            fil =+              case mfil of+                [    ] -> Just $ INT.Filter mfil+                ' ':cs -> Just $ INT.Filter cs+                ______ -> Nothing+        '/':'l'                :mfil ->+          -- TODO: DRY+          Message (List fil)           where-            tpl =-              Template-                { purpose      = txt-                , instructions = []-                , examples     = []-                , files        = []-                }-            xml = INT.tpl2xml tpl-      where-        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-                }-            }-        caseMode txt c cs =-          case mmod of-            Just mod ->-              printLn ("Changed to " ++ low ++ "-mode") >>-              loop (nxt txt (ctx { mode = mod, pile = Nothing }) Nothing) eval+            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 (Path False Nothing)+            Just idx ->+              if 0 <= idx && idx < length pfs then+                Message (Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))+              else+                Message (Path False Nothing)               where-                low = map toLower $ show mod-            Nothing ->-              printLn ("Invalid mode: " ++ c:cs) >>-              loop (nxt txt ctx Nothing) eval+                pfs = concatMap INT.filePaths $ pile ctx           where-            mmod = readMaybe (toUpper c : map toLower cs) :: Maybe INT.Mode-        caseSend txt msg =-          pds                           >>= \  ds ->-          tis                           >>= \  is ->-          eval ctx (xml ds (concat is)) >>= \ (upd, res) ->-          printLn res                   >>-          loop (nxt txt upd (Just res)) eval+            oidx =+              case midx of+                [] -> Nothing+                cs -> readMaybe cs :: Maybe Int+        '/':'f'            :' ':midx ->+          -- TODO: DRY+          case oidx of+            Nothing  ->+              Message (Path False Nothing)+            Just idx ->+              if 0 <= idx && idx < length pfs then+                Message (Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))+              else+                Message (Path False Nothing)+              where+                pfs = concatMap INT.filePaths $ pile ctx           where-            cwd =-              case root ctx of-                Just (INT.Root cs) -> cs-                Nothing            -> []-            pds =-              ( mapM-                  ( \ fap ->-                      INT.File .-                      (,) (drop (length cwd) fap) .-                      lines-                      <$> readFileStrict fap-                  ) .-                concatMap INT.filePaths .-                pile-              ) ctx--            tis =-              -- TODO: This need to be refactored-              findFiles cwd ("*/tpl/" ++ mod ++ "_instructions_*.json") >>= \ efs ->-              case efs of-                Right aps ->-                  mapM (\ ap -> dec <$> readFileStrict ap) aps-                Left  ___ ->-                  pure []+            oidx =+              case midx of+                [] -> Nothing+                cs -> readMaybe cs :: Maybe Int+        '/':'n':'u':'m':'s':' ':midx ->+          -- TODO: DRY+          case oidx of+            Nothing  ->+              Message (Path True Nothing)+            Just idx ->+              if 0 <= idx && idx < length pfs then+                Message (Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))+              else+                Message (Path True Nothing)               where-                mod   = (map toLower . show . mode) ctx-                dec x =-                  case JSON.decode x :: Either JSON.DecodeError [String] of-                    Right xs -> xs-                    Left  __ -> []-            tpl fs is =-              Template-                { purpose      = msg-                , instructions = is-                , examples     =-                  -- TODO: Look in {root}/tpl/{mode}_examples_*.md-                  []-                , files        = fs+                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 (Path True Nothing)+            Just idx ->+              if 0 <= idx && idx < length pfs then+                Message (Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))+              else+                Message (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 Repo++        '/':'r':'u':'c':'k'    :midx -> Ruck   midx+        '/':'r'                :midx -> Ruck   midx++        "/exit"                      -> Exit+        "/e"                         -> Exit+        "/help"                      -> Help+        "/?"                         -> Help+        "/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 (Text txt)++    -- TODO: Refactoring needed+    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                 }-            xml xs ys = INT.tpl2xml $ tpl xs ys+            , chat =+              case o of+                Nothing ->        chat $ hist c+                Just  r -> (r:) $ chat $ hist c+            }+        } -        caseFile txt midx nums =+    -- TODO: Refactoring needed+    caseMode txt c cs =+      case mmod of+        Just mod ->+          printLn ("Changed to " ++ low ++ "-mode") >>+          loop+            ( (nxt txt ctx Nothing)+                { mode = mod+                , pile = Just $ INT.FilePaths []+                , ruck = Just $ INT.Files     []+                }+            ) eval+          where+            low = map toLower $ show mod+        Nothing ->+          printLn ("Invalid mode: " ++ c:cs) >>+          loop ctx eval+      where+        mmod = readMaybe (toUpper c : map toLower cs) :: Maybe INT.Mode++    caseHist txt chits chats =+      ( if chits then+          printLn "* Chits:" >>+          ( mapM_ printLn . UTL.combine . UTL.chits True . prev . chit . hist+          ) ctx+        else+          pure ()+      ) >>+      ( if chats then+          printLn "* Chats:" >>+          ( mapM_ printLn . UTL.combine . UTL.chats True .        chat . hist+          ) ctx+        else+          pure ()+      ) >>+      loop (nxt txt ctx Nothing) eval++    caseExit =+      printLn "Λ-gent will shutdown" >>+      return ()+    caseFile txt ns ls =+      ( mapM_ printLn .+        UTL.combine .+        UTL.file ns+      ) (unlines ls) >>+      loop (nxt txt ctx Nothing) eval+    caseHelp txt =+      printLn help >>+      loop (nxt txt ctx Nothing) eval++    casePaths txt fps =+      eval ctx Root >>= \ (upd, action) ->+      case action of+        Paths (INT.FilePaths rfps) ->+          ( case rfps of+              [cwd] ->+                mapM_ printLn .+                UTL.combine .+                UTL.files [] True .+                -- NOTE: Show relative paths+                map (drop (length cwd)) $+                fps+              _____ ->+                printLn "Missing root path"+          ) >>+          loop+            ( (nxt txt upd Nothing)+                { pile = Just $ INT.FilePaths fps+                }+            ) eval+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    casePile txt =+      eval ctx Root >>= \ (upd, action) ->+      case action of+        Paths (INT.FilePaths fps) ->+          ( case fps of+              [cwd] ->+                mapM_ printLn .+                UTL.combine .+                UTL.files [] True .+                -- NOTE: Show relative paths+                map (drop (length cwd)) .+                concatMap INT.filePaths .+                pile $+                upd+              _____ ->+                printLn "Missing root path"+          ) >>+          loop (nxt txt upd Nothing) eval+        Message (Text cs)         ->+          printLn cs >>+          loop (nxt txt upd (Just cs)) eval+        None                      ->+          loop (nxt txt upd Nothing) eval+        _________________________ ->+          -- NOTE: Unexpected error+          printLn "Unexpected error" >>+          loop (nxt txt upd (Just [])) eval++    caseRuck txt midx =+      ( if null midx then+          -- NOTE: If no optional index provided, show only paths+          ( mapM_ printLn .+            UTL.combine .+            UTL.files [] True .+            concatMap fps .+            ruck+          ) ctx+        else+          -- NOTE: Otherwise, show content or index error           ( case idx of               Just i ->-                if 0 <= i && i < length pfs then-                  let-                    cwd =-                      case root ctx of-                        Just (INT.Root cs) -> cs-                        Nothing            -> []-                    fap = pfs !! i-                  in-                    readFileStrict fap >>= \ f ->-                    ( mapM_ printLn .-                      COM.combine .-                      COM.file nums-                    ) f >>-                    loop-                      ( nxt txt-                        ( ctx-                          { file =-                            Just-                              ( INT.File-                                -- NOTE: Store relative path-                                ( drop (length cwd) fap-                                , lines f-                                )-                              )-                          }-                        ) Nothing-                      ) eval+                if 0 <= i && i < len then+                  ( mapM_ printLn .+                    UTL.combine .+                    UTL.file True .+                    concatMap f .+                    ruck+                  ) ctx                 else                   let                     m = "Index (" ++ show i ++ ") is out of bounds."                   in-                    printLn m >>-                    loop (nxt txt ctx Nothing) eval+                    printLn m+                where+                  f (INT.Files fs) =+                    case fs !! i of+                      INT.File (_,ls) -> unlines ls               Nothing ->-                printLn "Invalid index" >>-                loop (nxt txt ctx Nothing) eval+                printLn "Invalid use of /ruck. Use space between cmd and index"           )-          where-            pfs = concatMap INT.filePaths $ pile ctx-            idx =-              case midx of-                [    ] -> Nothing-                ' ':cs -> readMaybe cs :: Maybe Int-                ______ -> Nothing-        caseList txt mfil =-          ( case fil of-              Nothing ->-                printLn "Invalid use of list. Use space between cmd and filter"-              _______ ->-                pure ()-          ) >>-          loop (nxt txt (ctx { list = fil }) Nothing) eval-          where-            fil =-              case mfil of-                [    ] -> Just $ INT.Filter mfil-                ' ':cs -> Just $ INT.Filter cs-                ______ -> Nothing-        casePile txt =-          ( mapM_ printLn .-            COM.combine .-            COM.files [] True .-            -- NOTE: Show relative paths-            map (drop (length cwd)) .-            concatMap INT.filePaths .-            pile-          ) ctx >>-          loop (nxt txt ctx Nothing) eval-          where-            cwd =-              case root ctx of-                Just (INT.Root cs) -> cs-                Nothing            -> []-        caseHist txt v =-          loop (nxt txt (ctx { hist = his { view = v } }) Nothing) eval-        caseWipe txt =-          printLn clear >>-          loop (nxt txt ctx Nothing) eval-        caseHelp txt =-          printLn help >>-          loop (nxt txt ctx Nothing) eval-        caseExit txt =-          printLn "Λ-gent will shutdown" >>-          loop (nxt txt (ctx { exit = INT.Exit True }) Nothing) eval-    where-      -- 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"+      ) >>+      loop (nxt txt ctx Nothing) eval+      where+        idx =+          case midx of+            [    ] -> Nothing+            ' ':cs -> readMaybe cs :: Maybe Int+            ______ -> Nothing+        len =+          case ruck ctx of+            Just (INT.Files fs) -> length fs+            Nothing             -> 0+        fps (INT.Files fs) =+          map ( \ (INT.File (p,_)) -> p) fs -head :: String-head =-  "# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."+    caseWipe txt =+      printLn clear >>+      loop (nxt txt ctx Nothing) eval+    caseUnknownCmd txt cmd =+      printLn msg >>+      loop (nxt txt ctx Nothing) eval+      where+        msg = "Command not recognized: " ++ cmd -help :: String-help =-  "# Supported commands:\n" ++-  "/?   or /help   | This message\n" ++-  "/e   or /exit   | Exit Λ-gent\n" ++-  "/w   or /wipe   | Clear screen\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" ++-  "/l f or /list f | List of files, limited by mode, file masks and filter\n" ++-  "/p   or /pile   | Show stored list of files. See /list above\n" ++-  "/f i or /file i | Show file with the given index. See, /pile above\n" ++-  "/n i or /nums i | Show file with line numbers. See /file above\n" ++-  "/s m or /send m | Sending /pile to LLM as context to the message"+    -- 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"++integrity :: IO (Either String ())+integrity =+  do+    ohi <- ENV.getEnv "LLM_SIGN_SHA"+    case ohi of+      Nothing -> pure $ Right ()+      Just hi ->+        do+          op <- cwd+          pn <- getProgName+          case op of+            Left  e -> pure $ Left e+            Right p ->+              do+                ehf <- sha ap+                case ehf of+                  Left  ef -> pure $ Left ef+                  Right hf ->+                    if hi == h64 then+                      pure $ Right ()+                    else+                      pure $+                      Left $+                      "# Λ-gent integrity failed:\n" +++                      "> " ++ hi  ++ " (expected)\n" +++                      "> " ++ h64 ++ " (observed)"+                    where+                      h64 = take 64 hf+              where+                ap =+                  concatMap id+                  $ lines p ++ [ "/" ] ++ lines pn   where-    ms =-      foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes+    -- TODO: Move "HELPERS (private)" private out from Internal/RIO.hs to+    -- Internal/IO.hs and then just wrap them with `RestrictedIO`. This will+    -- allow for logic like this to be simplified+    cwd =+      do+        (exitcode, out, err) <- readProcessWithExitCode "pwd" [] []+        case exitcode of+          ExitSuccess ->+            pure $ Right out+          ExitFailure _ ->+            pure $ Left err+    sha p =+      do+        (exitcode, out, err) <- readProcessWithExitCode "sha256sum" [ p ] []+        case exitcode of+          ExitSuccess ->+            pure $ Right out+          ExitFailure _ ->+            pure $ Left err

@@ -1,133 +0,0 @@-{-# OPTIONS_GHC -Wall -Werror #-}--{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}-{-# LANGUAGE Safe                         #-}--{-# LANGUAGE DeriveDataTypeable           #-}-------------------------------------------------------------------------------------- |--- Copyright  : (c) 2026 SPISE MISU ApS--- License    : SSPL-1.0 OR AGPL-3.0-only--- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>--- Stability  : experimental------------------------------------------------------------------------------------module Agent.Utils.Common-  ( -- * Files-    files-  , file-    -- * History-  , chits-  , chats-    -- * Helpers-  , combine-  , leftpad-  , index-  , split-  , linesOptNums-  )-where------------------------------------------------------------------------------------import           Prelude hiding ( lines )-import qualified Prelude as Prelude------------------------------------------------------------------------------------combine-  :: [ (String, String) ]-  -> [ String ]-combine =-  map-  ( \ (x, y) ->-      if null x then-        y-      else-        x ++ ": " ++ y-  )--leftpad-  :: Char-  -> Int-  -> [Char]-  -> [Char]-leftpad chr rep cs =-  replicate (rep - length xs) chr ++ xs-  where-    xs = take rep cs--index-  :: Int-  -> Int-  -> String-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-  :: String-  -> Bool-  -> [ String ]-  -> [ (String, String) ]-files prefix nums fs =-  linesOptNums prefix nums 0 fs--file-  :: Bool-  -> String-  -> [ (String, String) ]-file nums f =-  linesOptNums [] nums 1 $ Prelude.lines f------------------------------------------------------------------------------------chits-  :: Bool-  -> [ String ]-  -> [ (String, String) ]-chits nums fs =-  linesOptNums [] nums 0 $ reverse fs--chats-  :: Bool-  -> [ String ]-  -> [ (String, String) ]-chats nums fs =-  linesOptNums [] nums 0 $ reverse fs-------------------------------------------------------------------------------------- HELPERS (private)--linesOptNums-  :: String-  -> Bool-  -> Int-  -> [ String ]-  -> [ (String, String) ]-linesOptNums prefix nums origo xs =-  zipWith (\ idx rel -> (prefix ++ f idx, rel)) [origo..] xs-  where-    len   = length $ show $ length xs-    f i =-      if nums then-        index len i-      else-        []

@@ -14,29 +14,31 @@ --------------------------------------------------------------------------------  module Internal.LLM-  ( Exit (..)+  ( UUID (..)   , Root (..)   , Filter (..)   , Mode (..)-  , View (..)   , Chit (..)   , Chat   , History (..)   , Mask (..)   , File (..)+  , Files (..)   , FileLine   , FilePaths (..)+  , AbsoluteFilePath (..)   , Template (..)   , modes-  , tpl2xml+  , tpl2xmls   ) where  --------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -newtype Exit = Exit Bool+newtype UUID = UUID String -newtype Root = Root FilePath+newtype Root = Root FilePath deriving Eq  newtype Filter = Filter String @@ -50,10 +52,6 @@   | Test   deriving (Bounded, Enum, Eq, Read, Show) -data View-  = Chits-  | Chats- data Chit =   Chit     { prev :: ![String]@@ -64,16 +62,17 @@  data History =   History-    { view :: ![View]-    , chit :: !Chit+    { chit :: !Chit     , chat :: !Chat     }  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------  newtype Mask = Mask [String]  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------  type Markdown = String @@ -81,8 +80,36 @@  newtype File = File (FilePath, [FileLine]) -newtype FilePaths = FilePaths { filePaths :: [FilePath] }+-------------------------------------------------------------------------------- +newtype Files = Files [File]++instance Semigroup Files where+  Files xs <> Files ys =+    Files (xs ++ ys)++instance Monoid Files where+  mempty = Files []++--------------------------------------------------------------------------------++newtype AbsoluteFilePath = AbsoluteFilePath FilePath++--------------------------------------------------------------------------------++-- NOTE: Then use `mconcat` to combine++data FilePaths = FilePaths { filePaths :: [FilePath] }++instance Semigroup FilePaths where+  FilePaths xs <> FilePaths ys =+    FilePaths (xs ++ ys)++instance Monoid FilePaths where+  mempty = FilePaths []++--------------------------------------------------------------------------------+ data Template =   Template     { purpose      :: !String@@ -92,41 +119,43 @@     }  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------  modes :: [Mode] modes =  [ minBound .. maxBound ] -tpl2xml+tpl2xmls   :: Template-  -> String-tpl2xml tpl =-  ( if eis && ees && efs then-      pur-    else-      "<purpose>" ++ pur ++ "</purpose>"-  ) ++-  ( if eis then-      []-    else-      "<instructions>" ++-      tis ++-      "</instructions>"-  ) ++-  ( if ees then-      []-    else-      "<examples>" ++-      tes ++-      "</examples>"-  ) ++-  ( if efs then-      []-    else-      "<files>" ++-      concatMap aux tfs ++-      "</files>"-  )+  -> [String]+tpl2xmls tpl =+  [ ( if eis && ees && efs then+        pur+      else+        "<purpose>" ++ pur ++ "</purpose>"+    ) +++    ( if eis then+        []+      else+        "<instructions>" +++        tis +++        "</instructions>"+    ) +++    ( if ees then+        []+      else+        "<examples>" +++        tes +++        "</examples>"+    ) +++    ( if efs then+        []+      else+        "<files>" +++        concatMap aux tfs +++        "</files>"+    )+  ]   where     pur =       purpose tpl ++@@ -138,12 +167,12 @@       ( if ees then           []         else-          ". Output MUST match provided `examples`"+          ". Output MUST match scaffolding from provided `examples`"       ) ++       ( if efs then           []         else-          ". List of provided `files` for context"+          ". Apply to each of the `files`"       )     eis = null tis     ees = null tes

@@ -58,7 +58,11 @@     -- * LLM (Code)   , llmCodeDir   , llmCodeMsk-  , llmCodeSeq, llmCodeGet+  , llmCodeIns, llmCodeExa+  , llmCodeSeq, llmCodeGet, llmCodeGit+  , llmCodePut+  , llmCodeKey, llmCodeAPI+  , llmCodeWeb     -- * LLM (Plan)   , llmPlanDir   , llmPlanMsk@@ -75,7 +79,9 @@  -------------------------------------------------------------------------------- -import           Data.Either              ( partitionEithers )+import           Control.Exception        ( SomeException, try )+import           Data.Char                ( isDigit )+import           Data.Either              ( fromLeft, partitionEithers ) import           Data.List                ( isPrefixOf ) import           Data.Maybe               ( maybeToList ) import qualified System.Environment.Blank as ENV@@ -103,9 +109,9 @@ import           Text.Read                ( readMaybe )  import qualified Internal.LLM             as LLM+import qualified Internal.Utils           as UTL  import qualified Agent.IO.Effects         as EFF-import qualified Agent.Utils.Common       as COM  -------------------------------------------------------------------------------- @@ -573,7 +579,7 @@               -- NOTE: Other escaped sequences (skip unless positions)               aux mln hps hns bcs acs               where-                ops = map readMaybe $ COM.split '\^[' ps :: [Maybe Position]+                ops = map readMaybe $ UTL.split '\^[' ps :: [Maybe Position]                 mln =                   -- NOTE: 0) Print "\^[[6n" position before action (unused)                   -- NOTE: 1) Print "\^[[6n" end position after action@@ -672,14 +678,12 @@   => LlmConf m   where     llmPathCWD-      -- :: m (Maybe String)       :: m (Maybe LLM.Root)  instance   EFF.LlmConf RIO   => LlmConf RIO   where-    -- llmPathCWD = getEnvVar "LLM_PATH_CWD"     llmPathCWD =       ( \ case           Just rp -> Just $ LLM.Root rp@@ -762,6 +766,69 @@ --------------------------------------------------------------------------------  class+  EFF.LlmCodeTmpl m+  => LlmCodeTmpl m+  where+    llmCodeIns+      :: m [LLM.File]+    llmCodeExa+      :: m [LLM.File]++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeTmpl RIO+  )+  => LlmCodeTmpl RIO+  where+    llmCodeIns =+      EFF.llmPathCWD >>= \ ocwd ->+      case ocwd of+        Just (LLM.Root root) ->+          realPath (root ++ "llm") >>= \ efap ->+          case efap of+            -- TODO: DRY+            Right fap ->+              findFiles fap "*code_instructions_*.json" >>= \ eafps ->+              case eafps of+                Right afps ->+                  mapM+                  ( \ abspath ->+                      LLM.File . (,) abspath . lines+                      <$> readFileStrict abspath+                  ) afps+                Left  __ ->+                  pure []+            Left ____ ->+              pure []+        Nothing ->+          pure []++    llmCodeExa =+      EFF.llmPathCWD >>= \ ocwd ->+      case ocwd of+        Just (LLM.Root root) ->+          realPath (root ++ "llm") >>= \ efap ->+          case efap of+            -- TODO: DRY+            Right fap ->+              findFiles fap "*code_examples_*.md" >>= \ eafps ->+              case eafps of+                Right afps ->+                  mapM+                  ( \ abspath ->+                      LLM.File . (,) abspath . lines+                      <$> readFileStrict abspath+                  ) afps+                Left  __ ->+                  pure []+            Left ____ ->+              pure []+        Nothing ->+          pure []++--------------------------------------------------------------------------------++class   ( EFF.LlmConf     m   , EFF.LlmCodeRoot m   , EFF.LlmCodeMask m@@ -772,8 +839,10 @@       :: Maybe LLM.Filter       -> m (Either [String] LLM.FilePaths)     llmCodeGet-      :: String+      :: LLM.AbsoluteFilePath       -> m (Either String LLM.File)+    llmCodeGit+      :: m (Either String String)  instance   ( EFF.LlmConf     RIO@@ -786,15 +855,15 @@       EFF.llmPathCWD >>= \ ocwd ->       case ocwd of         Just (LLM.Root root) ->-          EFF.llmCodeDir                 >>= \ cdir ->-          EFF.llmCodeMsk                 >>= \ cmsk ->-          realPath (root ++ "/" ++ cdir) >>= \ efap ->+          EFF.llmCodeDir          >>= \ cdir ->+          EFF.llmCodeMsk          >>= \ cmsk ->+          realPath (root ++ cdir) >>= \ efap ->           case efap of             -- TODO: DRY             Right fap ->               ( \ case-                  ([], rs) -> Right $ LLM.FilePaths $ concat rs-                  (ls, __) -> Left                           ls+                  ([], rs) -> Right $ LLM.FilePaths $ mconcat rs+                  (ls, __) -> Left                            ls               )               . partitionEithers               <$> mapM (\ msk -> findFiles fap ("*" ++ fil ++ "*" ++ msk)) cmsk@@ -808,29 +877,242 @@             Just (LLM.Filter f) ->  f             Nothing             -> [ ] -    llmCodeGet abspath =+    llmCodeGet (LLM.AbsoluteFilePath abspath) =       EFF.llmPathCWD >>= \ ocwd ->       EFF.llmCodeDir >>= \ cdir ->       case ocwd of         -- TODO: DRY         Just (LLM.Root root) ->-          realPath (root ++ "/" ++ cdir) >>= \ efap ->+          realPath (root ++ cdir) >>= \ efap ->           case efap of             Right fap ->               if fap `isPrefixOf` abspath then-                Right . LLM.File . (,) abspath . lines+                -- NOTE: Root relative path+                Right . LLM.File . (,) (drop len abspath) . lines                 <$> readFileStrict abspath               else                 pure $ Left $ notPrefixRootAndMode fap abspath LLM.Code             Left  err ->               pure $ Left err+            where+              len = length root         Nothing ->           pure $ Left noLlmConf +    llmCodeGit =+      EFF.llmPathCWD >>= \ ocwd ->+      case ocwd of+        Just (LLM.Root root) ->+          realPath root >>= \ efap ->+          case efap of+            -- TODO: DRY+            Right fap ->+              gitExist fap >>= \ igit ->+              if igit then+                gitBranchesDesc fap+              else+                pure $ Left "No GIT repo initialized"+            Left err ->+              pure $ Left err+        Nothing ->+          pure $ Left noLlmConf+ --------------------------------------------------------------------------------++class+  ( EFF.LlmConf m+  , EFF.LlmCodeRoot m+  )+  => LlmCodeSave m+  where+    llmCodePut+      :: String+      -> LLM.Files+      -> m (Either String String)++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeRoot RIO+  )+  => LlmCodeSave RIO+  where+    -- TODO: Needs some refactoring at some point …+    llmCodePut ___ (LLM.Files []) =+      pure $ Left "No files provided, therefore no action performed"+    llmCodePut txt (LLM.Files fs) =+      EFF.llmPathCWD >>= \ ocwd ->+      EFF.llmCodeDir >>= \ cdir ->+      case ocwd of+        Just (LLM.Root root) ->+          realPath root >>= \ erap ->+          case erap of+            Right rp ->+              gitExist     rp >>= \ igit ->+              gitignoreTmp rp >>= \ itmp ->+              case (igit, itmp) of+                (True,  True) ->+                  timestampUTC >>= \ mts ->+                  case mts of+                    Just ts ->+                      realPath (root ++ "tmp") >>= \ etmp ->+                      case etmp of+                        Right tmp ->+                          gitWorktreeAdd root ts tap >>= \ ewta ->+                          (+                            mapM+                              ( \ (LLM.File (fp, fls)) ->+                                  let+                                    fil = tap ++ "/" ++ fp+                                    len = length $ tap ++ "/"+                                  in+                                    if dir `isPrefixOf` fil then+                                      ensureFolderPath tap fil           >>= \ eefp ->+                                      writeFileStrict  fil (unlines fls) >>= \ ewfs ->+                                      case (eefp, ewfs) of+                                        (Right efp, Right wfs) ->+                                          pure $ Right $ unlines+                                          [ "* Ensuring folder exists:"+                                          , efp+                                          , "* Writing file to folder:"+                                          , wfs+                                          ]+                                        (_, _) ->+                                          pure $ Left $ unlines+                                          [ "* Ensuring folder exists:"+                                          , fromLeft "No error" eefp+                                          , "* Writing file to folder:"+                                          , fromLeft "No error" ewfs+                                          ]+                                    else+                                      pure $ Left $+                                      ( (drop len fil) +++                                        " doesn't start with " +++                                        (drop len dir)+                                      )+                              )+                            fs+                          ) >>= \ ewfs ->+                          gitAddFiles         tap     >>= \ ewaf ->+                          gitCommit           tap txt >>= \ ewcf ->+                          gitWorktreeRem root tap     >>= \ ewrf ->+                          case+                            ( ewta+                            , partitionEithers ewfs+                            , ewaf+                            , ewcf+                            , ewrf+                            )+                          of+                            (   Right wta+                              , ( []+                                , xs+                                )+                              , Right ___+                              , Right wcf+                              , Right wrf+                              ) ->+                              gitUpdateBranchDesc root ts txt >>= \ ewtb ->+                              case ewtb of+                                Right _ ->+                                  pure $ Right $ unlines+                                  [ "# Temporary worktree branch:"+                                  , "## Adding:"+                                  , wta+                                  , "## Saving files:"+                                  , concat xs+                                  , "## Adding files and committing :"+                                  , wcf+                                  , "## Removing:"+                                  , wrf+                                  ]+                                Left  e ->  pure $ Left e+                            ( _, (es,__), _, _, _) ->+                              gitUpdateBranchDesc root ts err >>= \ ewtb ->+                              case ewtb of+                                Right _ ->+                                  pure $ Left $ unlines+                                  [ "# Temporary worktree branch error(s):"+                                  , "## Adding:"+                                  , fromLeft "No error" ewta+                                  , "## Adding description:"+                                  , fromLeft "No error" ewtb+                                  , "## Saving files:"+                                  , concat es+                                  , "## Adding files:"+                                  , fromLeft "No error" ewaf+                                  , "## Committing:"+                                  , fromLeft "No error" ewcf+                                  , "## Removing:"+                                  , fromLeft "No error" ewrf+                                  ]+                                Left  e ->  pure $ Left e+                              where+                                err = "[ERROR]: " ++ txt+                          where+                            tap = tmp ++ "/" ++ ts+                            dir = tap ++ "/" ++ cdir+                        Left  e ->+                          pure $ Left e+                    _______ ->+                      pure $ Left "No timestamp"+                (False, ____) ->+                  pure $ Left "No GIT repo initialized"+                (____, False) ->+                  pure $ Left "No /tmp/ folder added to the .gitignore file"+            Left err ->+              pure $ Left err+        Nothing ->+          pure $ Left noLlmConf+ --------------------------------------------------------------------------------  class+  ( EFF.LlmConf m+  , EFF.LlmCodeConf m+  )+  => LlmCodeConf m+  where+    llmCodeAPI+      :: m (Maybe String)+    llmCodeKey+      :: m (Maybe String)++instance+  ( EFF.LlmConf RIO+  , EFF.LlmCodeConf RIO+  )+  => LlmCodeConf RIO+  where+    llmCodeAPI = getEnvVar "LLM_CODE_LOCALHOST_API"+    llmCodeKey = pure Nothing++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf m+  , EFF.LlmCodeConf m+  )+  => LlmCodePost m+  where+    llmCodeWeb+      :: String+      -> m (Either String String)++instance+  ( EFF.LlmConf RIO+  , EFF.LlmCodeConf RIO+  )+  => LlmCodePost RIO+  where+    llmCodeWeb json =+      EFF.llmCodeAPI >>= \ mapi ->+      EFF.llmCodeKey >>= \ mkey ->+      llmCurl json mapi mkey++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class   EFF.LlmConf m   => LlmPlanRoot m   where@@ -895,15 +1177,15 @@       EFF.llmPathCWD >>= \ ocwd ->       case ocwd of         Just (LLM.Root root) ->-          EFF.llmPlanDir                 >>= \ pdir ->-          EFF.llmPlanMsk                 >>= \ pmsk ->-          realPath (root ++ "/" ++ pdir) >>= \ efap ->+          EFF.llmPlanDir          >>= \ pdir ->+          EFF.llmPlanMsk          >>= \ pmsk ->+          realPath (root ++ pdir) >>= \ efap ->           case efap of             -- TODO: DRY             Right fap ->               ( \ case-                  ([], rs) -> Right $ LLM.FilePaths $ concat rs-                  (ls, __) -> Left                           ls+                  ([], rs) -> Right $ LLM.FilePaths $ mconcat rs+                  (ls, __) -> Left                            ls               )               . partitionEithers               <$> mapM (\ msk -> findFiles fap ("*" ++ fil ++ "*" ++ msk)) pmsk@@ -923,16 +1205,19 @@       case ocwd of         -- TODO: DRY         Just (LLM.Root root) ->-          realPath (root ++ "/" ++ pdir) >>= \ efap ->+          realPath (root ++ pdir) >>= \ efap ->           case efap of             Right fap ->               if fap `isPrefixOf` abspath then-                Right . LLM.File . (,) abspath . lines+                -- NOTE: Root relative path+                Right . LLM.File . (,) (drop len abspath) . lines                 <$> readFileStrict abspath               else                 pure $ Left $ notPrefixRootAndMode fap abspath LLM.Plan             Left  err ->               pure $ Left err+            where+              len = length root         Nothing ->           pure $ Left noLlmConf @@ -977,27 +1262,9 @@   => LlmPlanPost RIO   where     llmPlanWeb json =-      EFF.llmPathCWD >>= \ ocwd ->-      case ocwd of-        Just (LLM.Root root) ->-          realPath root >>= \ efap ->-          case efap of-            Right rp ->-              gitExist     rp >>= \ git ->-              gitignoreTmp rp >>= \ tmp ->-              case (git, tmp) of-                (True,  True) ->-                  EFF.llmPlanAPI >>= \ mapi ->-                  EFF.llmPlanKey >>= \ mkey ->-                  llmCurl json mapi mkey-                (False, ____) ->-                  pure $ Left "No GIT repo initialized"-                (____, False) ->-                  pure $ Left "No /tmp/ folder added to the .gitignore file"-            Left err ->-              pure $ Left err-        Nothing ->-          pure $ Left noLlmConf+      EFF.llmPlanAPI >>= \ mapi ->+      EFF.llmPlanKey >>= \ mkey ->+      llmCurl json mapi mkey  -------------------------------------------------------------------------------- --------------------------------------------------------------------------------@@ -1021,15 +1288,29 @@         Left err   )   <$> withExitCodeCwd path "find"+        -- NOTE: Use -ipath and -iname (case insensitive) instead?         [ path-        , "-path"-        , mask           -- NOTE: Limit to files, excluding symbolic links         , "-type", "f"+          -- NOTE: Exclude tmp folder+        , "-not"+        , "-path"+        , path ++ "/tmp/*"+        , "-and"+          -- NOTE: Exclude llm tpl folder+        , "-not"+        , "-ipath"+        , path ++ "/llm/*"+        , "-and"           -- NOTE: Exclude dot files and hereby tmp Emacs files (.*#)         , "-not"         , "-name"         , ".*"+        , "-and"+          -- NOTE: Look for filter mask+        , "-path"+        , mask+        , "-print"         ]  getEnvVar@@ -1075,6 +1356,71 @@   where     gi = path ++ "/.gitignore" +gitWorktreeAdd+  :: FilePath+  -> String+  -> FilePath+  -> RIO (Either String String)+gitWorktreeAdd root ts path =+  withExitCodeCwd root "git"+    [ "worktree"+    , "add", "-b", ts+    , path+    ]++gitAddFiles+  :: FilePath+  -> RIO (Either String String)+gitAddFiles path =+  withExitCodeCwd path "git"+    [ "add"+    , "."+    ]++gitCommit+  :: FilePath+  -> String+  -> RIO (Either String String)+gitCommit root mesg =+  withExitCodeCwd root "git"+    [ "commit"+    , "-m"+    , mesg+    ]++gitWorktreeRem+  :: FilePath+  -> FilePath+  -> RIO (Either String String)+gitWorktreeRem root path =+  withExitCodeCwd root "git"+    [ "worktree"+    , "remove"+    , path+    ]++gitBranchesDesc+  :: FilePath+  -> RIO (Either String String)+gitBranchesDesc root =+  withExitCodeCwd root "git"+    [ "config"+    , "--get-regexp"+    , "branch.*.description"+    ]++gitUpdateBranchDesc+  :: FilePath+  -> String+  -> String+  -> RIO (Either String String)+gitUpdateBranchDesc path ts desc =+  withExitCodeCwd path "git"+    [ "config"+    , "branch." ++ ts ++ ".description"+    , desc+    ]+ llmCurl   :: String   -> Maybe String@@ -1086,7 +1432,7 @@       RestrictedIO $ pure $ Left "No API address was provided"     (Just api, Nothing) ->       withExitCodeStdIn "curl"-        ( [ --"--verbose"+        ( [ -- "--verbose"             "--silent"           , "--show-error"           ]@@ -1102,7 +1448,7 @@         ( [ --"--verbose"             "--silent"           , "--show-error"-          , "--header", "\"Authorization: \"" ++ key ++ "\""+          , "--header", "Authorization: " ++ key           ]           ++ hs ++           [ -- NOTE: https://curl.se/docs/manpage.html#--json@@ -1113,47 +1459,86 @@         json     where       hs =-        [ "--header" , "\"Accept: application/json\""-        , "--header" , "\"Accept-Encoding: gzip, deflate, br\""-        , "--header" , "\"Content-Type: application/json; charset=utf-8\""-        , "--header" , "\"User-Agent: Λ-gent/0.11\""+        [ "--header" , "Accept: application/json"+        , "--header" , "Accept-Encoding: gzip, deflate, br"+        , "--header" , "Content-Type: application/json; charset=utf-8"+        , "--header" , "User-Agent: Λ-gent/0.11"         ]  readFileStrict   :: FilePath   -> RIO String readFileStrict path =-  -- NOTE: «Too Many Open Files» error in Linux+  -- TODO:   ---  -- - http://woshub.com/too-many-open-files-error-linux/+  -- Refactor `RIO String` to `RIO (Either String String)`   RestrictedIO $-  readFile path >>= \cs ->-  length cs `seq` pure cs+  do+    eproc <-+      try+        ( aux+        ) :: IO (Either SomeException String)+    case eproc of+        Right txt -> pure txt+        Left  ___ -> pure []+  where+    aux =+      readFile path >>= \cs ->+      length cs `seq` pure cs +writeFileStrict+  :: FilePath+  -> String+  -> RIO (Either String String)+writeFileStrict path txt =+  RestrictedIO $+  do+    eproc <-+      try+        ( writeFile path txt+        ) :: IO (Either SomeException ())+    case eproc of+        Right _ ->+          pure $ Right path+        Left  e -> pure $ Left $ show e+ realPath   :: FilePath   -> RIO (Either String String) realPath path =+  -- NOTE: `realpath` removes any trailing '/' for directories+  --   -- NOTE: Remove any '\NUL` from filepaths   -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110   ( \case-      Right str -> Right $ filter (/= '\NUL') str+      Right str -> Right $ filter (/= '\n') str       Left  err -> Left err   )   <$> withExitCode "realpath"-        [ "--canonicalize-existing"-        , "--logical"-        , "--physical"-        -- NOTE: End each output line with NUL, not newline-        , "--zero"-        , path+        [ path         ] +ensureFolderPath+  :: FilePath+  -> FilePath+  -> RIO (Either String String)+ensureFolderPath root path =+  withExitCodeCwd root "dirname" [ path ] >>= \ eadp ->+  case eadp of+    Right adp ->+      withExitCodeCwd root "mkdir" [ "-p", foo ] >>= \ emeh ->+      case emeh of+        Right _ -> pure $ Right foo+        Left  e -> pure $ Left  e+      where+        foo = filter (/= '\n') adp+    Left  err -> pure $ Left err+ timestampUTC :: RIO (Maybe String) timestampUTC =   ( \case-      Right str -> Just str-      Left  ___ -> Nothing+      Right cs -> Just $ filter ( \ c -> c == '-' || isDigit c ) cs+      Left  __ -> Nothing   )   <$> withExitCode "date"         [ "-u"@@ -1167,12 +1552,18 @@ withExitCode cmd args =   RestrictedIO $   do-    (exitcode, out, err) <- readProcessWithExitCode cmd args []-    case exitcode of-      ExitSuccess ->-        pure $ Right out-      ExitFailure _ ->-        pure $ Left err+    eproc <-+      try+        ( readProcessWithExitCode cmd args []+        ) :: IO (Either SomeException ((ExitCode, String, String)))+    case eproc of+        Right (exitcode, out, err) ->+          case exitcode of+            ExitSuccess ->+              pure $ Right out+            ExitFailure _ ->+              pure $ Left $ err+        Left e -> pure $ Left $ show e  withExitCodeStdIn   ::  String@@ -1182,17 +1573,20 @@ withExitCodeStdIn cmd args txt =   RestrictedIO $   do-    (Just hinp, Just hout, Just herr, ph) <- createProcess rcp-    hPutStrLn hinp txt-    hClose    hinp-    out <- hGetContents hout-    err <- hGetContents herr-    exitcode <- waitForProcess ph-    case exitcode of-      ExitSuccess ->-        pure $ Right out-      ExitFailure _ ->-        pure $ Left  err+    eproc <-+      try+        ( aux+        ) :: IO (Either SomeException ((ExitCode, String, String)))+    case eproc of+        Right (exitcode, out, err) ->+          case exitcode of+            ExitSuccess ->+              -- DEBUG: Add --verbose flag which is dispatched to stderr+              -- pure $ Right (" DEBUG: " ++ err ++ out)+              pure $ Right out+            ExitFailure _ ->+              pure $ Left $ err+        Left e -> pure $ Left $ show e     where       raw = proc cmd args       rcp =@@ -1201,21 +1595,36 @@           , std_out = CreatePipe           , std_err = CreatePipe           }+      aux =+        do+          (Just hinp, Just hout, Just herr, ph) <- createProcess rcp+          hPutStrLn hinp txt+          hClose    hinp+          out <- hGetContents hout+          err <- hGetContents herr+          exitcode <- waitForProcess ph+          return (exitcode, out, err)  withExitCodeCwd-  ::  String-  ->  String+  :: String+  -> String   -> [String]   -> RIO (Either String String) withExitCodeCwd path cmd args =   RestrictedIO $   do-    (exitcode, out, err) <- readCreateProcessWithExitCode rcp []-    case exitcode of-      ExitSuccess ->-        pure $ Right out-      ExitFailure _ ->-        pure $ Left $ err+    eproc <-+      try+        ( readCreateProcessWithExitCode rcp []+        ) :: IO (Either SomeException ((ExitCode, String, String)))+    case eproc of+        Right (exitcode, out, err) ->+          case exitcode of+            ExitSuccess ->+              pure $ Right out+            ExitFailure _ ->+              pure $ Left $ err+        Left e -> pure $ Left $ show e     where       raw = proc cmd args       rcp = raw { cwd = Just path }

@@ -0,0 +1,133 @@+{-# OPTIONS_GHC -Wall -Werror #-}++{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}++{-# LANGUAGE DeriveDataTypeable           #-}++--------------------------------------------------------------------------------++-- |+-- Copyright  : (c) 2026 SPISE MISU ApS+-- License    : SSPL-1.0 OR AGPL-3.0-only+-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>+-- Stability  : experimental++--------------------------------------------------------------------------------++module Internal.Utils+  ( -- * Files+    files+  , file+    -- * History+  , chits+  , chats+    -- * Helpers+  , combine+  , leftpad+  , index+  , split+  , linesOptNums+  )+where++--------------------------------------------------------------------------------++import           Prelude hiding ( lines )+import qualified Prelude as Prelude++--------------------------------------------------------------------------------++combine+  :: [ (String, String) ]+  -> [ String ]+combine =+  map+  ( \ (x, y) ->+      if null x then+        y+      else+        x ++ ": " ++ y+  )++leftpad+  :: Char+  -> Int+  -> [Char]+  -> [Char]+leftpad chr rep cs =+  replicate (rep - length xs) chr ++ xs+  where+    xs = take rep cs++index+  :: Int+  -> Int+  -> String+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+  :: String+  -> Bool+  -> [ String ]+  -> [ (String, String) ]+files prefix nums fs =+  linesOptNums prefix nums 0 fs++file+  :: Bool+  -> String+  -> [ (String, String) ]+file nums f =+  linesOptNums [] nums 1 $ Prelude.lines f++--------------------------------------------------------------------------------++chits+  :: Bool+  -> [ String ]+  -> [ (String, String) ]+chits nums fs =+  linesOptNums [] nums 0 $ reverse fs++chats+  :: Bool+  -> [ String ]+  -> [ (String, String) ]+chats nums fs =+  linesOptNums [] nums 0 $ reverse fs++--------------------------------------------------------------------------------++-- HELPERS (private)++linesOptNums+  :: String+  -> Bool+  -> Int+  -> [ String ]+  -> [ (String, String) ]+linesOptNums prefix nums origo xs =+  zipWith (\ idx rel -> (prefix ++ f idx, rel)) [origo..] xs+  where+    len   = length $ show $ length xs+    f i =+      if nums then+        index len i+      else+        []