never executed always true always false
1 module PureClaw.Agent.Completion
2 ( -- * Completion function builder
3 buildCompleter
4 -- * Pure completion logic (exported for testing)
5 , slashCompletions
6 ) where
7
8 import Control.Exception
9 import Data.Char qualified as Char
10 import Data.IORef
11 import Data.List qualified as L
12 import Data.Map.Strict qualified as Map
13 import Data.Text qualified as T
14 import Data.Time.Clock qualified as Time
15 import System.Console.Haskeline qualified as HL
16 import System.Timeout qualified as Timeout
17
18 import PureClaw.Agent.AgentDef qualified as AgentDef
19 import PureClaw.Agent.Env
20 import PureClaw.Agent.SlashCommands
21 import PureClaw.CLI.Config (getPureclawDir)
22 import PureClaw.Core.Types
23 import PureClaw.Handles.Log (mkNoOpLogHandle)
24 import PureClaw.Providers.Class
25 import System.FilePath ((</>))
26
27 -- | TTL cache for model listing results (30 seconds).
28 data ModelCache = ModelCache
29 { _mc_models :: [ModelId]
30 , _mc_expiry :: Time.UTCTime
31 }
32
33 -- | Build a haskeline 'CompletionFunc' from a live 'AgentEnv' reference.
34 -- Creates an internal cache for model listing results.
35 -- The IORef is read at completion time, so it reflects hot-swapped providers.
36 buildCompleter :: IORef (Maybe AgentEnv) -> IO (HL.CompletionFunc IO)
37 buildCompleter envRef = do
38 cacheRef <- newIORef Nothing
39 pure (completerImpl envRef cacheRef)
40
41 completerImpl :: IORef (Maybe AgentEnv) -> IORef (Maybe ModelCache) -> HL.CompletionFunc IO
42 completerImpl envRef cacheRef (leftOfCursor, _rightOfCursor) = do
43 let line = reverse leftOfCursor
44 mEnv <- readIORef envRef
45 dynamicCandidates <- getDynamicCandidates mEnv cacheRef line
46 let static = slashCompletions line
47 allCandidates = L.nub (static ++ dynamicCandidates)
48 let wordStart = lastWord line
49 if null allCandidates
50 then pure (leftOfCursor, [])
51 else do
52 let completions = map (\c ->
53 HL.Completion
54 { HL.replacement = drop (length wordStart) c
55 , HL.display = c
56 , HL.isFinished = not (hasSubcommands c)
57 }) allCandidates
58 pure (leftOfCursor, completions)
59
60 -- | Extract the last word being typed.
61 lastWord :: String -> String
62 lastWord = reverse . takeWhile (/= ' ') . reverse
63
64 -- | Check if a completion target has further subcommands.
65 hasSubcommands :: String -> Bool
66 hasSubcommands candidate =
67 let lowerCandidate = map Char.toLower candidate
68 in any (\spec ->
69 let syntax = map Char.toLower (T.unpack (_cs_syntax spec))
70 in syntax /= lowerCandidate && (lowerCandidate ++ " ") `L.isPrefixOf` syntax
71 ) allCommandSpecs
72
73 -- | Pure static completions for slash commands.
74 slashCompletions :: String -> [String]
75 slashCompletions line
76 | not ("/" `L.isPrefixOf` stripped) = []
77 | stripped == "/" = L.nub (map commandName allCommandSpecs)
78 | ' ' `notElem` stripped =
79 filter (matchesCI stripped) (L.nub (map commandName allCommandSpecs))
80 | otherwise =
81 let (cmd, rest) = break (== ' ') stripped
82 partial = dropWhile (== ' ') rest
83 in completeSubcommands cmd partial
84 where
85 stripped = dropWhile (== ' ') line
86
87 -- | Complete subcommands for a known command prefix.
88 completeSubcommands :: String -> String -> [String]
89 completeSubcommands cmd partial =
90 let lowerCmd = map Char.toLower cmd
91 matchingSpecs = filter (\s -> map Char.toLower (commandName s) == lowerCmd) allCommandSpecs
92 subcommands = concatMap (extractSubcommands lowerCmd) matchingSpecs
93 in filter (matchesCI partial) subcommands
94
95 -- | Extract subcommand names from a CommandSpec syntax string.
96 extractSubcommands :: String -> CommandSpec -> [String]
97 extractSubcommands cmdPrefix spec =
98 let syntax = T.unpack (_cs_syntax spec)
99 rest = dropWhile (== ' ') (drop (length cmdPrefix) syntax)
100 in case words rest of
101 (sub : _)
102 | not (isPlaceholder sub) -> [sub]
103 _ -> []
104
105 -- | Check if a word is a placeholder like @\<name\>@ or @[N]@.
106 isPlaceholder :: String -> Bool
107 isPlaceholder ('<' : _) = True
108 isPlaceholder ('[' : _) = True
109 isPlaceholder _ = False
110
111 -- | Get dynamic completions that require IO.
112 getDynamicCandidates :: Maybe AgentEnv -> IORef (Maybe ModelCache) -> String -> IO [String]
113 getDynamicCandidates Nothing _ _ = pure []
114 getDynamicCandidates (Just env) cacheRef line = do
115 let lower = map Char.toLower (dropWhile (== ' ') line)
116 if "/target " `L.isPrefixOf` lower
117 then do
118 let partial = drop 8 (dropWhile (== ' ') line)
119 -- Complete with running harness names + available model names
120 harnesses <- readIORef (_env_harnesses env)
121 let harnessNames = map T.unpack (Map.keys harnesses)
122 models <- getCachedModels env cacheRef
123 let modelNames = map (T.unpack . unModelId) models
124 pure (filter (matchesCI partial) (harnessNames ++ modelNames))
125 else if "/msg " `L.isPrefixOf` lower
126 then do
127 let rest = drop 5 (dropWhile (== ' ') line)
128 -- Only complete the first argument (target name), not the message body
129 if ' ' `notElem` rest
130 then do
131 harnesses <- readIORef (_env_harnesses env)
132 let harnessNames = map T.unpack (Map.keys harnesses)
133 pure (filter (matchesCI rest) harnessNames)
134 else pure []
135 else if "/harness start " `L.isPrefixOf` lower
136 then do
137 let partial = drop 15 (dropWhile (== ' ') line)
138 names = concatMap (\(canonical, aliases, _) ->
139 T.unpack canonical : map T.unpack aliases) knownHarnesses
140 pure (filter (matchesCI partial) names)
141 else if "/agent info " `L.isPrefixOf` lower || "/agent start " `L.isPrefixOf` lower
142 then do
143 let prefixLen = if "/agent info " `L.isPrefixOf` lower then 12 else 13
144 partial = drop prefixLen (dropWhile (== ' ') line)
145 agentsDir <- (</> "agents") <$> getPureclawDir
146 defs <- AgentDef.discoverAgents mkNoOpLogHandle agentsDir
147 let names = map (T.unpack . AgentDef.unAgentName . AgentDef._ad_name) defs
148 pure (map T.unpack (agentNameMatches (map T.pack names) (T.pack partial)))
149 else if "/provider " `L.isPrefixOf` lower
150 then do
151 let partial = drop 10 (dropWhile (== ' ') line)
152 names = ["anthropic", "openai", "openrouter", "ollama"]
153 pure (filter (matchesCI partial) names)
154 else
155 pure []
156
157 -- | Get models with a 30-second TTL cache.
158 getCachedModels :: AgentEnv -> IORef (Maybe ModelCache) -> IO [ModelId]
159 getCachedModels env cacheRef = do
160 now <- Time.getCurrentTime
161 mCache <- readIORef cacheRef
162 case mCache of
163 Just cache | _mc_expiry cache > now -> pure (_mc_models cache)
164 _ -> do
165 models <- getModelsWithTimeout env
166 let expiry = Time.addUTCTime 30 now
167 writeIORef cacheRef (Just (ModelCache models expiry))
168 pure models
169
170 -- | Query the provider for available models with a 3-second timeout.
171 getModelsWithTimeout :: AgentEnv -> IO [ModelId]
172 getModelsWithTimeout env = do
173 mProvider <- readIORef (_env_provider env)
174 case mProvider of
175 Nothing -> pure []
176 Just provider -> do
177 result <- try @SomeException (Timeout.timeout 3000000 (listModels provider))
178 case result of
179 Right (Just models) -> pure models
180 _ -> pure []
181
182 -- | Case-insensitive prefix match.
183 matchesCI :: String -> String -> Bool
184 matchesCI prefix candidate =
185 map Char.toLower prefix `L.isPrefixOf` map Char.toLower candidate
186
187 -- | Extract the command name (first word) from a CommandSpec's syntax.
188 commandName :: CommandSpec -> String
189 commandName spec =
190 case words (T.unpack (_cs_syntax spec)) of
191 (cmd : _) -> cmd
192 [] -> T.unpack (_cs_syntax spec)