commit 38b8af7e8321a1fd27efb0e4b8f00d74fd1de96b · anil.recoil.org/slop

+9 -13

stack/river/bin/river_cli.ml

···

       269
       269
        
             Ptime.compare b.updated a.updated

     

       270
       270
        
           ) combined

     

       271
       271
        
       

     

       272
       272
       -
         let sync_user ~sw ~requests env state ~username =

     

       272
       272
       +
         let sync_user client state ~username =

     

       273
       273
        
           match State.load_user state username with

     

       274
       274
        
           | None ->

     

       275
       275
        
             Log.err (fun m -> m "User %s not found" username);

     
···

       280
       280
        
           | Some user ->

     

       281
       281
        
             Log.info (fun m -> m "Syncing feeds for user %s..." username);

     

       282
       282
        
       

     

       283
       283
       -
             (* Fetch all feeds concurrently using the shared session *)

     

       283
       283
       +
             (* Fetch all feeds concurrently using the client *)

     

       284
       284
        
             let fetched_feeds =

     

       285
       285
        
               Eio.Fiber.List.filter_map (fun source ->

     

       286
       286
        
                 try

     

       287
       287
        
                   Log.info (fun m -> m "  Fetching %s (%s)..." source.River.name source.River.url);

     

       288
       288
       -
                   Some (River.fetch ~sw ~requests env source)

     

       288
       288
       +
                   Some (River.fetch client source)

     

       289
       289
        
                 with e ->

     

       290
       290
        
                   Log.err (fun m -> m "  Failed to fetch %s: %s"

     

       291
       291
        
                     source.River.name (Printexc.to_string e));

     
···

       330
       330
        
               0

     

       331
       331
        
             end

     

       332
       332
        
       

     

       333
       333
       -
         let sync_all ~sw ~requests env state =

     

       333
       333
       +
         let sync_all client state =

     

       334
       334
        
           let users = State.list_users state in

     

       335
       335
        
           if users = [] then begin

     

       336
       336
        
             Log.info (fun m -> m "No users to sync");

     
···

       340
       340
        
       

     

       341
       341
        
             let results =

     

       342
       342
        
               Eio.Fiber.List.map (fun username ->

     

       343
       343
       -
                 let result = sync_user ~sw ~requests env state ~username in

     

       343
       343
       +
                 let result = sync_user client state ~username in

     

       344
       344
        
                 Log.debug (fun m -> m "Completed sync for user");

     

       345
       345
        
                 result

     

       346
       346
        
               ) users

     
···

       626
       626
        
             let state = { xdg } in

     

       627
       627
        
             State.ensure_directories state;

     

       628
       628
        
       

     

       629
       629
       -
             Eio.Switch.run @@ fun sw ->

     

       630
       630
       -
               (* Create a single Requests session for all operations *)

     

       631
       631
       -
               let requests = Requests.create ~sw env

     

       632
       632
       -
                 ~follow_redirects:true

     

       633
       633
       -
                 ~max_redirects:5 in

     

       634
       634
       -
       

     

       629
       629
       +
             (* Use River.Client.with_client for resource management *)

     

       630
       630
       +
             River.Client.with_client env @@ fun client ->

     

       635
       631
        
               match username_opt with

     

       636
       636
       -
               | Some username -> Sync.sync_user ~sw ~requests env state ~username

     

       637
       637
       -
               | None -> Sync.sync_all ~sw ~requests env state

     

       632
       632
       +
               | Some username -> Sync.sync_user client state ~username

     

       633
       633
       +
               | None -> Sync.sync_all client state

     

       638
       634
        
           ) $ username_opt)

     

       639
       635
        
       

     

       640
       636
        
       (* List command - doesn't need network, just reads local files *)

stack/river/dune-project

···

       30
       30
        
         (eio_main

     

       31
       31
        
          (>= 1.0))

     

       32
       32
        
         requests

     

       33
       33
       +
         requests_json_api

     

       33
       34
        
         eiocmd

     

       34
       35
        
         logs

     

       35
       36
        
         ptime

+3 -2

stack/river/example/aggregate_feeds.ml

···

       9
       9
        
           ]

     

       10
       10
        
       

     

       11
       11
        
       let main env =

     

       12
       12
       -
         Eio.Switch.run @@ fun sw ->

     

       13
       13
       -
         let feeds = List.map (River.fetch ~sw env) sources in

     

       12
       12
       +
         (* Use River.Client.with_client for proper resource management *)

     

       13
       13
       +
         River.Client.with_client env @@ fun client ->

     

       14
       14
       +
         let feeds = List.map (River.fetch client) sources in

     

       14
       15
        
         let posts = River.posts feeds in

     

       15
       16
        
         let entries = River.create_atom_entries posts in

     

       16
       17
        
         let feed =

