1 (** The repository list, and the project directory pages that share its shape. 2 3 A project directory is the same page scoped to a subtree, so both are 4 described here. *) 5 6 (** One entry in the list: either a repository, or a directory that expands to 7 reveal the repositories beneath it. *) 8 let rec repo_row ~prefix ~dates node = 9 match node with 10 | Resolvers.Repo { repo_name; description } -> 11 let path = if prefix = "" then repo_name else prefix ^ "/" ^ repo_name in 12 let described = 13 if description = Resolvers.default_repo_description then [] 14 else [ Ui.inline_text ~class_:"repo-description" description ] 15 in 16 let updated = 17 match List.assoc_opt path dates with 18 | None | Some None -> Ui.nothing 19 | Some (Some date) -> 20 Ui.inline_text ~class_:"commit-ago" (Time_format.relative_time date) 21 in 22 Ui.item 23 [ 24 Ui.link 25 ~href:(Components.url (Routes.Repo path)) 26 (Ui.inline_text ~class_:"repo-name" repo_name :: described); 27 updated; 28 ] 29 | Resolvers.Directory (name, children) -> 30 let path = if prefix = "" then name else prefix ^ "/" ^ name in 31 Components.directory ~route:(Routes.Project_dir path) ~name 32 (List.map (repo_row ~prefix:path ~dates) children) 33 34 (** Repositories may be grouped into Favorites and Archived sections. With no 35 grouping configured the list renders flat and unheaded, which keeps the 36 common case free of pointless chrome. *) 37 let render (site : Layout.site) ~dates ?(prefix = "") ?(favorites = []) 38 ?(archived = []) ?readme nodes = 39 let repo_list id nodes = Ui.items_of ~id (repo_row ~prefix ~dates) nodes in 40 let optional_group ~class_ ~title ~expanded ~id = function 41 | [] -> Ui.nothing 42 | repos -> 43 Ui.region ~class_ 44 [ Components.group ~expanded ~title [ repo_list id repos ] ] 45 in 46 let favorites_group = 47 optional_group ~class_:"repo-section repo-favorites" ~title:"Favorites" 48 ~expanded:true ~id:"repo-list-favorites" favorites 49 in 50 let archived_group = 51 optional_group ~class_:"repo-section repo-archived" ~title:"Archived" 52 ~expanded:false ~id:"repo-list-archived" archived 53 in 54 let main_group = 55 Ui.block ~id:"repositories" 56 (match (favorites, archived) with 57 | [], [] -> [ repo_list "repo-list" nodes ] 58 | _ when nodes = [] -> [] 59 | _ -> 60 [ 61 Components.group ~expanded:true ~title:"Repositories" 62 [ repo_list "repo-list" nodes ]; 63 ]) 64 in 65 let readme_panel = 66 match readme with 67 | None -> Ui.nothing 68 | Some (blob : Resolvers.Blob.t) -> Components.inline_readme blob.content 69 in 70 (* A project directory page is titled by its own segment; the root page by the 71 configured site title. *) 72 let nav_title = 73 if prefix = "" then site.root_title 74 else 75 match List.rev (String.split_on_char '/' prefix) with 76 | name :: _ -> name 77 | [] -> prefix 78 in 79 Ui.respond 80 @@ Layout.render site 81 { 82 title = nav_title; 83 repo = None; 84 subtitle = ""; 85 active = Summary; 86 toolbar = []; 87 home_href = 88 (if prefix = "" then None 89 else Some (Components.url (Project_dir prefix))); 90 content = 91 [ 92 Ui.block ~class_:"root-layout" 93 [ 94 Ui.block ~class_:"root-repos" 95 [ favorites_group; main_group; archived_group ]; 96 Ui.block ~class_:"root-readme" [ readme_panel ]; 97 ]; 98 ]; 99 } 100