diff options
| -rw-r--r-- | lib/handlers.ml | 14 | ||||
| -rw-r--r-- | lib/resolvers.ml | 61 | ||||
| -rw-r--r-- | lib/views.ml | 42 |
3 files changed, 58 insertions, 59 deletions
diff --git a/lib/handlers.ml b/lib/handlers.ml index e63e911..7a37b20 100644 --- a/lib/handlers.ml +++ b/lib/handlers.ml @@ -4,8 +4,7 @@ let root _req = Views.root () module Repo = struct let ( let* ) m f = - let open Lwt.Infix in - m >>= function + Lwt.bind m @@ function | Ok x -> f x | Error e -> let msg = Format.asprintf "%a" Resolvers.Store.pp_error e in @@ -13,11 +12,10 @@ module Repo = struct let summary req = let repo = Dream.param req "repo" in - (* let* branches = Resolvers.Branch.all repo in *) - (* let* commits = Resolvers.Commit.recent repo 10 in *) - let* commits = Resolvers.Commit.head repo in + let* branches = Resolvers.Branch.all repo in + let* commits = Resolvers.Commit.recent repo 10 in let authors = [ "John Pork"; "Sebastian Jellybean" ] in - Views.Repo.summary repo () [commits] authors + Views.Repo.summary repo branches commits authors let log req = let repo = Dream.param req "repo" in @@ -37,8 +35,8 @@ module Repo = struct let refs req = let repo = Dream.param req "repo" in - (* let* branches = Resolvers.Branch.all repo in *) - Views.Repo.refs repo () + let* branches = Resolvers.Branch.all repo in + Views.Repo.refs repo branches let commit req = let repo = Dream.param req "repo" in diff --git a/lib/resolvers.ml b/lib/resolvers.ml index 9baa116..f7bf31a 100644 --- a/lib/resolvers.ml +++ b/lib/resolvers.ml @@ -31,7 +31,7 @@ module Commit = struct let to_t c = let open Store.Value in { - hash = Store.Value.Commit.digest c |> Store.Hash.to_hex; + hash = Commit.digest c |> Store.Hash.to_hex; parents = Commit.parents c |> List.map Store.Hash.to_hex; author = Commit.author c; message = Commit.message c; @@ -64,36 +64,35 @@ module Commit = struct walk [] head_commit.hash n end -(* module Branch = struct *) -(* type t = { hash : string; name : string } *) - -(* let to_t (branch : Store.Reference.t) = *) -(* { *) -(* hash = Store.Reference.hash branch ; *) -(* name = Store.Reference.contents branch; *) -(* } *) - -(* let of_id repo id = *) -(* let* store = store repo in *) -(* let hash = Store.Hash.of_hex id in *) -(* Store.Ref.resolve store hash *) -(* |> Lwt_result.map @@ function *) -(* | Git.Reference.Ref branch -> to_t branch *) -(* | _ -> failwith "no head tree id" *) - -(* let all repo = *) -(* let* store = store repo in *) -(* let* refs = Store.Ref.list store in *) -(* let branches = *) -(* List.map *) -(* (fun (reference, hash) -> *) -(* let name = Git.Reference.to_string reference in *) -(* let hash = Store.Hash.to_hex hash in *) -(* { name; hash }) *) -(* refs *) -(* in *) -(* Lwt_result.return branches *) -(* end *) +module Branch = struct + type t = { name : string; hash : string } + + let to_t (reference, hash) = { name = reference; hash } + + let all repo = + let* store = store repo in + let open Lwt.Syntax in + let* refs = Store.Ref.list store in + let branches = + List.map + (fun (reference, hash) -> + let name = Git.Reference.to_string reference in + let hash = Store.Hash.to_hex hash in + { name; hash }) + refs + in + Lwt_result.return branches + + let of_id repo id = + let* branches = all repo in + let branch = + branches + |> List.find_opt (fun branch -> Filename.basename branch.name = id) + in + match branch with + | Some branch -> Lwt_result.return branch + | None -> Lwt_result.fail @@ `Msg ("Found no branch matching " ^ id) +end module Entry = struct type t = { hash : string; name : string; perm : int } diff --git a/lib/views.ml b/lib/views.ml index ca012fc..3a5de9d 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -95,25 +95,27 @@ module Repo = struct let li_of_author author = HTML.(li [] [ txt "%s" author ]) - (* let li_of_branch repo (branch : Resolvers.Branch.t) = *) - (* HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ]) *) + let li_of_branch repo (branch : Resolvers.Branch.t) = + HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ]) let li_of_commit repo (commit : Resolvers.Commit.t) = - let open HTML in let short_hash = Resolvers.short_hash commit.hash in - match commit.message with - | None -> li [] [ txt "%s" short_hash ] - | Some msg -> - li [] - [ - Routes.link_to - (Commit (repo, commit.hash)) - (null - [ - span [ class_ "commit-hash" ] [ txt "%s" short_hash ]; - txt " — %s" msg; - ]); - ] + let content = + match commit.message with + | None -> txt "%s" short_hash + | Some msg -> + let route = Routes.Commit (repo, commit.hash) in + let node = + HTML.( + null + [ + span [ class_ "commit-hash" ] [ txt "%s" short_hash ]; + txt " — %s" msg; + ]) + in + Routes.link_to route node + in + HTML.li [] [ content ] let li_of_entry repo (entry : Resolvers.Entry.t) = let display_name = @@ -125,12 +127,12 @@ module Repo = struct in HTML.(li [] [ Routes.link_to route @@ txt "%s" display_name ]) - let summary repo _branches commits authors = + let summary repo branches commits authors = let content = HTML. [ h3 [] [ txt "Branches" ]; - (* ul [] (List.map (li_of_branch repo) branches); *) + ul [] (List.map (li_of_branch repo) branches); h3 [] [ txt "Latest commits" ]; ul [] (List.map (li_of_commit repo) commits); h3 [] [ txt "Authors" ]; @@ -146,12 +148,12 @@ module Repo = struct content; } - let refs repo _branches = + let refs repo branches = let content = HTML. [ h3 [] [ txt "Branches" ]; - (* ul [] (List.map (li_of_branch repo) branches); *) + ul [] (List.map (li_of_branch repo) branches); ] in respond |