never executed always true always false
1 module PureClaw.CLI.Commands
2 ( -- * Entry point
3 runCLI
4 -- * Options (exported for testing)
5 , ChatOptions (..)
6 , chatOptionsParser
7 -- * Enums (exported for testing)
8 , ProviderType (..)
9 , MemoryBackend (..)
10 ) where
11
12 import Data.Maybe
13 import Data.Set qualified as Set
14 import Data.Text qualified as T
15 import Data.Text.Encoding qualified as TE
16 import Network.HTTP.Client qualified as HTTP
17 import Network.HTTP.Client.TLS qualified as HTTP
18 import Options.Applicative
19 import System.Environment
20 import System.Exit
21 import System.IO
22
23 import PureClaw.Agent.Identity
24 import PureClaw.Agent.Loop
25 import PureClaw.Channels.CLI
26 import PureClaw.Core.Types
27 import PureClaw.Handles.File
28 import PureClaw.Handles.Log
29 import PureClaw.Handles.Memory
30 import PureClaw.Handles.Network
31 import PureClaw.Handles.Shell
32 import PureClaw.Memory.Markdown
33 import PureClaw.Memory.SQLite
34 import PureClaw.Providers.Anthropic
35 import PureClaw.Providers.Class
36 import PureClaw.Providers.Ollama
37 import PureClaw.Providers.OpenAI
38 import PureClaw.Providers.OpenRouter
39 import PureClaw.Security.Policy
40 import PureClaw.Security.Secrets
41 import PureClaw.Tools.FileRead
42 import PureClaw.Tools.FileWrite
43 import PureClaw.Tools.Git
44 import PureClaw.Tools.HttpRequest
45 import PureClaw.Tools.Memory
46 import PureClaw.Tools.Registry
47 import PureClaw.Tools.Shell
48
49 -- | Supported LLM providers.
50 data ProviderType
51 = Anthropic
52 | OpenAI
53 | OpenRouter
54 | Ollama
55 deriving stock (Show, Eq, Ord, Bounded, Enum)
56
57 -- | Supported memory backends.
58 data MemoryBackend
59 = NoMemory
60 | SQLiteMemory
61 | MarkdownMemory
62 deriving stock (Show, Eq, Ord, Bounded, Enum)
63
64 -- | CLI chat options.
65 data ChatOptions = ChatOptions
66 { _co_model :: String
67 , _co_apiKey :: Maybe String
68 , _co_system :: Maybe String
69 , _co_provider :: ProviderType
70 , _co_allowCommands :: [String]
71 , _co_memory :: MemoryBackend
72 , _co_soul :: Maybe String
73 }
74 deriving stock (Show, Eq)
75
76 -- | Parser for chat options.
77 chatOptionsParser :: Parser ChatOptions
78 chatOptionsParser = ChatOptions
79 <$> strOption
80 ( long "model"
81 <> short 'm'
82 <> value "claude-sonnet-4-20250514"
83 <> showDefault
84 <> help "Model to use"
85 )
86 <*> optional (strOption
87 ( long "api-key"
88 <> help "API key (default: from env var for chosen provider)"
89 ))
90 <*> optional (strOption
91 ( long "system"
92 <> short 's'
93 <> help "System prompt (overrides SOUL.md)"
94 ))
95 <*> option parseProviderType
96 ( long "provider"
97 <> short 'p'
98 <> value Anthropic
99 <> showDefaultWith providerToText
100 <> help "LLM provider: anthropic, openai, openrouter, ollama"
101 )
102 <*> many (strOption
103 ( long "allow"
104 <> short 'a'
105 <> help "Allow a shell command (repeatable, e.g. --allow git --allow ls)"
106 ))
107 <*> option parseMemoryBackend
108 ( long "memory"
109 <> value NoMemory
110 <> showDefaultWith memoryToText
111 <> help "Memory backend: none, sqlite, markdown"
112 )
113 <*> optional (strOption
114 ( long "soul"
115 <> help "Path to SOUL.md identity file (default: ./SOUL.md if it exists)"
116 ))
117
118 -- | Parse a provider type from a CLI string.
119 parseProviderType :: ReadM ProviderType
120 parseProviderType = eitherReader $ \s -> case s of
121 "anthropic" -> Right Anthropic
122 "openai" -> Right OpenAI
123 "openrouter" -> Right OpenRouter
124 "ollama" -> Right Ollama
125 _ -> Left $ "Unknown provider: " <> s <> ". Choose: anthropic, openai, openrouter, ollama"
126
127 -- | Display a provider type as a CLI string.
128 providerToText :: ProviderType -> String
129 providerToText Anthropic = "anthropic"
130 providerToText OpenAI = "openai"
131 providerToText OpenRouter = "openrouter"
132 providerToText Ollama = "ollama"
133
134 -- | Parse a memory backend from a CLI string.
135 parseMemoryBackend :: ReadM MemoryBackend
136 parseMemoryBackend = eitherReader $ \s -> case s of
137 "none" -> Right NoMemory
138 "sqlite" -> Right SQLiteMemory
139 "markdown" -> Right MarkdownMemory
140 _ -> Left $ "Unknown memory backend: " <> s <> ". Choose: none, sqlite, markdown"
141
142 -- | Display a memory backend as a CLI string.
143 memoryToText :: MemoryBackend -> String
144 memoryToText NoMemory = "none"
145 memoryToText SQLiteMemory = "sqlite"
146 memoryToText MarkdownMemory = "markdown"
147
148 -- | Full CLI parser with help and version.
149 cliParserInfo :: ParserInfo ChatOptions
150 cliParserInfo = info (chatOptionsParser <**> helper)
151 ( fullDesc
152 <> progDesc "Interactive AI chat with tool use"
153 <> header "pureclaw — Haskell-native AI agent runtime"
154 )
155
156 -- | Main CLI entry point.
157 runCLI :: IO ()
158 runCLI = do
159 opts <- execParser cliParserInfo
160 runChat opts
161
162 -- | Run an interactive chat session.
163 runChat :: ChatOptions -> IO ()
164 runChat opts = do
165 let logger = mkStderrLogHandle
166
167 -- Provider
168 manager <- HTTP.newTlsManager
169 provider <- resolveProvider (_co_provider opts) (_co_apiKey opts) manager
170
171 -- Model
172 let model = ModelId (T.pack (_co_model opts))
173
174 -- System prompt: explicit --system flag > SOUL.md > nothing
175 sysPrompt <- case _co_system opts of
176 Just s -> pure (Just (T.pack s))
177 Nothing -> do
178 let soulPath = fromMaybe "SOUL.md" (_co_soul opts)
179 ident <- loadIdentity soulPath
180 if ident == defaultIdentity
181 then pure Nothing
182 else pure (Just (identitySystemPrompt ident))
183
184 -- Security policy
185 let policy = buildPolicy (_co_allowCommands opts)
186
187 -- Handles
188 let channel = mkCLIChannelHandle
189 workspace = WorkspaceRoot "."
190 sh = mkShellHandle logger
191 fh = mkFileHandle workspace
192 nh = mkNetworkHandle manager
193 mh <- resolveMemory (_co_memory opts)
194
195 -- Tool registry
196 let registry = buildRegistry policy sh workspace fh mh nh
197
198 hSetBuffering stdout LineBuffering
199 _lh_logInfo logger $ "Provider: " <> T.pack (providerToText (_co_provider opts))
200 _lh_logInfo logger $ "Model: " <> T.pack (_co_model opts)
201 _lh_logInfo logger $ "Memory: " <> T.pack (memoryToText (_co_memory opts))
202 case _co_allowCommands opts of
203 [] -> _lh_logInfo logger "Commands: none (deny all)"
204 cmds -> _lh_logInfo logger $ "Commands: " <> T.intercalate ", " (map T.pack cmds)
205 putStrLn "PureClaw 0.1.0 — Haskell-native AI agent runtime"
206 putStrLn "Type your message and press Enter. Ctrl-D to exit."
207 putStrLn ""
208 runAgentLoop provider model channel logger sysPrompt registry
209
210 -- | Build the tool registry with all available tools.
211 buildRegistry :: SecurityPolicy -> ShellHandle -> WorkspaceRoot -> FileHandle -> MemoryHandle -> NetworkHandle -> ToolRegistry
212 buildRegistry policy sh workspace fh mh nh =
213 let reg = uncurry registerTool
214 in reg (shellTool policy sh)
215 $ reg (fileReadTool workspace fh)
216 $ reg (fileWriteTool workspace fh)
217 $ reg (gitTool policy sh)
218 $ reg (memoryStoreTool mh)
219 $ reg (memoryRecallTool mh)
220 $ reg (httpRequestTool AllowAll nh)
221 emptyRegistry
222
223 -- | Build a security policy from the list of allowed commands.
224 buildPolicy :: [String] -> SecurityPolicy
225 buildPolicy [] = defaultPolicy
226 buildPolicy cmds =
227 let cmdNames = Set.fromList (map (CommandName . T.pack) cmds)
228 in defaultPolicy
229 { _sp_allowedCommands = AllowList cmdNames
230 , _sp_autonomy = Full
231 }
232
233 -- | Resolve the LLM provider from the provider type.
234 resolveProvider :: ProviderType -> Maybe String -> HTTP.Manager -> IO SomeProvider
235 resolveProvider Anthropic keyOpt manager = do
236 apiKey <- resolveApiKey keyOpt "ANTHROPIC_API_KEY"
237 pure (MkProvider (mkAnthropicProvider manager apiKey))
238 resolveProvider OpenAI keyOpt manager = do
239 apiKey <- resolveApiKey keyOpt "OPENAI_API_KEY"
240 pure (MkProvider (mkOpenAIProvider manager apiKey))
241 resolveProvider OpenRouter keyOpt manager = do
242 apiKey <- resolveApiKey keyOpt "OPENROUTER_API_KEY"
243 pure (MkProvider (mkOpenRouterProvider manager apiKey))
244 resolveProvider Ollama _ manager =
245 pure (MkProvider (mkOllamaProvider manager))
246
247 -- | Resolve an API key from a CLI flag or an environment variable.
248 resolveApiKey :: Maybe String -> String -> IO ApiKey
249 resolveApiKey (Just key) _ = pure (mkApiKey (TE.encodeUtf8 (T.pack key)))
250 resolveApiKey Nothing envVar = do
251 envKey <- lookupEnv envVar
252 case envKey of
253 Just key -> pure (mkApiKey (TE.encodeUtf8 (T.pack key)))
254 Nothing -> die $ "No API key provided. Use --api-key or set " <> envVar
255
256 -- | Resolve the memory backend.
257 resolveMemory :: MemoryBackend -> IO MemoryHandle
258 resolveMemory NoMemory = pure mkNoOpMemoryHandle
259 resolveMemory SQLiteMemory = mkSQLiteMemoryHandle ".pureclaw/memory.db"
260 resolveMemory MarkdownMemory = mkMarkdownMemoryHandle ".pureclaw/memory"