A-gent 0.11.0.7 → 0.11.0.8

raw patch · 11 files changed

+1981/−1375 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 +8/−3
• CHANGELOG.md +57/−8
• src/Agent/Data/ANSI/EscapeCode.hs +217/−0
• src/Agent/IO/Effects.hs +13/−7
• src/Agent/IO/Restricted.hs +80/−1126
• src/Agent/LLM.hs +240/−124
• src/Agent/Utils/Code.hs +0/−70
• src/Agent/Utils/Common.hs +46/−27
• src/Agent/Utils/Plan.hs +0/−70
• src/Internal/LLM.hs +165/−0
• src/Internal/RIO.hs +1215/−0

@@ -9,7 +9,7 @@ build-type: Simple                                                name: A-gent-version: 0.11.0.7+version: 0.11.0.8  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@@ -141,23 +141,28 @@   hs-source-dirs:       src   other-modules:+      -- error: [GHC-87110]+      -- Could not load module ‘Internal.…’.+      -- it is a hidden module in the package ‘A-gent-0.11.0.…’       Internal.GaloisInc.Text.JSON       Internal.GaloisInc.Text.JSON.Generic       Internal.GaloisInc.Text.JSON.String       Internal.GaloisInc.Text.JSON.Types       --       Internal.GlasgowUniversity.Data.Generics.Aliases+      --+      Internal.LLM+      Internal.RIO   exposed-modules:       Agent.Control.Concurrent       Agent.Control.IFC       Agent.Control.MAC+      Agent.Data.ANSI.EscapeCode       --       Agent.IO.Effects       Agent.IO.Restricted       --       Agent.Utils.Common-      Agent.Utils.Code-      Agent.Utils.Plan       --       Agent.JSON       --

@@ -1,7 +1,56 @@ # Revision history for Λ-gent -## 0.11.0.7  -- 2026-03-30+## 0.11.0.8 -- 2026-04-15 +* Refactored `/pile` to no longer storing a `find` filter but the absolute path+  to the `find` results.+  +  > **NOTE:** Even though absolute path is stored, only relative will be shown.+  +* `/list` performance has been improved instead of performing the filters with+  Haskell, it's now passed to the `find` command.+  +* Added logic to request `ISO-8601` timestamps (`UTC`) that are file path safe.++* Added to website, info tab, a guide on how to setup LSP support for IDE's:++  * https://a-gent.org/info.html#lsp-support-for-ides+  +* Due to future `git-worktree` usage, the folder `/tmp/` MUST exist in the root+  of the project and it needs to be added to the `.gitignore` file to avoid+  `GIT` collisions.+  +* Added `Internal.RIO` so the application can execute `RestrictedIO`, but,+  consumers of the `Λ-gent` package will NOT.++* All `Context` properties, except `load`, have now `internal` constructor+  types. This will ensure that we will know that they have been instantiated by+  the `Λ-gents`.+  +* From `0.11.0.6 -- 2026-03-20` below:+  +  > **NOTE**: Fix is not verified. Well, this update will confirm (or not).+  +  * Package is NO longer marked as broken: <https://github.com/NixOS/nixpkgs/blob/haskell-updates/pkgs/development/haskell-modules/configuration-hackage2nix/broken.yaml»++* Added `withExitCodeStdIn` as `curl` has a limit on data that can be sent as a+  parameter.++* A `Agent.Data.ANSI.EscapeCode` module has been added to help distinguish+  between input/output.++* `/send` (`/s`) has been added to provide the capability of sending `/pile`+  files as context to messages sent to LLM's.++* `repl` and `replWithMode` now need to provide an optional value for the+  projects `rootPath`. This refactoring has been added to ease logic+  implementation for the `Λ-gent` package.+  +  > **NOTE**: Changes to current existing Λ-gent scripts can be done by just+  > post-fixing `Nothing`. Example: `replWithMode Echo eval Nothing`++## 0.11.0.7 -- 2026-03-30+ * We seem to have fixed multi-line issues. I guess we can say that we are   probably as good as `GHCi`.   @@ -21,7 +70,7 @@        * `CTRL + D` equivalent to `DELETE`. -## 0.11.0.6  -- 2026-03-20+## 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.@@ -51,11 +100,11 @@ * 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+## 0.11.0.5 -- 2026-03-08  * `ENTER` only triggers if something is typed. -## 0.11.0.4  -- 2026-03-08+## 0.11.0.4 -- 2026-03-08  * Fixed the `BUG` when trying to print emojii's ('🍎', '🍏', …): @@ -66,7 +115,7 @@   by adding `setLocaleEncoding utf8` to `replWithMode`. Now instead of crashing,   invalid `UTF-8` characters will just be shown as single or multiple `?`. -## 0.11.0.3  -- 2026-03-06+## 0.11.0.3 -- 2026-03-06  * Made `read` usable by providing support for: @@ -77,7 +126,7 @@        * Move to start and end of the text with `HOME` and `END`. -## 0.11.0.2  -- 2026-03-05+## 0.11.0.2 -- 2026-03-05  * Fixed issue with Hackage. The project now builds for:   * `ghc-9.4.8`@@ -86,12 +135,12 @@   * `ghc-9.10.3`   * `ghc-9.12.2` -## 0.11.0.1  -- 2026-03-05+## 0.11.0.1 -- 2026-03-05  * Issue with Hackage. Since the service builds with `9.8.4` we have to comply   with that. -## 0.11.0.0  -- 2026-03-04+## 0.11.0.0 -- 2026-03-04  * Initial release after feedback from the NixOS Copenhagen User Group, March   meetup: <https://www.meetup.com/nixos-copenhagen-user-group/events/313205865/>