+1 -1

stack/river/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name river)

     

       3
       3
        
        (public_name river)

     

       4
       4
       -
        (libraries eio eio_main requests logs str syndic lambdasoup uri ptime))

     

       4
       4
       +
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime))

+11 -5

stack/river/lib/feed.ml

···

       54
       54
        
             Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));

     

       55
       55
        
             raise e

     

       56
       56
        
       

     

       57
       57
       -
       let fetch ~sw ?requests env (source : source) =

     

       57
       57
       +
       let fetch client (source : source) =

     

       58
       58
        
         Log.info (fun m -> m "Fetching feed '%s' from %s" source.name source.url);

     

       59
       59
        
       

     

       60
       60
        
         let xmlbase = Uri.of_string @@ source.url in

     

       61
       61
       +
       

     

       62
       62
       +
         (* Use Requests_json_api.get_result for clean Result-based error handling *)

     

       63
       63
       +
         let session = Client.session client in

     

       61
       64
        
         let response =

     

       62
       62
       -
           try Http.get ~sw ?requests env source.url

     

       63
       63
       -
           with e ->

     

       64
       64
       -
             Log.err (fun m -> m "Failed to fetch feed '%s': %s" source.name (Printexc.to_string e));

     

       65
       65
       -
             raise e

     

       65
       65
       +
           match Requests_json_api.get_result session source.url with

     

       66
       66
       +
           | Ok body ->

     

       67
       67
       +
               Log.info (fun m -> m "Successfully fetched %s (%d bytes)" source.url (String.length body));

     

       68
       68
       +
               body

     

       69
       69
       +
           | Error (status, msg) ->

     

       70
       70
       +
               Log.err (fun m -> m "Failed to fetch feed '%s': HTTP %d - %s" source.name status msg);

     

       71
       71
       +
               failwith (Printf.sprintf "HTTP %d: %s" status msg)

     

       66
       72
        
         in

     

       67
       73
        
       

     

       68
       74
        
         let content = classify_feed ~xmlbase response in

-81

stack/river/lib/http.ml

