forced evolution

lib/core/tuatara_cmd.ml

···
              Tuatara_fetch.detect_feed_type ~content_type:result.content_type result.content)
         | None -> Tuatara_fetch.detect_feed_type ~content_type:result.content_type result.content
       in
-      let metadata = Tuatara_fetch.get_feed_metadata ~feed_type:detected_type result.content in
+      let metadata = Tuatara_fetch.get_feed_metadata ~feed_type:detected_type ~url result.content in
       let title = match name with Some n -> Some n | None -> metadata.title in
       let source = Source.make
         ~url
···
     List.iter (fun source ->
       let source_name = Option.value (Source.title source) ~default:(Source.url source) in
       let source_url = Source.url source in
-      let feed_type = Source.feed_type source in
       Fmt.pr "Fetching %s...@." source_name;
       let last_content = ref None in
       try
···
           Fmt.pr "  Not modified@."
         | Some result ->
           last_content := Some result.content;
+          (* Re-detect feed type from content - this handles cases where the
+             stored type was wrong or the feed format changed *)
+          let feed_type =
+            Tuatara_fetch.detect_feed_type
+              ~content_type:result.content_type
+              result.content
+          in
           let posts = Tuatara_fetch.parse_feed
             ~source_id:(Source.id source)
             ~feed_type
             ~created_at:now
+            ~url:source_url
             result.content
           in
           let new_count = ref 0 in
···
           let source = Source.set_etag source result.etag in
           let source = Source.set_last_modified source result.last_modified in
           let metadata = Tuatara_fetch.get_feed_metadata
-            ~feed_type:(Source.feed_type source)
+            ~feed_type
+            ~url:source_url
             result.content
           in
           let source = match metadata.title with
···
           match !last_content with
           | Some content ->
             claude_invoked := true;
+            let feed_type = Tuatara_fetch.detect_feed_type ~content_type:None content in
             let _ = invoke_claude_fix ~sw ~process_mgr ~clock ~source_url ~feed_type ~error_msg:msg ~content in
             ()
           | None -> ()
···
           match !last_content with
           | Some content ->
             claude_invoked := true;
+            let feed_type = Tuatara_fetch.detect_feed_type ~content_type:None content in
             let _ = invoke_claude_fix ~sw ~process_mgr ~clock ~source_url ~feed_type ~error_msg:msg ~content in
             ()
           | None -> ()

lib/core/tuatara_fetch.ml

···
 
 (* Detect feed type from content *)
 let detect_feed_type ~content_type content =
-  (* First try content-type header *)
-  let from_header =
-    match content_type with
-    | Some ct ->
-      let ct = String.lowercase_ascii ct in
-      if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then
-        Some Source.Json
-      else if String.length ct >= 21 && String.sub ct 0 21 = "application/feed+json" then
-        Some Source.Json
-      else if String.length ct >= 20 && String.sub ct 0 20 = "application/atom+xml" then
-        Some Source.Atom
-      else if String.length ct >= 19 && String.sub ct 0 19 = "application/rss+xml" then
-        Some Source.Rss
-      else if String.length ct >= 15 && String.sub ct 0 15 = "application/xml" then
-        Some Source.Rss
-      else if String.length ct >= 8 && String.sub ct 0 8 = "text/xml" then
-        Some Source.Rss
-      else
-        None
-    | None -> None
-  in
-  (* Refine by looking at content *)
-  match from_header with
-  | Some ft -> ft
-  | None ->
+  (* Helper to detect feed type from XML content *)
+  let detect_from_content content =
     let content = String.trim content in
     if String.length content > 0 then
       if content.[0] = '{' then
-        Source.Json
+        Some Source.Json
       else if content.[0] = '<' then
         (* XML - check for rss vs atom *)
         let prefix = String.lowercase_ascii (String.sub content 0 (min 500 (String.length content))) in
         (* Check for RSS first - RSS feeds may include atom namespace for self-links *)
         if try let _ = Str.search_forward (Str.regexp "<rss") prefix 0 in true
            with Not_found -> false then
-          Source.Rss
+          Some Source.Rss
         else if try let _ = Str.search_forward (Str.regexp "<feed") prefix 0 in true
            with Not_found -> false then
-          Source.Atom
+          Some Source.Atom
         else if try let _ = Str.search_forward (Str.regexp "xmlns.*atom") prefix 0 in true
                 with Not_found -> false then
-          Source.Atom
+          Some Source.Atom
         else
-          Source.Rss
+          Some Source.Rss
       else
+        None
+    else
+      None
+  in
+  (* First check content - this is more reliable than content-type headers,
+     especially for feeds served through aggregators like FeedBurner which
+     may serve RSS feeds with application/atom+xml content-type *)
+  match detect_from_content content with
+  | Some ft -> ft
+  | None ->
+    (* Fall back to content-type header *)
+    match content_type with
+    | Some ct ->
+      let ct = String.lowercase_ascii ct in
+      if String.length ct >= 16 && String.sub ct 0 16 = "application/json" then
+        Source.Json
+      else if String.length ct >= 21 && String.sub ct 0 21 = "application/feed+json" then
+        Source.Json
+      else if String.length ct >= 20 && String.sub ct 0 20 = "application/atom+xml" then
         Source.Atom
-    else
-      Source.Atom
+      else if String.length ct >= 19 && String.sub ct 0 19 = "application/rss+xml" then
+        Source.Rss
+      else if String.length ct >= 15 && String.sub ct 0 15 = "application/xml" then
+        Source.Rss
+      else if String.length ct >= 8 && String.sub ct 0 8 = "text/xml" then
+        Source.Rss
+      else
+        Source.Atom (* Default fallback *)
+    | None -> Source.Atom (* Default fallback *)
 
 (* Fetch from local file *)
 let fetch_file ~fs path =
···
   else
     url
 
+(* Quirks for specific feeds that have non-standard formats *)
+module Quirks = struct
+  let weekday_name = function
+    | 0 -> "Sun" | 1 -> "Mon" | 2 -> "Tue" | 3 -> "Wed"
+    | 4 -> "Thu" | 5 -> "Fri" | _ -> "Sat"
+
+  let month_name = function
+    | 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr"
+    | 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug"
+    | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | _ -> "Dec"
+
+  (* Convert ISO 8601 date to RFC 822 format.
+     digitalflapjack.com uses ISO 8601 dates in RSS pubDate/lastBuildDate
+     but RSS spec requires RFC 822 format. *)
+  let iso8601_to_rfc822 iso =
+    try
+      (* Parse ISO 8601: 2025-10-22T12:24:00-00:00 or 2025-10-22T12:24:00Z *)
+      let year = int_of_string (String.sub iso 0 4) in
+      let month = int_of_string (String.sub iso 5 2) in
+      let day = int_of_string (String.sub iso 8 2) in
+      let hour = int_of_string (String.sub iso 11 2) in
+      let min = int_of_string (String.sub iso 14 2) in
+      let sec = int_of_string (String.sub iso 17 2) in
+      (* Calculate day of week using Zeller's formula *)
+      let m = if month < 3 then month + 12 else month in
+      let y = if month < 3 then year - 1 else year in
+      let dow = (day + (13 * (m + 1)) / 5 + y + y/4 - y/100 + y/400) mod 7 in
+      let wday = weekday_name ((dow + 6) mod 7) in
+      Printf.sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT"
+        wday day (month_name month) year hour min sec
+    with _ -> iso (* Return unchanged if parsing fails *)
+
+  (* digitalflapjack.com uses ISO 8601 dates in RSS which requires RFC 822 *)
+  let fix_digitalflapjack_dates content =
+    (* Match ISO 8601 dates in pubDate and lastBuildDate tags *)
+    let re = Str.regexp "<\\(pubDate\\|lastBuildDate\\)>\\([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]T[0-9][0-9]:[0-9][0-9]:[0-9][0-9]\\)[-+Z][^<]*</\\(pubDate\\|lastBuildDate\\)>" in
+    Str.global_substitute re (fun s ->
+      let tag = Str.matched_group 1 s in
+      let iso_date = Str.matched_group 2 s in
+      let rfc822 = iso8601_to_rfc822 iso_date in
+      Printf.sprintf "<%s>%s</%s>" tag rfc822 tag
+    ) content
+
+  (* Fix empty subtitle tags in Atom feeds.
+     The Syndic library fails with Not_found on empty <subtitle></subtitle> tags.
+     This affects feeds like onkargulati.com and other Jekyll-generated feeds. *)
+  let fix_empty_subtitle content =
+    let re = Str.regexp "<subtitle[^>]*></subtitle>" in
+    Str.global_replace re "" content
+
+  (* Fix Atom entries missing <author> elements.
+     Per RFC 4287, entries MUST have an author unless the feed has one.
+     Syndic enforces this strictly, so we add a default author to entries
+     that are missing one. This is a generic fix for many Atom feeds. *)
+  let fix_missing_entry_authors content =
+    (* Check if this looks like an Atom feed *)
+    let is_atom =
+      try let _ = Str.search_forward (Str.regexp "<feed[^>]*xmlns=['\"]http://www.w3.org/2005/Atom['\"]") content 0 in true
+      with Not_found ->
+        try let _ = Str.search_forward (Str.regexp "<feed") content 0 in true
+        with Not_found -> false
+    in
+    if not is_atom then content
+    else
+      (* Check if feed has a top-level author *)
+      let has_feed_author =
+        try
+          let feed_start = Str.search_forward (Str.regexp "<feed") content 0 in
+          let first_entry = try Str.search_forward (Str.regexp "<entry") content feed_start with Not_found -> String.length content in
+          let feed_section = String.sub content feed_start (first_entry - feed_start) in
+          try let _ = Str.search_forward (Str.regexp "<author>") feed_section 0 in true
+          with Not_found -> false
+        with Not_found -> false
+      in
+      if has_feed_author then content
+      else
+        (* Add a default author to entries that don't have one *)
+        let default_author = "<author><name>Unknown</name></author>" in
+        (* Match entry blocks and check if they have an author *)
+        let buf = Buffer.create (String.length content + 1000) in
+        let pos = ref 0 in
+        let entry_re = Str.regexp "<entry>" in
+        let author_re = Str.regexp "<author>" in
+        let end_entry_re = Str.regexp "</entry>" in
+        while
+          try
+            let entry_start = Str.search_forward entry_re content !pos in
+            let entry_end = Str.search_forward end_entry_re content entry_start in
+            let entry_block = String.sub content entry_start (entry_end - entry_start) in
+            (* Check if this entry has an author *)
+            let has_author =
+              try let _ = Str.search_forward author_re entry_block 0 in true
+              with Not_found -> false
+            in
+            (* Add content before entry *)
+            Buffer.add_substring buf content !pos (entry_start - !pos);
+            if has_author then begin
+              (* Entry has author, copy as-is *)
+              Buffer.add_substring buf content entry_start (entry_end + 8 - entry_start);
+            end else begin
+              (* Entry lacks author, add default after <entry> tag *)
+              Buffer.add_string buf "<entry>\n    ";
+              Buffer.add_string buf default_author;
+              (* Add rest of entry content (skip the <entry> tag itself) *)
+              Buffer.add_substring buf content (entry_start + 7) (entry_end + 8 - entry_start - 7);
+            end;
+            pos := entry_end + 8;
+            true
+          with Not_found -> false
+        do () done;
+        (* Add remaining content *)
+        Buffer.add_substring buf content !pos (String.length content - !pos);
+        Buffer.contents buf
+
+  let apply_for_url url content =
+    (* Apply domain-specific fixes *)
+    let content =
+      if String.length url >= 20 &&
+         try let _ = Str.search_forward (Str.regexp "digitalflapjack\\.com") url 0 in true
+         with Not_found -> false
+      then fix_digitalflapjack_dates content
+      else content
+    in
+    (* Apply generic Atom fixes - empty subtitle tags cause Syndic to fail *)
+    let content = fix_empty_subtitle content in
+    (* Fix Atom entries missing author elements *)
+    fix_missing_entry_authors content
+end
+
 (* Main fetch function *)
 let fetch ~sw ~clock ~net ~fs url ?etag ?if_modified_since () =
   if is_local_path url then
···
     ?published ?updated ?author ~tags ~created_at ()
 
 (* Parse feed content and return posts *)
-let parse_feed ~source_id ~feed_type ~created_at content =
+let parse_feed ~source_id ~feed_type ~created_at ~url content =
+  let content = Quirks.apply_for_url url content in
   try
     match feed_type with
     | Source.Atom ->
···
   description : string option;
 }
 
-let get_feed_metadata ~feed_type content =
+let get_feed_metadata ~feed_type ~url content =
+  let content = Quirks.apply_for_url url content in
   try
     match feed_type with
     | Source.Atom ->

lib/core/tuatara_fetch.mli

···
   source_id:string ->
   feed_type:Source.feed_type ->
   created_at:Ptime.t ->
+  url:string ->
   string -> Post.t list
 
 (** Feed metadata extracted from feed *)
···
 }
 
 (** Extract metadata from feed content *)
-val get_feed_metadata : feed_type:Source.feed_type -> string -> feed_metadata
+val get_feed_metadata : feed_type:Source.feed_type -> url:string -> string -> feed_metadata