@@ -0,0 +1,217 @@+{-# 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.Data.ANSI.EscapeCode+  ( Colour+    ( Black+    , Red+    , Green+    , Yellow+    , Blue+    , Magenta+    , Cyan+    , White+    )+  , Frecuency+    ( Slow+    , Fast+    )+  --+  , sgr+  --+  , foreground+  , background+  , bold+  , faint+  , italic+  , underline+  , blink+  )+where++--------------------------------------------------------------------------------++data Colour+  = Black+  | Red+  | Green+  | Yellow+  | Blue+  | Magenta+  | Cyan+  | White+  deriving (Eq)++instance Enum Colour where+  fromEnum Black   = 0+  fromEnum Red     = 1+  fromEnum Green   = 2+  fromEnum Yellow  = 3+  fromEnum Blue    = 4+  fromEnum Magenta = 5+  fromEnum Cyan    = 6+  fromEnum White   = 7++  toEnum 0 = Black+  toEnum 1 = Red+  toEnum 2 = Green+  toEnum 3 = Yellow+  toEnum 4 = Blue+  toEnum 5 = Magenta+  toEnum 6 = Cyan+  toEnum 7 = White+  toEnum _ = error "Colour code not supported"++type Bright = Bool++data Background = BG !Bool Bright Colour+data Foreground = FG !Bool Bright Colour++data Frecuency+  = Slow+  | Fast++data Blink = B !Bool Frecuency++data SelectGraphicRendition+  = SGR !Background !Foreground !Bool !Bool !Bool !Bool !Blink String++instance Show SelectGraphicRendition where+  show (SGR bg fg bo fa it un bl text) =+    "\ESC[" +++    "0"     +++    (cb bg) +++    (cf fg) +++    (fb bo) +++    (ff fa) +++    (fi it) +++    (fu un) +++    (bf bl) +++    "m"     +++    text    +++    "\ESC[00m"+    where+      cb (BG True  True  c) = ";" ++ (show $ 60 + 40 + fromEnum c)+      cb (BG True  False c) = ";" ++ (show $      40 + fromEnum c)+      cb (BG False _____ _) = [                                  ]+      cf (FG True  True  c) = ";" ++ (show $ 60 + 30 + fromEnum c)+      cf (FG True  False c) = ";" ++ (show $      30 + fromEnum c)+      cf (FG False _____ _) = [                                  ]+      fb     True  = ";01"+      fb     False = [   ]+      ff     True  = ";02"+      ff     False = [   ]+      fi     True  = ";03"+      fi     False = [   ]+      fu     True  = ";04"+      fu     False = [   ]+      bf (B  True  Slow) = ";05"+      bf (B  True  Fast) = ";06"+      bf (B  False ____) = [   ]++--------------------------------------------------------------------------------++sgr+  :: String+  -> SelectGraphicRendition++foreground+  :: Bright+  -> Colour+  -> SelectGraphicRendition+  -> SelectGraphicRendition++background+  :: Bright+  -> Colour+  -> SelectGraphicRendition+  -> SelectGraphicRendition++bold+  :: SelectGraphicRendition+  -> SelectGraphicRendition++faint+  :: SelectGraphicRendition+  -> SelectGraphicRendition++italic+  :: SelectGraphicRendition+  -> SelectGraphicRendition++underline+  :: SelectGraphicRendition+  -> SelectGraphicRendition++blink+  :: Frecuency+  -> SelectGraphicRendition+  -> SelectGraphicRendition++--------------------------------------------------------------------------------+sgr =+  SGR bg fg bo fa it un bl+  where+    fg = FG False undefined undefined+    bg = BG False undefined undefined+    bo = False+    fa = False+    it = False+    un = False+    bl = B False undefined++--------------------------------------------------------------------------------++foreground b c (SGR bg __ bo fa it un bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    fg = FG True b c++background b c (SGR __ fg bo fa it un bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    bg = BG True b c++bold (SGR bg fg __ fa it un bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    bo = True++faint (SGR bg fg bo __ it un bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    fa = True++italic (SGR bg fg bo fa __ un bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    it = True++underline (SGR bg fg bo fa it __ bl txt) =+  SGR bg fg bo fa it un bl txt+  where+    un = True++blink f (SGR bg fg bo fa it un __ txt) =+  SGR bg fg bo fa it un bl txt+  where+    bl = B True f++--------------------------------------------------------------------------------++-- References+--+-- ANSI escape code:+-- * https://en.wikipedia.org/wiki/ANSI_escape_code#SGR_parameters

@@ -35,12 +35,17 @@  -------------------------------------------------------------------------------- ++import qualified Internal.LLM as LLM++--------------------------------------------------------------------------------+ class   Monad m   => LlmConf m   where     llmPathCWD-      :: m (Maybe String)+      :: m (Maybe LLM.Root)  -------------------------------------------------------------------------------- --------------------------------------------------------------------------------@@ -93,11 +98,11 @@   => LlmCodeRead m   where     llmCodeSeq-      :: Maybe String-      -> m (Either String [ String ])+      :: Maybe LLM.Filter+      -> m (Either [String] LLM.Files)     llmCodeGet       :: String-      -> m (Either String String)+      -> m (Either String LLM.File)  -------------------------------------------------------------------------------- @@ -136,15 +141,16 @@   ( LlmConf m   , LlmPlanRoot m   , LlmPlanMask m+  , LlmCodeRead m   )   => LlmPlanRead m   where     llmPlanSeq-      :: Maybe String-      -> m (Either String [ String ])+      :: Maybe LLM.Filter+      -> m (Either [String] LLM.Files)     llmPlanGet       :: String-      -> m (Either String String)+      -> m (Either String LLM.File)  -------------------------------------------------------------------------------- 

@@ -3,1129 +3,83 @@ {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe                         #-} -{-# LANGUAGE FlexibleContexts             #-}-{-# LANGUAGE UndecidableInstances         #-}--{-# LANGUAGE MonoLocalBinds               #-}--{-# 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------ Safe {H}askell------ https://simonmar.github.io/bib/safe-haskell-2012_abstract.html------ (David Terei, David Mazières, Simon Marlow, Simon Peyton Jones) Haskell ’12:--- Proceedings of the Fifth ACM SIGPLAN Symposium on Haskell, Copenhagen,--- Denmark, ACM, 2012------ Though Haskell is predominantly type-safe, implementations contain a few--- loopholes through which code can bypass typing and module encapsulation. This--- paper presents Safe Haskell, a language extension that closes these--- loopholes. Safe Haskell makes it possible to confine and safely execute--- untrusted, possibly malicious code. By strictly enforcing types, Safe Haskell--- allows a variety of different policies from API sandboxing to--- information-flow control to be implemented easily as monads. Safe Haskell is--- aimed to be as unobtrusive as possible. It enforces properties that--- programmers tend to meet already by convention. We describe the design of--- Safe Haskell and an implementation (currently shipping with GHC) that infers--- safety for code that lies in a safe subset of the language. We use Safe--- Haskell to implement an online Haskell interpreter that can securely execute--- arbitrary untrusted code with no overhead. The use of Safe Haskell greatly--- simplifies this task and allows the use of a large body of existing code and--- tools.------------------------------------------------------------------------------------module Agent.IO.Restricted-  ( RIO ()-  , run-    -- * Environment-  , getEnvVar-    -- * Read/Print-  , input-  , output-    -- * LLM (Config)-  , llmPathCWD-    -- * LLM (Chat)-  , llmChatKey, llmChatAPI-  , llmChatWeb-    -- * LLM (Code)-  , llmCodeDir-  , llmCodeMsk-  , llmCodeSeq, llmCodeGet-    -- * LLM (Plan)-  , llmPlanDir-  , llmPlanMsk-  , llmPlanSeq, llmPlanGet-  , llmPlanKey, llmPlanAPI-  , llmPlanWeb-  )-where------------------------------------------------------------------------------------import           Data.Either              ( partitionEithers )-import           Data.List                ( isInfixOf )-import           Data.Maybe               ( fromMaybe, maybeToList )-import qualified System.Environment.Blank as ENV-import           System.Exit-  ( ExitCode (ExitFailure, ExitSuccess)-  )-import           System.IO                ( hFlush, hReady, stdin, stdout )-import           System.Process-  ( CreateProcess (cwd)-  , proc-  , readCreateProcessWithExitCode-  , readProcessWithExitCode-  )-import           Text.Read                ( readMaybe )--import qualified Agent.IO.Effects         as EFF-import qualified Agent.Utils.Common       as COM-------------------------------------------------------------------------------------newtype RIO a = RestrictedIO { run :: IO a }--instance Functor RIO where-  fmap f m = RestrictedIO $      f <$> run m--instance Applicative RIO where-  pure      = RestrictedIO . pure-  (<*>) f m = RestrictedIO $ run f <*> run m--instance Monad RIO where-  (>>=) m f = RestrictedIO $ run m >>= run . f---------------------------------------------------------------------------------------------------------------------------------------------------------------------data Position =-  Position Int Int-  deriving (Eq, Show)--instance Ord Position where-  (<=) (Position y1 x1) (Position y2 x2) =-    case compare y1 y2 of-      GT -> False-      EQ -> x1 <= x2-      LT -> True--instance Read Position where-  readsPrec _ str =-    -- NOTE:-    -- "\ESC[#;#R" => "\ESC" and "[#;#R" (only parse last)-    maybeToList-    ( readMaybe (f str) >>= \ y ->-      readMaybe (g str) >>= \ x ->-        Just-          ( Position y x-          , h str-          )-    )-    where-      f = takeWhile (/= ';') . drop 1 . dropWhile (/= '[')-      g = takeWhile (/= 'R') . drop 1 . dropWhile (/= ';')-      h = drop 1 . dropWhile (/= 'R') . dropWhile (/= ';') . dropWhile (/= '[')------------------------------------------------------------------------------------data MultiLine =-  MultiLine-    { stx :: Maybe Position-    , cur :: Maybe Position-    , etx :: Maybe Position-    , col :: Int-    }-  deriving Show---------------------------------------------------------------------------------------------------------------------------------------------------------------------class StdIn m where-  input-    :: [ String ]-    -> [ String ]-    -> m String--class StdOut m where-  output-    :: String-    -> m ()------------------------------------------------------------------------------------instance StdIn RIO where-  -- BUG: Issue with multiline text-  input prev next =-    -- NOTE: "\ESC7" - save cursor position (SCO)-    -- - https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797#cursor-controls-    RestrictedIO $ putStr "\ESC7" >> aux gen prev next [] []-    where-      msv = 32767 :: Int-      gen =-        MultiLine-          { stx = Nothing-          , cur = Nothing-          , etx = Nothing-          , col = 0-          }-      aux mlp hps hns bcs acs =-        key >>= \ k ->-        case (k < ['\32'], k) of-          (True , ['\^H']) ->-            case bcs of-              -- NOTE: CTRL + H or Backspace (remove char if any and re-write-              -- after chars)-              [    ] -> aux mlp hps hns bcs acs-              (_:cs) ->-                hFlush stdout >>-                -- NOTE: 0) Print "\ESC[6n" position before action-                putStr "\ESC[6n" >>-                -- NOTE: Remove char-                putChar '\^H'    >>-                -- NOTE: Save position-                putStr "\ESC7"   >>-                -- NOTE: Clear rest of screen from position-                putStr "\ESC[0J" >>-                -- NOTE: Print after chars-                putStr  acs      >>-                -- NOTE: 1) Print "\ESC[6n" end position after action-                putStr "\ESC[6n" >>-                -- NOTE: 2) Print "\ESC[6n" column witdh-                putStr ("\ESC[" ++ show msv ++ "C") >>-                putStr "\ESC[6n"                    >>-                -- NOTE: Go back to saved position-                putStr "\ESC8"   >>-                -- NOTE: 3) Print "\ESC[6n" current position after action-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp hps hns cs acs-          (True , ['\^J']) ->-            -- NOTE: ENTER (line feed) only if something is typed-            case (bcs, acs) of-              ([], []) ->-                aux mlp hps hns bcs acs-              ________ ->-                pure $ (++ acs) $ reverse $ bcs-          (True , ['\^L']) ->-            -- NOTE: CTRL + L (form feed) becomes "/w" (clear screen)-            pure $ "/wipe"-          (True , ['\^U']) ->-            -- NOTE: CTRL + U cut text to start-            hFlush stdout >>-            -- NOTE: 0) Print "\ESC[6n" position before action-            putStr "\ESC[6n" >>-            -- NOTE: Go back to start of line-            putStr hom >> hFlush stdout >>-            -- NOTE: Save position-            putStr "\ESC7"   >>-            -- NOTE: Clear rest of screen from position-            putStr "\ESC[0J" >>-            -- NOTE: Print after chars-            putStr  acs      >>-            -- NOTE: 1) Print "\ESC[6n" end position after action-            putStr "\ESC[6n" >>-            -- NOTE: 2) Print "\ESC[6n" column witdh-            putStr ("\ESC[" ++ show msv ++ "C") >>-            putStr "\ESC[6n"                    >>-            -- NOTE: Go back to saved position-            putStr "\ESC8"   >>-            -- NOTE: 3) Print "\ESC[6n" current position after action-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mlp hps hns [] acs-            where-              hom =-                case mlp of-                  MultiLine { stx = Just (Position y x) } ->-                    "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                  _______________________________________ ->-                    "\ESC8"-          (True , ['\^K']) ->-            -- NOTE: CTRL + K cut text to end-            hFlush stdout >>-            -- NOTE: 0) Print "\ESC[6n" position before action-            putStr "\ESC[6n" >>-            -- NOTE: Save position-            putStr "\ESC7"   >>-            -- NOTE: Clear rest of screen from position-            putStr "\ESC[0J" >>-            -- NOTE: 1) Print "\ESC[6n" end position after action-            putStr "\ESC[6n" >>-            -- NOTE: 2) Print "\ESC[6n" column witdh-            putStr ("\ESC[" ++ show msv ++ "C") >>-            putStr "\ESC[6n"                    >>-            -- NOTE: Go back to saved position-            putStr "\ESC8"   >>-            -- NOTE: 3) Print "\ESC[6n" current position after action-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mlp hps hns bcs []-          (True , ['\ESC','[','H']) ->-            -- NOTE: HOME-            ---            -- NOTE: Move to start of text-            putStr hom       >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mln hps hns [] (reverse bcs ++ acs)-            where-              (mln, hom) =-                case mlp of-                  MultiLine { stx = Just (Position y x) } ->-                    ( mlp { cur = Just (Position y x) }-                    , "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                    )-                  _______________________________________ ->-                    ( mlp-                    , "\ESC8"-                    )-          (True , ['\ESC','[','F']) ->-            -- NOTE: END-            ---            -- NOTE: Move to end of text-            hFlush stdout >>-            putStr hom       >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mln hps hns ((++ bcs) $ reverse $ acs) []-            where-              (mln, hom) =-                case mlp of-                  MultiLine { etx = Just (Position y x) } ->-                    ( mlp { cur = Just (Position y x) }-                    , "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                    )-                  _______________________________________ ->-                    ( mlp-                    , "\ESC8"-                    )-          (True , ['\^A']) ->-            -- NOTE: CTRL + A to move to start of text-            ---            -- TODO: DRY as equal to HOME-            -- NOTE: Move to start of text-            hFlush stdout >>-            putStr hom       >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mln hps hns [] ((reverse bcs) ++ acs)-            where-              (mln, hom) =-                case mlp of-                  MultiLine { stx = Just (Position y x) } ->-                    ( mlp { cur = Just (Position y x) }-                    , "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                    )-                  _______________________________________ ->-                    ( mlp-                    , "\ESC8"-                    )-          (True , ['\^E']) ->-            -- NOTE: CTRL + E to move to end of text-            ---            -- TODO: DRY as equal to END-            -- NOTE: Move to end of text-            hFlush stdout >>-            putStr hom    >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mln hps hns ((++ bcs) $ reverse acs) []-            where-              (mln, hom) =-                case mlp of-                  MultiLine { etx = Just (Position y x) } ->-                    ( mlp { cur = Just (Position y x) }-                    , "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                    )-                  _______________________________________ ->-                    ( mlp-                    , "\ESC8"-                    )-          (True , ['\ESC','[','A']) ->-            -- NOTE: Allowed escaped sequences: Arrow "↑"-            case (hps, hns) of-              ([  ], _) -> aux mlp hps hns bcs acs-              (p:ps, _) ->-                hFlush stdout >>-                -- NOTE: 0) Print "\ESC[6n" position before action-                putStr "\ESC[6n" >>-                -- NOTE: Move to start of text-                putStr hom       >>-                -- NOTE: Print previous line-                putStr p >>-                -- NOTE: Save position-                putStr "\ESC7"   >>-                -- NOTE: Clear rest of screen from position-                putStr "\ESC[0J" >>-                -- NOTE: Print after chars-                putStr  []       >>-                -- NOTE: 1) Print "\ESC[6n" end position after action-                putStr "\ESC[6n" >>-                -- NOTE: 2) Print "\ESC[6n" column witdh-                putStr ("\ESC[" ++ show msv ++ "C") >>-                putStr "\ESC[6n"                    >>-                -- NOTE: Go back to saved position-                putStr "\ESC8"   >>-                -- NOTE: 3) Print "\ESC[6n" current position after action-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp ps (p:hns) rev []-                where-                  rev = reverse p-                  hom =-                    case mlp of-                      MultiLine { stx = Just (Position y x) } ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                      _______________________________________ ->-                        "\ESC8"-          (True , ['\ESC','[','B']) ->-            -- NOTE: Allowed escaped sequences: Arrow "↓"-            case (hps, hns) of-              (_, [  ]) -> aux mlp hps hns bcs acs-              (_, p:ps) ->-                hFlush stdout >>-                -- NOTE: 0) Print "\ESC[6n" position before action-                putStr "\ESC[6n" >>-                -- NOTE: Move to start of text-                putStr hom       >>-                -- NOTE: Print previous line-                putStr p >>-                -- NOTE: Save position-                putStr "\ESC7"   >>-                -- NOTE: Clear rest of screen from position-                putStr "\ESC[0J" >>-                -- NOTE: Print after chars-                putStr  []       >>-                -- NOTE: 1) Print "\ESC[6n" end position after action-                putStr "\ESC[6n" >>-                -- NOTE: 2) Print "\ESC[6n" column witdh-                putStr ("\ESC[" ++ show msv ++ "C") >>-                putStr "\ESC[6n"                    >>-                -- NOTE: Go back to saved position-                putStr "\ESC8"   >>-                -- NOTE: 3) Print "\ESC[6n" current position after action-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp (p:hps) ps rev []-                where-                  rev = reverse p-                  hom =-                    case mlp of-                      MultiLine { stx = Just (Position y x) } ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                      _______________________________________ ->-                        "\ESC8"-          (True , ['\ESC','[','C']) ->-            -- NOTE: Allowed escaped sequences: Arrow "→"-            case (bcs, acs) of-              (_, [  ]) ->-                aux mlp hps hns    bcs  acs-              (_, c:cs) ->-                hFlush stdout >>-                ( if pl then-                    putStr ("\ESC[" ++ "1" ++ "E")-                  else-                    putStr k-                ) >>-                -- NOTE: Update current position-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp hps hns (c:bcs) cs-                where-                  pl =-                    case mlp of-                      MultiLine-                        { cur = Just (Position cy cx)-                        , etx = Just (Position ey __)-                        , col = cw-                        } -> cy <= ey && cx == cw-                      ___ -> False-          (True , ['\ESC','[','D']) ->-            -- NOTE: Allowed escaped sequences: Arrow "←"-            case (bcs, acs) of-              ([  ], _) ->-                aux mlp hps hns bcs    acs-              (c:cs, _) ->-                hFlush stdout >>-                ( if pl then-                    putStr ("\ESC[" ++      "1" ++ "F") >>-                    putStr ("\ESC[" ++ show msv ++ "C")-                  else-                    putStr k-                ) >>-                -- NOTE: Update current position-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp hps hns  cs (c:acs)-                where-                  pl =-                    case mlp of-                      MultiLine-                        { stx = Just (Position sy __)-                        , cur = Just (Position cy 01)-                        } -> sy < cy-                      ___ -> False--          (True , ['\ESC','[','1',';','5','C']) ->-            -- NOTE: Allowed escaped sequences: CTRL + Arrow "→"-            -- NOTE: Move to end of text-            hFlush stdout    >>-            putStr np        >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mlp hps hns (ts ++ bcs) ds-            where-              ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs-              ts = drop (length ds) $ reverse acs-              lc = length ts-              np =-                case mlp of-                  MultiLine-                    { cur = Just (Position cy cx)-                    , etx = Just (Position ey _ )-                    , col = cw-                    } ->-                    case (cy < ey, compare (cw - cx) lc) of-                      (True, LT) ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                        where-                          y = cy + 1-                          x = lc - (cw - cx)-                      __________ ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                        where-                          y = cy-                          x = cx + lc-                  ___ -> []--          (True , ['\ESC','[','1',';','5','D']) ->-            -- NOTE: Allowed escaped sequences: CTRL + Arrow "←"-            hFlush stdout    >>-            putStr np        >>-            -- NOTE: Update current position-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mlp hps hns ds (ts ++ acs)-            where-              ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs-              ts = drop (length ds) $ reverse bcs-              lc = length ts-              np =-                case mlp of-                  MultiLine-                    { stx = Just (Position sy _ )-                    , cur = Just (Position cy cx)-                    , col = cw-                    } ->-                    case (sy < cy, compare cx lc) of-                      (True, LT) ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                        where-                          y = cy - 1-                          x = cw - (lc - cx)-                      __________ ->-                        "\ESC[" ++ show y ++ ";" ++ show x ++ "H"-                        where-                          y = cy-                          x = cx - lc-                  ___ -> []-          (True , ['\ESC','[','3','~']) ->-            -- NOTE: CTRL + D behave as delete key-            -- TODO: Use DRY-            case acs of-              -- NOTE: Delete (remove char if any and re-write after chars)-              [    ] -> aux mlp hps hns bcs acs-              (_:cs) ->-                hFlush stdout >>-                -- NOTE: 0) Print "\ESC[6n" position before action-                putStr "\ESC[6n" >>-                -- NOTE: Save position-                putStr "\ESC7"   >>-                -- NOTE: Clear rest of screen from position-                putStr "\ESC[0J" >>-                -- NOTE: Print after chars-                putStr  cs       >>-                -- NOTE: 1) Print "\ESC[6n" end position after action-                putStr "\ESC[6n" >>-                -- NOTE: 2) Print "\ESC[6n" column witdh-                putStr ("\ESC[" ++ show msv ++ "C") >>-                putStr "\ESC[6n"                    >>-                -- NOTE: Go back to saved position-                putStr "\ESC8"   >>-                -- NOTE: 3) Print "\ESC[6n" current position after action-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp hps hns bcs cs-          (True , ['\^D']) ->-            -- NOTE: CTRL + D behave as delete key-            -- TODO: Use DRY-            case acs of-              -- NOTE: Delete (remove char if any and re-write after chars)-              [    ] -> aux mlp hps hns bcs acs-              (_:cs) ->-                hFlush stdout >>-                -- NOTE: 0) Print "\ESC[6n" position before action-                putStr "\ESC[6n" >>-                -- NOTE: Save position-                putStr "\ESC7"   >>-                -- NOTE: Clear rest of screen from position-                putStr "\ESC[0J" >>-                -- NOTE: Print after chars-                putStr  cs       >>-                -- NOTE: 1) Print "\ESC[6n" end position after action-                putStr "\ESC[6n" >>-                -- NOTE: 2) Print "\ESC[6n" column witdh-                putStr ("\ESC[" ++ show msv ++ "C") >>-                putStr "\ESC[6n"                    >>-                -- NOTE: Go back to saved position-                putStr "\ESC8"   >>-                -- NOTE: 3) Print "\ESC[6n" current position after action-                putStr "\ESC[6n" >> hFlush stdout >>-                aux mlp hps hns bcs cs-          (True , '\ESC':ps) ->-            -- NOTE: Other escaped sequences (skip unless positions)-            aux mln hps hns bcs acs-            where-              ops = map readMaybe $ COM.split '\ESC' ps :: [Maybe Position]-              mln =-                -- NOTE: 0) Print "\ESC[6n" position before action (unused)-                -- NOTE: 1) Print "\ESC[6n" end position after action-                -- NOTE: 2) Print "\ESC[6n" column witdh-                -- NOTE: 3) Print "\ESC[6n" current position after action-                case (mlp, ops) of-                  (___________________________,-                   [                                           ]) ->-                    mlp-                  (MultiLine { stx = Nothing },-                   [Just (Position y x)                        ]) ->-                    mlp-                      { stx = Just sp-                      , cur = Just sp-                      , etx = Just sp-                      , col = x-                      }-                    where-                      sp = Position y x-                  (MultiLine { etx = Just ep },-                   [Just cp                                    ]) ->-                    if cp > ep then-                      mlp-                        { cur = Just cp-                        , etx = Just cp-                        }-                    else-                      mlp-                        { cur = Just cp-                        }-                  (MultiLine { stx = Nothing },-                   [Just sp,Just ep,Just (Position _ w),Just cp]) ->-                    mlp-                      { stx = Just sp-                      , cur = Just cp-                      , etx = Just ep-                      , col = w-                      }-                  (___________________________,-                   [Just __,Just ep,Just (Position _ w),Just cp]) ->-                    mlp-                      { cur = Just cp-                      , etx = Just ep-                      , col = w-                      }-                  _______________________________________________ ->-                    mlp-          (True , _) ->-            aux mlp hps hns bcs acs-          (False, ['\DEL']) ->-            -- NOTE: DELETE (skip)-            aux mlp hps hns bcs acs-          (False, _) ->-            hFlush stdout >>-            -- NOTE: 0) Print "\ESC[6n" position before action-            putStr "\ESC[6n" >>-            -- NOTE: Type key or text-            putStr k         >>-            -- NOTE: Save position-            putStr "\ESC7"   >>-            -- NOTE: Clear rest of screen from position-            putStr "\ESC[0J" >>-            -- NOTE: Print after chars-            putStr  acs      >>-            -- NOTE: 1) Print "\ESC[6n" end position after action-            putStr "\ESC[6n" >>-            -- NOTE: 2) Print "\ESC[6n" column witdh-            putStr ("\ESC[" ++ show msv ++ "C") >>-            putStr "\ESC[6n"                    >>-            -- NOTE: Go back to saved position-            putStr "\ESC8"   >>-            -- NOTE: 3) Print "\ESC[6n" current position after action-            putStr "\ESC[6n" >> hFlush stdout >>-            aux mlp hps hns (reverse k ++ bcs) acs-      key =-        -- NOTE: https://stackoverflow.com/a/38553473-        reverse <$> nxt []-        where-          nxt cs =-            do-              c <- getChar-              m <- hReady stdin-              (if m then nxt else pure) (c:cs)--instance StdOut RIO where-  output x = RestrictedIO $-    putStr x >> hFlush stdout---------------------------------------------------------------------------------------------------------------------------------------------------------------------class-  EFF.LlmConf m-  => LlmConf m-  where-    llmPathCWD-      :: m (Maybe String)--instance-  EFF.LlmConf RIO-  => LlmConf RIO-  where-    llmPathCWD = getEnvVar "LLM_PATH_CWD"---------------------------------------------------------------------------------------------------------------------------------------------------------------------class-  EFF.LlmChatConf m-  => LlmChatConf m-  where-    llmChatAPI-      :: m (Maybe String)-    llmChatKey-      :: m (Maybe String)--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.LlmConf m-  => LlmPlanRoot m-  where-    llmPlanDir-      :: m String--instance-  ( EFF.LlmConf     RIO-  , EFF.LlmPlanRoot RIO-  )-  => LlmPlanRoot RIO-  where-    llmPlanDir = pure "llm"------------------------------------------------------------------------------------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 rp `isInfixOf` 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-        -- NOTE: Relative paths instead of full-        $ map (filter (/= '\NUL') . drop (length path))-        $ 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"-          ]-          ++ hs ++-          [ "--data", json-          , api ++ "/chat/completions"-          ]-        )-    (Just api, Just key) ->-      withExitCode "curl"-        ( [ "--silent"-          , "--show-error"-          , "--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 >>= \cs ->-  length cs `seq` pure cs--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 }+--------------------------------------------------------------------------------++-- |+-- Copyright  : (c) 2026 SPISE MISU ApS+-- License    : SSPL-1.0 OR AGPL-3.0-only+-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>+-- Stability  : experimental+--+-- Safe {H}askell+--+-- https://simonmar.github.io/bib/safe-haskell-2012_abstract.html+--+-- (David Terei, David Mazières, Simon Marlow, Simon Peyton Jones) Haskell ’12:+-- Proceedings of the Fifth ACM SIGPLAN Symposium on Haskell, Copenhagen,+-- Denmark, ACM, 2012+--+-- Though Haskell is predominantly type-safe, implementations contain a few+-- loopholes through which code can bypass typing and module encapsulation. This+-- paper presents Safe Haskell, a language extension that closes these+-- loopholes. Safe Haskell makes it possible to confine and safely execute+-- untrusted, possibly malicious code. By strictly enforcing types, Safe Haskell+-- allows a variety of different policies from API sandboxing to+-- information-flow control to be implemented easily as monads. Safe Haskell is+-- aimed to be as unobtrusive as possible. It enforces properties that+-- programmers tend to meet already by convention. We describe the design of+-- Safe Haskell and an implementation (currently shipping with GHC) that infers+-- safety for code that lies in a safe subset of the language. We use Safe+-- Haskell to implement an online Haskell interpreter that can securely execute+-- arbitrary untrusted code with no overhead. The use of Safe Haskell greatly+-- simplifies this task and allows the use of a large body of existing code and+-- tools.++--------------------------------------------------------------------------------++module Agent.IO.Restricted+  ( RIO+  -- , run+    -- * Environment+  , getEnvVar+    -- * LLM (Config)+  , llmPathCWD+    -- * LLM (Chat)+  , llmChatKey, llmChatAPI+  , llmChatWeb+    -- * LLM (Code)+  , llmCodeDir+  , llmCodeMsk+  , llmCodeSeq, llmCodeGet+    -- * LLM (Plan)+  , llmPlanDir+  , llmPlanMsk+  , llmPlanSeq, llmPlanGet+  , llmPlanKey, llmPlanAPI+  , llmPlanWeb+  )+where++--------------------------------------------------------------------------------++import           Internal.RIO ( RIO )++import           Internal.RIO ( getEnvVar )++import           Internal.RIO+  ( llmChatAPI+  , llmChatKey+  , llmChatWeb+  , llmCodeDir+  , llmCodeGet+  , llmCodeMsk+  , llmCodeSeq+  , llmPathCWD+  , llmPlanAPI+  , llmPlanDir+  , llmPlanGet+  , llmPlanKey+  , llmPlanMsk+  , llmPlanSeq+  , llmPlanWeb+  )

@@ -5,7 +5,7 @@  {-# LANGUAGE RankNTypes                   #-} -{-# LANGUAGE TupleSections                #-}+{-# LANGUAGE LambdaCase                   #-}  -------------------------------------------------------------------------------- @@ -22,16 +22,21 @@  module Agent.LLM   ( -- * Modes-    Mode(..)+    INT.Mode(..)     -- * Context   , Load   , History(..)   , Context(..)+  , INT.files     -- * Paramenters   , Eval     -- * Methods   , repl   , replWithMode+  , rootPath+    -- * Helpers+  , combineFiles+  , getFile   ) where @@ -59,69 +64,44 @@ import           Text.Read                            ( readMaybe )  import           Internal.GaloisInc.Text.JSON.Generic ( Data )--import           Agent.IO.Restricted+import           Internal.LLM+  ( Chit (..)+  , History (..)+  , Template (..)+  , View (..)+  , modes+  )+import qualified Internal.LLM                         as INT+import           Internal.RIO   ( RIO (..)+  , findFiles   , input   , output+  , readFileStrict   )++import qualified Agent.Data.ANSI.EscapeCode           as AEC+import qualified Agent.JSON                           as JSON import qualified Agent.Utils.Common                   as COM  -------------------------------------------------------------------------------- -data Mode-  = Auto-  | Chat-  | Code-  | Docs-  | Echo-  | Plan-  | Test-  deriving (Bounded, Enum, Eq, Read, Show)- type Load a =   ( Data a   , Show a   )   => Maybe a -data View-  = None-  | Both-  | Chit'-  | Chat'--data Chit =-  Chit-    { prev :: [String]-    -- TODO: add: yank :: Maybe String to store cutted text?-    , next :: [String]-    }--type Chat = [String]--data History =-  History-    { view :: View-    , chit :: Chit-    , chat :: Chat-    }--type Index = Int--type Numbers = Bool--type Filter = String- data Context a =   Context-    { exit :: Bool-    , mode :: Mode-    , load :: Load a-    , hist :: History-    , list :: Maybe Filter-    , safe :: Maybe Filter-    , file :: Maybe (Index, Numbers)+    { exit :: !INT.Exit+    , root :: !(Maybe INT.Root)+    , mode :: !INT.Mode+    , load :: !(Load a)+    , hist :: !INT.History+    , list :: !(Maybe INT.Filter)+    , pile :: !(Maybe INT.Files)+    , file :: !(Maybe INT.File)     }  type Eval a =@@ -131,17 +111,25 @@  -------------------------------------------------------------------------------- +rootPath+  :: RIO (Maybe INT.Root)+  -> IO  (Maybe INT.Root)+rootPath =+  run+ repl   :: Eval a+  -> Maybe INT.Root   -> IO () repl =-  replWithMode Chat+  replWithMode INT.Chat  replWithMode-  :: Mode+  :: INT.Mode   -> Eval a+  -> Maybe INT.Root   -> IO ()-replWithMode mod proc =+replWithMode mod proc mroot =   do     setLocaleEncoding utf8     hSetBuffering stderr NoBuffering@@ -154,12 +142,13 @@     where       ctx =         Context-          { exit = False+          { exit = INT.Exit False+          , root = mroot           , mode = mod           , load = Nothing           , hist =             History-              { view = None+              { view = []               , chit =                 Chit                   { prev = []@@ -168,14 +157,31 @@               , chat = []               }           , list = Nothing-          , safe = Nothing+          , pile = Just $ INT.Files [] -- Nothing           , file = Nothing           }  -------------------------------------------------------------------------------- --- HELPERS+-- HELPERS (public) +combineFiles+  :: INT.Files+  -> INT.Files+  -> INT.Files+combineFiles (INT.Files xs) (INT.Files ys) =+  INT.Files $ xs ++ ys++getFile+  :: INT.File+  -> (FilePath, [INT.FileLine])+getFile (INT.File f) =+  f++--------------------------------------------------------------------------------++-- HELPERS (private)+ {- NOTE: Doesn't seem to work ctrlC :: IO () -> IO () ctrlC task =@@ -190,27 +196,46 @@   -> RIO () loop ctx eval =   case ctx of-    Context { exit = True }                    ->+    Context { exit = INT.Exit True }                    ->       return ()-    Context { hist = History { view = Both } } ->+    Context { hist = History { view = [ Chits, Chats ] } } ->       printLn "* Chits:" >>-      (mapM_ printLn $ COM.chits True $ prev $ chit $ hist ctx) >>+      ( mapM_ printLn . COM.combine . COM.chits True . prev . chit . hist+      ) ctx >>       printLn "* Chats:" >>-      (mapM_ printLn $ COM.chats True $        chat $ hist ctx) >>-      loop (ctx { hist = ((hist ctx) { view = None }) }) eval-    Context { hist = History { view = Chit' } } ->+      ( mapM_ print   . 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.chits True $ prev $ chit $ hist ctx) >>-      loop (ctx { hist = ((hist ctx) { view = None }) }) eval-    Context { hist = History { view = Chat' } } ->+      ( 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.chats True $        chat $ hist ctx) >>-      loop (ctx { hist = ((hist ctx) { view = None }) }) eval+      ( 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.files .+        pile+      ) upd >>+      loop (upd { list = Nothing }) eval+      where+        cwd =+          case root ctx of+            Just (INT.Root cs) -> cs+            Nothing            -> []     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, _) ->+      loop upd eval+    Context { file = Just _ }   ->       eval    ctx [ ] >>= \ (upd, res) ->       printLn res     >>       loop (upd { file = Nothing }) eval@@ -221,18 +246,20 @@       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+        '/':'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-        "/safe"                      -> caseSafe txt-        "/s"                         -> caseSafe txt-        "/hist"                      -> caseHist txt Both-        "/h"                         -> caseHist txt Both-        "/chit"                      -> caseHist txt Chit'-        "/chat"                      -> caseHist txt Chat'+        "/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@@ -245,9 +272,18 @@           where             msg = "Command not recognized: " ++ cmd         ____________________________ ->-          eval    ctx txt >>= \ (upd, res) ->+          eval    ctx xml >>= \ (upd, res) ->           printLn res     >>           loop (nxt txt upd (Just res)) eval+          where+            tpl =+              Template+                { purpose      = txt+                , instructions = []+                , examples     = []+                , documents    = []+                }+            xml = INT.tpl2xml tpl       where         his       = hist ctx         chi       = chit his@@ -263,46 +299,113 @@                     }                 , chat =                   case o of-                    Nothing -> (       chat $ hist c)-                    Just  r -> ((r:) $ chat $ hist c)+                    Nothing ->        chat $ hist c+                    Just  r -> (r:) $ chat $ hist c                 }             }-        -- NOTE: Enforce DRY in cases         caseMode txt c cs =           case mmod of             Just mod ->               printLn ("Changed to " ++ low ++ "-mode") >>-              loop (nxt txt (ctx { mode = mod, safe = Nothing }) Nothing) eval+              loop (nxt txt (ctx { mode = mod, pile = Nothing }) Nothing) eval               where                 low = map toLower $ show mod             Nothing ->               printLn ("Invalid mode: " ++ c:cs) >>               loop (nxt txt ctx Nothing) eval           where-            mmod = readMaybe (toUpper c : map toLower cs) :: Maybe Mode-        caseFile txt midx =-          case lst of-            Just _ ->-              loop (nxt txt (ctx { file = (, False) <$> idx }) Nothing) eval-            Nothing ->-              printLn ("Invalid index") >>-              loop (nxt txt ctx Nothing) eval+            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           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 }) Nothing) eval-            Nothing ->-              printLn ("Invalid index") >>-              loop (nxt txt ctx Nothing) eval+            cwd =+              case root ctx of+                Just (INT.Root cs) -> cs+                Nothing            -> []+            pds =+              ( mapM+                  ( \ fap ->+                      INT.Document .+                      INT.File .+                      (,) (drop (length cwd) fap) .+                      lines+                      <$> readFileStrict fap+                  ) .+                concatMap INT.files .+                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 []+              where+                mod   = (map toLower . show . mode) ctx+                dec x =+                  case JSON.decode x :: Either JSON.DecodeError [String] of+                    Right xs -> xs+                    Left  __ -> []+            tpl ds is =+              Template+                { purpose      = msg+                , instructions = is+                , examples     =+                  -- TODO: Look in {root}/tpl/{mode}_examples_*.md+                  []+                , documents    = ds+                }+            xml xs ys = INT.tpl2xml $ tpl xs ys++        caseFile txt midx nums =+          ( 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+                else+                  let+                    m = "Index (" ++ show i ++ ") is out of bounds."+                  in+                    printLn m >>+                    loop (nxt txt ctx Nothing) eval+              Nothing ->+                printLn "Invalid index" >>+                loop (nxt txt ctx Nothing) eval+          )           where-            lst = safe ctx+            pfs = concatMap INT.files $ pile ctx             idx =               case midx of                 [    ] -> Nothing@@ -313,11 +416,24 @@           where             fil =               case mfil of-                [    ] -> Just mfil-                ' ':cs -> Just cs+                [    ] -> Just $ INT.Filter mfil+                ' ':cs -> Just $ INT.Filter cs                 ______ -> Nothing-        caseSafe txt =-          loop (nxt txt (ctx { list = safe ctx }) Nothing) eval+        casePile txt =+          ( mapM_ printLn .+            COM.combine .+            COM.files [] True .+            -- NOTE: Show relative paths+            map (drop (length cwd)) .+            concatMap INT.files .+            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 =@@ -328,19 +444,17 @@           loop (nxt txt ctx Nothing) eval         caseExit txt =           printLn "Λ-gent will shutdown" >>-          loop (nxt txt (ctx { exit = True }) Nothing) eval+          loop (nxt txt (ctx { exit = INT.Exit True }) Nothing) eval     where       -- NOTE: Clear screen & Move top-left-      clear     = "\ESC[H\ESC[2J" -- NOTE: See `infocmp -x`-      prompt    = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> "+      clear     = "\^[[H\^[[2J" -- NOTE: See `infocmp -x`+      prompt    =+        (show . AEC.bold . AEC.sgr)+        ("Λ-" ++ (map toLower . show . mode) ctx ++ "> ")       read      = input-      print     = output+      print     = output . show . AEC.faint . AEC.sgr       printLn x = print $ x ++ "\n" -modes :: [Mode]-modes =- [ minBound .. maxBound ]- head :: String head =   "# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."@@ -355,9 +469,11 @@   "/h   or /hist   | View chit-chat (input and output) history\n" ++   "        /chit   | View chit (input) history\n" ++   "        /chat   | View chat (output) history\n" ++-  "/s   or /safe   | Show stored list of files. See /list below\n" ++   "/l f or /list f | List of files, limited by mode, file masks and filter\n" ++-  "/f i or /file i | Show file with the given index. See, /safe above\n" ++-  "/n i or /nums i | Show file with line numbers. See /file above"+  "/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"   where-    ms = foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes+    ms =+      foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes

@@ -1,70 +0,0 @@-{-# 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

@@ -3,6 +3,8 @@ {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe                         #-} +{-# LANGUAGE DeriveDataTypeable           #-}+ --------------------------------------------------------------------------------  -- |@@ -21,14 +23,33 @@   , 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@@ -61,54 +82,52 @@ --------------------------------------------------------------------------------  files-  :: Bool-  -> [ String ]+  :: String+  -> Bool   -> [ String ]-files nums fs =-  linesOptNums nums 0 fs+  -> [ (String, String) ]+files prefix nums fs =+  linesOptNums prefix nums 0 fs  file-  ::  Bool-  ->  String-  -> [String]+  :: Bool+  -> String+  -> [ (String, String) ] file nums f =-  linesOptNums nums 1 $ lines f+  linesOptNums [] nums 1 $ Prelude.lines f  --------------------------------------------------------------------------------  chits   :: Bool   -> [ String ]-  -> [ String ]+  -> [ (String, String) ] chits nums fs =-  linesOptNums nums 0 $ reverse fs+  linesOptNums [] nums 0 $ reverse fs  chats   :: Bool   -> [ String ]-  -> [ String ]+  -> [ (String, String) ] chats nums fs =-  linesOptNums nums 0 $ reverse fs+  linesOptNums [] nums 0 $ reverse fs  --------------------------------------------------------------------------------  -- HELPERS (private)  linesOptNums-  :: Bool+  :: String+  -> Bool   -> Int   -> [ String ]-  -> [ String ]-linesOptNums nums origo xs =-  if null xs then-    []-  else-    map (\ (idx, rel) -> f idx rel)-    $ zip [origo..] xs-    where-      len   = length $ show $ length xs-      f i x =-        if nums then-          index len i ++ ": " ++ x-        else-          x+  -> [ (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+        []

@@ -1,70 +0,0 @@-{-# 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

@@ -0,0 +1,165 @@+{-# 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 Internal.LLM+  ( Exit (..)+  , Root (..)+  , Filter (..)+  , Mode (..)+  , View (..)+  , Chit (..)+  , Chat+  , History (..)+  , Mask (..)+  , File (..)+  , FileLine+  , Files (..)+  , Document (..)+  , Template (..)+  , modes+  , tpl2xml+  )+where++--------------------------------------------------------------------------------++newtype Exit = Exit Bool++newtype Root = Root FilePath++newtype Filter = Filter String++data Mode+  = Auto+  | Chat+  | Code+  | Docs+  | Echo+  | Plan+  | Test+  deriving (Bounded, Enum, Eq, Read, Show)++data View+  = Chits+  | Chats++data Chit =+  Chit+    { prev :: ![String]+    , next :: ![String]+    }++type Chat = [String]++data History =+  History+    { view :: ![View]+    , chit :: !Chit+    , chat :: !Chat+    }++--------------------------------------------------------------------------------++newtype Mask = Mask [String]++--------------------------------------------------------------------------------++type Markdown = String++type FileLine = String++newtype File = File { file :: (FilePath, [FileLine]) }++newtype Files = Files { files :: [FilePath] }++newtype Document = Document { document :: File }++data Template =+  Template+    { purpose      :: !String+    , instructions :: ![String]+    , examples     :: ![Markdown]+    , documents    :: ![Document]+    }++--------------------------------------------------------------------------------++modes :: [Mode]+modes =+ [ minBound .. maxBound ]++tpl2xml+  :: Template+  -> String+tpl2xml tpl =+  ( if eis && ees && eds then+      pur+    else+      "<purpose>" ++ pur ++ "</purpose>"+  ) +++  ( if eis then+      []+    else+      "<instructions>" +++      tis +++      "</instructions>"+  ) +++  ( if ees then+      []+    else+      "<examples>" +++      tes +++      "</examples>"+  ) +++  ( if eds then+      []+    else+      "<documents>" +++      concatMap aux tds +++      "</documents>"+  )+  where+    pur =+      purpose tpl +++      ( if eis then+          []+        else+          ". Follow the specififed `instructions`"+      ) +++      ( if ees then+          []+        else+          ". Output MUST match provided `examples`"+      ) +++      ( if ees then+          []+        else+          ". List of provided `documents`"+      )+    eis = null tis+    ees = null tes+    eds = null tds+    tis =+      concatMap (\ x -> "<instruction>" ++ x ++ "</instruction>")+      $ instructions tpl+    tes =+      concatMap (\ x -> "<example>" ++ x ++ "</example>")+      $ examples tpl+    tds = zip [0 :: Int ..] $ documents tpl+    aux (i, Document (File (src, ls))) =+      "<document index=\"" ++ show i ++ "\">" +++      "<source>" ++ src ++ "</source>" +++      "<content>" ++ unlines ls ++ "</content>" +++      "</document>"

@@ -0,0 +1,1215 @@+{-# OPTIONS_GHC -Wall -Werror #-}++{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}+{-# LANGUAGE Safe                         #-}++{-# LANGUAGE FlexibleContexts             #-}+{-# LANGUAGE UndecidableInstances         #-}++{-# 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+--+-- Safe {H}askell+--+-- https://simonmar.github.io/bib/safe-haskell-2012_abstract.html+--+-- (David Terei, David Mazières, Simon Marlow, Simon Peyton Jones) Haskell ’12:+-- Proceedings of the Fifth ACM SIGPLAN Symposium on Haskell, Copenhagen,+-- Denmark, ACM, 2012+--+-- Though Haskell is predominantly type-safe, implementations contain a few+-- loopholes through which code can bypass typing and module encapsulation. This+-- paper presents Safe Haskell, a language extension that closes these+-- loopholes. Safe Haskell makes it possible to confine and safely execute+-- untrusted, possibly malicious code. By strictly enforcing types, Safe Haskell+-- allows a variety of different policies from API sandboxing to+-- information-flow control to be implemented easily as monads. Safe Haskell is+-- aimed to be as unobtrusive as possible. It enforces properties that+-- programmers tend to meet already by convention. We describe the design of+-- Safe Haskell and an implementation (currently shipping with GHC) that infers+-- safety for code that lies in a safe subset of the language. We use Safe+-- Haskell to implement an online Haskell interpreter that can securely execute+-- arbitrary untrusted code with no overhead. The use of Safe Haskell greatly+-- simplifies this task and allows the use of a large body of existing code and+-- tools.++--------------------------------------------------------------------------------++module Internal.RIO+  ( RIO ()+  , run+    -- * Environment+  , getEnvVar+    -- * Read/Print+  , input+  , output+    -- * LLM (Config)+  , llmPathCWD+    -- * LLM (Chat)+  , llmChatKey, llmChatAPI+  , llmChatWeb+    -- * LLM (Code)+  , llmCodeDir+  , llmCodeMsk+  , llmCodeSeq, llmCodeGet+    -- * LLM (Plan)+  , llmPlanDir+  , llmPlanMsk+  , llmPlanSeq, llmPlanGet+  , llmPlanKey, llmPlanAPI+  , llmPlanWeb+    -- * Internal+  , findFiles+  , readFileStrict+    -- * Temp+  , timestampUTC+  )+where++--------------------------------------------------------------------------------++import           Data.Either              ( partitionEithers )+import           Data.List                ( isPrefixOf )+import           Data.Maybe               ( maybeToList )+import qualified System.Environment.Blank as ENV+import           System.Exit+  ( ExitCode (ExitFailure, ExitSuccess)+  )+import           System.IO+  ( hClose+  , hFlush+  , hGetContents+  , hPutStrLn+  , hReady+  , stdin+  , stdout+  )+import           System.Process+  ( CreateProcess (cwd, std_err, std_in, std_out)+  , StdStream (CreatePipe)+  , createProcess+  , proc+  , readCreateProcessWithExitCode+  , readProcessWithExitCode+  , waitForProcess+  )+import           Text.Read                ( readMaybe )++import qualified Internal.LLM             as LLM++import qualified Agent.IO.Effects         as EFF+import qualified Agent.Utils.Common       as COM++--------------------------------------------------------------------------------++newtype RIO a = RestrictedIO { run :: IO a }++instance Functor RIO where+  fmap f m = RestrictedIO $      f <$> run m++instance Applicative RIO where+  pure      = RestrictedIO . pure+  (<*>) f m = RestrictedIO $ run f <*> run m++instance Monad RIO where+  (>>=) m f = RestrictedIO $ run m >>= run . f++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++data Position =+  Position !Int !Int+  deriving (Eq, Show)++instance Ord Position where+  (<=) (Position y1 x1) (Position y2 x2) =+    case compare y1 y2 of+      GT -> False+      EQ -> x1 <= x2+      LT -> True++instance Read Position where+  readsPrec _ str =+    -- NOTE:+    -- "\^[[#;#R" => "\^[" and "[#;#R" (only parse last)+    maybeToList+    ( readMaybe (f str) >>= \ y ->+      readMaybe (g str) >>= \ x ->+        Just+          ( Position y x+          , h str+          )+    )+    where+      f = takeWhile (/= ';') . drop 1 . dropWhile (/= '[')+      g = takeWhile (/= 'R') . drop 1 . dropWhile (/= ';')+      h = drop 1 . dropWhile (/= 'R') . dropWhile (/= ';') . dropWhile (/= '[')++--------------------------------------------------------------------------------++data MultiLine =+  MultiLine+    { stx :: !(Maybe Position)+    , cur :: !(Maybe Position)+    , etx :: !(Maybe Position)+    , col :: !Int+    }+  deriving Show++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class StdIn m where+  input+    :: [ String ]+    -> [ String ]+    -> m String++class StdOut m where+  output+    :: String+    -> m ()++--------------------------------------------------------------------------------++instance StdIn RIO where+  input prev next =+    -- NOTE: "\^[7" - save cursor position (SCO)+    -- - https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797#cursor-controls+    RestrictedIO $ putStr "\^[7" >> aux gen prev next [] []+    where+      msv = 32767 :: Int+      gen =+        MultiLine+          { stx = Nothing+          , cur = Nothing+          , etx = Nothing+          , col = 0+          }+      aux mlp hps hns bcs acs =+        block >>= \ blk ->+        case (blk < ['\32'], blk) of+          -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER) and+          -- then map to ASCII control codes (use Caret notation cos Λ prefix):+          --+          -- - https://en.wikipedia.org/wiki/ASCII#Control_code_table+          (True , ['\^J'])                     -> caseEnter+          (True , ['\^H'])                     -> caseBackspace+          (True , ['\^[','[','3','~'])         -> caseDelete+          (True , ['\^D'])                     -> caseDelete+          (True , ['\^[','[','H'])             -> caseHome+          (True , ['\^A'])                     -> caseHome+          (True , ['\^[','[','F'])             -> caseEnd+          (True , ['\^E'])                     -> caseEnd+          (True , ['\^L'])                     -> caseWipe+          (True , ['\^U'])                     -> caseWipeStart+          (True , ['\^K'])                     -> caseWipeEnd+          (True , ['\^[','[','A'])             -> caseArrowUp+          (True , ['\^[','[','B'])             -> caseArrowDown+          (True , ['\^[','[','C'])             -> caseArrowRight blk+          (True , ['\^[','[','D'])             -> caseArrowLeft  blk+          (True , ['\^[','[','1',';','5','C']) -> caseArrowCtrlRight+          (True , ['\^[','[','1',';','5','D']) -> caseArrowCtrlLeft+          (True , '\^[':ps)                    -> casePositions ps+          (True , _)                           -> caseSkip+          (False, ['\DEL'])                    -> caseSkip+          (False, _)                           -> caseText blk+          where+            caseEnter =+              -- NOTE: ENTER (line feed) only if something is typed+              case (bcs, acs) of+                ([], []) ->+                  aux mlp hps hns bcs acs+                ________ ->+                  hFlush stdout >>+                  -- NOTE: Move to end of text+                  putStr hom    >>+                  hFlush stdout >>+                  (pure . (++ acs) . reverse) bcs+                  where+                    hom =+                      case mlp of+                        MultiLine { etx = Just (Position y x) } ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                        _______________________________________ ->+                          []+            caseBackspace =+              -- NOTE: BACKSPACE / CTRL + H (remove char if any and re-write+              -- after chars)+              case bcs of+                [    ] -> aux mlp hps hns bcs acs+                (_:cs) ->+                  hFlush stdout >>+                  -- NOTE: 0) Print "\^[[6n" position before action+                  putStr "\^[[6n"                    >>+                  -- NOTE: Remove char+                  putChar '\^H'                      >>+                  -- NOTE: Save position+                  putStr "\^[7"                      >>+                  -- NOTE: Clear rest of screen from position+                  putStr "\^[[0J"                    >>+                  -- NOTE: Print after chars+                  putStr  acs                        >>+                  -- NOTE: 1) Print "\^[[6n" end position after action+                  putStr "\^[[6n"                    >>+                  -- NOTE: 2) Print "\^[[6n" column witdh+                  putStr ("\^[[" ++ show msv ++ "C") >>+                  putStr "\^[[6n"                    >>+                  -- NOTE: Go back to saved position+                  putStr "\^[8"                      >>+                  -- NOTE: 3) Print "\^[[6n" current position after action+                  putStr "\^[[6n"                    >>+                  hFlush stdout                      >>+                  aux mlp hps hns cs acs+            caseDelete =+              -- NOTE: DELETE / CTRL + D behave as delete key+              case acs of+                -- NOTE: Delete (remove char if any and re-write after chars)+                [    ] -> aux mlp hps hns bcs acs+                (_:cs) ->+                  hFlush stdout                      >>+                  -- NOTE: 0) Print "\^[[6n" position before action+                  putStr "\^[[6n"                    >>+                  -- NOTE: Save position+                  putStr "\^[7"                      >>+                  -- NOTE: Clear rest of screen from position+                  putStr "\^[[0J"                    >>+                  -- NOTE: Print after chars+                  putStr  cs                         >>+                  -- NOTE: 1) Print "\^[[6n" end position after action+                  putStr "\^[[6n"                    >>+                  -- NOTE: 2) Print "\^[[6n" column witdh+                  putStr ("\^[[" ++ show msv ++ "C") >>+                  putStr "\^[[6n"                    >>+                  -- NOTE: Go back to saved position+                  putStr "\^[8"                      >>+                  -- NOTE: 3) Print "\^[[6n" current position after action+                  putStr "\^[[6n"                    >>+                  hFlush stdout                      >>+                  aux mlp hps hns bcs cs+            caseHome =+              -- NOTE: HOME / CTRL + A to move to start of text+              hFlush stdout >>+              putStr hom    >>+              hFlush stdout >>+              aux mln hps hns [] (reverse bcs ++ acs)+              where+                (mln, hom) =+                  case mlp of+                    MultiLine { stx = Just (Position y x) } ->+                      ( mlp { cur = Just (Position y x) }+                      , "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                      )+                    _______________________________________ ->+                      ( mlp+                      , "\^[8"+                      )+            caseEnd =+              -- NOTE: END / CTRL + E to move to end of text+              hFlush stdout >>+              putStr hom    >>+              hFlush stdout >>+              aux mln hps hns ((++ bcs) $ reverse acs) []+              where+                (mln, hom) =+                  case mlp of+                    MultiLine { etx = Just (Position y x) } ->+                      ( mlp { cur = Just (Position y x) }+                      , "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                      )+                    _______________________________________ ->+                      ( mlp+                      , []+                      )+            caseWipe =+              -- NOTE: CTRL + L (form feed) becomes "/w" (clear screen)+              pure "/wipe"+            caseWipeStart =+              -- NOTE: CTRL + U cut text to start+              hFlush stdout                      >>+              -- NOTE: 0) Print "\^[[6n" position before action+              putStr "\^[[6n"                    >>+              -- NOTE: Go back to start of line+              putStr hom                         >>+              -- NOTE: Save position+              putStr "\^[7"                      >>+              -- NOTE: Clear rest of screen from position+              putStr "\^[[0J"                    >>+              -- NOTE: Print after chars+              putStr  acs                        >>+              -- NOTE: 1) Print "\^[[6n" end position after action+              putStr "\^[[6n"                    >>+              -- NOTE: 2) Print "\^[[6n" column witdh+              putStr ("\^[[" ++ show msv ++ "C") >>+              putStr "\^[[6n"                    >>+              -- NOTE: Go back to saved position+              putStr "\^[8"                      >>+              -- NOTE: 3) Print "\^[[6n" current position after action+              putStr "\^[[6n"                    >>+              hFlush stdout                      >>+              aux mlp hps hns [] acs+              where+                hom =+                  case mlp of+                    MultiLine { stx = Just (Position y x) } ->+                      "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                    _______________________________________ ->+                      "\^[8"+            caseWipeEnd =+              -- NOTE: CTRL + K cut text to end+              hFlush stdout                      >>+              -- NOTE: 0) Print "\^[[6n" position before action+              putStr "\^[[6n"                    >>+              -- NOTE: Save position+              putStr "\^[7"                      >>+              -- NOTE: Clear rest of screen from position+              putStr "\^[[0J"                    >>+              -- NOTE: 1) Print "\^[[6n" end position after action+              putStr "\^[[6n"                    >>+              -- NOTE: 2) Print "\^[[6n" column witdh+              putStr ("\^[[" ++ show msv ++ "C") >>+              putStr "\^[[6n"                    >>+              -- NOTE: Go back to saved position+              putStr "\^[8"                      >>+              -- NOTE: 3) Print "\^[[6n" current position after action+              putStr "\^[[6n"                    >>+              hFlush stdout                      >>+              aux mlp hps hns bcs []+            caseArrowUp =+              -- NOTE: Allowed escaped sequences: Arrow "↑"+              case (hps, hns) of+                ([  ], _) -> aux mlp hps hns bcs acs+                (p:ps, _) ->+                  hFlush stdout >>+                  -- NOTE: 0) Print "\^[[6n" position before action+                  putStr "\^[[6n"                    >>+                  -- NOTE: Move to start of text+                  putStr hom                         >>+                  -- NOTE: Print previous line+                  putStr p                           >>+                  -- NOTE: Save position+                  putStr "\^[7"                      >>+                  -- NOTE: Clear rest of screen from position+                  putStr "\^[[0J"                    >>+                  -- NOTE: Print after chars+                  putStr  []                         >>+                  -- NOTE: 1) Print "\^[[6n" end position after action+                  putStr "\^[[6n"                    >>+                  -- NOTE: 2) Print "\^[[6n" column witdh+                  putStr ("\^[[" ++ show msv ++ "C") >>+                  putStr "\^[[6n"                    >>+                  -- NOTE: Go back to saved position+                  putStr "\^[8"                      >>+                  -- NOTE: 3) Print "\^[[6n" current position after action+                  putStr "\^[[6n"                    >>+                  hFlush stdout                      >>+                  aux mlp ps (p:hns) rev []+                  where+                    rev = reverse p+                    hom =+                      case mlp of+                        MultiLine { stx = Just (Position y x) } ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                        _______________________________________ ->+                          "\^[8"+            caseArrowDown =+              -- NOTE: Allowed escaped sequences: Arrow "↓"+              case (hps, hns) of+                (_, [  ]) -> aux mlp hps hns bcs acs+                (_, p:ps) ->+                  hFlush stdout >>+                  -- NOTE: 0) Print "\^[[6n" position before action+                  putStr "\^[[6n"                    >>+                  -- NOTE: Move to start of text+                  putStr hom                         >>+                  -- NOTE: Print previous line+                  putStr p                           >>+                  -- NOTE: Save position+                  putStr "\^[7"                      >>+                  -- NOTE: Clear rest of screen from position+                  putStr "\^[[0J"                    >>+                  -- NOTE: Print after chars+                  putStr  []                         >>+                  -- NOTE: 1) Print "\^[[6n" end position after action+                  putStr "\^[[6n"                    >>+                  -- NOTE: 2) Print "\^[[6n" column witdh+                  putStr ("\^[[" ++ show msv ++ "C") >>+                  putStr "\^[[6n"                    >>+                  -- NOTE: Go back to saved position+                  putStr "\^[8"                      >>+                  -- NOTE: 3) Print "\^[[6n" current position after action+                  putStr "\^[[6n"                    >>+                  hFlush stdout                      >>+                  aux mlp (p:hps) ps rev []+                  where+                    rev = reverse p+                    hom =+                      case mlp of+                        MultiLine { stx = Just (Position y x) } ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                        _______________________________________ ->+                          "\^[8"+            caseArrowRight str =+              -- NOTE: Allowed escaped sequences: Arrow "→"+              case (bcs, acs) of+                (_, [  ]) ->+                  aux mlp hps hns    bcs  acs+                (_, c:cs) ->+                  hFlush stdout   >>+                  ( if pl then+                      putStr ("\^[[" ++ "1" ++ "E")+                    else+                      putStr str+                  ) >>+                  -- NOTE: Update current position+                  putStr "\^[[6n" >>+                  hFlush stdout   >>+                  aux mlp hps hns (c:bcs) cs+                  where+                    pl =+                      case mlp of+                        MultiLine+                          { cur = Just (Position cy cx)+                          , etx = Just (Position ey __)+                          , col = cw+                          } -> cy <= ey && cx == cw+                        ___ -> False+            caseArrowLeft str =+              -- NOTE: Allowed escaped sequences: Arrow "←"+              case (bcs, acs) of+                ([  ], _) ->+                  aux mlp hps hns bcs    acs+                (c:cs, _) ->+                  hFlush stdout >>+                  ( if pl then+                      putStr ("\^[[" ++      "1" ++ "F") >>+                      putStr ("\^[[" ++ show msv ++ "C")+                    else+                      putStr str+                  ) >>+                  -- NOTE: Update current position+                  putStr "\^[[6n" >>+                  hFlush stdout >>+                  aux mlp hps hns  cs (c:acs)+                  where+                    pl =+                      case mlp of+                        MultiLine+                          { stx = Just (Position sy __)+                          , cur = Just (Position cy 01)+                          } -> sy < cy+                        ___ -> False+            caseArrowCtrlRight =+              -- NOTE: Allowed escaped sequences: CTRL + Arrow "→"+              -- NOTE: Move to end of text+              hFlush stdout   >>+              putStr np       >>+              -- NOTE: Update current position+              putStr "\^[[6n" >>+              hFlush stdout   >>+              aux mlp hps hns (ts ++ bcs) ds+              where+                ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs+                ts = drop (length ds) $ reverse acs+                lc = length ts+                np =+                  case mlp of+                    MultiLine+                      { cur = Just (Position cy cx)+                      , etx = Just (Position ey _ )+                      , col = cw+                      } ->+                      case (cy < ey, compare (cw - cx) lc) of+                        (True, LT) ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                          where+                            y = cy + 1+                            x = lc - (cw - cx)+                        __________ ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                          where+                            y = cy+                            x = cx + lc+                    ___ -> []+            caseArrowCtrlLeft =+              -- NOTE: Allowed escaped sequences: CTRL + Arrow "←"+              hFlush stdout   >>+              putStr np       >>+              -- NOTE: Update current position+              putStr "\^[[6n" >>+              hFlush stdout   >>+              aux mlp hps hns ds (ts ++ acs)+              where+                ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs+                ts = drop (length ds) $ reverse bcs+                lc = length ts+                np =+                  case mlp of+                    MultiLine+                      { stx = Just (Position sy _ )+                      , cur = Just (Position cy cx)+                      , col = cw+                      } ->+                      case (sy < cy, compare cx lc) of+                        (True, LT) ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                          where+                            y = cy - 1+                            x = cw - (lc - cx)+                        __________ ->+                          "\^[[" ++ show y ++ ";" ++ show x ++ "H"+                          where+                            y = cy+                            x = cx - lc+                    ___ -> []+            casePositions ps =+              -- NOTE: Other escaped sequences (skip unless positions)+              aux mln hps hns bcs acs+              where+                ops = map readMaybe $ COM.split '\^[' ps :: [Maybe Position]+                mln =+                  -- NOTE: 0) Print "\^[[6n" position before action (unused)+                  -- NOTE: 1) Print "\^[[6n" end position after action+                  -- NOTE: 2) Print "\^[[6n" column witdh+                  -- NOTE: 3) Print "\^[[6n" current position after action+                  case (mlp, ops) of+                    (___________________________,+                     [                                           ]) ->+                      mlp+                    (MultiLine { stx = Nothing },+                     [Just (Position y x)                        ]) ->+                      mlp+                        { stx = Just sp+                        , cur = Just sp+                        , etx = Just sp+                        , col = x+                        }+                      where+                        sp = Position y x+                    (MultiLine { etx = Just ep },+                     [Just cp                                    ]) ->+                      if cp > ep then+                        mlp+                          { cur = Just cp+                          , etx = Just cp+                          }+                      else+                        mlp+                          { cur = Just cp+                          }+                    (MultiLine { stx = Nothing },+                     [Just sp,Just ep,Just (Position _ w),Just cp]) ->+                      mlp+                        { stx = Just sp+                        , cur = Just cp+                        , etx = Just ep+                        , col = w+                        }+                    (___________________________,+                     [Just __,Just ep,Just (Position _ w),Just cp]) ->+                      mlp+                        { cur = Just cp+                        , etx = Just ep+                        , col = w+                        }+                    _______________________________________________ ->+                      mlp+            caseSkip =+              aux mlp hps hns bcs acs+            caseText str =+              hFlush stdout                      >>+              -- NOTE: 0) Print "\^[[6n" position before action+              putStr "\^[[6n"                    >>+              -- NOTE: Type key or text+              putStr str                         >>+              -- NOTE: Save position+              putStr "\^[7"                      >>+              -- NOTE: Clear rest of screen from position+              putStr "\^[[0J"                    >>+              -- NOTE: Print after chars+              putStr  acs                        >>+              -- NOTE: 1) Print "\^[[6n" end position after action+              putStr "\^[[6n"                    >>+              -- NOTE: 2) Print "\^[[6n" column witdh+              putStr ("\^[[" ++ show msv ++ "C") >>+              putStr "\^[[6n"                    >>+              -- NOTE: Go back to saved position+              putStr "\^[8"                      >>+              -- NOTE: 3) Print "\^[[6n" current position after action+              putStr "\^[[6n"                    >>+              hFlush stdout                      >>+              aux mlp hps hns (reverse str ++ bcs) acs+      block =+        -- NOTE: https://stackoverflow.com/a/38553473+        --+        -- We refactored and named it `block` instead of `key` as it is possible+        -- to paste a huge block of text. Calling that a keystroke, doesn't seem+        -- appropiate+        reverse <$> nxt []+        where+          nxt cs =+            do+              c <- getChar+              m <- hReady stdin+              (if m then nxt else pure) (c:cs)++instance StdOut RIO where+  output x = RestrictedIO $+    putStr x >> hFlush stdout++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  EFF.LlmConf m+  => 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+          Nothing -> Nothing+      )+      <$> getEnvVar "LLM_PATH_CWD"++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  EFF.LlmChatConf m+  => LlmChatConf m+  where+    llmChatAPI+      :: m (Maybe String)+    llmChatKey+      :: m (Maybe String)++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 LLM.Filter+      -> m (Either [String] LLM.Files)+    llmCodeGet+      :: String+      -> m (Either String LLM.File)++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmCodeRoot RIO+  , EFF.LlmCodeMask RIO+  )+  => LlmCodeRead RIO+  where+    llmCodeSeq mfilter =+      EFF.llmPathCWD >>= \ ocwd ->+      case ocwd of+        Just (LLM.Root root) ->+          EFF.llmCodeDir                 >>= \ cdir ->+          EFF.llmCodeMsk                 >>= \ cmsk ->+          realPath (root ++ "/" ++ cdir) >>= \ efap ->+          case efap of+            -- TODO: DRY+            Right fap ->+              ( \ case+                  ([], rs) -> Right $ LLM.Files $ concat rs+                  (ls, __) -> Left                       ls+              )+              . partitionEithers+              <$> mapM (\ msk -> findFiles fap ("*" ++ fil ++ "*" ++ msk)) cmsk+            Left err ->+              pure $ Left [err]+        Nothing ->+          pure $ Left [noLlmConf]+      where+        fil =+          case mfilter of+            Just (LLM.Filter f) ->  f+            Nothing             -> [ ]++    llmCodeGet abspath =+      EFF.llmPathCWD >>= \ ocwd ->+      EFF.llmCodeDir >>= \ cdir ->+      case ocwd of+        -- TODO: DRY+        Just (LLM.Root root) ->+          realPath (root ++ "/" ++ cdir) >>= \ efap ->+          case efap of+            Right fap ->+              if fap `isPrefixOf` abspath then+                Right . LLM.File . (,) abspath . lines+                <$> readFileStrict abspath+              else+                pure $ Left $ notPrefixRootAndMode fap abspath LLM.Code+            Left  err ->+              pure $ Left err+        Nothing ->+          pure $ Left noLlmConf++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++class+  EFF.LlmConf m+  => LlmPlanRoot m+  where+    llmPlanDir+      :: m String++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanRoot RIO+  )+  => LlmPlanRoot RIO+  where+    llmPlanDir = pure "."++--------------------------------------------------------------------------------++class+  EFF.LlmConf m+  => LlmPlanMask m+  where+    llmPlanMsk+      :: m [String]++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanMask RIO+  )+  => LlmPlanMask RIO+  where+    llmPlanMsk =+      pure+        [ "*.org"+        , "*.md"+        ]++--------------------------------------------------------------------------------++class+  ( EFF.LlmConf     m+  , EFF.LlmPlanRoot m+  , EFF.LlmPlanMask m+  , EFF.LlmCodeRead m+  )+  => LlmPlanRead m+  where+    llmPlanSeq+      :: Maybe LLM.Filter+      -> m (Either [String] LLM.Files)+    llmPlanGet+      :: String+      -> m (Either String LLM.File)++instance+  ( EFF.LlmConf     RIO+  , EFF.LlmPlanRoot RIO+  , EFF.LlmPlanMask RIO+  , EFF.LlmCodeRead RIO+  )+  => LlmPlanRead RIO+  where+    llmPlanSeq mfilter =+      EFF.llmPathCWD >>= \ ocwd ->+      case ocwd of+        Just (LLM.Root root) ->+          EFF.llmPlanDir                 >>= \ pdir ->+          EFF.llmPlanMsk                 >>= \ pmsk ->+          realPath (root ++ "/" ++ pdir) >>= \ efap ->+          case efap of+            -- TODO: DRY+            Right fap ->+              ( \ case+                  ([], rs) -> Right $ LLM.Files $ concat rs+                  (ls, __) -> Left                       ls+              )+              . partitionEithers+              <$> mapM (\ msk -> findFiles fap ("*" ++ fil ++ "*" ++ msk)) pmsk+            Left err ->+              pure $ Left [err]+        Nothing ->+          pure $ Left [noLlmConf]+      where+        fil =+          case mfilter of+            Just (LLM.Filter f) ->  f+            Nothing             -> [ ]++    llmPlanGet abspath =+      EFF.llmPathCWD >>= \ ocwd ->+      EFF.llmPlanDir >>= \ pdir ->+      case ocwd of+        -- TODO: DRY+        Just (LLM.Root root) ->+          realPath (root ++ "/" ++ pdir) >>= \ efap ->+          case efap of+            Right fap ->+              if fap `isPrefixOf` abspath then+                Right . LLM.File . (,) abspath . lines+                <$> readFileStrict abspath+              else+                pure $ Left $ notPrefixRootAndMode fap abspath LLM.Plan+            Left  err ->+              pure $ Left err+        Nothing ->+          pure $ Left noLlmConf++--------------------------------------------------------------------------------++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 ->+      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++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- HELPERS (public)++findFiles+  :: FilePath+  -> 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+        -- NOTE: We use absolute paths, but, only show relative+        $ map (filter (/= '\NUL'))+        $ lines str+      Left  err ->+        Left err+  )+  <$> withExitCodeCwd path "find"+        [ path+        , "-path"+        , mask+        ]++getEnvVar+  :: String+  -> RIO (Maybe String)+getEnvVar =+  RestrictedIO . ENV.getEnv++--------------------------------------------------------------------------------++-- HELPERS (private)++noLlmConf :: String+noLlmConf =+  "No EFF.LlmConf instance is defined."++notPrefixRootAndMode+  :: FilePath+  -> FilePath+  -> LLM.Mode+  -> String+notPrefixRootAndMode rpath apath mode =+  rpath ++ " is not a prefix of " ++ apath ++ " for: " ++ show mode++gitExist+  :: FilePath+  -> RIO Bool+gitExist path =+  ( \case+      Right _ -> True+      Left  _ -> False+  )+  <$> withExitCodeCwd path "git"+        [ "status"+        ]++gitignoreTmp+  :: FilePath+  -> RIO Bool+gitignoreTmp path =+  any (== "/tmp/") . lines+  <$> readFileStrict gi+  where+    gi = path ++ "/.gitignore"++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) ->+      withExitCodeStdIn "curl"+        ( [ --"--verbose"+            "--silent"+          , "--show-error"+          ]+          ++ hs +++          [ -- NOTE: https://curl.se/docs/manpage.html#--json+            "--json", "@-"+          , api ++ "/chat/completions"+          ]+        )+        json+    (Just api, Just key) ->+      withExitCodeStdIn "curl"+        ( [ --"--verbose"+            "--silent"+          , "--show-error"+          , "--header", "\"Authorization: \"" ++ key ++ "\""+          ]+          ++ hs +++          [ -- NOTE: https://curl.se/docs/manpage.html#--json+            "--json", "@-"+          , api ++ "/chat/completions"+          ]+        )+        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\""+        ]++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 >>= \cs ->+  length cs `seq` pure cs++realPath+  :: FilePath+  -> 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+        ]++timestampUTC :: RIO (Maybe String)+timestampUTC =+  ( \case+      Right str -> Just str+      Left  ___ -> Nothing+  )+  <$> withExitCode "date"+        [ "-u"+        , "+'%Y%m%d-%H%M%S-%N'"+        ]++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++withExitCodeStdIn+  ::  String+  -> [String]+  ->  String+  -> RIO (Either String String)+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+    where+      raw = proc cmd args+      rcp =+        raw+          { std_in  = CreatePipe+          , std_out = CreatePipe+          , std_err = CreatePipe+          }++withExitCodeCwd+  ::  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+    where+      raw = proc cmd args+      rcp = raw { cwd = Just path }