···

       1
       1
       -
       (*

     

       2
       2
       -
        * Copyright (c) 2014, OCaml.org project

     

       3
       3
       -
        * Copyright (c) 2015 KC Sivaramakrishnan <sk826@cl.cam.ac.uk>

     

       4
       4
       -
        *

     

       5
       5
       -
        * Permission to use, copy, modify, and distribute this software for any

     

       6
       6
       -
        * purpose with or without fee is hereby granted, provided that the above

     

       7
       7
       -
        * copyright notice and this permission notice appear in all copies.

     

       8
       8
       -
        *

     

       9
       9
       -
        * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES

     

       10
       10
       -
        * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF

     

       11
       11
       -
        * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

     

       12
       12
       -
        * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

     

       13
       13
       -
        * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

     

       14
       14
       -
        * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF

     

       15
       15
       -
        * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       16
       16
       -
        *)

     

       17
       17
       -
       

     

       18
       18
       -
       (* Download urls — using Requests library with Eio *)

     

       19
       19
       -
       

     

       20
       20
       -
       let src = Logs.Src.create "river.http" ~doc:"River HTTP client"

     

       21
       21
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       22
       22
       -
       

     

       23
       23
       -
       exception Status_unhandled of string

     

       24
       24
       -
       exception Timeout

     

       25
       25
       -
       

     

       26
       26
       -
       let get ~sw ?requests env url =

     

       27
       27
       -
         Log.info (fun m -> m "Fetching URL: %s" url);

     

       28
       28
       -
       

     

       29
       29
       -
         try

     

       30
       30
       -
           (* Create or use existing Requests session with automatic redirect following *)

     

       31
       31
       -
           let req = match requests with

     

       32
       32
       -
             | Some r -> r

     

       33
       33
       -
             | None ->

     

       34
       34
       -
                 Requests.create ~sw env

     

       35
       35
       -
                   ~follow_redirects:true

     

       36
       36
       -
                   ~max_redirects:5

     

       37
       37
       -
           in

     

       38
       38
       -
       

     

       39
       39
       -
           Log.debug (fun m -> m "Using Requests session with max_redirects=5");

     

       40
       40
       -
       

     

       41
       41
       -
           (* Make the GET request with timeout *)

     

       42
       42
       -
           let response =

     

       43
       43
       -
             try

     

       44
       44
       -
               Log.debug (fun m -> m "Making GET request with 3s timeout");

     

       45
       45
       -
               Requests.get req

     

       46
       46
       -
                 ~timeout:(Requests.Timeout.create ~total:3.0 ())

     

       47
       47
       -
                 url

     

       48
       48
       -
             with

     

       49
       49
       -
             | Requests.Error.ConnectionError msg ->

     

       50
       50
       -
                 Log.err (fun m -> m "Connection error for %s: %s" url msg);

     

       51
       51
       -
                 raise (Status_unhandled (Printf.sprintf "Connection error: %s" msg))

     

       52
       52
       -
             | Requests.Error.Timeout ->

     

       53
       53
       -
                 Log.err (fun m -> m "Request timeout for %s after 3s" url);

     

       54
       54
       -
                 raise Timeout

     

       55
       55
       -
             | Requests.Error.TooManyRedirects { url; count; max } ->

     

       56
       56
       -
                 Log.err (fun m -> m "Too many redirects (%d/%d) for %s" count max url);

     

       57
       57
       -
                 raise (Status_unhandled (Printf.sprintf "Too many redirects (%d/%d) for %s" count max url))

     

       58
       58
       -
           in

     

       59
       59
       -
       

     

       60
       60
       -
           (* Check the status code *)

     

       61
       61
       -
           let status = Requests.Response.status_code response in

     

       62
       62
       -
           Log.debug (fun m -> m "Received response with status %d" status);

     

       63
       63
       -
       

     

       64
       64
       -
           if status >= 200 && status < 300 then begin

     

       65
       65
       -
             (* Success - read the body *)

     

       66
       66
       -
             let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       67
       67
       -
             let body_size = String.length body in

     

       68
       68
       -
             Log.info (fun m -> m "Successfully fetched %s (%d bytes)" url body_size);

     

       69
       69
       -
             body

     

       70
       70
       -
           end else begin

     

       71
       71
       -
             Log.err (fun m -> m "HTTP error %d for %s" status url);

     

       72
       72
       -
             raise (Status_unhandled (Printf.sprintf "HTTP status %d" status))

     

       73
       73
       -
           end

     

       74
       74
       -
       

     

       75
       75
       -
         with

     

       76
       76
       -
         | (Status_unhandled _ | Timeout) as e ->

     

       77
       77
       -
             (* Already logged *)

     

       78
       78
       -
             raise e

     

       79
       79
       -
         | e ->

     

       80
       80
       -
             Log.err (fun m -> m "Unexpected error fetching %s: %s" url (Printexc.to_string e));

     

       81
       81
       -
             raise e

+4 -2

stack/river/lib/river.ml

···

       18
       18
        
       let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"

     

       19
       19
        
       module Log = (val Logs.src_log src : Logs.LOG)

     

       20
       20
        
       

     

       21
       21
       +
       module Client = Client

     

       22
       22
       +
       

     

       21
       23
        
       type source = Feed.source = { name : string; url : string }

     

       22
       24
        
       type feed = Feed.t

     

       23
       25
        
       type post = Post.t

     

       24
       26
        
       

     

       25
       25
       -
       let fetch ~sw ?requests env source =

     

       27
       27
       +
       let fetch client source =

     

       26
       28
        
         Log.info (fun m -> m "Fetching feed: %s" source.name);

     

       27
       27
       -
         Feed.fetch ~sw ?requests env source

     

       29
       29
       +
         Feed.fetch client source

     

       28
       30
        
       

     

       29
       31
        
       let name feed = feed.Feed.name

     

       30
       32
        
       let url feed = feed.Feed.url

+6 -12

stack/river/lib/river.mli

