diff --git a/A-gent.cabal b/A-gent.cabal --- a/A-gent.cabal +++ b/A-gent.cabal @@ -9,13 +9,12 @@ build-type: Simple name: A-gent -version: 0.11.0.5 +version: 0.11.0.6 synopsis: Polite & well educated LLM agent with excellent manners that always behaves well description: Polite and well educated LLM agent with excellent manners that always behaves well -homepage: https://a-gent.org -bug-reports: https://bsky.app/profile/a-gent.org +homepage: https://a-gent.org license: SSPL-1.0 OR AGPL-3.0-only license-file: LICENSE.md @@ -56,8 +55,10 @@ -- Prelude base >= 4 && < 5 -- Process + -- NOTE: github.com/NixOS/hydra builds with stackage lastest LST (24.…) + -- and stackage only has 'containers 0.7' while hackage has '0.8' , process >= 1.6.25.0 && < 2 - , containers >= 0.8 && < 1 + , containers >= 0.7 && < 1 -- JSON , mtl >= 2.3.1 && < 3 ghc-options: @@ -139,21 +140,26 @@ base hs-source-dirs: src - exposed-modules: + other-modules: Internal.GaloisInc.Text.JSON Internal.GaloisInc.Text.JSON.Generic Internal.GaloisInc.Text.JSON.String Internal.GaloisInc.Text.JSON.Types -- Internal.GlasgowUniversity.Data.Generics.Aliases - -- - Agent.JSON - -- + exposed-modules: + Agent.Control.Concurrent Agent.Control.IFC Agent.Control.MAC -- Agent.IO.Effects Agent.IO.Restricted + -- + Agent.Utils.Common + Agent.Utils.Code + Agent.Utils.Plan + -- + Agent.JSON -- Agent.LLM diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,35 @@ # Revision history for Λ-gent +## 0.11.0.6 -- 2026-03-20 + +* Added a `todo.org` file in the root folder of the project. This will allow to + see current, but also future, status of the project. + +* Expanded file capabilities for `Code` and `Plan`. + + * Files will be shown with `relative` paths. However, they will be handled + with `absolute` paths under the hood. + +* Added a few more `REPL` commands and improvements to typing. + + * **NOTE**: There is a `bug` with regard of multi-line text. Hopefully it will + be fixed shortly. + +* No longer on Bluesky and therefore, removed from `cabal` file. + +* Issue with `haskellPackages` on `NixOS`. It seems that they use `stack` to + build with the latest `LTS`. The fix is to change in the `cabal` file the + following version contraint: `containers >= 0.7 && < 1` as `stackage` only has + the version `0.7` of the `containers` package. + + * **NOTE**: Fix is not verified. Well, this update will confirm (or not). + +* Added the `Agent.Control.Concurrent` module to provide support for + asynchronous tasks. + +* Added `Agent.Utils` modules to help for the respective `modes`. This will help + keep `Λ-gent` code small by providing ready to plug code bloks. + ## 0.11.0.5 -- 2026-03-08 * `ENTER` only triggers if something is typed. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +import Distribution.Simple + ( defaultMain + ) + +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain diff --git a/src/Agent/Control/Concurrent.hs b/src/Agent/Control/Concurrent.hs new file mode 100644 --- /dev/null +++ b/src/Agent/Control/Concurrent.hs @@ -0,0 +1,85 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +{-# LANGUAGE LambdaCase #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +module Agent.Control.Concurrent + ( Async + , Task + , fork + , wait + , join + ) +where + +-------------------------------------------------------------------------------- + +import Control.Concurrent ( ThreadId, forkFinally ) +import Control.Concurrent.MVar + ( MVar + , newEmptyMVar + , putMVar + , readMVar + ) +import GHC.Exception ( SomeException, throw ) + +-------------------------------------------------------------------------------- + +data Task a = Task !ThreadId (IO (Either SomeException a)) + +-------------------------------------------------------------------------------- + +-- | +-- To prevent the users from adding instances of `Async`, we +-- provide a middle-layer (`Proxy`) between the `Monad` instance and the `Proxy` +-- (`Async`) instance. + +class Monad m => Proxy m where + new :: m (MVar a) + put :: MVar a -> a -> m ( ) + get :: MVar a -> m a +class Proxy m => Async m where + fork :: m a -> m (Task a) + wait :: Task a -> m a + join :: [ Task a ] -> m ( ) + +-------------------------------------------------------------------------------- + +instance Proxy IO where + -- | newEmptyMVar: Create an MVar which is initially empty. + new = newEmptyMVar + -- | putMVar: Put a value into an MVar. + put = putMVar + -- | + -- readMVar: Atomically read the contents of an MVar. If the MVar is currently + -- empty, readMVar will wait until it is full. readMVar is guaranteed to + -- receive the next putMVar. + get = readMVar + +instance Async IO where + fork compute = + new >>= \ var -> + forkFinally compute (finally var) >>= \ tid -> + pure $ Task tid $ get var + where + finally v r = put v r + wait (Task _ mvar) = + ( \case + Right v -> v + Left e -> throw e + ) + <$> mvar + join = + mapM_ wait diff --git a/src/Agent/Control/IFC.hs b/src/Agent/Control/IFC.hs --- a/src/Agent/Control/IFC.hs +++ b/src/Agent/Control/IFC.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE MultiParamTypeClasses #-} diff --git a/src/Agent/Control/MAC.hs b/src/Agent/Control/MAC.hs --- a/src/Agent/Control/MAC.hs +++ b/src/Agent/Control/MAC.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} -------------------------------------------------------------------------------- @@ -62,20 +62,12 @@ -------------------------------------------------------------------------------- -import Control.Monad - ( ap - , liftM - ) +import Control.Monad ( ap, liftM ) -import Control.Exception - ( Exception - , SomeException - ) +import Control.Exception ( Exception, SomeException ) import qualified Control.Exception as Ex -import Agent.Control.IFC - ( Flow - ) +import Agent.Control.IFC ( Flow ) -------------------------------------------------------------------------------- diff --git a/src/Agent/IO/Effects.hs b/src/Agent/IO/Effects.hs --- a/src/Agent/IO/Effects.hs +++ b/src/Agent/IO/Effects.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} -------------------------------------------------------------------------------- @@ -14,17 +14,160 @@ -------------------------------------------------------------------------------- module Agent.IO.Effects - ( -- * LLM - LlmChatConf(llmChatKey, llmChatAPI) - , LlmChatCurl(llmChatCurl) + ( -- * LLM (Config) + LlmConf(llmPathCWD) + -- * LLM (Chat) + , LlmChatConf(llmChatKey, llmChatAPI) + , LlmChatPost(llmChatWeb) + , -- * LLM (Code) + LlmCodeRoot(llmCodeDir) + , LlmCodeMask(llmCodeMsk) + , LlmCodeRead(llmCodeSeq, llmCodeGet) + , LlmCodeSave(llmCodePut) + , -- * LLM (Plan) + LlmPlanRoot(llmPlanDir) + , LlmPlanMask(llmPlanMsk) + , LlmPlanRead(llmPlanSeq, llmPlanGet) + , LlmPlanConf(llmPlanKey, llmPlanAPI) + , LlmPlanPost(llmPlanWeb) ) where -------------------------------------------------------------------------------- -class Monad m => LlmChatConf m where - llmChatAPI :: m (Maybe String) - llmChatKey :: m (Maybe String) +class + Monad m + => LlmConf m + where + llmPathCWD + :: m (Maybe String) -class LlmChatConf m => LlmChatCurl m where - llmChatCurl :: String -> m (Either String String) +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +class + Monad m + => LlmChatConf m + where + llmChatAPI + :: m (Maybe String) + llmChatKey + :: m (Maybe String) + +-------------------------------------------------------------------------------- + +class + LlmChatConf m + => LlmChatPost m + where + llmChatWeb + :: String + -> m (Either String String) + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +class + Monad m + => LlmCodeRoot m + where + llmCodeDir + :: m String -- Ex: "src" + +-------------------------------------------------------------------------------- + +class + Monad m + => LlmCodeMask m + where + llmCodeMsk + :: m [ String ] -- Ex: [ "*.hs", "*.lhs" ] + +-------------------------------------------------------------------------------- + +class + ( LlmConf m + , LlmCodeRoot m + , LlmCodeMask m + ) + => LlmCodeRead m + where + llmCodeSeq + :: Maybe String + -> m (Either String [ String ]) + llmCodeGet + :: String + -> m (Either String String) + +-------------------------------------------------------------------------------- + +class + ( LlmConf m + , LlmCodeRoot m + ) + => LlmCodeSave m + where + llmCodePut + :: m [ (String, String) ] + -> m [ (Either String ()) ] + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +class + Monad m + => LlmPlanRoot m + where + llmPlanDir + :: m String -- Ex: "llm" + +-------------------------------------------------------------------------------- + +class + Monad m + => LlmPlanMask m + where + llmPlanMsk + :: m [ String ] -- Ex: [ "plan_*.md" ] + +-------------------------------------------------------------------------------- + +class + ( LlmConf m + , LlmPlanRoot m + , LlmPlanMask m + ) + => LlmPlanRead m + where + llmPlanSeq + :: Maybe String + -> m (Either String [ String ]) + llmPlanGet + :: String + -> m (Either String String) + +-------------------------------------------------------------------------------- + +class + Monad m + => LlmPlanConf m + where + llmPlanAPI + :: m (Maybe String) + llmPlanKey + :: m (Maybe String) + +-------------------------------------------------------------------------------- + +class + ( LlmConf m + , LlmPlanConf m + ) + => LlmPlanPost m + where + llmPlanWeb + :: String + -> m (Either String String) + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/Agent/IO/Restricted.hs b/src/Agent/IO/Restricted.hs --- a/src/Agent/IO/Restricted.hs +++ b/src/Agent/IO/Restricted.hs @@ -1,13 +1,15 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE LambdaCase #-} + -------------------------------------------------------------------------------- -- | @@ -50,37 +52,44 @@ -- * Read/Print , input , output + -- * LLM (Config) + , llmPathCWD -- * LLM (Chat) , llmChatKey, llmChatAPI - , llmChatCurl + , llmChatWeb -- * LLM (Code) + , llmCodeDir + , llmCodeMsk + , llmCodeSeq, llmCodeGet + -- * LLM (Plan) + , llmPlanDir + , llmPlanMsk + , llmPlanSeq, llmPlanGet + , llmPlanKey, llmPlanAPI + , llmPlanWeb + -- * Temporary + , readFileStrict ) where -------------------------------------------------------------------------------- +import Data.Either ( partitionEithers ) +import Data.List ( isInfixOf ) +import Data.Maybe ( fromMaybe ) import qualified System.Environment.Blank as ENV -import System.IO - {- - ( hFlush, hPutStr, stdout - , hSetEncoding - , utf8 - ) - -} - ( hFlush, stdout - , hReady, stdin - ) import System.Exit - ( ExitCode - ( ExitFailure - , ExitSuccess - ) + ( ExitCode (ExitFailure, ExitSuccess) ) +import System.IO ( hFlush, hReady, stdin, stdout ) import System.Process - ( readProcessWithExitCode + ( CreateProcess (cwd) + , proc + , readCreateProcessWithExitCode + , readProcessWithExitCode ) -import qualified Agent.IO.Effects as EFF +import qualified Agent.IO.Effects as EFF -------------------------------------------------------------------------------- @@ -97,25 +106,36 @@ (>>=) m f = RestrictedIO $ run m >>= run . f -------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- class StdIn m where - input :: m String + input + :: [ String ] + -> [ String ] + -> m String class StdOut m where - output :: String -> m () + output + :: String + -> m () +-------------------------------------------------------------------------------- + instance StdIn RIO where - input = - RestrictedIO $ aux [] [] + -- BUG: Issue with multiline text + input prev next = + -- TODO: CTRL+U (erase from cursor to start of line) and CTRL+K (erase from + -- cursor to end of line + RestrictedIO $ aux prev next [] [] where - aux bcs acs = + aux hps hns bcs acs = key >>= \ k -> - case k of + case (k < [ '\32' ], k) of -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER) - '\008':[] -> + (True , '\008':[]) -> case bcs of -- NOTE: Backspace (remove char if any and re-write after chars) - [ ] -> aux bcs acs + [ ] -> aux hps hns bcs acs (_:cs) -> putChar '\008' >> hFlush stdout >> putChar '\032' >> hFlush stdout >> @@ -124,96 +144,141 @@ putChar '\008' >> hFlush stdout >> putStr acs >> hFlush stdout >> putStr rm >> hFlush stdout >> - aux cs acs + aux hps hns cs acs where + la = [ '\ESC', '[', 'D' ] lc = length acs es = concatMap id $ take lc $ repeat sp rm = concatMap id $ take lc $ repeat la sp = [ ' ' ] - la = [ '\ESC', '[', 'D' ] - '\010':[] -> - -- NOTE: Enter (only if something is typed) + (True , '\010':[]) -> + -- NOTE: ENTER (only if something is typed) case (bcs, acs) of ([], []) -> - aux bcs acs + aux hps hns bcs acs ________ -> pure $ (++ acs) $ reverse $ bcs - '\ESC':'[':'C':[] -> - -- NOTE: Allowed escaped sequences: Arrow "->" + (True , '\012':[]) -> + -- NOTE: Form Feed becomes "/w" (clear screen) + pure $ "/w" + (True , '\ESC':'[':'A':[]) -> + -- NOTE: Allowed escaped sequences: Arrow "↑" + case (txt, hps, hns) of + (_, [ ], _) -> aux hps hns bcs acs + (_, p:ps, _) -> + putStr rm >> hFlush stdout >> + putStr es >> hFlush stdout >> + putStr rm >> hFlush stdout >> + putStr p >> hFlush stdout >> + aux ps (p:hns) rev [] + where + rev = reverse p + where + sp = [ ' ' ] + la = [ '\ESC', '[', 'D' ] + lc = length txt + es = concatMap id $ take lc $ repeat sp + rm = concatMap id $ take lc $ repeat la + txt = (++ acs) $ reverse $ bcs + (True , '\ESC':'[':'B':[]) -> + -- NOTE: Allowed escaped sequences: Arrow "↓" + case (txt, hps, hns) of + (_, _, [ ]) -> aux hps hns bcs acs + (_, _, p:ps) -> + putStr rm >> hFlush stdout >> + putStr es >> hFlush stdout >> + putStr rm >> hFlush stdout >> + putStr p >> hFlush stdout >> + aux (p:hps) ps rev [] + where + rev = reverse p + where + sp = [ ' ' ] + la = [ '\ESC', '[', 'D' ] + lc = length txt + es = concatMap id $ take lc $ repeat sp + rm = concatMap id $ take lc $ repeat la + txt = (++ acs) $ reverse $ bcs + (True , '\ESC':'[':'C':[]) -> + -- NOTE: Allowed escaped sequences: Arrow "→" case (bcs, acs) of (_, [ ]) -> - aux bcs acs + aux hps hns bcs acs (_, c:cs) -> putStr k >> hFlush stdout >> - aux (c:bcs) cs - '\ESC':'[':'D':[ ] -> - -- NOTE: Allowed escaped sequences: Arrow "<-" + aux hps hns (c:bcs) cs + (True , '\ESC':'[':'D':[ ]) -> + -- NOTE: Allowed escaped sequences: Arrow "←" case (bcs, acs) of ([ ], _) -> - aux bcs acs + aux hps hns bcs acs (c:cs, _) -> putStr k >> hFlush stdout >> - aux cs (c:acs) - '\ESC':'[':'H':[] -> - -- NOTE: HOME - putStr rm >> hFlush stdout >> - (aux [] ((reverse bcs) ++ acs)) - where - lc = length bcs - rm = concatMap id $ take lc $ repeat la - la = [ '\ESC', '[', 'D' ] - '\ESC':'[':'1':';':'5':'C':[] -> - -- NOTE: Allowed escaped sequences: CTRL + Arrow "->" + aux hps hns cs (c:acs) + (True , '\ESC':'[':'1':';':'5':'C':[]) -> + -- NOTE: Allowed escaped sequences: CTRL + Arrow "→" putStr rm >> hFlush stdout >> - (aux (ts ++ bcs) ds) + (aux hps hns (ts ++ bcs) ds) where ds = dropWhile (== ' ') $ dropWhile (/= ' ') acs ts = drop (length ds) $ reverse acs + la = [ '\ESC', '[', 'C' ] lc = length ts rm = concatMap id $ take lc $ repeat la - la = [ '\ESC', '[', 'C' ] - '\ESC':'[':'1':';':'5':'D':[] -> - -- NOTE: Allowed escaped sequences: CTRL + Arrow "<-" + (True , '\ESC':'[':'1':';':'5':'D':[]) -> + -- NOTE: Allowed escaped sequences: CTRL + Arrow "←" putStr rm >> hFlush stdout >> - (aux ds (ts ++ acs)) + (aux hps hns ds (ts ++ acs)) where ds = dropWhile (== ' ') $ dropWhile (/= ' ') bcs ts = drop (length ds) $ reverse bcs + la = [ '\ESC', '[', 'D' ] lc = length ts rm = concatMap id $ take lc $ repeat la + (True , '\ESC':'[':'H':[]) -> + -- NOTE: HOME + -- HERE: + putStr rm >> hFlush stdout >> + (aux hps hns [] ((reverse bcs) ++ acs)) + where la = [ '\ESC', '[', 'D' ] - '\ESC':'[':'F':[] -> + lc = length bcs + rm = concatMap id $ take lc $ repeat la + (True , '\ESC':'[':'F':[]) -> -- NOTE: END putStr rm >> hFlush stdout >> - (aux ((++ bcs) $ reverse $ acs) []) + (aux hps hns ((++ bcs) $ reverse $ acs) []) where + la = [ '\ESC', '[', 'C' ] lc = length acs rm = concatMap id $ take lc $ repeat la - la = [ '\ESC', '[', 'C' ] - '\ESC':'[':'3':'~':[] -> + (True , '\ESC':'[':'3':'~':[]) -> case acs of -- NOTE: Delete (remove char if any and re-write after chars) - [ ] -> aux bcs acs + [ ] -> aux hps hns bcs acs (_:cs) -> putStr cs >> hFlush stdout >> putChar ' ' >> hFlush stdout >> putStr rm >> hFlush stdout >> - (aux bcs cs) + (aux hps hns bcs cs) where + la = [ '\ESC', '[', 'D' ] lc = length acs rm = concatMap id $ take lc $ repeat la - la = [ '\ESC', '[', 'D' ] - '\ESC':__ -> + (True , '\ESC':__) -> -- NOTE: Other escaped sequences (skip) - aux bcs acs - '\DEL':[] -> + aux hps hns bcs acs + (True , _) -> + -- NOTE: Skip all other unhandled control keys + aux hps hns bcs acs + (False, '\DEL':[]) -> -- NOTE: DELETE (skip) - aux bcs acs - _________ -> + aux hps hns bcs acs + (False, _) -> putStr k >> hFlush stdout >> putStr acs >> hFlush stdout >> putStr rm >> hFlush stdout >> - (aux (reverse k ++ bcs) acs) + (aux hps hns (reverse k ++ bcs) acs) where lc = length acs rm = concatMap id $ take lc $ repeat la @@ -222,7 +287,7 @@ -- NOTE: https://stackoverflow.com/a/38553473 reverse <$> nxt [] where - nxt cs = + nxt cs = do c <- getChar m <- hReady stdin @@ -233,62 +298,454 @@ putStr x >> hFlush stdout -------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- -class SysEnv m where - getEnvVar :: String -> m (Maybe String) +class + EFF.LlmConf m + => LlmConf m + where + llmPathCWD + :: m (Maybe String) -instance SysEnv RIO where - getEnvVar = RestrictedIO . ENV.getEnv +instance + EFF.LlmConf RIO + => LlmConf RIO + where + llmPathCWD = getEnvVar "LLM_PATH_CWD" -------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- -class ReadProc m where - withExitCode :: String -> [String] -> m (Either String String) +class + EFF.LlmChatConf m + => LlmChatConf m + where + llmChatAPI + :: m (Maybe String) + llmChatKey + :: m (Maybe String) -instance ReadProc RIO where - withExitCode app fs = RestrictedIO $ - do - (exitcode, out, err) <- readProcessWithExitCode app fs [] - case exitcode of - ExitSuccess -> - pure $ Right out - ExitFailure _ -> +instance + EFF.LlmChatConf RIO + => LlmChatConf RIO + where + llmChatAPI = getEnvVar "LLM_CHAT_LOCALHOST_API" + llmChatKey = pure Nothing + +-------------------------------------------------------------------------------- + +class + EFF.LlmChatConf m + => LlmChatPost m + where + llmChatWeb + :: String -> m (Either String String) + +instance + EFF.LlmChatConf RIO + => LlmChatPost RIO + where + llmChatWeb json = + EFF.llmChatAPI >>= \ mapi -> + EFF.llmChatKey >>= \ mkey -> + llmCurl json mapi mkey + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +class + EFF.LlmConf m + => LlmCodeRoot m + where + llmCodeDir + :: m String + +instance + ( EFF.LlmConf RIO + , EFF.LlmCodeRoot RIO + ) + => LlmCodeRoot RIO + where + llmCodeDir = pure "src" + +-------------------------------------------------------------------------------- + +class + EFF.LlmCodeMask m + => LlmCodeMask m + where + llmCodeMsk + :: m [ String ] + +instance + ( EFF.LlmConf RIO + , EFF.LlmCodeMask RIO + ) + => LlmCodeMask RIO + where + llmCodeMsk = pure [ "*.hs" ] + +-------------------------------------------------------------------------------- + +class + ( EFF.LlmConf m + , EFF.LlmCodeRoot m + , EFF.LlmCodeMask m + ) + => LlmCodeRead m + where + llmCodeSeq + :: Maybe String + -> m (Either String [ String ]) + llmCodeGet + :: String + -> m (Either String String) + +instance + ( EFF.LlmConf RIO + , EFF.LlmCodeRoot RIO + , EFF.LlmCodeMask RIO + ) + => LlmCodeRead RIO + where + llmCodeSeq mfilter = + EFF.llmPathCWD >>= \ ocwd -> + EFF.llmCodeDir >>= \ cdir -> + EFF.llmCodeMsk >>= \ cmsk -> + realPath (fromMaybe [] ocwd ++ "/" ++ cdir) >>= \ efrp -> + case efrp of + Right frp -> + ( \ case + ([], rs) -> + Right $ concat rs + (ls, __) -> + Left $ foldl1 (\ x y -> x ++ "\n" ++ y) ls + ) + . partitionEithers + . map + ( \ case + Right fns -> + case mfilter of + Nothing -> Right rel + Just fil -> Right $ filter (isInfixOf fil) rel + where + rel = map (cdir ++ ) fns + Left err -> + Left err + ) + <$> mapM (findFiles frp) cmsk + Left err -> pure $ Left err + llmCodeGet relpath = + EFF.llmPathCWD >>= \ ocwd -> + realPath (fromMaybe [] ocwd) >>= \ efrp -> + case efrp of + Right frp -> + Right <$> readFileStrict (frp ++ "/" ++ relpath) + Left err -> + pure $ Left err + -------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- -class (EFF.LlmChatConf m, SysEnv m) => LlmChatConf m where - llmChatAPI :: m (Maybe String) - llmChatKey :: m (Maybe String) +class + EFF.LlmConf m + => LlmPlanRoot m + where + llmPlanDir + :: m String -instance (EFF.LlmChatConf RIO, SysEnv RIO) => LlmChatConf RIO where - llmChatAPI = getEnvVar "LLM_CHAT_LOCALHOST_API" - llmChatKey = pure Nothing +instance + ( EFF.LlmConf RIO + , EFF.LlmPlanRoot RIO + ) + => LlmPlanRoot RIO + where + llmPlanDir = pure "llm" -class (EFF.LlmChatConf m , ReadProc m) => LlmChatCurl m where - llmChatCurl :: String -> m (Either String String) +-------------------------------------------------------------------------------- -instance (EFF.LlmChatConf RIO, ReadProc RIO) => LlmChatCurl RIO where - llmChatCurl json = - llmChatAPI >>= \ mapi -> - llmChatKey >>= \ mkey -> - case (mapi, mkey) of - (Nothing, _ ) -> - RestrictedIO $ pure $ Left "No API address was provided" - (Just api, Nothing) -> - withExitCode "curl" - [ "--silent" +class + EFF.LlmConf m + => LlmPlanMask m + where + llmPlanMsk + :: m [ String ] + +instance + ( EFF.LlmConf RIO + , EFF.LlmPlanMask RIO + ) + => LlmPlanMask RIO + where + llmPlanMsk = pure [ "plan_*.md" ] + +-------------------------------------------------------------------------------- + +class + ( EFF.LlmConf m + , EFF.LlmPlanRoot m + , EFF.LlmPlanMask m + ) + => LlmPlanRead m + where + llmPlanSeq + :: Maybe String + -> m (Either String [ String ]) + llmPlanGet + :: String + -> m (Either String String) + +instance + ( EFF.LlmConf RIO + , EFF.LlmPlanRoot RIO + , EFF.LlmPlanMask RIO + ) + => LlmPlanRead RIO + where + llmPlanSeq mfilter = + EFF.llmPathCWD >>= \ ocwd -> + EFF.llmPlanDir >>= \ pdir -> + EFF.llmPlanMsk >>= \ pmsk -> + realPath (fromMaybe [] ocwd ++ "/" ++ pdir) >>= \ efrp -> + case efrp of + Right frp -> + ( \ case + ([], rs) -> + Right $ concat rs + (ls, __) -> + Left $ foldl1 (\ x y -> x ++ "\n" ++ y) ls + ) + . partitionEithers + . map + ( \ case + Right fns -> + case mfilter of + Nothing -> Right rel + Just fil -> Right $ filter (isInfixOf fil) rel + where + rel = map (pdir ++ ) fns + Left err -> + Left err + ) + <$> mapM (findFiles frp) pmsk + Left err -> + pure $ Left err + + llmPlanGet path = + EFF.llmPathCWD >>= \ ocwd -> + EFF.llmPlanDir >>= \ pdir -> + realPath (fromMaybe [] ocwd ++ "/" ++ pdir) >>= \ efrp -> + case efrp of + Right rp -> + if isInfixOf rp path then + Right <$> readFileStrict path + else + pure $ Left $ "File: " ++ path ++ " is not in: " ++ rp + Left err -> + pure $ Left err + +-------------------------------------------------------------------------------- + +class + ( EFF.LlmConf m + , EFF.LlmPlanConf m + ) + => LlmPlanConf m + where + llmPlanAPI + :: m (Maybe String) + llmPlanKey + :: m (Maybe String) + +instance + ( EFF.LlmConf RIO + , EFF.LlmPlanConf RIO + ) + => LlmPlanConf RIO + where + llmPlanAPI = getEnvVar "LLM_PLAN_LOCALHOST_API" + llmPlanKey = pure Nothing + +-------------------------------------------------------------------------------- + +class + ( EFF.LlmConf m + , EFF.LlmPlanConf m + ) + => LlmPlanPost m + where + llmPlanWeb + :: String + -> m (Either String String) + +instance + ( EFF.LlmConf RIO + , EFF.LlmPlanConf RIO + ) + => LlmPlanPost RIO + where + llmPlanWeb json = + EFF.llmPathCWD >>= \ ocwd -> + realPath (fromMaybe [] ocwd) >>= \ efrp -> + case efrp of + Right rp -> + gitExist rp >>= \ git -> + if git then + EFF.llmPlanAPI >>= \ mapi -> + EFF.llmPlanKey >>= \ mkey -> + llmCurl json mapi mkey + else + pure $ Left "No GIT repo initialized" + Left err -> + pure $ Left err + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-- HELPERS (public) + +getEnvVar + :: String + -> RIO (Maybe String) +getEnvVar = + RestrictedIO . ENV.getEnv + +-------------------------------------------------------------------------------- + +-- HELPERS (private) + +findFiles + :: String + -> String + -> RIO (Either String [String]) +findFiles path mask = + -- NOTE: Remove any '\NUL` from filepaths + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110 + ( \case + Right str -> + Right + $ map (filter (/= '\NUL')) + $ map (drop (length path)) -- NOTE: Relative paths instead of full + $ lines str + Left err -> + Left err + ) + <$> withExitCodeAndCWD path "find" + [ path + , "-name" + , mask + ] + +gitExist + :: String + -> RIO Bool +gitExist path = + ( \case + Right _ -> True + Left _ -> False + ) + <$> withExitCodeAndCWD path "git" + [ "status" + ] + +llmCurl + :: String + -> Maybe String + -> Maybe String + -> RIO (Either String String) +llmCurl json mapi mkey = + case (mapi, mkey) of + (Nothing, _ ) -> + RestrictedIO $ pure $ Left "No API address was provided" + (Just api, Nothing) -> + withExitCode "curl" + ( [ "--silent" , "--show-error" - , "--header" , "\"Content-Type: application/json; charset=utf-8\"" - , "--data" , json + ] + ++ hs ++ + [ "--data", json , api ++ "/chat/completions" ] - (Just api, Just key) -> - withExitCode "curl" - [ "--silent" + ) + (Just api, Just key) -> + withExitCode "curl" + ( [ "--silent" , "--show-error" - , "--header" , "\"Authorization: \"" ++ key ++ "\"" - , "--header" , "\"Content-Type: application/json; charset=utf-8\"" - , "--data" , json + , "--header", "\"Authorization: \"" ++ key ++ "\"" + ] + ++ hs ++ + [ "--data", json , api ++ "/chat/completions" ] + ) + where + hs = + [ "--header" , "\"Accept: application/json\"" + , "--header" , "\"Accept-Encoding: gzip, deflate, br\"" + , "--header" , "\"Content-Type: application/json; charset=utf-8\"" + , "--header" , "\"User-Agent: Λ-gent/0.11\"" + ] + +readFileStrict + :: FilePath + -> RIO String +readFileStrict path = + -- NOTE: «Too Many Open Files» error in Linux + -- + -- - http://woshub.com/too-many-open-files-error-linux/ + RestrictedIO $ + readFile path >>= \bs -> + length bs `seq` pure bs + +realPath + :: String + -> RIO (Either String String) +realPath path = + -- NOTE: Remove any '\NUL` from filepaths + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110 + ( \case + Right str -> Right $ filter (/= '\NUL') str + Left err -> Left err + ) + <$> withExitCode "realpath" + [ "--canonicalize-existing" + , "--logical" + , "--physical" + -- NOTE: End each output line with NUL, not newline + , "--zero" + , path + ] + +withExitCode + :: String + -> [String] + -> RIO (Either String String) +withExitCode cmd args = + RestrictedIO $ + do + (exitcode, out, err) <- readProcessWithExitCode cmd args [] + case exitcode of + ExitSuccess -> + pure $ Right out + ExitFailure _ -> + pure $ Left err + +withExitCodeAndCWD + :: String + -> String + -> [String] + -> RIO (Either String String) +withExitCodeAndCWD path cmd args = + RestrictedIO $ + do + (exitcode, out, err) <- readCreateProcessWithExitCode rcp [] + case exitcode of + ExitSuccess -> + pure $ Right out + ExitFailure _ -> + pure $ Left err + where + raw = proc cmd args + rcp = raw { cwd = Just path } diff --git a/src/Agent/JSON.hs b/src/Agent/JSON.hs --- a/src/Agent/JSON.hs +++ b/src/Agent/JSON.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} -------------------------------------------------------------------------------- @@ -25,16 +25,14 @@ -------------------------------------------------------------------------------- -import Data.Data - ( Data - ) +import Data.Data ( Data ) -import Internal.GaloisInc.Text.JSON.Generic - ( Result(Error, Ok) +import Internal.GaloisInc.Text.JSON.Generic + ( Result (Error, Ok) , encodeJSON , fromJSON ) -import Internal.GaloisInc.Text.JSON.String +import Internal.GaloisInc.Text.JSON.String ( readJSValue , runGetJSON ) diff --git a/src/Agent/LLM.hs b/src/Agent/LLM.hs --- a/src/Agent/LLM.hs +++ b/src/Agent/LLM.hs @@ -1,10 +1,12 @@ {-# OPTIONS_GHC -Wall -Werror #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} + -------------------------------------------------------------------------------- -- | @@ -23,6 +25,7 @@ Mode(..) -- * Context , Load + , History(..) , Context(..) -- * Paramenters , Eval @@ -34,24 +37,33 @@ -------------------------------------------------------------------------------- -import Prelude hiding (head, mod, print, read) - -import Data.Char - ( toLower +import Prelude hiding + ( head + , mod + , print + , read ) + +import Data.Char ( toLower, toUpper ) +import GHC.IO.Encoding ( setLocaleEncoding ) import System.IO - ( BufferMode(NoBuffering) - , hFlush, hSetBuffering, hSetEcho - , stderr, stdin, stdout + ( BufferMode (NoBuffering) + , hFlush + , hSetBuffering + , hSetEcho + , stderr + , stdin + , stdout , utf8 ) -import GHC.IO.Encoding - ( setLocaleEncoding - ) +import Text.Read ( readMaybe ) +import Internal.GaloisInc.Text.JSON.Generic ( Data ) + import Agent.IO.Restricted -import Agent.JSON - ( Data + ( RIO (..) + , input + , output ) -------------------------------------------------------------------------------- @@ -64,27 +76,34 @@ | Echo | Plan | Test - deriving (Bounded, Enum, Eq, Show) - -{- TODO: Use ↑ and ↓ to see previous and current input text -data Text = - Text - { prev :: [String] - , curr :: String - , next :: [String] - } --} + deriving (Bounded, Enum, Eq, Read, Show) type Load a = Data a => Maybe a +data History = + History + { view :: Bool + , prev :: [String] + , next :: [String] + } + +type Index = Int + +type Numbers = Bool + +type Filter = String + data Context a = Context { exit :: Bool , mode :: Mode - -- , text :: Text , load :: Load a + , hist :: History + , list :: Maybe Filter + , safe :: Maybe Filter + , file :: Maybe (Index, Numbers) } type Eval a = @@ -110,7 +129,8 @@ hSetBuffering stderr NoBuffering hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering - hSetEcho stdin False -- NOTE: No default output when typing + -- NOTE: No default output when typing + hSetEcho stdin False putStrLn head >> hFlush stdout run $ loop ctx proc where @@ -119,49 +139,151 @@ { exit = False , mode = mod , load = Nothing + , hist = + History + { view = False + , prev = [] + , next = [] + } + , list = Nothing + , safe = Nothing + , file = Nothing } -------------------------------------------------------------------------------- -- HELPERS +{- NOTE: Doesn't seem to work +ctrlC :: IO () -> IO () +ctrlC task = + -- NOTE: Catch CTRL+C + -- https://neilmitchell.blogspot.com/2015/05/handling-control-c-in-haskell.html + sync . (:[]) <$> fork task +-} + loop :: Context a -> Eval a -> RIO () loop ctx eval = - if exit ctx then - return () - else - print prompt >> - read >>= \ txt -> - case txt of - "/exit" -> - printLn [] >> - printLn "Λ-gent will shutdown" >> - loop (ctx { exit = True }) eval - "/help" -> - printLn [ ] >> - printLn help >> - loop ctx eval - "/mode chat" -> - printLn [ ] >> - printLn "Changed to chat-mode" >> - loop (ctx { mode = Chat }) eval - "/mode code" -> - printLn [ ] >> - printLn "Changed to code-mode" >> - loop (ctx { mode = Code }) eval - "/mode echo" -> - printLn [ ] >> - printLn "Changed to echo-mode" >> - loop (ctx { mode = Echo }) eval - ____________ -> - eval ctx txt >>= \ (upd, res) -> - printLn [ ] >> - printLn res >> - loop upd eval + case ctx of + Context { exit = True } -> + return () + Context { hist = History { view = True } } -> + eval ctx [ ] >>= \ (upd, res) -> + printLn res >> + loop (upd { hist = ((hist ctx) { view = False }) }) eval + Context { list = Just _ } -> + eval ctx [ ] >>= \ (upd, res) -> + printLn res >> + loop (upd { list = Nothing, safe = list ctx }) eval + Context { file = Just _, safe = Just _ } -> + eval ctx [ ] >>= \ (upd, res) -> + printLn res >> + loop (upd { file = Nothing }) eval + __________________________________________ -> + print prompt >> + read hps hns >>= \ txt -> + printLn [ ] >> + case txt of + '/':'m':'o':'d':'e':' ':c:cs -> caseMode txt c cs + '/':'m' :' ':c:cs -> caseMode txt c cs + '/':'f':'i':'l':'e' :midx -> caseFile txt midx + '/':'f' :midx -> caseFile txt midx + '/':'n':'u':'m':'s' :midx -> caseNums txt midx + '/':'n' :midx -> caseNums txt midx + '/':'l':'i':'s':'t' :mfil -> caseList txt mfil + '/':'l' :mfil -> caseList txt mfil + "/safe" -> caseSafe txt + "/s" -> caseSafe txt + "/hist" -> caseHist txt + "/h" -> caseHist txt + "/wipe" -> caseWipe txt + "/w" -> caseWipe txt + "/help" -> caseHelp txt + "/?" -> caseHelp txt + "/exit" -> caseExit txt + "/e" -> caseExit txt + '/':cmd -> + printLn msg >> + loop (nxt txt ctx) eval + where + msg = "Command not recognized: " ++ cmd + ____________________________ -> + eval ctx txt >>= \ (upd, res) -> + printLn res >> + loop (nxt txt upd) eval + where + his = hist ctx + hps = prev his + hns = next his + nxt p c = c { hist = (hist c) { prev = p : hps } } + -- NOTE: Enforce DRY in cases + caseMode txt c cs = + case mmod of + Just mod -> + printLn ("Changed to " ++ low ++ "-mode") >> + loop (nxt txt (ctx { mode = mod, safe = Nothing })) eval + where + low = map toLower $ show mod + Nothing -> + printLn ("Invalid mode: " ++ c:cs) >> + loop (nxt txt ctx) eval + where + mmod = readMaybe (toUpper c : map toLower cs) :: Maybe Mode + caseFile txt midx = + case lst of + Just _ -> + loop (nxt txt (ctx { file = (, False) <$> idx })) eval + Nothing -> + printLn ("Invalid index") >> + loop (nxt txt ctx) eval + where + lst = safe ctx + idx = + case midx of + [ ] -> Nothing + ' ':cs -> readMaybe cs :: Maybe Int + ______ -> Nothing + caseNums txt midx = + case lst of + Just _ -> + loop (nxt txt (ctx { file = (, True) <$> idx })) eval + Nothing -> + printLn ("Invalid index") >> + loop (nxt txt ctx) eval + where + lst = safe ctx + idx = + case midx of + [ ] -> Nothing + ' ':cs -> readMaybe cs :: Maybe Int + ______ -> Nothing + caseList txt mfil = + loop (nxt txt (ctx { list = fil })) eval + where + fil = + case mfil of + [ ] -> Just mfil + ' ':cs -> Just cs + ______ -> Nothing + caseSafe txt = + loop (nxt txt (ctx { list = safe ctx })) eval + caseHist txt = + loop (nxt txt (ctx { hist = his { view = True } })) eval + caseWipe txt = + -- NOTE: Clear screen & Move top-left + printLn clear >> + loop (nxt txt ctx) eval + caseHelp txt = + printLn help >> + loop (nxt txt ctx) eval + caseExit txt = + printLn "Λ-gent will shutdown" >> + loop (nxt txt (ctx { exit = True })) eval where + clear = "\ESC[H\ESC[2J" -- NOTE: See `infocmp -x` prompt = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> " read = input print = output @@ -173,13 +295,19 @@ head :: String head = - "# Quit Λ-gent with `/exit`. For more commands, type `/help`." + "# Exit Λ-gent with /e or /exit. For more commands, type /? or /help." help :: String help = - "# Supported commands\n" ++ - "* /help : This message\n" ++ - "* /exit : Quit Λ-gent\n" ++ - "* /mode : Change mode to {" ++ ms ++ "}`. Ex:`/mode code`" + "# Supported commands:\n" ++ + "/? or /help | This message\n" ++ + "/e or /exit | Exit Λ-gent\n" ++ + "/w or /wipe | Clear screen\n" ++ + "/m or /mode | Change to {" ++ ms ++ "}. Ex: /m code\n" ++ + "/h or /hist | View input history\n" ++ + "/s or /safe | Show stored list of files. See /list below\n" ++ + "/l f or /list f | List of files, limited by mode, file masks and filter\n" ++ + "/f i or /file i | Show file with the given index. See, /safe above\n" ++ + "/n i or /nums i | Show file with line numbers. See /file above" where ms = foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes diff --git a/src/Agent/Utils/Code.hs b/src/Agent/Utils/Code.hs new file mode 100644 --- /dev/null +++ b/src/Agent/Utils/Code.hs @@ -0,0 +1,70 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +{-# LANGUAGE LambdaCase #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- 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 diff --git a/src/Agent/Utils/Common.hs b/src/Agent/Utils/Common.hs new file mode 100644 --- /dev/null +++ b/src/Agent/Utils/Common.hs @@ -0,0 +1,81 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- Stability : experimental + +-------------------------------------------------------------------------------- + +module Agent.Utils.Common + ( -- * Files + files + , file + -- * Helpers + , leftpad + , index + ) +where + +-------------------------------------------------------------------------------- + +leftpad + :: Char + -> Int + -> [Char] + -> [Char] +leftpad chr rep cs = + replicate (rep - length xs) chr ++ xs + where + xs = take rep cs + +index + :: Int + -> Int + -> String +index rep idx = + leftpad '0' rep $ show idx + +files + :: Bool + -> [ String ] + -> [ String ] +files nums fs = + if null fs then + [] + else + map (\ (idx, rel) -> f idx rel) + $ zip [0..] fs + where + len = length $ show $ length fs + f i x = + if nums then + index len i ++ ": " ++ x + else + x + +file + :: Bool + -> String + -> String +file nums f = + if null f then + [] + else + unlines + $ map (\ (idx, rel) -> g idx rel) + $ zip [1..] ls + where + ls = lines f + len = length $ show $ length ls + g i x = + if nums then + index len i ++ ": " ++ x + else + x diff --git a/src/Agent/Utils/Plan.hs b/src/Agent/Utils/Plan.hs new file mode 100644 --- /dev/null +++ b/src/Agent/Utils/Plan.hs @@ -0,0 +1,70 @@ +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + +{-# LANGUAGE LambdaCase #-} + +-------------------------------------------------------------------------------- + +-- | +-- Copyright : (c) 2026 SPISE MISU ApS +-- License : SSPL-1.0 OR AGPL-3.0-only +-- Maintainer : SPISE MISU +-- 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