source: code/trunk/cli/gemini.ml@ 14

let ext = ".gmi"

module GeminiConverter = struct
        include Converter.Gemini
        let angled_uri u a = if String.sub u 0 10 <> "urn:txtid:" then
                angled_uri u a else angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a
end

let page _conversion text =
  let open Logarion.Text in
  "# " ^ text.title
  ^ "\nAuthors: " ^ Logarion.Person.Set.to_string text.authors
  ^ "\nDate: " ^ Logarion.Date.(pretty_date @@ listing text.date)
  ^ let module T = Parsers.Plain_text.Make (GeminiConverter) in
  "\n" ^ T.of_string text.body ""

let date_index title meta_list =
  List.fold_left
    (fun a m ->
      a ^ "=> " ^ Logarion.Text.short_id m ^ ".gmi " ^
        Logarion.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n")
    ("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list

let to_dated_links ?(limit) meta_list =
  let meta_list = match limit with
    | None -> meta_list
    | Some limit->
       let rec reduced acc i = function
         | [] -> acc
         | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in
       List.rev @@ reduced [] 0 meta_list
  in
  List.fold_left
    (fun a m ->
      a
      ^ "=> " ^ Logarion.Text.short_id m ^ ".gmi "
      ^ Logarion.(Date.(pretty_date (listing m.Text.date))) ^ " "
      ^ m.Logarion.Text.title ^ "\n")
    "" meta_list

let topic_link root topic =
  let replaced_space = String.map (function ' '->'+' | x->x) in
         "=> index." ^ replaced_space  root ^ ".gmi " ^ String.capitalize_ascii topic ^ "\n"

let text_item path meta =
  let open Logarion in
  "=> " ^ path ^ Text.short_id meta ^ ".gmi "
  ^ Date.(pretty_date (listing meta.Text.date)) ^ " "
  ^ meta.Text.title ^ "\n"

let listing_index topic_map topic_roots path metas =
  let rec item_group topics =
    List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics
  and sub_groups topic = match Logarion.Topic_set.Map.find_opt topic topic_map with
    | None -> ""
    | Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics)
  and items topic =
    let items =
      let open Logarion in
      List.fold_left
        (fun a e ->
        if String_set.mem topic (String_set.map (Logarion.Topic_set.topic) (Text.set "Topics" e))
        then text_item path e ^ a else a) "" metas in
    match items with
    | "" -> ""
    | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x
  in
  item_group topic_roots

let fold_topic_roots topic_roots =
  let list_item root t = topic_link root t in
  List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots)

let topic_main_index title topic_roots metas =
        "# " ^ title ^ "\n\n"
  ^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "")
  ^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas
  ^ "\n=> index.date.gmi More by date\n"

let topic_sub_index title topic_map topic_root metas =
  "# " ^ title ^ "\n\n"
  ^ listing_index topic_map [topic_root] "" metas

let indices r =
        let open Logarion in
        let file name = File_store.file (Filename.concat r.Conversion.dir name) in
        let index_name = try Store.KV.find "Gemini-index" r.kv with Not_found -> "index.gmi" in
        let title = try Store.KV.find "Title" r.Conversion.kv with Not_found -> "" in

        if index_name <> "" then
                file index_name (topic_main_index title r.topic_roots r.texts);

        file "index.date.gmi" (date_index title r.texts);

        List.iter
                (fun topic -> file ("index." ^ topic ^ ".gmi")
                 (topic_sub_index title r.topics topic r.texts))
                r.topic_roots;

        let base_url = try
                let _i = Str.(search_forward (regexp "gemini?://[^;]*") (Store.KV.find "Locations" r.kv) 0) in
                Str.(matched_string (Store.KV.find "Locations" r.kv))
                with Not_found -> prerr_endline "Missing location for Gemini"; "" in
        file "gmi.atom" (Atom.feed title r.id base_url "text/gemini" r.texts)