···

       15
       15
        
        * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       16
       16
        
        *)

     

       17
       17
        
       

     

       18
       18
       +
       (** River HTTP client *)

     

       19
       19
       +
       module Client = Client

     

       20
       20
       +
       

     

       18
       21
        
       type source = { name : string; url : string }

     

       19
       22
        
       (** The source of a feed. *)

     

       20
       23
        
       

     

       21
       24
        
       type feed

     

       22
       25
        
       type post

     

       23
       26
        
       

     

       24
       24
       -
       val fetch :

     

       25
       25
       -
         sw:Eio.Switch.t ->

     

       26
       26
       -
         ?requests:(([> float Eio.Time.clock_ty ] as 'a) Eio.Resource.t, ([> [> `Generic ] Eio.Net.ty ] as 'b) Eio.Resource.t) Requests.t ->

     

       27
       27
       -
         < clock : 'a Eio.Resource.t;

     

       28
       28
       -
           fs : Eio.Fs.dir_ty Eio.Path.t;

     

       29
       29
       -
           net : 'b Eio.Resource.t; .. > ->

     

       30
       30
       -
         source ->

     

       31
       31
       -
         feed

     

       32
       32
       -
       (** [fetch ~sw ?requests env source] returns an Atom or RSS feed from a source.

     

       27
       27
       +
       val fetch : Client.t -> source -> feed

     

       28
       28
       +
       (** [fetch client source] returns an Atom or RSS feed from a source.

     

       33
       29
        
       

     

       34
       34
       -
           @param sw The switch to use for resource cleanup

     

       35
       35
       -
           @param requests Optional Requests session to reuse. If not provided, a new session will be created

     

       36
       36
       -
           @param env The Eio environment

     

       30
       30
       +
           @param client The River HTTP client

     

       37
       31
        
           @param source The feed source to fetch *)

     

       38
       32
        
       

     

       39
       33
        
       val name : feed -> string

stack/river/river.opam

···

       15
       15
        
         "eio" {>= "1.0"}

     

       16
       16
        
         "eio_main" {>= "1.0"}

     

       17
       17
        
         "requests"

     

       18
       18
       +
         "requests_json_api"

     

       18
       19
        
         "eiocmd"

     

       19
       20
        
         "logs"

     

       20
       21
        
         "ptime"

+5 -7

stack/river/test/test_eio_river.ml

···

       9
       9
        
       let main env =

     

       10
       10
        
         Printf.printf "Testing River library with Eio and Requests...\n";

     

       11
       11
        
       

     

       12
       12
       -
         Eio.Switch.run @@ fun sw ->

     

       12
       12
       +
         (* Use River.Client.with_client for proper resource management *)

     

       13
       13
       +
         River.Client.with_client env @@ fun client ->

     

       13
       14
        
         (* Test fetching feeds *)

     

       14
       15
        
         let feeds =

     

       15
       16
        
           try

     

       16
       16
       -
             List.map (River.fetch ~sw env) test_sources

     

       17
       17
       +
             List.map (River.fetch client) test_sources

     

       17
       18
        
           with

     

       18
       18
       -
           | River__Http.Status_unhandled msg ->

     

       19
       19
       -
               Printf.printf "HTTP error: %s\n" msg;

     

       20
       20
       -
               []

     

       21
       21
       -
           | River__Http.Timeout ->

     

       22
       22
       -
               Printf.printf "Request timed out\n";

     

       19
       19
       +
           | Failure msg ->

     

       20
       20
       +
               Printf.printf "Error: %s\n" msg;

     

       23
       21
        
               []

     

       24
       22
        
           | e ->

     

       25
       23
        
               Printf.printf "Error: %s\n" (Printexc.to_string e);

+4 -6

stack/river/test/test_logging.ml

···

       27
       27
        
         (* Test with logging *)

     

       28
       28
        
         Printf.printf "Testing River library with logging...\n\n";

     

       29
       29
        
       

     

       30
       30
       -
         Eio.Switch.run @@ fun sw ->

     

       30
       30
       +
         (* Use River.Client.with_client for proper resource management *)

     

       31
       31
       +
         River.Client.with_client env @@ fun client ->

     

       31
       32
        
         (* Demonstrate fetching with logging *)

     

       32
       33
        
         let feeds =

     

       33
       34
        
           try

     

       34
       34
       -
             List.map (River.fetch ~sw env) test_sources

     

       35
       35
       +
             List.map (River.fetch client) test_sources

     

       35
       36
        
           with

     

       36
       36
       -
           | River__Http.Status_unhandled msg ->

     

       37
       37
       +
           | Failure msg ->

     

       37
       38
        
               Printf.printf "Expected error (for demo): %s\n" msg;

     

       38
       38
       -
               []

     

       39
       39
       -
           | River__Http.Timeout ->

     

       40
       40
       -
               Printf.printf "Timeout (expected for non-existent feed)\n";

     

       41
       39
        
               []

     

       42
       40
        
           | e ->

     

       43
       41
        
               Printf.printf "Error: %s\n" (Printexc.to_string e);