A-gent 0.11.0.5 → 0.11.0.6

raw patch · 13 files changed

+1286/−206 lines, 13 filesdep ~containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• A-gent.cabal +14/−8
• CHANGELOG.md +30/−0
• Setup.hs +20/−0
• src/Agent/Control/Concurrent.hs +85/−0
• src/Agent/Control/IFC.hs +1/−1
• src/Agent/Control/MAC.hs +4/−12
• src/Agent/IO/Effects.hs +152/−9
• src/Agent/IO/Restricted.hs +565/−108
• src/Agent/JSON.hs +5/−7
• src/Agent/LLM.hs +189/−61
• src/Agent/Utils/Code.hs +70/−0
• src/Agent/Utils/Common.hs +81/−0
• src/Agent/Utils/Plan.hs +70/−0

@@ -9,13 +9,12 @@ build-type: Simple                                                name: A-gent-version: 0.11.0.5+version: 0.11.0.6  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              -homepage:    https://a-gent.org-bug-reports: https://bsky.app/profile/a-gent.org+homepage: https://a-gent.org            license: SSPL-1.0 OR AGPL-3.0-only license-file: LICENSE.md@@ -56,8 +55,10 @@       -- Prelude       base       >= 4        && < 5       -- Process+      -- NOTE: github.com/NixOS/hydra builds with stackage lastest LST (24.…)+      -- and stackage only has 'containers 0.7' while hackage has '0.8'     , process    >= 1.6.25.0 && < 2-    , containers >= 0.8      && < 1+    , containers >= 0.7      && < 1       -- JSON     , mtl        >= 2.3.1    && < 3   ghc-options:@@ -139,21 +140,26 @@       base   hs-source-dirs:       src-  exposed-modules:+  other-modules:       Internal.GaloisInc.Text.JSON       Internal.GaloisInc.Text.JSON.Generic       Internal.GaloisInc.Text.JSON.String       Internal.GaloisInc.Text.JSON.Types       --       Internal.GlasgowUniversity.Data.Generics.Aliases-      ---      Agent.JSON-      --+  exposed-modules:+      Agent.Control.Concurrent       Agent.Control.IFC       Agent.Control.MAC       --       Agent.IO.Effects       Agent.IO.Restricted+      --+      Agent.Utils.Common+      Agent.Utils.Code+      Agent.Utils.Plan+      --+      Agent.JSON       --       Agent.LLM 

@@ -1,5 +1,35 @@ # Revision history for Λ-gent +## 0.11.0.6  -- 2026-03-20++* Added a `todo.org` file in the root folder of the project. This will allow to+  see current, but also future, status of the project.++* Expanded file capabilities for `Code` and `Plan`.++  * Files will be shown with `relative` paths. However, they will be handled+    with `absolute` paths under the hood.++* Added a few more `REPL` commands and improvements to typing.++  * **NOTE**: There is a `bug` with regard of multi-line text. Hopefully it will+    be fixed shortly.++* No longer on Bluesky and therefore, removed from `cabal` file.++* Issue with `haskellPackages` on `NixOS`. It seems that they use `stack` to+  build with the latest `LTS`. The fix is to change in the `cabal` file the+  following version contraint: `containers >= 0.7 && < 1` as `stackage` only has+  the version `0.7` of the `containers` package.+  +  * **NOTE**: Fix is not verified. Well, this update will confirm (or not).++* Added the `Agent.Control.Concurrent` module to provide support for+  asynchronous tasks.++* Added `Agent.Utils` modules to help for the respective `modes`. This will help+  keep `Λ-gent` code small by providing ready to plug code bloks.+ ## 0.11.0.5  -- 2026-03-08  * `ENTER` only triggers if something is typed.

@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -Wall -Werror #-}++--------------------------------------------------------------------------------++-- |+-- Copyright  : (c) 2026 SPISE MISU ApS+-- License    : SSPL-1.0 OR AGPL-3.0-only+-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>+-- Stability  : experimental++--------------------------------------------------------------------------------++import           Distribution.Simple+  ( defaultMain+  )++--------------------------------------------------------------------------------++main :: IO ()+main = defaultMain

