1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | Web page reader tool - fetches and summarizes web pages.
--
-- : out omni-agent-tools-webreader
-- : dep aeson
-- : dep http-conduit
-- : run trafilatura
module Omni.Agent.Tools.WebReader
( -- * Tool
webReaderTool,
-- * Direct API
fetchWebpage,
extractText,
fetchAndSummarize,
-- * Testing
main,
test,
)
where
import Alpha
import qualified Control.Concurrent.Sema as Sema
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Data.Text.IO as TIO
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import qualified Network.HTTP.Client as HTTPClient
import qualified Network.HTTP.Simple as HTTP
import qualified Omni.Agent.Engine as Engine
import qualified Omni.Agent.Provider as Provider
import qualified Omni.Test as Test
import qualified System.Exit as Exit
import qualified System.IO as IO
import qualified System.Process as Process
import qualified System.Timeout as Timeout
main :: IO ()
main = Test.run test
test :: Test.Tree
test =
Test.group
"Omni.Agent.Tools.WebReader"
[ Test.unit "extractText removes HTML tags" <| do
let html = "<html><body><p>Hello world</p></body></html>"
result = extractText html
("Hello world" `Text.isInfixOf` result) Test.@=? True,
Test.unit "extractText removes script tags" <| do
let html = "<html><script>alert('hi')</script><p>Content</p></html>"
result = extractText html
("alert" `Text.isInfixOf` result) Test.@=? False
("Content" `Text.isInfixOf` result) Test.@=? True,
Test.unit "webReaderTool has correct schema" <| do
let tool = webReaderTool "test-key"
Engine.toolName tool Test.@=? "read_webpages"
]
-- | Fetch timeout in microseconds (15 seconds - short because blocked sites won't respond anyway)
fetchTimeoutMicros :: Int
fetchTimeoutMicros = 15 * 1000000
-- | Summarization timeout in microseconds (30 seconds)
summarizeTimeoutMicros :: Int
summarizeTimeoutMicros = 30 * 1000000
-- | Maximum concurrent fetches
maxConcurrentFetches :: Int
maxConcurrentFetches = 10
-- | Simple debug logging to stderr
dbg :: Text -> IO ()
dbg = TIO.hPutStrLn IO.stderr
fetchWebpage :: Text -> IO (Either Text Text)
fetchWebpage url = do
dbg ("[webreader] Fetching: " <> url)
result <-
Timeout.timeout fetchTimeoutMicros <| do
innerResult <-
try <| do
req0 <- HTTP.parseRequest (Text.unpack url)
let req =
HTTP.setRequestMethod "GET"
<| HTTP.setRequestHeader "User-Agent" ["Mozilla/5.0 (compatible; OmniBot/1.0)"]
<| HTTP.setRequestHeader "Accept" ["text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"]
<| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro fetchTimeoutMicros)
<| req0
HTTP.httpLBS req
case innerResult of
Left (e :: SomeException) -> do
dbg ("[webreader] Fetch error: " <> url <> " - " <> tshow e)
pure (Left ("Failed to fetch URL: " <> tshow e))
Right response -> do
let status = HTTP.getResponseStatusCode response
if status >= 200 && status < 300
then do
let body = HTTP.getResponseBody response
text = TE.decodeUtf8With (\_ _ -> Just '?') (BL.toStrict body)
len = Text.length text
dbg ("[webreader] Fetched: " <> url <> " (" <> tshow len <> " chars)")
pure (Right text)
else do
dbg ("[webreader] HTTP " <> tshow status <> ": " <> url)
pure (Left ("HTTP error: " <> tshow status))
case result of
Nothing -> do
dbg ("[webreader] Timeout: " <> url)
pure (Left ("Timeout fetching " <> url))
Just r -> pure r
-- | Fast single-pass text extraction from HTML
-- Strips all tags in one pass, no expensive operations
extractText :: Text -> Text
extractText html = collapseWhitespace (stripAllTags html)
where
-- Single pass: accumulate text outside of tags
stripAllTags :: Text -> Text
stripAllTags txt = Text.pack (go (Text.unpack txt) False [])
where
go :: [Char] -> Bool -> [Char] -> [Char]
go [] _ acc = reverse acc
go ('<' : rest) _ acc = go rest True acc -- Enter tag
go ('>' : rest) True acc = go rest False (' ' : acc) -- Exit tag, add space
go (_ : rest) True acc = go rest True acc -- Inside tag, skip
go (c : rest) False acc = go rest False (c : acc) -- Outside tag, keep
collapseWhitespace = Text.unwords <. Text.words
-- | Maximum chars to send for summarization (keep it small for fast LLM response)
maxContentForSummary :: Int
maxContentForSummary = 15000
-- | Maximum summary length to return
maxSummaryLength :: Int
maxSummaryLength = 1000
-- | Timeout for trafilatura extraction in microseconds (10 seconds)
extractTimeoutMicros :: Int
extractTimeoutMicros = 10 * 1000000
-- | Extract article content using trafilatura (Python library)
-- Falls back to naive extractText if trafilatura fails
extractWithTrafilatura :: Text -> IO Text
extractWithTrafilatura html = do
let pythonScript =
"import sys; import trafilatura; "
<> "html = sys.stdin.read(); "
<> "result = trafilatura.extract(html, include_comments=False, include_tables=False); "
<> "print(result if result else '')"
proc =
(Process.proc "python3" ["-c", Text.unpack pythonScript])
{ Process.std_in = Process.CreatePipe,
Process.std_out = Process.CreatePipe,
Process.std_err = Process.CreatePipe
}
result <-
Timeout.timeout extractTimeoutMicros <| do
(exitCode, stdoutStr, _stderrStr) <- Process.readCreateProcessWithExitCode proc (Text.unpack html)
case exitCode of
Exit.ExitSuccess -> pure (Text.strip (Text.pack stdoutStr))
Exit.ExitFailure _ -> pure ""
case result of
Just txt | not (Text.null txt) -> pure txt
_ -> do
dbg "[webreader] trafilatura failed, falling back to naive extraction"
pure (extractText (Text.take 100000 html))
summarizeContent :: Text -> Text -> Text -> IO (Either Text Text)
summarizeContent apiKey url content = do
let truncatedContent = Text.take maxContentForSummary content
haiku = Provider.defaultOpenRouter apiKey "anthropic/claude-haiku-4.5"
dbg ("[webreader] Summarizing: " <> url <> " (" <> tshow (Text.length truncatedContent) <> " chars)")
dbg "[webreader] Calling LLM for summarization..."
startTime <- getCurrentTime
result <-
Timeout.timeout summarizeTimeoutMicros
<| Provider.chat
haiku
[]
[ Provider.Message
Provider.System
( "You are a webpage summarizer. Extract the key information in 3-5 bullet points. "
<> "Be extremely concise - max 500 characters total. No preamble, just bullets."
)
Nothing
Nothing,
Provider.Message
Provider.User
("Summarize: " <> url <> "\n\n" <> truncatedContent)
Nothing
Nothing
]
endTime <- getCurrentTime
let elapsed = diffUTCTime endTime startTime
dbg ("[webreader] LLM call completed in " <> tshow elapsed)
case result of
Nothing -> do
dbg ("[webreader] Summarize timeout after " <> tshow elapsed <> ": " <> url)
pure (Left ("Timeout summarizing " <> url))
Just (Left err) -> do
dbg ("[webreader] Summarize error: " <> url <> " - " <> err)
pure (Left ("Summarization failed: " <> err))
Just (Right msg) -> do
let summary = Text.take maxSummaryLength (Provider.msgContent msg)
dbg ("[webreader] Summarized: " <> url <> " (" <> tshow (Text.length summary) <> " chars)")
pure (Right summary)
-- | Fetch and summarize a single URL, returning a result object
-- This is the core function used by both single and batch tools
fetchAndSummarize :: Text -> Text -> IO Aeson.Value
fetchAndSummarize apiKey url = do
fetchResult <- fetchWebpage url
case fetchResult of
Left err ->
pure (Aeson.object ["url" .= url, "error" .= err])
Right html -> do
dbg ("[webreader] Extracting article from: " <> url <> " (" <> tshow (Text.length html) <> " chars HTML)")
extractStart <- getCurrentTime
textContent <- extractWithTrafilatura html
extractEnd <- getCurrentTime
let extractElapsed = diffUTCTime extractEnd extractStart
dbg ("[webreader] Extracted: " <> url <> " (" <> tshow (Text.length textContent) <> " chars text) in " <> tshow extractElapsed)
if Text.null (Text.strip textContent)
then pure (Aeson.object ["url" .= url, "error" .= ("Page appears to be empty or JavaScript-only" :: Text)])
else do
summaryResult <- summarizeContent apiKey url textContent
case summaryResult of
Left err ->
pure
( Aeson.object
[ "url" .= url,
"error" .= err,
"raw_content" .= Text.take 2000 textContent
]
)
Right summary ->
pure
( Aeson.object
[ "url" .= url,
"success" .= True,
"summary" .= summary
]
)
-- | Web reader tool - fetches and summarizes webpages in parallel
webReaderTool :: Text -> Engine.Tool
webReaderTool apiKey =
Engine.Tool
{ Engine.toolName = "read_webpages",
Engine.toolDescription =
"Fetch and summarize webpages in parallel. Each page is processed independently - "
<> "failures on one page won't affect others. Returns a list of summaries.",
Engine.toolJsonSchema =
Aeson.object
[ "type" .= ("object" :: Text),
"properties"
.= Aeson.object
[ "urls"
.= Aeson.object
[ "type" .= ("array" :: Text),
"items" .= Aeson.object ["type" .= ("string" :: Text)],
"description" .= ("List of URLs to read and summarize" :: Text)
]
],
"required" .= (["urls"] :: [Text])
],
Engine.toolExecute = executeWebReader apiKey
}
executeWebReader :: Text -> Aeson.Value -> IO Aeson.Value
executeWebReader apiKey v =
case Aeson.fromJSON v of
Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e])
Aeson.Success (args :: WebReaderArgs) -> do
let urls = wrUrls args
dbg ("[webreader] Starting batch: " <> tshow (length urls) <> " URLs")
results <- Sema.mapPool maxConcurrentFetches (fetchAndSummarize apiKey) urls
let succeeded = length (filter isSuccess results)
dbg ("[webreader] Batch complete: " <> tshow succeeded <> "/" <> tshow (length urls) <> " succeeded")
pure
( Aeson.object
[ "results" .= results,
"total" .= length urls,
"succeeded" .= succeeded
]
)
where
isSuccess (Aeson.Object obj) = KeyMap.member "success" obj
isSuccess _ = False
newtype WebReaderArgs = WebReaderArgs
{ wrUrls :: [Text]
}
deriving (Generic)
instance Aeson.FromJSON WebReaderArgs where
parseJSON =
Aeson.withObject "WebReaderArgs" <| \v ->
WebReaderArgs </ (v Aeson..: "urls")
|