@@ -0,0 +1,85 @@+{-# OPTIONS_GHC -Wall -Werror #-}++{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}++{-# LANGUAGE LambdaCase                   #-}++--------------------------------------------------------------------------------++-- |+-- 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.Control.Concurrent+  ( Async+  , Task+  , fork+  , wait+  , join+  )+where++--------------------------------------------------------------------------------++import           Control.Concurrent      ( ThreadId, forkFinally )+import           Control.Concurrent.MVar+  ( MVar+  , newEmptyMVar+  , putMVar+  , readMVar+  )+import           GHC.Exception           ( SomeException, throw )++--------------------------------------------------------------------------------++data Task a = Task !ThreadId (IO (Either SomeException a))++--------------------------------------------------------------------------------++-- |+-- To prevent the users from adding instances of `Async`, we+-- provide a middle-layer (`Proxy`) between the `Monad` instance and the `Proxy`+-- (`Async`) instance.++class Monad m => Proxy m where+  new :: m (MVar a)+  put ::    MVar a -> a -> m ( )+  get ::    MVar a ->      m  a+class Proxy m => Async m where+  fork ::   m    a   -> m (Task a)+  wait ::   Task a   -> m       a+  join :: [ Task a ] -> m      ( )++--------------------------------------------------------------------------------++instance Proxy IO where+  -- | newEmptyMVar: Create an MVar which is initially empty.+  new = newEmptyMVar+  -- | putMVar: Put a value into an MVar.+  put = putMVar+  -- |+  -- readMVar: Atomically read the contents of an MVar. If the MVar is currently+  -- empty, readMVar will wait until it is full. readMVar is guaranteed to+  -- receive the next putMVar.+  get = readMVar++instance Async IO where+  fork compute =+    new                               >>= \ var ->+    forkFinally compute (finally var) >>= \ tid ->+    pure $ Task tid $ get var+    where+      finally v r = put v r+  wait (Task _ mvar) =+    ( \case+        Right v ->       v+        Left  e -> throw e+    )+    <$> mvar+  join =+    mapM_ wait

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  {-# LANGUAGE MultiParamTypeClasses        #-} 

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  -------------------------------------------------------------------------------- @@ -62,20 +62,12 @@  -------------------------------------------------------------------------------- -import           Control.Monad-  ( ap-  , liftM-  )+import           Control.Monad     ( ap, liftM ) -import           Control.Exception-  ( Exception-  , SomeException-  )+import           Control.Exception ( Exception, SomeException ) import qualified Control.Exception as Ex -import           Agent.Control.IFC-  ( Flow-  )+import           Agent.Control.IFC ( Flow )  -------------------------------------------------------------------------------- 

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  -------------------------------------------------------------------------------- @@ -14,17 +14,160 @@ --------------------------------------------------------------------------------  module Agent.IO.Effects-  ( -- * LLM-    LlmChatConf(llmChatKey, llmChatAPI)-  , LlmChatCurl(llmChatCurl)+  ( -- * LLM (Config)+    LlmConf(llmPathCWD)+    -- * LLM (Chat)+  , LlmChatConf(llmChatKey, llmChatAPI)+  , LlmChatPost(llmChatWeb)+  , -- * LLM (Code)+    LlmCodeRoot(llmCodeDir)+  , LlmCodeMask(llmCodeMsk)+  , LlmCodeRead(llmCodeSeq, llmCodeGet)+  , LlmCodeSave(llmCodePut)+  , -- * LLM (Plan)+    LlmPlanRoot(llmPlanDir)+  , LlmPlanMask(llmPlanMsk)+  , LlmPlanRead(llmPlanSeq, llmPlanGet)+  , LlmPlanConf(llmPlanKey, llmPlanAPI)+  , LlmPlanPost(llmPlanWeb)   ) where  -------------------------------------------------------------------------------- -class  Monad m => LlmChatConf m where-  llmChatAPI :: m (Maybe String)-  llmChatKey :: m (Maybe String)+class+  Monad m+  => LlmConf m+  where+    llmPathCWD+      :: m (Maybe String) -class LlmChatConf m => LlmChatCurl m where-  llmChatCurl :: String -> m (Either String String)+--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  Monad m+  => LlmChatConf m+  where+    llmChatAPI+      :: m (Maybe String)+    llmChatKey+      :: m (Maybe String)++--------------------------------------------------------------------------------++class+  LlmChatConf m+  => LlmChatPost m+  where+    llmChatWeb+      :: String+      -> m (Either String String)++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  Monad m+  => LlmCodeRoot m+  where+    llmCodeDir+      :: m String -- Ex: "src"++--------------------------------------------------------------------------------++class+  Monad m+  => LlmCodeMask m+  where+    llmCodeMsk+      :: m [ String ] -- Ex: [ "*.hs", "*.lhs" ]++--------------------------------------------------------------------------------++class+  ( LlmConf m+  , LlmCodeRoot m+  , LlmCodeMask m+  )+  => LlmCodeRead m+  where+    llmCodeSeq+      :: Maybe String+      -> m (Either String [ String ])+    llmCodeGet+      :: String+      -> m (Either String String)++--------------------------------------------------------------------------------++class+  ( LlmConf m+  , LlmCodeRoot m+  )+  => LlmCodeSave m+  where+    llmCodePut+      :: m [ (String, String) ]+      -> m [ (Either String ()) ]++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  Monad m+  => LlmPlanRoot m+  where+    llmPlanDir+      :: m String -- Ex: "llm"++--------------------------------------------------------------------------------++class+  Monad m+  => LlmPlanMask m+  where+    llmPlanMsk+      :: m [ String ] -- Ex: [ "plan_*.md" ]++--------------------------------------------------------------------------------++class+  ( LlmConf m+  , LlmPlanRoot m+  , LlmPlanMask m+  )+  => LlmPlanRead m+  where+    llmPlanSeq+      :: Maybe String+      -> m (Either String [ String ])+    llmPlanGet+      :: String+      -> m (Either String String)++--------------------------------------------------------------------------------++class+  Monad m+  => LlmPlanConf m+  where+    llmPlanAPI+      :: m (Maybe String)+    llmPlanKey+      :: m (Maybe String)++--------------------------------------------------------------------------------++class+  ( LlmConf m+  , LlmPlanConf m+  )+  => LlmPlanPost m+  where+    llmPlanWeb+      :: String+      -> m (Either String String)++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------

@@ -1,13 +1,15 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  {-# LANGUAGE FlexibleContexts             #-} {-# LANGUAGE UndecidableInstances         #-}  {-# LANGUAGE MonoLocalBinds               #-} +{-# LANGUAGE LambdaCase                   #-}+ --------------------------------------------------------------------------------  -- |@@ -50,37 +52,44 @@     -- * Read/Print   , input   , output+    -- * LLM (Config)+  , llmPathCWD     -- * LLM (Chat)   , llmChatKey, llmChatAPI-  , llmChatCurl+  , llmChatWeb     -- * LLM (Code)+  , llmCodeDir+  , llmCodeMsk+  , llmCodeSeq, llmCodeGet+    -- * LLM (Plan)+  , llmPlanDir+  , llmPlanMsk+  , llmPlanSeq, llmPlanGet+  , llmPlanKey, llmPlanAPI+  , llmPlanWeb+    -- * Temporary+  , readFileStrict   ) where  -------------------------------------------------------------------------------- +import           Data.Either              ( partitionEithers )+import           Data.List                ( isInfixOf )+import           Data.Maybe               ( fromMaybe ) import qualified System.Environment.Blank as ENV-import           System.IO-  {--  ( hFlush, hPutStr, stdout-  , hSetEncoding-  , utf8-  )-  -}-  ( hFlush, stdout-  , hReady, stdin-  ) import           System.Exit-  ( ExitCode-    ( ExitFailure-    , ExitSuccess-    )+  ( ExitCode (ExitFailure, ExitSuccess)   )+import           System.IO                ( hFlush, hReady, stdin, stdout ) import           System.Process-  ( readProcessWithExitCode+  ( CreateProcess (cwd)+  , proc+  , readCreateProcessWithExitCode+  , readProcessWithExitCode   ) -import qualified Agent.IO.Effects as EFF+import qualified Agent.IO.Effects         as EFF  -------------------------------------------------------------------------------- @@ -97,25 +106,36 @@   (>>=) m f = RestrictedIO $ run m >>= run . f  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------  class StdIn m where-  input :: m String +  input+    :: [ String ]+    -> [ String ]+    -> m String  class StdOut m where-  output :: String -> m ()+  output+    :: String+    -> m () +--------------------------------------------------------------------------------+ instance StdIn RIO where-  input =-    RestrictedIO $ aux [] []+  -- BUG: Issue with multiline text+  input prev next =+    -- TODO: CTRL+U (erase from cursor to start of line) and CTRL+K (erase from+    --       cursor to end of line+    RestrictedIO $ aux prev next [] []     where-      aux bcs acs =+      aux hps hns bcs acs =         key >>= \ k ->-        case k of+        case (k < [ '\32' ], k) of           -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER)-          '\008':[] ->+          (True , '\008':[]) ->             case bcs of               -- NOTE: Backspace (remove char if any and re-write after chars)-              [    ] -> aux bcs acs+              [    ] -> aux hps hns bcs acs               (_:cs) ->                 putChar '\008' >> hFlush stdout >>                 putChar '\032' >> hFlush stdout >>@@ -124,96 +144,141 @@                 putChar '\008' >> hFlush stdout >>                 putStr  acs    >> hFlush stdout >>                 putStr  rm     >> hFlush stdout >>-                aux cs  acs+                aux hps hns cs  acs                 where+                  la = [ '\ESC', '[', 'D' ]                   lc = length acs                   es = concatMap id $ take lc $ repeat sp                   rm = concatMap id $ take lc $ repeat la                   sp = [ ' ' ]-                  la = [ '\ESC', '[', 'D' ]-          '\010':[] ->-            -- NOTE: Enter (only if something is typed)+          (True , '\010':[]) ->+            -- NOTE: ENTER (only if something is typed)             case (bcs, acs) of               ([], []) ->-                aux bcs acs+                aux hps hns bcs acs               ________ ->                 pure $ (++ acs) $ reverse $ bcs-          '\ESC':'[':'C':[] ->-            -- NOTE: Allowed escaped sequences: Arrow "->"+          (True , '\012':[]) ->+            -- NOTE: Form Feed becomes "/w" (clear screen)+            pure $ "/w"+          (True , '\ESC':'[':'A':[]) ->+            -- NOTE: Allowed escaped sequences: Arrow "↑"+            case (txt, hps, hns) of+              (_, [  ], _) -> aux hps hns bcs acs+              (_, p:ps, _) ->+                putStr rm >> hFlush stdout >>+                putStr es >> hFlush stdout >>+                putStr rm >> hFlush stdout >>+                putStr p  >> hFlush stdout >>+                aux ps (p:hns) rev []+                where+                  rev = reverse p+            where+              sp = [ ' ' ]+              la = [ '\ESC', '[', 'D' ]+              lc = length txt+              es = concatMap id $ take lc $ repeat sp+              rm = concatMap id $ take lc $ repeat la+              txt = (++ acs) $ reverse $ bcs+          (True , '\ESC':'[':'B':[]) ->+            -- NOTE: Allowed escaped sequences: Arrow "↓"+            case (txt, hps, hns) of+              (_, _, [  ]) -> aux hps hns bcs acs+              (_, _, p:ps) ->+                putStr rm >> hFlush stdout >>+                putStr es >> hFlush stdout >>+                putStr rm >> hFlush stdout >>+                putStr p  >> hFlush stdout >>+                aux (p:hps) ps rev []+                where+                  rev = reverse p+            where+              sp = [ ' ' ]+              la = [ '\ESC', '[', 'D' ]+              lc = length txt+              es = concatMap id $ take lc $ repeat sp+              rm = concatMap id $ take lc $ repeat la+              txt = (++ acs) $ reverse $ bcs+          (True , '\ESC':'[':'C':[]) ->+            -- NOTE: Allowed escaped sequences: Arrow "→"             case (bcs, acs) of               (_, [  ]) ->-                aux    bcs  acs+                aux hps hns    bcs  acs               (_, c:cs) ->                 putStr k >> hFlush stdout >>-                aux (c:bcs)  cs-          '\ESC':'[':'D':[    ] ->-            -- NOTE: Allowed escaped sequences: Arrow "<-"+                aux hps hns (c:bcs)  cs+          (True , '\ESC':'[':'D':[    ]) ->+            -- NOTE: Allowed escaped sequences: Arrow "←"             case (bcs, acs) of               ([  ], _) ->-                aux bcs    acs+                aux hps hns bcs    acs               (c:cs, _) ->                 putStr k >> hFlush stdout >>-                aux  cs (c:acs)-          '\ESC':'[':'H':[] ->-            -- NOTE: HOME-            putStr rm >> hFlush stdout >>-            (aux [] ((reverse bcs) ++ acs))-            where-              lc = length bcs-              rm = concatMap id $ take lc $ repeat la-              la = [ '\ESC', '[', 'D' ]-          '\ESC':'[':'1':';':'5':'C':[] ->-            -- NOTE: Allowed escaped sequences: CTRL + Arrow "->"+                aux hps hns  cs (c:acs)+          (True , '\ESC':'[':'1':';':'5':'C':[]) ->+            -- NOTE: Allowed escaped sequences: CTRL + Arrow "→"             putStr rm >> hFlush stdout >>-            (aux (ts ++ bcs) ds)+            (aux hps hns (ts ++ bcs) ds)             where               ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs               ts = drop (length ds) $ reverse acs+              la = [ '\ESC', '[', 'C' ]               lc = length ts               rm = concatMap id $ take lc $ repeat la-              la = [ '\ESC', '[', 'C' ]-          '\ESC':'[':'1':';':'5':'D':[] ->-            -- NOTE: Allowed escaped sequences: CTRL + Arrow "<-"+          (True , '\ESC':'[':'1':';':'5':'D':[]) ->+            -- NOTE: Allowed escaped sequences: CTRL + Arrow "←"             putStr rm >> hFlush stdout >>-            (aux ds (ts ++ acs))+            (aux hps hns ds (ts ++ acs))             where               ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs               ts = drop (length ds) $ reverse bcs+              la = [ '\ESC', '[', 'D' ]               lc = length ts               rm = concatMap id $ take lc $ repeat la+          (True , '\ESC':'[':'H':[]) ->+            -- NOTE: HOME+            -- HERE:+            putStr rm >> hFlush stdout >>+            (aux hps hns [] ((reverse bcs) ++ acs))+            where               la = [ '\ESC', '[', 'D' ]-          '\ESC':'[':'F':[] ->+              lc = length bcs+              rm = concatMap id $ take lc $ repeat la+          (True , '\ESC':'[':'F':[]) ->             -- NOTE: END             putStr rm >> hFlush stdout >>-            (aux ((++ bcs) $ reverse $ acs) [])+            (aux hps hns ((++ bcs) $ reverse $ acs) [])             where+              la = [ '\ESC', '[', 'C' ]               lc = length acs               rm = concatMap id $ take lc $ repeat la-              la = [ '\ESC', '[', 'C' ]-          '\ESC':'[':'3':'~':[] ->+          (True , '\ESC':'[':'3':'~':[]) ->             case acs of               -- NOTE: Delete (remove char if any and re-write after chars)-              [    ] -> aux bcs acs+              [    ] -> aux hps hns bcs acs               (_:cs) ->                 putStr  cs  >> hFlush stdout >>                 putChar ' ' >> hFlush stdout >>                 putStr  rm  >> hFlush stdout >>-                (aux bcs cs)+                (aux hps hns bcs cs)                 where+                  la = [ '\ESC', '[', 'D' ]                   lc = length acs                   rm = concatMap id $ take lc $ repeat la-                  la = [ '\ESC', '[', 'D' ]-          '\ESC':__ ->+          (True , '\ESC':__) ->             -- NOTE: Other escaped sequences (skip)-            aux bcs acs-          '\DEL':[] ->+            aux hps hns bcs acs+          (True ,  _) ->+            -- NOTE: Skip all other unhandled control keys+            aux hps hns bcs acs+          (False, '\DEL':[]) ->             -- NOTE: DELETE (skip)-            aux bcs acs-          _________ ->+            aux hps hns bcs acs+          (False, _) ->             putStr k   >> hFlush stdout >>             putStr acs >> hFlush stdout >>             putStr rm  >> hFlush stdout >>-            (aux (reverse k ++ bcs) acs)+            (aux hps hns (reverse k ++ bcs) acs)             where               lc = length acs               rm = concatMap id $ take lc $ repeat la@@ -222,7 +287,7 @@         -- NOTE: https://stackoverflow.com/a/38553473         reverse <$> nxt []         where-          nxt cs = +          nxt cs =             do               c <- getChar               m <- hReady stdin@@ -233,62 +298,454 @@     putStr x >> hFlush stdout  --------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -class SysEnv m where-  getEnvVar :: String -> m (Maybe String)+class+  EFF.LlmConf m+  => LlmConf m+  where+    llmPathCWD+      :: m (Maybe String) -instance SysEnv RIO where-  getEnvVar = RestrictedIO . ENV.getEnv+instance+  EFF.LlmConf RIO+  => LlmConf RIO+  where+    llmPathCWD = getEnvVar "LLM_PATH_CWD"  --------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -class ReadProc m where-  withExitCode :: String -> [String] -> m (Either String String)+class+  EFF.LlmChatConf m+  => LlmChatConf m+  where+    llmChatAPI+      :: m (Maybe String)+    llmChatKey+      :: m (Maybe String) -instance ReadProc RIO where-  withExitCode app fs = RestrictedIO $-    do-      (exitcode, out, err) <- readProcessWithExitCode app fs []-      case exitcode of-        ExitSuccess ->-          pure $ Right out-        ExitFailure _ ->+instance+  EFF.LlmChatConf RIO+  => LlmChatConf RIO+  where+    llmChatAPI = getEnvVar "LLM_CHAT_LOCALHOST_API"+    llmChatKey = pure Nothing++--------------------------------------------------------------------------------++class+  EFF.LlmChatConf m+  => LlmChatPost m+  where+    llmChatWeb+      :: String -> m (Either String String)++instance+  EFF.LlmChatConf RIO+  => LlmChatPost RIO+  where+    llmChatWeb json =+      EFF.llmChatAPI >>= \ mapi ->+      EFF.llmChatKey >>= \ mkey ->+      llmCurl json mapi mkey++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  EFF.LlmConf m+  => LlmCodeRoot m+  where+    llmCodeDir+      :: m String++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeRoot RIO+  )+  => LlmCodeRoot RIO+  where+    llmCodeDir = pure "src"++--------------------------------------------------------------------------------++class+  EFF.LlmCodeMask m+  => LlmCodeMask m+  where+    llmCodeMsk+      :: m [ String ]++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeMask RIO+  )+  => LlmCodeMask RIO+  where+    llmCodeMsk = pure  [ "*.hs" ]++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf     m+  , EFF.LlmCodeRoot m+  , EFF.LlmCodeMask m+  )+  => LlmCodeRead m+  where+    llmCodeSeq+      :: Maybe String+      -> m (Either String [ String ])+    llmCodeGet+      :: String+      -> m (Either String String)++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeRoot RIO+  , EFF.LlmCodeMask RIO+  )+  => LlmCodeRead RIO+  where+    llmCodeSeq mfilter =+      EFF.llmPathCWD                              >>= \ ocwd ->+      EFF.llmCodeDir                              >>= \ cdir ->+      EFF.llmCodeMsk                              >>= \ cmsk ->+      realPath (fromMaybe [] ocwd ++ "/" ++ cdir) >>= \ efrp ->+      case efrp of+        Right frp ->+          ( \ case+              ([], rs) ->+                Right $ concat                           rs+              (ls, __) ->+                Left  $ foldl1 (\ x y -> x ++ "\n" ++ y) ls+          )+          . partitionEithers+          . map+            ( \ case+                Right fns ->+                  case mfilter of+                    Nothing  -> Right                          rel+                    Just fil -> Right $ filter (isInfixOf fil) rel+                  where+                    rel = map (cdir ++ ) fns+                Left  err ->+                  Left err+            )+          <$> mapM (findFiles frp) cmsk+        Left err ->           pure $ Left err +    llmCodeGet relpath =+      EFF.llmPathCWD               >>= \ ocwd ->+      realPath (fromMaybe [] ocwd) >>= \ efrp ->+      case efrp of+        Right frp ->+          Right <$> readFileStrict (frp ++ "/" ++ relpath)+        Left  err ->+          pure $ Left err+ --------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -class (EFF.LlmChatConf m, SysEnv m) => LlmChatConf m where-  llmChatAPI :: m (Maybe String)-  llmChatKey :: m (Maybe String)+class+  EFF.LlmConf m+  => LlmPlanRoot m+  where+    llmPlanDir+      :: m String -instance (EFF.LlmChatConf RIO, SysEnv RIO) => LlmChatConf RIO where-  llmChatAPI = getEnvVar "LLM_CHAT_LOCALHOST_API"-  llmChatKey = pure Nothing+instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanRoot RIO+  )+  => LlmPlanRoot RIO+  where+    llmPlanDir = pure "llm" -class (EFF.LlmChatConf m , ReadProc m) => LlmChatCurl m where-  llmChatCurl :: String -> m (Either String String)+-------------------------------------------------------------------------------- -instance (EFF.LlmChatConf RIO, ReadProc RIO) => LlmChatCurl RIO where-  llmChatCurl json =-    llmChatAPI >>= \ mapi ->-    llmChatKey >>= \ mkey ->-    case (mapi, mkey) of-      (Nothing, _ ) ->-        RestrictedIO $ pure $ Left "No API address was provided"-      (Just api, Nothing) ->-        withExitCode "curl"-          [ "--silent"+class+  EFF.LlmConf m+  => LlmPlanMask m+  where+    llmPlanMsk+      :: m [ String ]++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanMask RIO+  )+  => LlmPlanMask RIO+  where+    llmPlanMsk = pure [ "plan_*.md" ]++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf     m+  , EFF.LlmPlanRoot m+  , EFF.LlmPlanMask m+  )+  => LlmPlanRead m+  where+    llmPlanSeq+      :: Maybe String+      -> m (Either String [ String ])+    llmPlanGet+      :: String+      -> m (Either String String)++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanRoot RIO+  , EFF.LlmPlanMask RIO+  )+  => LlmPlanRead RIO+  where+    llmPlanSeq mfilter =+      EFF.llmPathCWD                              >>= \ ocwd ->+      EFF.llmPlanDir                              >>= \ pdir ->+      EFF.llmPlanMsk                              >>= \ pmsk ->+      realPath (fromMaybe [] ocwd ++ "/" ++ pdir) >>= \ efrp ->+      case efrp of+        Right frp ->+          ( \ case+              ([], rs) ->+                Right $ concat                           rs+              (ls, __) ->+                Left  $ foldl1 (\ x y -> x ++ "\n" ++ y) ls+          )+          . partitionEithers+          . map+            ( \ case+                Right fns ->+                  case mfilter of+                    Nothing  -> Right                          rel+                    Just fil -> Right $ filter (isInfixOf fil) rel+                  where+                    rel = map (pdir ++ ) fns+                Left  err ->+                  Left err+            )+          <$> mapM (findFiles frp) pmsk+        Left err ->+          pure $ Left err++    llmPlanGet path =+      EFF.llmPathCWD                              >>= \ ocwd ->+      EFF.llmPlanDir                              >>= \ pdir ->+      realPath (fromMaybe [] ocwd ++ "/" ++ pdir) >>= \ efrp ->+      case efrp of+        Right rp ->+          if isInfixOf rp path then+            Right <$> readFileStrict path+          else+            pure $ Left $ "File: " ++ path ++ " is not in: " ++ rp+        Left err ->+          pure $ Left err++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf m+  , EFF.LlmPlanConf m+  )+  => LlmPlanConf m+  where+    llmPlanAPI+      :: m (Maybe String)+    llmPlanKey+      :: m (Maybe String)++instance+  ( EFF.LlmConf RIO+  , EFF.LlmPlanConf RIO+  )+  => LlmPlanConf RIO+  where+    llmPlanAPI = getEnvVar "LLM_PLAN_LOCALHOST_API"+    llmPlanKey = pure Nothing++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf m+  , EFF.LlmPlanConf m+  )+  => LlmPlanPost m+  where+    llmPlanWeb+      :: String+      -> m (Either String String)++instance+  ( EFF.LlmConf RIO+  , EFF.LlmPlanConf RIO+  )+  => LlmPlanPost RIO+  where+    llmPlanWeb json =+      EFF.llmPathCWD               >>= \ ocwd ->+      realPath (fromMaybe [] ocwd) >>= \ efrp ->+      case efrp of+        Right rp ->+          gitExist rp >>= \ git ->+          if git then+            EFF.llmPlanAPI >>= \ mapi ->+            EFF.llmPlanKey >>= \ mkey ->+            llmCurl json mapi mkey+          else+            pure $ Left "No GIT repo initialized"+        Left err ->+          pure $ Left err++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- HELPERS (public)++getEnvVar+  :: String+  -> RIO (Maybe String)+getEnvVar =+  RestrictedIO . ENV.getEnv++--------------------------------------------------------------------------------++-- HELPERS (private)++findFiles+  :: String+  -> String+  -> RIO (Either String [String])+findFiles path mask =+  -- NOTE: Remove any '\NUL` from filepaths+  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110+  ( \case+      Right str ->+        Right+        $ map (filter (/= '\NUL'))+        $ map (drop (length path)) -- NOTE: Relative paths instead of full+        $ lines str+      Left  err ->+        Left err+  )+  <$> withExitCodeAndCWD path "find"+        [ path+        , "-name"+        , mask+        ]++gitExist+  :: String+  -> RIO Bool+gitExist path =+  ( \case+      Right _ -> True+      Left  _ -> False+  )+  <$> withExitCodeAndCWD path "git"+        [ "status"+        ]++llmCurl+  :: String+  -> Maybe String+  -> Maybe String+  -> RIO (Either String String)+llmCurl json mapi mkey =+  case (mapi, mkey) of+    (Nothing, _ ) ->+      RestrictedIO $ pure $ Left "No API address was provided"+    (Just api, Nothing) ->+      withExitCode "curl"+        ( [ "--silent"           , "--show-error"-          , "--header" , "\"Content-Type: application/json; charset=utf-8\""-          , "--data"   , json+          ]+          ++ hs +++          [ "--data", json           , api ++ "/chat/completions"           ]-      (Just api, Just key) ->-        withExitCode "curl"-          [ "--silent"+        )+    (Just api, Just key) ->+      withExitCode "curl"+        ( [ "--silent"           , "--show-error"-          , "--header" , "\"Authorization: \"" ++ key ++ "\""-          , "--header" , "\"Content-Type: application/json; charset=utf-8\""-          , "--data"   , json+          , "--header", "\"Authorization: \"" ++ key ++ "\""+          ]+          ++ hs +++          [ "--data", json           , api ++ "/chat/completions"           ]+        )+    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\""+        ]++readFileStrict+  :: FilePath+  -> RIO String+readFileStrict path =+  -- NOTE: «Too Many Open Files» error in Linux+  --+  -- - http://woshub.com/too-many-open-files-error-linux/+  RestrictedIO $+  readFile path >>= \bs ->+  length bs `seq` pure bs++realPath+  :: String+  -> RIO (Either String String)+realPath path =+  -- NOTE: Remove any '\NUL` from filepaths+  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110+  ( \case+      Right str -> Right $ filter (/= '\NUL') str+      Left  err -> Left err+  )+  <$> withExitCode "realpath"+        [ "--canonicalize-existing"+        , "--logical"+        , "--physical"+        -- NOTE: End each output line with NUL, not newline+        , "--zero"+        , path+        ]++withExitCode+  ::  String+  -> [String]+  -> RIO (Either String String)+withExitCode cmd args =+  RestrictedIO $+  do+    (exitcode, out, err) <- readProcessWithExitCode cmd args []+    case exitcode of+      ExitSuccess ->+        pure $ Right out+      ExitFailure _ ->+        pure $ Left err++withExitCodeAndCWD+  ::  String+  ->  String+  -> [String]+  -> RIO (Either String String)+withExitCodeAndCWD path cmd args =+  RestrictedIO $+  do+    (exitcode, out, err) <- readCreateProcessWithExitCode rcp []+    case exitcode of+      ExitSuccess ->+        pure $ Right out+      ExitFailure _ ->+        pure $ Left err+    where+      raw = proc cmd args+      rcp = raw { cwd = Just path }

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  -------------------------------------------------------------------------------- @@ -25,16 +25,14 @@  -------------------------------------------------------------------------------- -import Data.Data-  ( Data-  )+import           Data.Data                            ( Data ) -import Internal.GaloisInc.Text.JSON.Generic-  ( Result(Error, Ok)+import           Internal.GaloisInc.Text.JSON.Generic+  ( Result (Error, Ok)   , encodeJSON   , fromJSON   )-import Internal.GaloisInc.Text.JSON.String+import           Internal.GaloisInc.Text.JSON.String   ( readJSValue   , runGetJSON   )

@@ -1,10 +1,12 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe                         #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}  {-# LANGUAGE RankNTypes                   #-} +{-# LANGUAGE TupleSections                #-}+ --------------------------------------------------------------------------------  -- |@@ -23,6 +25,7 @@     Mode(..)     -- * Context   , Load+  , History(..)   , Context(..)     -- * Paramenters   , Eval@@ -34,24 +37,33 @@  -------------------------------------------------------------------------------- -import           Prelude hiding (head, mod, print, read)--import           Data.Char-  ( toLower+import           Prelude                              hiding+  ( head+  , mod+  , print+  , read   )++import           Data.Char                            ( toLower, toUpper )+import           GHC.IO.Encoding                      ( setLocaleEncoding ) import           System.IO-  ( BufferMode(NoBuffering)-  , hFlush, hSetBuffering, hSetEcho-  , stderr, stdin, stdout+  ( BufferMode (NoBuffering)+  , hFlush+  , hSetBuffering+  , hSetEcho+  , stderr+  , stdin+  , stdout   , utf8   )-import           GHC.IO.Encoding-  ( setLocaleEncoding-  )+import           Text.Read                            ( readMaybe ) +import           Internal.GaloisInc.Text.JSON.Generic ( Data )+ import           Agent.IO.Restricted-import           Agent.JSON-  ( Data+  ( RIO (..)+  , input+  , output   )  --------------------------------------------------------------------------------@@ -64,27 +76,34 @@   | Echo   | Plan   | Test-  deriving (Bounded, Enum, Eq, Show)--{- TODO: Use ↑ and ↓ to see previous and current input text-data Text =-  Text-    { prev :: [String]-    , curr ::  String-    , next :: [String]-    }--}+  deriving (Bounded, Enum, Eq, Read, Show)  type Load a =   Data a   => Maybe a +data History =+  History+    { view :: Bool+    , prev :: [String]+    , next :: [String]+    }++type Index = Int++type Numbers = Bool++type Filter = String+ data Context a =   Context     { exit :: Bool     , mode :: Mode-    -- , text :: Text     , load :: Load a+    , hist :: History+    , list :: Maybe Filter+    , safe :: Maybe Filter+    , file :: Maybe (Index, Numbers)     }  type Eval a =@@ -110,7 +129,8 @@     hSetBuffering stderr NoBuffering     hSetBuffering stdin  NoBuffering     hSetBuffering stdout NoBuffering-    hSetEcho      stdin  False -- NOTE: No default output when typing+    -- NOTE: No default output when typing+    hSetEcho      stdin  False     putStrLn head >> hFlush stdout     run $ loop ctx proc     where@@ -119,49 +139,151 @@           { exit = False           , mode = mod           , load = Nothing+          , hist =+            History+              { view = False+              , prev = []+              , next = []+              }+          , list = Nothing+          , safe = Nothing+          , file = Nothing           }  --------------------------------------------------------------------------------  -- HELPERS +{- NOTE: Doesn't seem to work+ctrlC :: IO () -> IO ()+ctrlC task =+  -- NOTE: Catch CTRL+C+  -- https://neilmitchell.blogspot.com/2015/05/handling-control-c-in-haskell.html+  sync . (:[]) <$> fork task+-}+ loop   :: Context a   -> Eval a   -> RIO () loop ctx eval =-  if exit ctx then-    return ()-  else-    print prompt >>-    read         >>= \ txt ->-    case txt of-      "/exit"      ->-        printLn  [] >>-        printLn "Λ-gent will shutdown" >>-        loop (ctx { exit = True }) eval-      "/help"      ->-        printLn [ ]  >>-        printLn help >>-        loop ctx eval-      "/mode chat" ->-        printLn [ ] >>-        printLn "Changed to chat-mode" >>-        loop (ctx { mode = Chat }) eval-      "/mode code" ->-        printLn [ ] >>-        printLn "Changed to code-mode" >>-        loop (ctx { mode = Code }) eval-      "/mode echo" ->-        printLn [ ] >>-        printLn "Changed to echo-mode" >>-        loop (ctx { mode = Echo }) eval-      ____________ ->-       eval    ctx txt >>= \ (upd, res) ->-       printLn [ ]     >>-       printLn res     >>-       loop    upd eval+  case ctx of+    Context { exit = True }                    ->+      return ()+    Context { hist = History { view = True } } ->+      eval    ctx [ ] >>= \ (upd, res) ->+      printLn res     >>+      loop (upd { hist = ((hist ctx) { view = False }) }) eval+    Context { list = Just _ } ->+      eval    ctx [ ] >>= \ (upd, res) ->+      printLn res     >>+      loop (upd { list = Nothing, safe = list ctx }) eval+    Context { file = Just _, safe = Just _ }   ->+      eval    ctx [ ] >>= \ (upd, res) ->+      printLn res     >>+      loop (upd { file = Nothing }) eval+    __________________________________________ ->+      print prompt >>+      read hps hns >>= \ txt ->+      printLn [ ]  >>+      case txt of+        '/':'m':'o':'d':'e':' ':c:cs -> caseMode txt c cs+        '/':'m'            :' ':c:cs -> caseMode txt c cs+        '/':'f':'i':'l':'e'    :midx -> caseFile txt midx+        '/':'f'                :midx -> caseFile txt midx+        '/':'n':'u':'m':'s'    :midx -> caseNums txt midx+        '/':'n'                :midx -> caseNums txt midx+        '/':'l':'i':'s':'t'    :mfil -> caseList txt mfil+        '/':'l'                :mfil -> caseList txt mfil+        "/safe"                      -> caseSafe txt+        "/s"                         -> caseSafe txt+        "/hist"                      -> caseHist txt+        "/h"                         -> caseHist txt+        "/wipe"                      -> caseWipe txt+        "/w"                         -> caseWipe txt+        "/help"                      -> caseHelp txt+        "/?"                         -> caseHelp txt+        "/exit"                      -> caseExit txt+        "/e"                         -> caseExit txt+        '/':cmd                      ->+          printLn msg >>+          loop (nxt txt ctx) eval+          where+            msg = "Command not recognized: " ++ cmd+        ____________________________ ->+          eval    ctx txt >>= \ (upd, res) ->+          printLn res     >>+          loop (nxt txt upd) eval+      where+        his     = hist ctx+        hps     = prev his+        hns     = next his+        nxt p c = c { hist = (hist c) { prev = p : hps } }+        -- NOTE: Enforce DRY in cases+        caseMode txt c cs =+          case mmod of+            Just mod ->+              printLn ("Changed to " ++ low ++ "-mode") >>+              loop (nxt txt (ctx { mode = mod, safe = Nothing })) eval+              where+                low = map toLower $ show mod+            Nothing ->+              printLn ("Invalid mode: " ++ c:cs) >>+              loop (nxt txt ctx) eval+          where+            mmod = readMaybe (toUpper c : map toLower cs) :: Maybe Mode+        caseFile txt midx =+          case lst of+            Just _ ->+              loop (nxt txt (ctx { file = (, False) <$> idx })) eval+            Nothing ->+              printLn ("Invalid index") >>+              loop (nxt txt ctx) eval+          where+            lst = safe ctx+            idx =+              case midx of+                [    ] -> Nothing+                ' ':cs -> readMaybe cs :: Maybe Int+                ______ -> Nothing+        caseNums txt midx =+          case lst of+            Just _ ->+              loop (nxt txt (ctx { file = (, True) <$> idx })) eval+            Nothing ->+              printLn ("Invalid index") >>+              loop (nxt txt ctx) eval+          where+            lst = safe ctx+            idx =+              case midx of+                [    ] -> Nothing+                ' ':cs -> readMaybe cs :: Maybe Int+                ______ -> Nothing+        caseList txt mfil =+          loop (nxt txt (ctx { list = fil })) eval+          where+            fil =+              case mfil of+                [    ] -> Just mfil+                ' ':cs -> Just cs+                ______ -> Nothing+        caseSafe txt =+          loop (nxt txt (ctx { list = safe ctx })) eval+        caseHist txt =+          loop (nxt txt (ctx { hist = his { view = True } })) eval+        caseWipe txt =+          -- NOTE: Clear screen & Move top-left+          printLn clear >>+          loop (nxt txt ctx) eval+        caseHelp txt =+          printLn help >>+          loop (nxt txt ctx) eval+        caseExit txt =+          printLn "Λ-gent will shutdown" >>+          loop (nxt txt (ctx { exit = True })) eval     where+      clear     = "\ESC[H\ESC[2J" -- NOTE: See `infocmp -x`       prompt    = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> "       read      = input       print     = output@@ -173,13 +295,19 @@  head :: String head =-  "# Quit Λ-gent with `/exit`. For more commands, type `/help`."+  "# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."  help :: String help =-  "# Supported commands\n" ++-  "* /help : This message\n" ++-  "* /exit : Quit Λ-gent\n" ++-  "* /mode : Change mode to {" ++ ms ++ "}`. Ex:`/mode code`"+  "# Supported commands:\n" +++  "/?   or /help   | This message\n" +++  "/e   or /exit   | Exit Λ-gent\n" +++  "/w   or /wipe   | Clear screen\n" +++  "/m   or /mode   | Change to {" ++ ms ++ "}. Ex: /m code\n" +++  "/h   or /hist   | View input history\n" +++  "/s   or /safe   | Show stored list of files. See /list below\n" +++  "/l f or /list f | List of files, limited by mode, file masks and filter\n" +++  "/f i or /file i | Show file with the given index. See, /safe above\n" +++  "/n i or /nums i | Show file with line numbers. See /file above"   where     ms = foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes

@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -Wall -Werror #-}++{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}++{-# LANGUAGE LambdaCase                   #-}++--------------------------------------------------------------------------------++-- |+-- 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.Code+  ( -- * Files+    files+  , file+  )+where++--------------------------------------------------------------------------------++import           Data.Either        ( fromRight )++import qualified Agent.IO.Effects   as EFF+import qualified Agent.Utils.Common as COM++--------------------------------------------------------------------------------++files+  :: EFF.LlmCodeRead rio+  => Maybe String+  -> rio [ String ]+files mfilter =+  filesHelper mfilter True++file+  :: EFF.LlmCodeRead rio+  => Maybe String+  -> Int+  -> Bool+  -> rio (Either String String)+file mfilter index nums =+  filesHelper mfilter False >>= \ fs ->+  if length fs > index && index >= 0 then+    ( \case+        Right f -> Right $ COM.file nums f+        Left  e -> Left e+    )+    <$> EFF.llmCodeGet (fs !! index)+  else+    pure $ Left msg+    where+      msg = "Index (" ++ show index ++ ") is out of bounds. See /last"++--------------------------------------------------------------------------------++-- HELPERS (private)++filesHelper+  :: EFF.LlmCodeRead rio+  => Maybe String+  -> Bool+  -> rio [ String ]+filesHelper mfilter nums =+  (COM.files nums) . fromRight [] <$> EFF.llmCodeSeq mfilter

@@ -0,0 +1,81 @@+{-# 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 <mail+hackage@spisemisu.com>+-- Stability  : experimental++--------------------------------------------------------------------------------++module Agent.Utils.Common+  ( -- * Files+    files+  , file+    -- * Helpers+  , leftpad+  , index+  )+where++--------------------------------------------------------------------------------++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++files+  :: Bool+  -> [ String ]+  -> [ String ]+files nums fs =+  if null fs then+    []+  else+    map (\ (idx, rel) -> f idx rel)+    $ zip [0..] fs+    where+      len   = length $ show $ length fs+      f i x =+        if nums then+          index len i ++ ": " ++ x+        else+          x++file+  :: Bool+  -> String+  -> String+file nums f =+  if null f then+    []+  else+    unlines+    $ map (\ (idx, rel) -> g idx rel)+    $ zip [1..] ls+    where+      ls    = lines f+      len   = length $ show $ length ls+      g i x =+        if nums then+          index len i ++ ": " ++ x+        else+          x

@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -Wall -Werror #-}++{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}++{-# LANGUAGE LambdaCase                   #-}++--------------------------------------------------------------------------------++-- |+-- 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.Plan+  ( -- * Files+    files+  , file+  )+where++--------------------------------------------------------------------------------++import           Data.Either        ( fromRight )++import qualified Agent.IO.Effects   as EFF+import qualified Agent.Utils.Common as COM++--------------------------------------------------------------------------------++files+  :: EFF.LlmPlanRead rio+  => Maybe String+  -> rio [ String ]+files mfilter =+  filesHelper mfilter True++file+  :: EFF.LlmPlanRead rio+  => Maybe String+  -> Int+  -> Bool+  -> rio (Either String String)+file mfilter index nums =+  filesHelper mfilter False >>= \ fs ->+  if length fs > index && index >= 0 then+    ( \case+        Right f -> Right $ COM.file nums f+        Left  e -> Left e+    )+    <$> EFF.llmPlanGet (fs !! index)+  else+    pure $ Left msg+    where+      msg = "Index (" ++ show index ++ ") is out of bounds. See /last"++--------------------------------------------------------------------------------++-- HELPERS (private)++filesHelper+  :: EFF.LlmPlanRead rio+  => Maybe String+  -> Bool+  -> rio [ String ]+filesHelper mfilter nums =+  (COM.files nums) . fromRight [] <$> EFF.llmPlanSeq mfilter