[OCaml] Mobile-friendly clone of cgit.
Merge branch 'pre-release'
Changed files
- .gitignore
- .kiro/agents/doc-updater.md
- .kiro/agents/good-taste.md
- .kiro/agents/test-runner.md
- .kiro/hooks/dune-fmt-pre-commit.json
- .kiro/hooks/run-tests-after-commit.json
- .kiro/steering/agents.md
- .kiro/steering/doc-updater.md
- .kiro/steering/test-runner.md
- AGENTS.org
- AGENTS.override.md
- README.org
- bin/config_writer.ml
- bin/dune
- bin/main.ml
- deploy/README.org
- deploy/config.toml
- deploy/ogit.service
- dune-project
- lib/config.ml
- lib/config_writer.ml
- lib/diff.ml
- lib/dune
- lib/handlers.ml
- lib/main.ml
- lib/resolvers.ml
- lib/resolvers.mli
- lib/routes.ml
- lib/static/styles.css
- lib/static_handler.ml
- lib/views.ml
- lib/views/layout.ml
- lib/views/repo.ml
- lib/views/root.ml
- lib/views/time_fmt.ml
- ogit.opam
- scripts/build-release.sh
- test/dune
- test/test_commit_parsing.ml
- test/test_config.ml
- test/test_diff.ml
- test/test_discovery.ml
- test/test_helpers.ml
- test/test_ogit.ml
- test/test_router.ml
- test/test_tree_paths.ml
- test/test_validation.ml
- test/test_views.ml
.gitignore
@@ -2,3 +2,4 @@
2
2
3
3
_build/
4
4
_opam/
5
Added:
dist/
.kiro/agents/doc-updater.md
@@ -0,0 +1,61 @@
1
Added:
# Documentation Updater Agent
2
Added:
3
Added:
## Role
4
Added:
5
Added:
You are the documentation agent for the ogit project. Your sole responsibility is to update project documentation when a new feature is added or existing behavior changes.
6
Added:
7
Added:
## Scope
8
Added:
9
Added:
You update these files:
10
Added:
11
Added:
- `README.org` — project overview, architecture, configuration, TODOs
12
Added:
- `AGENTS.org` — agent guidance, project norms, repository map
13
Added:
- `deploy/README.org` — deployment documentation (if deployment changes)
14
Added:
- `.kiro/steering/agents.md` — Kiro-specific agent steering (must mirror AGENTS.org content)
15
Added:
- `.kiro/steering/test-runner.md` — test-runner integration (if testing workflow changes)
16
Added:
- `.kiro/agents/*.md` — agent definitions (if new agents are added or behavior changes)
17
Added:
18
Added:
## Behavior
19
Added:
20
Added:
1. Receive a summary of the feature or change that was implemented.
21
Added:
2. Identify which documentation files need updating.
22
Added:
3. For `.org` files, write valid Org mode syntax (headlines with `*`, markup with `=code=`, `[[links]]`, list items with `-`).
23
Added:
4. For `.md` files, write standard Markdown.
24
Added:
5. Keep documentation concise and consistent with existing style.
25
Added:
6. Report back what was updated and why.
26
Added:
27
Added:
## Guidelines
28
Added:
29
Added:
- **Architecture section**: Update when new modules, layers, or request-flow stages are added.
30
Added:
- **Configuration section**: Update when new config keys or environment variables are introduced.
31
Added:
- **Repository Map**: Update when new top-level directories or significant files are added.
32
Added:
- **TODOs**: Remove items that have been completed; add new known issues.
33
Added:
- **Steering files**: Keep `.kiro/steering/agents.md` in sync with `AGENTS.org` — they must reflect the same rules.
34
Added:
- Preserve existing formatting conventions (Org mode date stamps, author fields, etc.).
35
Added:
36
Added:
## Output Format
37
Added:
38
Added:
After updating, report:
39
Added:
40
Added:
```
41
Added:
DOCS UPDATED
42
Added:
============
43
Added:
Files modified:
44
Added:
- <file_path>: <brief description of change>
45
Added:
46
Added:
Sync status:
47
Added:
- AGENTS.org ↔ .kiro/steering/agents.md: in sync | needs manual review
48
Added:
```
49
Added:
50
Added:
## Tools Available
51
Added:
52
Added:
- read_file: to inspect current documentation
53
Added:
- str_replace / fs_write: to update documentation files
54
Added:
- grep_search: to find references that may need updating
55
Added:
56
Added:
## Constraints
57
Added:
58
Added:
- Do NOT modify source code, test files, or build configuration.
59
Added:
- Do NOT commit changes — leave that to the calling agent.
60
Added:
- Only modify documentation and steering files.
61
Added:
- When in doubt about a change, describe what you would update and ask for confirmation rather than guessing.
.kiro/agents/good-taste.md
@@ -0,0 +1,65 @@
1
Added:
# Good Taste Agent
2
Added:
3
Added:
## Role
4
Added:
5
Added:
You are the style advisor for the ogit project — a discerning
6
Added:
connoisseur of idiomatic OCaml. You are invoked on-demand for
7
Added:
code review and stylistic guidance, not as a routine gatekeeper.
8
Added:
9
Added:
Mechanical formatting is handled automatically by the pre-commit
10
Added:
hook (`opam exec -- dune fmt`). Your job is the subjective part:
11
Added:
identifying code that is technically valid but could be more
12
Added:
readable, idiomatic, or maintainable.
13
Added:
14
Added:
## When to Invoke
15
Added:
16
Added:
The main agent SHOULD invoke you when:
17
Added:
- A large or complex change has been made (multiple files, new module)
18
Added:
- Unfamiliar OCaml patterns are introduced
19
Added:
- The main agent wants a second opinion on structure or naming
20
Added:
21
Added:
The main agent SHOULD NOT invoke you for:
22
Added:
- Routine single-line fixes
23
Added:
- CSS-only changes
24
Added:
- Documentation-only changes
25
Added:
26
Added:
## Behavior
27
Added:
28
Added:
1. Read the diff or files under review.
29
Added:
2. Review for stylistic observations:
30
Added:
- Overly long lines that could be broken more readably
31
Added:
- Inconsistent naming (e.g., mixing `snake_case` and abbreviations)
32
Added:
- Unnecessary intermediate bindings that obscure intent
33
Added:
- Missing or misleading comments
34
Added:
- Code that could use more idiomatic OCaml constructs (e.g.,
35
Added:
`Option.map` instead of manual match, `List.concat_map` instead
36
Added:
of map+concat, pipeline operators for clarity)
37
Added:
- WCAG compliance in views (contrast, semantics, targets)
38
Added:
3. Report back concisely.
39
Added:
40
Added:
## Output Format
41
Added:
42
Added:
```
43
Added:
GOOD TASTE REVIEW
44
Added:
=================
45
Added:
Files reviewed: <list>
46
Added:
47
Added:
Style notes:
48
Added:
- <file:line> — <observation>
49
Added:
50
Added:
Verdict: Ship it. | Needs seasoning.
51
Added:
```
52
Added:
53
Added:
## Tools Available
54
Added:
55
Added:
- read_file: to inspect source files for style review
56
Added:
- grep_search: to find patterns worth flagging
57
Added:
- execute_bash: to run `git diff` for context
58
Added:
59
Added:
## Constraints
60
Added:
61
Added:
- Do NOT modify any source files.
62
Added:
- Do NOT run `dune fmt` — that's the hook's job now.
63
Added:
- Do NOT commit or push anything.
64
Added:
- Style notes are advisory; the main agent decides whether to act.
65
Added:
- Keep your report brief. Nobody likes a verbose pedant.
.kiro/agents/test-runner.md
@@ -0,0 +1,41 @@
1
Added:
# Test Runner Agent
2
Added:
3
Added:
## Role
4
Added:
You are the test runner agent for the ogit project. Your
5
Added:
responsibility is to run the full test suite after a commit is made,
6
Added:
report results clearly, and help diagnose any failures.
7
Added:
8
Added:
## Behavior
9
Added:
10
Added:
1. Run the test suite using `opam exec -- dune test`
11
Added:
2. Parse and summarize the output:
12
Added:
- If all tests pass, report a short success summary with the number
13
Added:
of tests run.
14
Added:
- If any tests fail, report which tests failed, their error output,
15
Added:
and suggest likely causes.
16
Added:
3. Always report the result back to the main agent concisely.
17
Added:
18
Added:
## Output Format
19
Added:
20
Added:
Report results in this format:
21
Added:
22
Added:
```
23
Added:
TEST REPORT
24
Added:
===========
25
Added:
Status: PASS | FAIL
26
Added:
Tests run: <count>
27
Added:
Failures: <list of failed test names, if any>
28
Added:
Duration: <time if available>
29
Added:
30
Added:
Details (on failure):
31
Added:
- <test_name>: <brief error description>
32
Added:
```
33
Added:
34
Added:
## Tools Available
35
Added:
- execute_bash: to run `opam exec -- dune test` and inspect output
36
Added:
- read_file: to inspect test source files if diagnosing failures
37
Added:
38
Added:
## Constraints
39
Added:
- Do NOT modify any source or test files.
40
Added:
- Do NOT commit or push anything.
41
Added:
- Only read and run commands. Report findings back to the calling agent.
.kiro/hooks/dune-fmt-pre-commit.json
@@ -0,0 +1,15 @@
1
Added:
{
2
Added:
"version": "v1",
3
Added:
"hooks": [
4
Added:
{
5
Added:
"name": "Auto-format before git commit",
6
Added:
"trigger": "PreToolUse",
7
Added:
"matcher": "execute_bash",
8
Added:
"action": {
9
Added:
"type": "command",
10
Added:
"command": "#!/bin/bash\nINPUT=$(cat)\nCOMMAND=$(echo \"$INPUT\" | python3 -c \"import sys,json; print(json.load(sys.stdin).get('tool_input',{}).get('command',''))\" 2>/dev/null)\nif ! echo \"$COMMAND\" | grep -qE 'git\\s+(commit|\\-c .* commit)'; then\n exit 0\nfi\ncd /home/blendux/git/ogit\nOUTPUT=$(opam exec -- dune fmt 2>&1)\nRC=$?\nif [ $RC -eq 0 ]; then\n echo 'Formatting clean — proceeding with commit.'\n exit 0\nfi\n# dune fmt exit 1 means it reformatted files; run again to confirm stable\nOUTPUT2=$(opam exec -- dune fmt 2>&1)\nRC2=$?\nif [ $RC2 -eq 0 ]; then\n CHANGED=$(git diff --name-only)\n if [ -n \"$CHANGED\" ]; then\n git add $CHANGED\n echo \"Reformatted and staged: $CHANGED\"\n fi\n exit 0\nelse\n echo \"dune fmt produced unstable output — blocking commit.\" >&2\n exit 2\nfi",
11
Added:
"timeout": 30
12
Added:
}
13
Added:
}
14
Added:
]
15
Added:
}
.kiro/hooks/run-tests-after-commit.json
@@ -0,0 +1,15 @@
1
Added:
{
2
Added:
"version": "v1",
3
Added:
"hooks": [
4
Added:
{
5
Added:
"name": "Run tests after git commit",
6
Added:
"trigger": "PostToolUse",
7
Added:
"matcher": "execute_bash",
8
Added:
"action": {
9
Added:
"type": "command",
10
Added:
"command": "#!/bin/bash\nINPUT=$(cat)\nCOMMAND=$(echo \"$INPUT\" | python3 -c \"import sys,json; print(json.load(sys.stdin).get('tool_input',{}).get('command',''))\" 2>/dev/null)\nif ! echo \"$COMMAND\" | grep -qE 'git\\s+(commit|\\-c .* commit)'; then\n exit 0\nfi\ncd /home/blendux/git/ogit\nOUTPUT=$(opam exec -- dune runtest 2>&1)\nRC=$?\nif [ $RC -eq 0 ]; then\n COUNT=$(echo \"$OUTPUT\" | grep -oP '\\d+ tests run' | head -1)\n echo \"TESTS PASSED: $COUNT\"\nelse\n echo \"TEST FAILURE:\"\n echo \"$OUTPUT\" | grep -A2 '\\[FAIL\\]'\nfi\nexit 0",
11
Added:
"timeout": 120
12
Added:
}
13
Added:
}
14
Added:
]
15
Added:
}
.kiro/steering/agents.md
@@ -0,0 +1,96 @@
1
Added:
# Agent Guidance
2
Added:
3
Added:
Author: Marius Peter
4
Added:
Date: 2026-07-09
5
Added:
6
Added:
## Normative Language
7
Added:
8
Added:
- **SHALL**: mandatory.
9
Added:
- **SHOULD**: expected unless there is a documented reason not to.
10
Added:
- **MAY**: optional.
11
Added:
- **MUST NOT**: prohibited.
12
Added:
13
Added:
## Context
14
Added:
15
Added:
### Scope
16
Added:
17
Added:
- The project SHALL implement a lightweight, mobile-friendly alternative to the cgit software.
18
Added:
19
Added:
## Architecture
20
Added:
21
Added:
### Opam switch
22
Added:
23
Added:
- The project SHALL rely on a project-local opam switch found at `./_opam/`.
24
Added:
25
Added:
### Build system
26
Added:
27
Added:
- The project SHALL use the Dune build system.
28
Added:
29
Added:
## Repository Map
30
Added:
31
Added:
- `README.org` — describes the overall architecture.
32
Added:
- `bin/` — contains the main ogit executable target.
33
Added:
- `lib/` — contains libraries used by ogit.
34
Added:
- `test/` — contains tests.
35
Added:
36
Added:
## Code
37
Added:
38
Added:
The public code repo is hosted at <https://git.mlnp.fr/ogit>.
39
Added:
40
Added:
### Versions
41
Added:
42
Added:
- The project SHALL target OCaml 5.2.1.
43
Added:
44
Added:
### Format
45
Added:
46
Added:
- The project code SHALL be formatted using the `.ocamlformat` config file located at the project root.
47
Added:
- Before committing code, agents SHALL run `dune fmt` and ensure that it completes successfully.
48
Added:
49
Added:
### Version control system
50
Added:
51
Added:
- The project SHALL use Git as its version control system.
52
Added:
53
Added:
#### Conventional Commits
54
Added:
55
Added:
- Commit messages SHALL follow the [Conventional Commits](https://www.conventionalcommits.org) specification.
56
Added:
- The commit message structure SHALL be: `<type>(<optional scope>): <description>`.
57
Added:
- Allowed types include: `feat`, `fix`, `docs`, `style`, `refactor`, `perf`, `test`, `build`, `ci`, `chore`, `revert`.
58
Added:
- Breaking changes SHALL be indicated by a `!` after the type/scope, or by a `BREAKING CHANGE:` footer.
59
Added:
- Commits created by an AI agent SHALL indicate so in the commit fields:
60
Added:
- `user.name` — concatenate agent model name, and intelligence or reasoning level.
61
Added:
- `user.email` — fictitious e-mail address identifying the agent's parent company.
62
Added:
- A commit SHALL be created after every modification request.
63
Added:
- If the next request is an adjustment, additional steering, or concerns the same files as those already committed, the latest commit SHALL be amended rather than a new commit being created.
64
Added:
65
Added:
#### Conventional Branch
66
Added:
67
Added:
- Branch names SHALL follow the [Conventional Branch](https://conventional-branch.github.io/) v1.1.0 specification.
68
Added:
- The branch name structure SHALL be: `<type>/<description>`.
69
Added:
- Allowed purpose prefixes: `feature/` (or `feat/`), `bugfix/` (or `fix/`), `hotfix/`, `release/`, `chore/`.
70
Added:
- Branches created by an AI agent SHALL use the appropriate AI agent source prefix (e.g. `ai/`, `claude/`, `copilot/`, `cursor/`, `codex/`).
71
Added:
- Trunk branches (`main`, `master`, `develop`) do not use a prefix.
72
Added:
- Branch descriptions SHALL use lowercase alphanumerics and hyphens only (dots permitted in release versions).
73
Added:
- Consecutive, leading, or trailing hyphens or dots MUST NOT appear in descriptions.
74
Added:
- Ticket numbers SHOULD be included where applicable (e.g. `feat/issue-42-add-pagination`).
75
Added:
76
Added:
## Documentation
77
Added:
78
Added:
- This repository SHALL use Org Mode for project documentation. New project docs SHALL use `.org` files.
79
Added:
- Architecture docs SHALL be updated when MQTT topics, payload schema, host roles, or data flow change.
80
Added:
81
Added:
## Testing
82
Added:
83
Added:
- Modifications to the code SHALL be followed by running regression tests.
84
Added:
- When attempting to compile this project, agents SHALL use a non-default Dream server listening port, so that agent test builds won't clash with an existing Dream server.
85
Added:
86
Added:
## Accessibility
87
Added:
88
Added:
- All rendered HTML SHALL conform to WCAG 2.1 AA.
89
Added:
- Text and interactive elements SHALL meet a minimum contrast ratio of 4.5:1 for normal text and 3:1 for large text (>=18.66px bold or >=24px).
90
Added:
- Interactive targets (links, buttons) SHALL have a minimum target size of 44×44 CSS pixels, or sufficient spacing to compensate per WCAG 2.5.8.
91
Added:
- Focus indicators SHALL be visible on all interactive elements (`:focus-visible` outline).
92
Added:
- Semantic HTML elements SHALL be preferred over `div`/`span` where an appropriate element exists (e.g. `nav`, `header`, `main`, `footer`, `time`).
93
Added:
- Images SHALL have descriptive `alt` text; decorative images SHALL use `alt=""` with `role="presentation"`.
94
Added:
- Skip navigation links SHALL be provided.
95
Added:
- ARIA landmarks and labels SHALL be used where native semantics are insufficient.
96
Added:
- When adding or modifying UI components, agents SHOULD verify contrast ratios against the page background and component background using computed values rather than assumptions.
.kiro/steering/doc-updater.md
@@ -0,0 +1,29 @@
1
Added:
---
2
Added:
inclusion: auto
3
Added:
---
4
Added:
5
Added:
# Documentation Updater Integration
6
Added:
7
Added:
After implementing a new feature or making a significant behavioral change, delegate documentation updates to the **doc-updater** agent defined in `.kiro/agents/doc-updater.md`.
8
Added:
9
Added:
## When to invoke
10
Added:
11
Added:
- A new module, route, handler, or view is added.
12
Added:
- Configuration options are added or changed.
13
Added:
- The request-flow architecture is modified.
14
Added:
- A new agent or hook is added under `.kiro/`.
15
Added:
- A TODO item is resolved.
16
Added:
17
Added:
## How to invoke
18
Added:
19
Added:
Use `orchestrate_subagent` with the `general-task-execution` role. Provide a prompt that includes:
20
Added:
21
Added:
1. A summary of what was implemented or changed.
22
Added:
2. Which areas of the codebase were affected.
23
Added:
3. Instruction to follow the doc-updater agent spec at `.kiro/agents/doc-updater.md`.
24
Added:
25
Added:
## After invocation
26
Added:
27
Added:
- Review the doc-updater's report.
28
Added:
- Stage and commit the documentation changes (separately or with the feature commit, as appropriate).
29
Added:
- Ensure `AGENTS.org` and `.kiro/steering/agents.md` remain in sync.
.kiro/steering/test-runner.md
@@ -0,0 +1,16 @@
1
Added:
---
2
Added:
inclusion: auto
3
Added:
---
4
Added:
5
Added:
# Test Runner Agent Integration
6
Added:
7
Added:
When you receive a `GIT_COMMIT_DETECTED` message from the post-commit
8
Added:
hook, you must:
9
Added:
10
Added:
1. Delegate to the **test-runner** agent defined in `.kiro/agents/test-runner.md` using `orchestrate_subagent` with the `general-task-execution` role.
11
Added:
2. The sub-agent's prompt should instruct it to:
12
Added:
- Run `opam exec -- dune test` in the workspace root
13
Added:
- Report results in the TEST REPORT format defined in the agent file
14
Added:
3. Relay the test report back to the user concisely.
15
Added:
16
Added:
If tests fail, offer to help diagnose and fix the failures before continuing with other work.
AGENTS.org
@@ -15,8 +15,8 @@
15
15
16
16
** Scope
17
17
18
Removed:
- The project SHALL implement a lightweight alternative to the cgit
19
Removed:
software.
18
Added:
- The project SHALL implement a lightweight, mobile-friendly
19
Added:
alternative to the cgit software.
20
20
21
21
* Architecture
22
22
@@ -54,8 +54,17 @@
54
54
** Version control system
55
55
56
56
- The project SHALL use Git as its version control system.
57
Removed:
- Commits created by an AI agent SHALL indicate so in the =user.name=
58
Removed:
and =user.email= fields.
57
Added:
- Commits created by an AI agent SHALL indicate so in the commit
58
Added:
fields:
59
Added:
- =user.name= :: concatenate agent model name, and intelligence or
60
Added:
reasoning level.
61
Added:
- =user.email= :: fictitious e-mail address identifying the agent's
62
Added:
parent company.
63
Added:
- A commit SHALL be created after every set of modifications brought
64
Added:
to the code.
65
Added:
- In case of adjustments being requested to code that was just
66
Added:
committed, the latest commit SHALL be amended, rather than a new
67
Added:
commit being created.
59
68
60
69
* Documentation
61
70
@@ -68,3 +77,29 @@
68
77
69
78
- Modifications to the code SHALL be followed by running regression
70
79
tests.
80
Added:
- When attempting to compile this project, agents SHALL use a
81
Added:
non-default Dream server listening port, so that agent test builds
82
Added:
won't clash with an existing Dream server.
83
Added:
84
Added:
* Accessibility
85
Added:
86
Added:
- All rendered HTML SHALL conform to WCAG 2.1 AA.
87
Added:
- Text and interactive elements SHALL meet a minimum contrast ratio of
88
Added:
4.5:1 for normal text and 3:1 for large text (>=18.66px bold or
89
Added:
>=24px).
90
Added:
- Interactive targets (links, buttons) SHALL have a minimum target
91
Added:
size of 44×44 CSS pixels, or sufficient spacing to compensate per
92
Added:
WCAG 2.5.8.
93
Added:
- Focus indicators SHALL be visible on all interactive elements
94
Added:
(=:focus-visible= outline).
95
Added:
- Semantic HTML elements SHALL be preferred over =div=/=span= where an
96
Added:
appropriate element exists (e.g. =nav=, =header=, =main=, =footer=,
97
Added:
=time=).
98
Added:
- Images SHALL have descriptive =alt= text; decorative images SHALL
99
Added:
use =alt=""= with =role="presentation"=.
100
Added:
- Skip navigation links SHALL be provided.
101
Added:
- ARIA landmarks and labels SHALL be used where native semantics are
102
Added:
insufficient.
103
Added:
- When adding or modifying UI components, agents SHOULD verify
104
Added:
contrast ratios against the page background and component background
105
Added:
using computed values rather than assumptions.
AGENTS.override.md
@@ -1,3 +0,0 @@
1
Removed:
# AGENTS.override.md
2
Removed:
3
Removed:
Use the AGENTS.org file.
README.org
@@ -7,14 +7,56 @@
7
7
8
8
* Ogit
9
9
10
Removed:
A mobile-friendly alternative to cgit.
10
Added:
A lightweight, mobile-friendly alternative to cgit.
11
11
12
12
13
Removed:
** Alternatives
13
Added:
* Architecture
14
14
15
Added:
The executable in =bin/main.ml= loads configuration and delegates to
16
Added:
=lib/main.ml=. Startup fails visibly when an explicitly selected
17
Added:
configuration file is missing or when configuration cannot be parsed or
18
Added:
validated.
19
Added:
20
Added:
Requests flow through the following layers:
21
Added:
22
Added:
1. =Routes= defines bidirectional, type-safe paths used for both Dream
23
Added:
route registration and generated links.
24
Added:
2. =Handlers= opens and validates one repository context per request,
25
Added:
maps application errors to HTTP statuses, and coordinates data
26
Added:
access with rendering.
27
Added:
3. =Resolvers= provides repository discovery and Git data access. An
28
Added:
opened repository context owns its Git store, resolved metadata, and
29
Added:
default-branch policy so operations in one request reuse the same
30
Added:
store.
31
Added:
4. =Views= renders data supplied by handlers. Views do not access the
32
Added:
filesystem or load configuration.
33
Added:
5. =Static_handler= serves assets embedded at build time by
34
Added:
=ocaml-crunch=.
35
Added:
36
Added:
Resolver failures retain their category until the HTTP boundary:
37
Added:
malformed input becomes =400 Bad Request=, missing repositories or Git
38
Added:
objects become =404 Not Found=, and storage or filesystem failures
39
Added:
become =500 Internal Server Error=.
40
Added:
41
Added:
42
Added:
* Configuration
43
Added:
44
Added:
Ogit reads the path named by =OGIT_CONFIG=. Otherwise it checks
45
Added:
=$XDG_CONFIG_HOME/ogit/config.toml= and finally
46
Added:
=/etc/ogit/config.toml=. When no explicit =OGIT_CONFIG= is selected, a
47
Added:
missing file uses environment-derived defaults; malformed or invalid
48
Added:
files never silently fall back.
49
Added:
50
Added:
The =commits_max_displayed= value controls commit list lengths on summary,
51
Added:
all-commit, and branch pages. =default_branch= is tried after =HEAD= and
52
Added:
before the conventional =main= and =master= fallbacks.
53
Added:
54
Added:
55
Added:
* Alternatives
56
Added:
15
57
- =cgit=
16
58
- Very fast page renders.
17
Removed:
- Unwieldly appearance on mobile.
59
Added:
- Unwieldy appearance on mobile.
18
60
- Extensive use of Git terminology; not beginner-friendly.
19
61
- codemadness' =stagit=
20
62
- Minimalist.
@@ -26,16 +68,8 @@
26
68
Listed in no particular order.
27
69
28
70
29
Removed:
** Features
30
Removed:
31
Removed:
- [ ] Repo file browser breadcrumbs
32
Removed:
- [ ] Diff view for commits
33
Removed:
- [ ] Index link
34
Removed:
- [ ] Config default app port
35
Removed:
36
Removed:
37
71
** Bugs
38
72
39
73
- [ ] Proper copyright holder management.
40
74
- Should be the main repository author by default, not the ogit
41
Removed:
process owner...
75
Added:
process owner.
bin/config_writer.ml
@@ -0,0 +1,3 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
let () = Ogit.Config.(default |> to_table |> write_file)
bin/dune
@@ -1,6 +1,6 @@
1
1
;;; -*- mode: lisp; -*-
2
2
3
Removed:
(executable
4
Removed:
(public_name ogit)
5
Removed:
(name main)
3
Added:
(executables
4
Added:
(names main config_writer)
5
Added:
(public_names ogit ogit-write-config)
6
6
(libraries ogit))
bin/main.ml
@@ -1,3 +1,15 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
let () = Ogit.Main.run ()
3
Added:
let usage = "Usage: ogit [--git-project-root <path>]"
4
Added:
5
Added:
let () =
6
Added:
let git_project_root = ref None in
7
Added:
let speclist =
8
Added:
[
9
Added:
( "--git-project-root",
10
Added:
Arg.String (fun path -> git_project_root := Some path),
11
Added:
"<path> Root directory containing Git repositories" );
12
Added:
]
13
Added:
in
14
Added:
Arg.parse speclist (fun _ -> ()) usage;
15
Added:
Ogit.Main.run ?git_project_root:!git_project_root ()
deploy/README.org
@@ -0,0 +1,73 @@
1
Added:
# -*- mode: org; -*-
2
Added:
3
Added:
#+TITLE: Deploying ogit
4
Added:
5
Added:
* Prerequisites
6
Added:
7
Added:
- Debian 11 (or similar) x86_64 VPS
8
Added:
- Nginx configured as a reverse proxy (not covered here)
9
Added:
- Bare git repositories under a common root (e.g. ~/srv/git~)
10
Added:
11
Added:
* Steps
12
Added:
13
Added:
** 1. Create the service user
14
Added:
15
Added:
#+begin_src sh
16
Added:
useradd --system --shell /usr/sbin/nologin --home-dir /nonexistent ogit
17
Added:
#+end_src
18
Added:
19
Added:
Ensure the =ogit= user can read your git repositories:
20
Added:
21
Added:
#+begin_src sh
22
Added:
usermod -aG git ogit # if repos are group-readable by 'git'
23
Added:
#+end_src
24
Added:
25
Added:
** 2. Install the binary
26
Added:
27
Added:
#+begin_src sh
28
Added:
cp dist/ogit /usr/local/bin/ogit
29
Added:
chmod 755 /usr/local/bin/ogit
30
Added:
#+end_src
31
Added:
32
Added:
** 3. Install the configuration
33
Added:
34
Added:
#+begin_src sh
35
Added:
mkdir -p /etc/ogit
36
Added:
cp deploy/config.toml /etc/ogit/config.toml
37
Added:
#+end_src
38
Added:
39
Added:
Edit ~/etc/ogit/config.toml~ to match your environment:
40
Added:
41
Added:
- =user= — displayed in the footer copyright
42
Added:
- =git_project_root= — path to the directory containing your bare repos
43
Added:
- =host= — bind address (keep =127.0.0.1= when behind Nginx)
44
Added:
- =port= — port Nginx will proxy to
45
Added:
46
Added:
** 4. Install and start the service
47
Added:
48
Added:
#+begin_src sh
49
Added:
cp deploy/ogit.service /etc/systemd/system/ogit.service
50
Added:
systemctl daemon-reload
51
Added:
systemctl enable --now ogit
52
Added:
#+end_src
53
Added:
54
Added:
** 5. Verify
55
Added:
56
Added:
#+begin_src sh
57
Added:
curl http://127.0.0.1:8081/
58
Added:
systemctl status ogit
59
Added:
#+end_src
60
Added:
61
Added:
* Updating
62
Added:
63
Added:
#+begin_src sh
64
Added:
systemctl stop ogit
65
Added:
cp dist/ogit /usr/local/bin/ogit
66
Added:
systemctl start ogit
67
Added:
#+end_src
68
Added:
69
Added:
* Logs
70
Added:
71
Added:
#+begin_src sh
72
Added:
journalctl -u ogit -f
73
Added:
#+end_src
deploy/config.toml
@@ -0,0 +1,9 @@
1
Added:
# ogit configuration
2
Added:
# Place at /etc/ogit/config.toml (or set OGIT_CONFIG to override)
3
Added:
4
Added:
user = "git"
5
Added:
default_branch = "main"
6
Added:
git_project_root = "/srv/git"
7
Added:
commits_max_displayed = 10
8
Added:
host = "127.0.0.1"
9
Added:
port = 8081
deploy/ogit.service
@@ -0,0 +1,28 @@
1
Added:
[Unit]
2
Added:
Description=ogit - mobile-friendly git web interface
3
Added:
After=network.target
4
Added:
5
Added:
[Service]
6
Added:
Type=simple
7
Added:
ExecStart=/usr/local/bin/ogit
8
Added:
Environment=OGIT_CONFIG=/etc/ogit/config.toml
9
Added:
Restart=on-failure
10
Added:
RestartSec=5
11
Added:
12
Added:
User=ogit
13
Added:
Group=ogit
14
Added:
15
Added:
# Hardening
16
Added:
NoNewPrivileges=yes
17
Added:
ProtectSystem=strict
18
Added:
ProtectHome=yes
19
Added:
ReadOnlyPaths=/srv/git
20
Added:
PrivateTmp=yes
21
Added:
PrivateDevices=yes
22
Added:
ProtectKernelTunables=yes
23
Added:
ProtectControlGroups=yes
24
Added:
RestrictSUIDSGID=yes
25
Added:
RestrictNamespaces=yes
26
Added:
27
Added:
[Install]
28
Added:
WantedBy=multi-user.target
dune-project
@@ -1,4 +1,4 @@
1
Removed:
(lang dune 3.24)
1
Added:
(lang dune 3.20)
2
2
3
3
(name ogit)
4
4
@@ -22,7 +22,9 @@
22
22
(dream-html (>= 3.11.2))
23
23
(git (>= 3.18.0))
24
24
(git-unix (>= 3.18.0))
25
Added:
(crunch (>= 4.0.0))
25
26
(ocamlformat (and :with-dev-setup (= 0.29.0)))
27
Added:
(alcotest (and :with-test (>= 1.7.0)))
26
28
(toml (>= 7.1.0)))
27
29
(tags
28
30
(git "web interface")))
lib/config.ml
@@ -7,71 +7,169 @@
7
7
default_branch : string;
8
8
git_project_root : string;
9
9
commits_max_displayed : int;
10
Added:
title : string;
11
Added:
host : string;
12
Added:
port : int;
10
13
}
11
14
15
Added:
type load_error =
16
Added:
| Not_found of string
17
Added:
| Parse_error of string
18
Added:
| Invalid_value of string
19
Added:
| Io_error of string
20
Added:
21
Added:
let environment_value name =
22
Added:
match Sys.getenv_opt name with Some "" | None -> None | value -> value
23
Added:
24
Added:
let getenv_first names ~default =
25
Added:
List.find_map environment_value names |> Option.value ~default
26
Added:
12
27
let default =
28
Added:
let home = getenv_first [ "HOME" ] ~default:"." in
13
29
{
14
Removed:
user = Sys.getenv "LOGNAME";
15
Removed:
default_branch = "master";
16
Removed:
git_project_root = Filename.concat (Sys.getenv "HOME") "git";
30
Added:
user = getenv_first [ "LOGNAME"; "USER" ] ~default:"git";
31
Added:
default_branch = "main";
32
Added:
git_project_root = Filename.concat home "git";
17
33
commits_max_displayed = 10;
34
Added:
title = "";
35
Added:
host = "127.0.0.1";
36
Added:
port = 8081;
18
37
}
19
38
20
39
let locate_config_file () =
21
Removed:
match Sys.getenv_opt "OGIT_CONFIG" with
40
Added:
match environment_value "OGIT_CONFIG" with
22
41
| Some file -> file
23
42
| None -> (
24
Removed:
match Sys.getenv_opt "XDG_CONFIG_HOME" with
43
Added:
match environment_value "XDG_CONFIG_HOME" with
25
44
| Some config_home ->
26
45
Filename.concat (Filename.concat config_home "ogit") "config.toml"
27
46
| None -> "/etc/ogit/config.toml")
28
47
29
Removed:
let config_file = locate_config_file ()
30
Removed:
31
48
let to_table t =
32
49
let open Types in
33
50
List.map
34
Removed:
(fun (k, v) -> (Min.key k, v))
51
Added:
(fun (key, value) -> (Min.key key, value))
35
52
[
36
53
("user", TString t.user);
37
54
("default_branch", TString t.default_branch);
38
55
("git_project_root", TString t.git_project_root);
39
56
("commits_max_displayed", TInt t.commits_max_displayed);
57
Added:
("title", TString t.title);
58
Added:
("host", TString t.host);
59
Added:
("port", TInt t.port);
40
60
]
41
61
|> Min.of_key_values
42
62
43
Removed:
let write_file ?(file = config_file) table =
44
Removed:
let oc = open_out file in
45
Removed:
Printer.string_of_table table |> Printf.fprintf oc "%s\n";
46
Removed:
close_out oc
63
Added:
let write_file ?file table =
64
Added:
let file = Option.value file ~default:(locate_config_file ()) in
65
Added:
Out_channel.with_open_text file (fun channel ->
66
Added:
Printer.string_of_table table |> Printf.fprintf channel "%s\n")
47
67
48
Removed:
let read_file ?(file = config_file) () =
68
Added:
let find_string table key =
69
Added:
match Types.Table.find_opt (Min.key key) table with
70
Added:
| Some (Types.TString value) -> Ok value
71
Added:
| Some _ -> Error (Invalid_value ("expected string for key: " ^ key))
72
Added:
| None -> Error (Invalid_value ("missing key: " ^ key))
73
Added:
74
Added:
let find_int table key =
75
Added:
match Types.Table.find_opt (Min.key key) table with
76
Added:
| Some (Types.TInt value) -> Ok value
77
Added:
| Some _ -> Error (Invalid_value ("expected int for key: " ^ key))
78
Added:
| None -> Error (Invalid_value ("missing key: " ^ key))
79
Added:
80
Added:
let find_string_opt table key ~default =
81
Added:
match Types.Table.find_opt (Min.key key) table with
82
Added:
| Some (Types.TString value) -> Ok value
83
Added:
| Some _ -> Error (Invalid_value ("expected string for key: " ^ key))
84
Added:
| None -> Ok default
85
Added:
86
Added:
let find_int_opt table key ~default =
87
Added:
match Types.Table.find_opt (Min.key key) table with
88
Added:
| Some (Types.TInt value) -> Ok value
89
Added:
| Some _ -> Error (Invalid_value ("expected int for key: " ^ key))
90
Added:
| None -> Ok default
91
Added:
92
Added:
let of_table table =
93
Added:
let ( let* ) = Result.bind in
94
Added:
let* git_project_root = find_string table "git_project_root" in
95
Added:
let* user = find_string table "user" in
96
Added:
let* default_branch = find_string table "default_branch" in
97
Added:
let* commits_max_displayed = find_int table "commits_max_displayed" in
98
Added:
let* title = find_string_opt table "title" ~default:default.title in
99
Added:
let* host = find_string_opt table "host" ~default:default.host in
100
Added:
let* port = find_int_opt table "port" ~default:default.port in
101
Added:
if commits_max_displayed <= 0 then
102
Added:
Error (Invalid_value "commits_max_displayed must be positive")
103
Added:
else if port < 1 || port > 65535 then
104
Added:
Error (Invalid_value "port must be between 1 and 65535")
105
Added:
else
106
Added:
Ok
107
Added:
{
108
Added:
git_project_root;
109
Added:
user;
110
Added:
default_branch;
111
Added:
commits_max_displayed;
112
Added:
title;
113
Added:
host;
114
Added:
port;
115
Added:
}
116
Added:
117
Added:
let io_error file error =
118
Added:
Io_error (Printf.sprintf "%s: %s" file (Unix.error_message error))
119
Added:
120
Added:
let file_exists file =
49
121
try
122
Added:
ignore (Unix.stat file);
123
Added:
Ok ()
124
Added:
with
125
Added:
| Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
126
Added:
Error (Not_found file)
127
Added:
| Unix.Unix_error (error, _, _) -> Error (io_error file error)
128
Added:
129
Added:
let read_file ?file () =
130
Added:
let file = Option.value file ~default:(locate_config_file ()) in
131
Added:
let ( let* ) = Result.bind in
132
Added:
let* () = file_exists file in
133
Added:
try
50
134
match Toml.Parser.from_filename file with
51
Removed:
| `Error (e, l) ->
52
Removed:
Error (Printf.sprintf "%s: %s at line %d" l.source e l.line)
53
Removed:
| `Ok table ->
54
Removed:
let find_string key =
55
Removed:
match Types.Table.find_opt (Min.key key) table with
56
Removed:
| Some (TString s) -> Ok s
57
Removed:
| Some _ -> Error ("Expected string for key: " ^ key)
58
Removed:
| None -> Error ("Missing key: " ^ key)
59
Removed:
in
60
Removed:
let find_int key =
61
Removed:
match Types.Table.find_opt (Min.key key) table with
62
Removed:
| Some (TInt i) -> Ok i
63
Removed:
| Some _ -> Error ("Expected int for key: " ^ key)
64
Removed:
| None -> Error ("Missing key: " ^ key)
65
Removed:
in
66
Removed:
let ( let* ) = Result.bind in
67
Removed:
let* git_project_root = find_string "git_project_root" in
68
Removed:
let* user = find_string "user" in
69
Removed:
let* default_branch = find_string "default_branch" in
70
Removed:
let* commits_max_displayed = find_int "commits_max_displayed" in
71
Removed:
Ok { git_project_root; user; default_branch; commits_max_displayed }
72
Removed:
with _ ->
73
Removed:
prerr_endline "[config.ml] Falling back to default config.";
74
Removed:
Ok default
135
Added:
| `Error (message, location) ->
136
Added:
Error
137
Added:
(Parse_error
138
Added:
(Printf.sprintf "%s: %s at line %d" location.source message
139
Added:
location.line))
140
Added:
| `Ok table -> of_table table
141
Added:
with Sys_error message -> Error (Io_error message)
75
142
76
Removed:
let default_port = 8081
77
Removed:
let config = match read_file () with Ok cfg -> cfg | Error _ -> default
143
Added:
let implicit_config_files () =
144
Added:
match environment_value "XDG_CONFIG_HOME" with
145
Added:
| Some config_home ->
146
Added:
[
147
Added:
Filename.concat (Filename.concat config_home "ogit") "config.toml";
148
Added:
"/etc/ogit/config.toml";
149
Added:
]
150
Added:
| None -> [ "/etc/ogit/config.toml" ]
151
Added:
152
Added:
let load () =
153
Added:
match environment_value "OGIT_CONFIG" with
154
Added:
| Some file -> read_file ~file ()
155
Added:
| None ->
156
Added:
let rec first_existing = function
157
Added:
| [] -> Ok default
158
Added:
| file :: rest -> (
159
Added:
match read_file ~file () with
160
Added:
| Error (Not_found _) -> first_existing rest
161
Added:
| result -> result)
162
Added:
in
163
Added:
first_existing (implicit_config_files ())
164
Added:
165
Added:
let pp_load_error formatter = function
166
Added:
| Not_found file ->
167
Added:
Format.fprintf formatter "configuration file not found: %s" file
168
Added:
| Parse_error message ->
169
Added:
Format.fprintf formatter "invalid configuration: %s" message
170
Added:
| Invalid_value message ->
171
Added:
Format.fprintf formatter "invalid configuration value: %s" message
172
Added:
| Io_error message ->
173
Added:
Format.fprintf formatter "could not read configuration: %s" message
174
Added:
175
Added:
let load_error_to_string error = Format.asprintf "%a" pp_load_error error
lib/config_writer.ml
@@ -1,3 +0,0 @@
1
Removed:
(* -*- mode: tuareg; -*- *)
2
Removed:
3
Removed:
let () = Config.(default |> to_table |> write_file)
lib/diff.ml
@@ -0,0 +1,165 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
type line_kind = Context | Addition | Deletion
4
Added:
5
Added:
type line = {
6
Added:
kind : line_kind;
7
Added:
old_number : int option;
8
Added:
new_number : int option;
9
Added:
text : string;
10
Added:
}
11
Added:
12
Added:
type hunk = {
13
Added:
old_start : int;
14
Added:
old_count : int;
15
Added:
new_start : int;
16
Added:
new_count : int;
17
Added:
lines : line list;
18
Added:
}
19
Added:
20
Added:
type file = {
21
Added:
path : string;
22
Added:
old_hash : string option;
23
Added:
new_hash : string option;
24
Added:
old_mode : int option;
25
Added:
new_mode : int option;
26
Added:
binary : bool;
27
Added:
hunks : hunk list;
28
Added:
}
29
Added:
30
Added:
let split_lines content =
31
Added:
match String.split_on_char '\n' content with
32
Added:
| [] -> []
33
Added:
| lines ->
34
Added:
if content = "" then []
35
Added:
else if String.ends_with ~suffix:"\n" content then
36
Added:
List.rev lines |> List.tl |> List.rev
37
Added:
else lines
38
Added:
39
Added:
let line_diff old_content new_content =
40
Added:
let old_lines = Array.of_list (split_lines old_content) in
41
Added:
let new_lines = Array.of_list (split_lines new_content) in
42
Added:
let old_length = Array.length old_lines in
43
Added:
let new_length = Array.length new_lines in
44
Added:
let matrix_size = old_length * new_length in
45
Added:
let rec all_deletions index acc =
46
Added:
if index = old_length then List.rev acc
47
Added:
else
48
Added:
all_deletions (index + 1)
49
Added:
({
50
Added:
kind = Deletion;
51
Added:
old_number = Some (index + 1);
52
Added:
new_number = None;
53
Added:
text = old_lines.(index);
54
Added:
}
55
Added:
:: acc)
56
Added:
in
57
Added:
let rec all_additions index acc =
58
Added:
if index = new_length then List.rev acc
59
Added:
else
60
Added:
all_additions (index + 1)
61
Added:
({
62
Added:
kind = Addition;
63
Added:
old_number = None;
64
Added:
new_number = Some (index + 1);
65
Added:
text = new_lines.(index);
66
Added:
}
67
Added:
:: acc)
68
Added:
in
69
Added:
if matrix_size > 4_000_000 then all_deletions 0 [] @ all_additions 0 []
70
Added:
else
71
Added:
let lengths = Array.make_matrix (old_length + 1) (new_length + 1) 0 in
72
Added:
for old_index = old_length - 1 downto 0 do
73
Added:
for new_index = new_length - 1 downto 0 do
74
Added:
lengths.(old_index).(new_index) <-
75
Added:
(if old_lines.(old_index) = new_lines.(new_index) then
76
Added:
lengths.(old_index + 1).(new_index + 1) + 1
77
Added:
else
78
Added:
max
79
Added:
lengths.(old_index + 1).(new_index)
80
Added:
lengths.(old_index).(new_index + 1))
81
Added:
done
82
Added:
done;
83
Added:
let rec build old_index new_index acc =
84
Added:
if old_index = old_length then List.rev acc @ all_additions new_index []
85
Added:
else if new_index = new_length then
86
Added:
List.rev acc @ all_deletions old_index []
87
Added:
else if old_lines.(old_index) = new_lines.(new_index) then
88
Added:
build (old_index + 1) (new_index + 1)
89
Added:
({
90
Added:
kind = Context;
91
Added:
old_number = Some (old_index + 1);
92
Added:
new_number = Some (new_index + 1);
93
Added:
text = old_lines.(old_index);
94
Added:
}
95
Added:
:: acc)
96
Added:
else if
97
Added:
lengths.(old_index + 1).(new_index)
98
Added:
>= lengths.(old_index).(new_index + 1)
99
Added:
then
100
Added:
build (old_index + 1) new_index
101
Added:
({
102
Added:
kind = Deletion;
103
Added:
old_number = Some (old_index + 1);
104
Added:
new_number = None;
105
Added:
text = old_lines.(old_index);
106
Added:
}
107
Added:
:: acc)
108
Added:
else
109
Added:
build old_index (new_index + 1)
110
Added:
({
111
Added:
kind = Addition;
112
Added:
old_number = None;
113
Added:
new_number = Some (new_index + 1);
114
Added:
text = new_lines.(new_index);
115
Added:
}
116
Added:
:: acc)
117
Added:
in
118
Added:
build 0 0 []
119
Added:
120
Added:
let hunks ?(context = 3) lines =
121
Added:
let lines = Array.of_list lines in
122
Added:
let length = Array.length lines in
123
Added:
let changed =
124
Added:
Array.to_list (Array.mapi (fun index line -> (index, line.kind)) lines)
125
Added:
|> List.filter_map (function
126
Added:
| index, (Addition | Deletion) -> Some index
127
Added:
| _, Context -> None)
128
Added:
in
129
Added:
let ranges =
130
Added:
let add_range ranges index =
131
Added:
let first = max 0 (index - context) in
132
Added:
let last = min (length - 1) (index + context) in
133
Added:
match ranges with
134
Added:
| (range_first, range_last) :: rest when first <= range_last + 1 ->
135
Added:
(range_first, max range_last last) :: rest
136
Added:
| _ -> (first, last) :: ranges
137
Added:
in
138
Added:
List.fold_left add_range [] changed |> List.rev
139
Added:
in
140
Added:
let number_or_zero get_number slice =
141
Added:
List.find_map get_number slice |> Option.value ~default:0
142
Added:
in
143
Added:
let make_hunk (first, last) =
144
Added:
let rec slice index acc =
145
Added:
if index > last then List.rev acc
146
Added:
else slice (index + 1) (lines.(index) :: acc)
147
Added:
in
148
Added:
let lines = slice first [] in
149
Added:
{
150
Added:
old_start = number_or_zero (fun line -> line.old_number) lines;
151
Added:
old_count =
152
Added:
List.fold_left
153
Added:
(fun count line ->
154
Added:
if Option.is_some line.old_number then count + 1 else count)
155
Added:
0 lines;
156
Added:
new_start = number_or_zero (fun line -> line.new_number) lines;
157
Added:
new_count =
158
Added:
List.fold_left
159
Added:
(fun count line ->
160
Added:
if Option.is_some line.new_number then count + 1 else count)
161
Added:
0 lines;
162
Added:
lines;
163
Added:
}
164
Added:
in
165
Added:
List.map make_hunk ranges
lib/dune
@@ -1,7 +1,16 @@
1
1
;; -*- mode: lisp; -*-
2
2
3
Added:
(include_subdirs unqualified)
4
Added:
3
5
(library
4
6
(name ogit)
5
7
(libraries dream dream-html git-unix toml)
6
8
(preprocess
7
9
(pps dream-html.ppx)))
10
Added:
11
Added:
(rule
12
Added:
(target static_assets.ml)
13
Added:
(deps
14
Added:
(source_tree static))
15
Added:
(action
16
Added:
(run ocaml-crunch -m plain -s -o %{target} static)))
lib/handlers.ml
@@ -1,81 +1,247 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
let root _req = Views.root ()
3
Added:
let error_response error =
4
Added:
let status, title =
5
Added:
match error with
6
Added:
| Resolvers.Bad_request _ -> (`Bad_Request, "Bad request")
7
Added:
| Resolvers.Not_found _ -> (`Not_Found, "Not found")
8
Added:
| Resolvers.Store_error _ | Resolvers.Internal _ ->
9
Added:
(`Internal_Server_Error, "Internal server error")
10
Added:
in
11
Added:
let message = Format.asprintf "%a" Resolvers.pp_error error in
12
Added:
Views.error_page ~status ~title message
4
13
14
Added:
let root_title config =
15
Added:
if config.Config.title = "" then "Repositories for " ^ config.Config.user
16
Added:
else config.Config.title
17
Added:
18
Added:
let root config _request =
19
Added:
match Resolvers.repositories config with
20
Added:
| Ok repositories ->
21
Added:
let open Lwt.Syntax in
22
Added:
let* repos_with_dates =
23
Added:
Lwt_list.map_p
24
Added:
(fun name ->
25
Added:
Lwt.bind (Resolvers.open_repository config name) @@ function
26
Added:
| Error _ -> Lwt.return (name, None)
27
Added:
| Ok repository ->
28
Added:
let* date = Resolvers.head_commit_date repository in
29
Added:
let* () = Resolvers.close_repository repository in
30
Added:
Lwt.return (name, date))
31
Added:
repositories
32
Added:
in
33
Added:
let sorted =
34
Added:
List.sort
35
Added:
(fun (_, a) (_, b) ->
36
Added:
match (a, b) with
37
Added:
| None, None -> 0
38
Added:
| None, Some _ -> 1
39
Added:
| Some _, None -> -1
40
Added:
| Some (ta, _), Some (tb, _) -> Int64.compare tb ta)
41
Added:
repos_with_dates
42
Added:
in
43
Added:
Views.root ~user:config.Config.user ~root_title:(root_title config) sorted
44
Added:
| Error error -> error_response error
45
Added:
5
46
module Repo = struct
6
Removed:
let ( let* ) m f =
7
Removed:
Lwt.bind m @@ function
8
Removed:
| Ok x -> f x
9
Removed:
| Error e ->
10
Removed:
let msg = Format.asprintf "%a" Resolvers.Store.pp_error e in
11
Removed:
Views.error_page msg
47
Added:
let ( let* ) result continue =
48
Added:
Lwt.bind result @@ function
49
Added:
| Ok value -> continue value
50
Added:
| Error error -> error_response error
12
51
13
Removed:
let handle handler req =
14
Removed:
let repo = Dream.param req "repo" in
15
Removed:
handler repo
52
Added:
let view_context config repository =
53
Added:
Views.Repo.context ~user:config.Config.user ~root_title:(root_title config)
54
Added:
~repo:(Resolvers.repository_name repository)
55
Added:
~description:(Resolvers.repository_description repository)
16
56
17
Removed:
let handle_id handler req =
18
Removed:
let repo = Dream.param req "repo" in
19
Removed:
let id = Dream.param req "id" in
20
Removed:
handler repo id
57
Added:
let with_repository config name continue =
58
Added:
Lwt.bind (Resolvers.open_repository config name) @@ function
59
Added:
| Error error -> error_response error
60
Added:
| Ok repository ->
61
Added:
let context = view_context config repository in
62
Added:
Lwt.finalize
63
Added:
(fun () -> continue repository context)
64
Added:
(fun () -> Resolvers.close_repository repository)
21
65
22
Removed:
let summary repo =
23
Removed:
let* branches = Resolvers.Reference.branches repo in
24
Removed:
let* commits = Resolvers.Commit.recent repo 10 in
25
Removed:
Views.Repo.summary repo branches commits
66
Added:
let handle config handler _request name = with_repository config name handler
26
67
27
Removed:
let commits repo =
28
Removed:
let* commits = Resolvers.Commit.recent repo 100 in
29
Removed:
Views.Repo.commits repo commits
68
Added:
let handle_request config handler request name =
69
Added:
with_repository config name (fun repository context ->
70
Added:
handler request repository context)
30
71
31
Removed:
let commit_id repo id =
32
Removed:
let* commit = Resolvers.Commit.of_id repo id in
33
Removed:
let* diff = Resolvers.Diff.of_commit repo commit in
34
Removed:
Views.Repo.commit repo commit diff
72
Added:
let handle_id config handler _request name id =
73
Added:
with_repository config name (fun repository context ->
74
Added:
handler repository context id)
35
75
36
Removed:
let files_at_head repo =
37
Removed:
let* tree = Resolvers.Tree.head repo in
38
Removed:
Views.Repo.files repo tree
76
Added:
let summary config repository context =
77
Added:
let* branches = Resolvers.Reference.branches repository in
78
Added:
let* commits =
79
Added:
Resolvers.Commit.recent repository config.Config.commits_max_displayed
80
Added:
in
81
Added:
Views.Repo.summary context branches commits
39
82
40
Removed:
let file_id repo id =
41
Removed:
let* res = Resolvers.blob_or_tree repo id in
42
Removed:
match res with
43
Removed:
| `Tree tree -> Views.Repo.files repo tree
44
Removed:
| `Blob blob -> Views.Repo.file repo blob
83
Added:
let commit_matches ?filter_type ?author ?committer
84
Added:
(commit : Resolvers.Commit.t) =
85
Added:
let type_matches =
86
Added:
match filter_type with
87
Added:
| None -> true
88
Added:
| Some expected ->
89
Added:
let summary =
90
Added:
match commit.message with
91
Added:
| None -> ""
92
Added:
| Some message -> (
93
Added:
match String.split_on_char '\n' message with
94
Added:
| [] -> ""
95
Added:
| summary :: _ -> summary)
96
Added:
in
97
Added:
let commit_type, _ = Views.Repo.parse_conventional summary in
98
Added:
commit_type = Some expected
99
Added:
in
100
Added:
let author_matches =
101
Added:
match author with
102
Added:
| None -> true
103
Added:
| Some email -> String.equal commit.author.email email
104
Added:
in
105
Added:
let committer_matches =
106
Added:
match committer with
107
Added:
| None -> true
108
Added:
| Some email -> String.equal commit.committer.email email
109
Added:
in
110
Added:
type_matches && author_matches && committer_matches
45
111
46
Removed:
let branches repo =
47
Removed:
let* branches = Resolvers.Reference.branches repo in
48
Removed:
Views.Repo.branches repo branches
112
Added:
let page_size = 20
49
113
50
Removed:
let tags repo =
51
Removed:
let* tags = Resolvers.Reference.tags repo in
52
Removed:
Views.Repo.tags repo tags
114
Added:
let commits _config request repository context =
115
Added:
let filter_type = Dream.query request "type" in
116
Added:
let author = Dream.query request "author" in
117
Added:
let committer = Dream.query request "committer" in
118
Added:
let page =
119
Added:
match Dream.query request "page" with
120
Added:
| None -> 1
121
Added:
| Some s -> (
122
Added:
match int_of_string_opt s with Some p when p > 0 -> p | _ -> 1)
123
Added:
in
124
Added:
let offset = (page - 1) * page_size in
125
Added:
(* Fetch one beyond orphan threshold to detect whether more exist *)
126
Added:
let fetch_count = offset + page_size + 11 in
127
Added:
let predicate = commit_matches ?filter_type ?author ?committer in
128
Added:
let* all_commits =
129
Added:
Resolvers.Commit.recent_matching repository fetch_count predicate
130
Added:
in
131
Added:
let total = List.length all_commits in
132
Added:
let after_offset =
133
Added:
if offset >= total then []
134
Added:
else List.filteri (fun i _ -> i >= offset) all_commits
135
Added:
in
136
Added:
let remaining = List.length after_offset in
137
Added:
(* If next page would have <10 items, absorb them; otherwise normal page *)
138
Added:
let effective_size =
139
Added:
if remaining > page_size && remaining <= page_size + 10 then remaining
140
Added:
else page_size
141
Added:
in
142
Added:
let page_commits =
143
Added:
List.filteri (fun i _ -> i < effective_size) after_offset
144
Added:
in
145
Added:
let has_next = remaining > effective_size in
146
Added:
let has_prev = page > 1 in
147
Added:
Views.Repo.commits ?filter_type ?author ?committer ~page ~has_prev ~has_next
148
Added:
context page_commits
53
149
54
Removed:
let readme repo =
55
Removed:
let* readme = Resolvers.Repo.readme repo in
56
Removed:
Views.Repo.file repo
57
Removed:
@@
58
Removed:
match readme with
59
Removed:
| None -> { content = "README does not exist for " ^ repo }
60
Removed:
| Some file -> file
150
Added:
let commits_branch _config repository context branch =
151
Added:
let* reference = Resolvers.Reference.of_id repository branch in
152
Added:
let fetch_count = page_size + 11 in
153
Added:
let* commits =
154
Added:
Resolvers.Commit.recent_from repository reference.hash fetch_count
155
Added:
in
156
Added:
let remaining = List.length commits in
157
Added:
let effective_size =
158
Added:
if remaining > page_size && remaining <= page_size + 10 then remaining
159
Added:
else page_size
160
Added:
in
161
Added:
let page_commits = List.filteri (fun i _ -> i < effective_size) commits in
162
Added:
let has_next = remaining > effective_size in
163
Added:
Views.Repo.commits ~page:1 ~has_prev:false ~has_next context page_commits
164
Added:
165
Added:
let commit_id repository context id =
166
Added:
let* commit = Resolvers.Commit.of_id repository id in
167
Added:
let* diff = Resolvers.Diff.of_commit repository commit in
168
Added:
Views.Repo.commit context commit diff
169
Added:
170
Added:
let find_readme repository (tree : Resolvers.Tree.t) =
171
Added:
match List.find_opt Resolvers.Entry.is_readme tree.entries with
172
Added:
| None -> Lwt_result.return None
173
Added:
| Some entry ->
174
Added:
Lwt.bind (Resolvers.blob_or_tree repository entry.hash) (function
175
Added:
| Ok (`Blob blob) -> Lwt.return (Ok (Some blob))
176
Added:
| Ok _ -> Lwt.return (Ok None)
177
Added:
| Error e -> Lwt.return (Error e))
178
Added:
179
Added:
let files_at_head repository context =
180
Added:
let* tree = Resolvers.Tree.head repository in
181
Added:
let* preloaded = Resolvers.Tree.preload repository tree in
182
Added:
let* readme = find_readme repository tree in
183
Added:
Views.Repo.files context [] ?readme preloaded
184
Added:
185
Added:
let file_id repository context id =
186
Added:
let* trail = Resolvers.Tree.find_path repository id in
187
Added:
let* object_ = Resolvers.blob_or_tree repository id in
188
Added:
match object_ with
189
Added:
| `Tree tree ->
190
Added:
let* preloaded = Resolvers.Tree.preload repository tree in
191
Added:
let* readme = find_readme repository tree in
192
Added:
Views.Repo.files context trail ?readme preloaded
193
Added:
| `Blob blob -> Views.Repo.file context trail blob
194
Added:
195
Added:
let branches repository context =
196
Added:
let* branches = Resolvers.Reference.branches repository in
197
Added:
Views.Repo.branches context branches
198
Added:
199
Added:
let tags repository context =
200
Added:
let* tags = Resolvers.Reference.tags repository in
201
Added:
Views.Repo.tags context tags
202
Added:
203
Added:
let raw_file repository _context id =
204
Added:
let* object_ = Resolvers.blob_or_tree repository id in
205
Added:
match object_ with
206
Added:
| `Blob blob ->
207
Added:
Lwt.return
208
Added:
(Dream.response
209
Added:
~headers:[ ("Content-Type", "text/plain; charset=utf-8") ]
210
Added:
blob.content)
211
Added:
| `Tree _ ->
212
Added:
error_response (Resolvers.Bad_request "object is a tree, not a blob")
213
Added:
214
Added:
let readme repository context =
215
Added:
let* readme = Resolvers.Repo.readme repository in
216
Added:
let blob =
217
Added:
match readme with
218
Added:
| None ->
219
Added:
Resolvers.Blob.
220
Added:
{
221
Added:
content =
222
Added:
"README does not exist for "
223
Added:
^ Resolvers.repository_name repository;
224
Added:
}
225
Added:
| Some blob -> blob
226
Added:
in
227
Added:
Views.Repo.file ~active:Layout.Readme context [] blob
61
228
end
62
229
63
Removed:
let all_handlers =
64
Removed:
let open Dream in
230
Added:
let routes config =
231
Added:
let open Dream_html in
65
232
[
66
Removed:
get "/" root;
67
Removed:
scope "/:repo" []
68
Removed:
Repo.
69
Removed:
[
70
Removed:
get "/" (handle summary);
71
Removed:
get "/summary/" (handle summary);
72
Removed:
get "/commits/" (handle commits);
73
Removed:
get "/commit/:id" (handle_id commit_id);
74
Removed:
get "/files/" (handle files_at_head);
75
Removed:
get "/file/:id" (handle_id file_id);
76
Removed:
get "/branches/" (handle branches);
77
Removed:
get "/tags/" (handle tags);
78
Removed:
get "/README" (handle readme);
79
Removed:
];
80
Removed:
get "/static/**" (static "./lib/static");
233
Added:
get Routes.root_path (root config);
234
Added:
get Routes.repo_root_path (Repo.handle config (Repo.summary config));
235
Added:
get Routes.repo_path (Repo.handle config (Repo.summary config));
236
Added:
get Routes.commits_path (Repo.handle_request config (Repo.commits config));
237
Added:
get Routes.commits_branch_path
238
Added:
(Repo.handle_id config (Repo.commits_branch config));
239
Added:
get Routes.commit_path (Repo.handle_id config Repo.commit_id);
240
Added:
get Routes.files_path (Repo.handle config Repo.files_at_head);
241
Added:
get Routes.file_path (Repo.handle_id config Repo.file_id);
242
Added:
get Routes.raw_file_path (Repo.handle_id config Repo.raw_file);
243
Added:
get Routes.branches_path (Repo.handle config Repo.branches);
244
Added:
get Routes.tags_path (Repo.handle config Repo.tags);
245
Added:
get Routes.readme_path (Repo.handle config Repo.readme);
246
Added:
get Routes.static_path Static_handler.handler;
81
247
]
lib/main.ml
@@ -1,5 +1,21 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
let run () =
4
Removed:
let port = Config.default_port in
5
Removed:
Dream.run ~port @@ Dream.logger @@ Dream.router Handlers.all_handlers
3
Added:
let run_with_config config =
4
Added:
Dream.run ~port:config.Config.port ~interface:config.Config.host
5
Added:
@@ Dream.logger
6
Added:
@@ Dream.router (Handlers.routes config)
7
Added:
8
Added:
let run ?git_project_root () =
9
Added:
let config =
10
Added:
match Config.load () with
11
Added:
| Ok config -> config
12
Added:
| Error error ->
13
Added:
if Option.is_some git_project_root then Config.default
14
Added:
else failwith (Config.load_error_to_string error)
15
Added:
in
16
Added:
let config =
17
Added:
match git_project_root with
18
Added:
| Some path -> { config with git_project_root = path }
19
Added:
| None -> config
20
Added:
in
21
Added:
run_with_config config
lib/resolvers.ml
@@ -2,8 +2,22 @@
2
2
3
3
module Store = Git_unix.Store
4
4
open Lwt_result.Syntax
5
Removed:
open Config
6
5
6
Added:
type error =
7
Added:
| Bad_request of string
8
Added:
| Not_found of string
9
Added:
| Store_error of Store.error
10
Added:
| Internal of string
11
Added:
12
Added:
let pp_error formatter = function
13
Added:
| Bad_request message -> Format.fprintf formatter "%s" message
14
Added:
| Not_found message -> Format.fprintf formatter "%s" message
15
Added:
| Store_error error -> Store.pp_error formatter error
16
Added:
| Internal message -> Format.fprintf formatter "%s" message
17
Added:
18
Added:
let map_store promise =
19
Added:
Lwt.map (Result.map_error (fun error -> Store_error error)) promise
20
Added:
7
21
let is_hex_digit = function
8
22
| '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
9
23
| _ -> false
@@ -13,7 +27,7 @@
13
27
14
28
let hash_of_hex hash =
15
29
if is_valid_hash_hex hash then Lwt_result.return (Store.Hash.of_hex hash)
16
Removed:
else Lwt_result.fail (`Msg ("invalid object id " ^ hash))
30
Added:
else Lwt_result.fail (Bad_request ("invalid object id " ^ hash))
17
31
18
32
let is_valid_repo_name repo =
19
33
let invalid_char = function '/' | '\\' | '\x00' -> true | _ -> false in
@@ -23,34 +37,72 @@
23
37
24
38
let validate_repo_name repo =
25
39
if is_valid_repo_name repo then Lwt_result.return repo
26
Removed:
else Lwt_result.fail (`Msg ("invalid repository name " ^ repo))
40
Added:
else Lwt_result.fail (Bad_request ("invalid repository name " ^ repo))
27
41
28
Removed:
let full_path path = Filename.concat config.git_project_root path
29
Removed:
30
42
type repository_layout = { worktree : string; git_dir : string }
31
43
32
Removed:
let is_directory path = try Sys.is_directory path with Sys_error _ -> false
44
Added:
let filesystem_error path error =
45
Added:
Internal (Printf.sprintf "%s: %s" path (Unix.error_message error))
33
46
34
Removed:
let is_git_directory path =
35
Removed:
is_directory path
36
Removed:
&& Sys.file_exists (Filename.concat path "HEAD")
37
Removed:
&& is_directory (Filename.concat path "objects")
47
Added:
let is_directory_result path =
48
Added:
try Ok ((Unix.stat path).st_kind = Unix.S_DIR) with
49
Added:
| Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false
50
Added:
| Unix.Unix_error (error, _, _) -> Error (filesystem_error path error)
38
51
39
Removed:
let repository_layout path =
52
Added:
let file_exists_result path =
53
Added:
try
54
Added:
ignore (Unix.stat path);
55
Added:
Ok true
56
Added:
with
57
Added:
| Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false
58
Added:
| Unix.Unix_error (error, _, _) -> Error (filesystem_error path error)
59
Added:
60
Added:
let is_git_directory_result path =
61
Added:
let ( let* ) = Result.bind in
62
Added:
let* directory = is_directory_result path in
63
Added:
if not directory then Ok false
64
Added:
else
65
Added:
let* has_head = file_exists_result (Filename.concat path "HEAD") in
66
Added:
let* has_objects = is_directory_result (Filename.concat path "objects") in
67
Added:
Ok (has_head && has_objects)
68
Added:
69
Added:
let repository_layout_result path =
70
Added:
let ( let* ) = Result.bind in
40
71
let dotgit = Filename.concat path ".git" in
41
Removed:
if is_git_directory path then Some { worktree = path; git_dir = path }
42
Removed:
else if is_directory path && is_git_directory dotgit then
43
Removed:
Some { worktree = path; git_dir = dotgit }
44
Removed:
else None
72
Added:
let* worktree = is_directory_result path in
73
Added:
if not worktree then Ok None
74
Added:
else
75
Added:
let* non_bare = is_git_directory_result dotgit in
76
Added:
if non_bare then Ok (Some { worktree = path; git_dir = dotgit })
77
Added:
else
78
Added:
let* bare = is_git_directory_result path in
79
Added:
if bare then Ok (Some { worktree = path; git_dir = path }) else Ok None
45
80
81
Added:
let repository_layout path =
82
Added:
match repository_layout_result path with
83
Added:
| Ok layout -> layout
84
Added:
| Error _ -> None
85
Added:
46
86
let is_repository path = Option.is_some (repository_layout path)
47
87
48
Removed:
let store repo =
49
Removed:
let* repo = validate_repo_name repo in
50
Removed:
match repository_layout (full_path repo) with
51
Removed:
| Some { worktree; git_dir } ->
52
Removed:
Store.v ~dotgit:(Fpath.v git_dir) (Fpath.v worktree)
53
Removed:
| None -> Lwt_result.fail (`Msg ("not a Git repository " ^ repo))
88
Added:
let repositories config =
89
Added:
try
90
Added:
let names = Sys.readdir config.Config.git_project_root |> Array.to_list in
91
Added:
let ( let* ) = Result.bind in
92
Added:
let rec collect repositories = function
93
Added:
| [] -> Ok (List.sort String.compare repositories)
94
Added:
| name :: rest when String.starts_with ~prefix:"." name ->
95
Added:
collect repositories rest
96
Added:
| name :: rest ->
97
Added:
let path = Filename.concat config.Config.git_project_root name in
98
Added:
let* layout = repository_layout_result path in
99
Added:
collect
100
Added:
(if Option.is_some layout then name :: repositories
101
Added:
else repositories)
102
Added:
rest
103
Added:
in
104
Added:
collect [] names
105
Added:
with Sys_error message -> Error (Internal message)
54
106
55
107
let default_repo_description = "Unnamed repository"
56
108
@@ -64,33 +116,58 @@
64
116
| description -> description
65
117
with Sys_error _ -> default_repo_description
66
118
67
Removed:
let repo_description repo =
68
Removed:
if is_valid_repo_name repo then
69
Removed:
match repository_layout (full_path repo) with
70
Removed:
| Some { git_dir; _ } ->
71
Removed:
let description_path = Filename.concat git_dir "description" in
72
Removed:
read_description_file description_path
73
Removed:
| None -> default_repo_description
74
Removed:
else default_repo_description
119
Added:
let description_of_layout { git_dir; _ } =
120
Added:
Filename.concat git_dir "description" |> read_description_file
75
121
76
Removed:
let short_hash hash = String.sub hash 0 8
122
Added:
type repository = {
123
Added:
name : string;
124
Added:
store : Store.t;
125
Added:
description : string;
126
Added:
default_branch : string;
127
Added:
}
128
Added:
129
Added:
let open_repository config name =
130
Added:
let* name = validate_repo_name name in
131
Added:
let path = Filename.concat config.Config.git_project_root name in
132
Added:
match repository_layout_result path with
133
Added:
| Error error -> Lwt_result.fail error
134
Added:
| Ok None -> Lwt_result.fail (Not_found ("not a Git repository " ^ name))
135
Added:
| Ok (Some ({ worktree; git_dir } as layout)) ->
136
Added:
let* store =
137
Added:
map_store (Store.v ~dotgit:(Fpath.v git_dir) (Fpath.v worktree))
138
Added:
in
139
Added:
Lwt_result.return
140
Added:
{
141
Added:
name;
142
Added:
store;
143
Added:
description = description_of_layout layout;
144
Added:
default_branch = config.Config.default_branch;
145
Added:
}
146
Added:
147
Added:
let repository_name repository = repository.name
148
Added:
let repository_description repository = repository.description
149
Added:
let close_repository repository = Store.close_pack_files repository.store
150
Added:
let short_hash hash = String.sub hash 0 (min 8 (String.length hash))
77
151
let branch_ref name = Git.Reference.v ("refs/heads/" ^ name)
78
152
79
Removed:
let fallback_branch_candidates () =
80
Removed:
let add acc name = if List.mem name acc then acc else acc @ [ name ] in
81
Removed:
let candidates = [] in
82
Removed:
let candidates = add candidates config.default_branch in
83
Removed:
let candidates = add candidates "main" in
84
Removed:
add candidates "master"
153
Added:
let fallback_branch_candidates_for default_branch =
154
Added:
List.fold_left
155
Added:
(fun candidates name ->
156
Added:
if List.mem name candidates then candidates else candidates @ [ name ])
157
Added:
[]
158
Added:
[ default_branch; "main"; "master" ]
85
159
86
Removed:
let resolve_head_hash store =
87
Removed:
let fail_store_error err =
88
Removed:
Lwt_result.fail (`Msg (Fmt.str "%a" Store.pp_error err))
160
Added:
let fallback_branch_candidates config =
161
Added:
fallback_branch_candidates_for config.Config.default_branch
162
Added:
163
Added:
let resolve_head_hash repository =
164
Added:
let resolve reference =
165
Added:
map_store (Store.Ref.resolve repository.store reference)
89
166
in
90
167
let rec try_references = function
91
168
| [] ->
92
169
let open Lwt.Syntax in
93
Removed:
let* references = Store.Ref.list store in
170
Added:
let* references = Store.Ref.list repository.store in
94
171
let branches =
95
172
references |> List.map fst
96
173
|> List.filter_map (fun reference ->
@@ -98,31 +175,56 @@
98
175
if String.starts_with ~prefix:"refs/heads/" name then
99
176
Some (name, reference)
100
177
else None)
101
Removed:
|> List.sort (fun (a, _) (b, _) -> String.compare a b)
178
Added:
|> List.sort (fun (left, _) (right, _) -> String.compare left right)
102
179
in
103
180
let rec try_branches = function
104
181
| [] ->
105
182
Lwt_result.fail
106
Removed:
(`Msg "no branch could be resolved for repository")
183
Added:
(Not_found "no branch could be resolved for repository")
107
184
| (_, reference) :: rest -> (
108
Removed:
Lwt.bind (Store.Ref.resolve store reference) @@ function
185
Added:
Lwt.bind (resolve reference) @@ function
109
186
| Ok hash -> Lwt_result.return hash
110
Removed:
| Error (`Reference_not_found _) -> try_branches rest
111
Removed:
| Error err -> fail_store_error err)
187
Added:
| Error (Store_error (`Reference_not_found _)) ->
188
Added:
try_branches rest
189
Added:
| Error error -> Lwt_result.fail error)
112
190
in
113
191
try_branches branches
114
192
| reference :: rest -> (
115
Removed:
Lwt.bind (Store.Ref.resolve store reference) @@ function
193
Added:
Lwt.bind (resolve reference) @@ function
116
194
| Ok hash -> Lwt_result.return hash
117
Removed:
| Error (`Reference_not_found _) -> try_references rest
118
Removed:
| Error err -> fail_store_error err)
195
Added:
| Error (Store_error (`Reference_not_found _)) -> try_references rest
196
Added:
| Error error -> Lwt_result.fail error)
119
197
in
120
Removed:
Lwt.bind (Store.Ref.resolve store Git.Reference.head) @@ function
198
Added:
Lwt.bind (resolve Git.Reference.head) @@ function
121
199
| Ok hash -> Lwt_result.return hash
122
Removed:
| Error (`Reference_not_found _) ->
123
Removed:
try_references (List.map branch_ref (fallback_branch_candidates ()))
124
Removed:
| Error err -> fail_store_error err
200
Added:
| Error (Store_error (`Reference_not_found _)) ->
201
Added:
fallback_branch_candidates_for repository.default_branch
202
Added:
|> List.map branch_ref |> try_references
203
Added:
| Error error -> Lwt_result.fail error
125
204
205
Added:
let read_value repository hash =
206
Added:
Lwt.bind (Store.read repository.store hash) @@ function
207
Added:
| Error (`Not_found _) ->
208
Added:
Lwt_result.fail
209
Added:
(Not_found ("no object matches id " ^ Store.Hash.to_hex hash))
210
Added:
| Error error -> Lwt_result.fail (Store_error error)
211
Added:
| Ok value -> Lwt_result.return value
212
Added:
213
Added:
let head_commit_date repository =
214
Added:
let open Lwt.Syntax in
215
Added:
let* result =
216
Added:
Lwt_result.bind (resolve_head_hash repository) @@ fun hash ->
217
Added:
Lwt.bind (Store.read repository.store hash) @@ function
218
Added:
| Error _ -> Lwt_result.return None
219
Added:
| Ok value -> (
220
Added:
match value with
221
Added:
| Git.Value.Commit commit ->
222
Added:
let author = Store.Value.Commit.author commit in
223
Added:
Lwt_result.return (Some author.Git.User.date)
224
Added:
| _ -> Lwt_result.return None)
225
Added:
in
226
Added:
Lwt.return (Result.value result ~default:None)
227
Added:
126
228
module Commit = struct
127
229
type user = Git.User.t
128
230
@@ -131,43 +233,64 @@
131
233
tree : string;
132
234
parents : string list;
133
235
author : user;
236
Added:
committer : user;
134
237
message : string option;
135
238
}
136
239
137
Removed:
let to_t c =
240
Added:
let to_t commit =
138
241
Store.
139
242
{
140
Removed:
hash = Value.Commit.digest c |> Hash.to_hex;
141
Removed:
tree = Value.Commit.tree c |> Hash.to_hex;
142
Removed:
parents = Value.Commit.parents c |> List.map Hash.to_hex;
143
Removed:
author = Value.Commit.author c;
144
Removed:
message = Value.Commit.message c;
243
Added:
hash = Value.Commit.digest commit |> Hash.to_hex;
244
Added:
tree = Value.Commit.tree commit |> Hash.to_hex;
245
Added:
parents = Value.Commit.parents commit |> List.map Hash.to_hex;
246
Added:
author = Value.Commit.author commit;
247
Added:
committer = Value.Commit.committer commit;
248
Added:
message = Value.Commit.message commit;
145
249
}
146
250
147
Removed:
let of_id repo id =
148
Removed:
let* store = store repo in
149
Removed:
let* hash = hash_of_hex id in
150
Removed:
Lwt_result.bind (Store.read store hash) @@ function
251
Added:
let of_hash repository hash =
252
Added:
Lwt_result.bind (read_value repository hash) @@ function
151
253
| Git.Value.Commit commit -> Lwt_result.return (to_t commit)
152
Removed:
| _ -> Lwt_result.fail @@ `Msg ("no commit matches id " ^ id)
254
Added:
| _ ->
255
Added:
Store.Hash.to_hex hash |> Printf.sprintf "no commit matches id %s"
256
Added:
|> fun message -> Lwt_result.fail (Not_found message)
153
257
154
Removed:
let head repo =
155
Removed:
let* store = store repo in
156
Removed:
let* hash = resolve_head_hash store in
157
Removed:
let id = hash |> Store.Hash.to_hex in
158
Removed:
of_id repo id
258
Added:
let of_id repository id =
259
Added:
let* hash = hash_of_hex id in
260
Added:
of_hash repository hash
159
261
160
Removed:
let recent repo n =
161
Removed:
let* head_commit = head repo in
162
Removed:
let rec walk acc hash count =
163
Removed:
if count = 0 then Lwt_result.return (List.rev acc)
262
Added:
let head repository =
263
Added:
let* hash = resolve_head_hash repository in
264
Added:
of_hash repository hash
265
Added:
266
Added:
let recent_matching_from repository hash count predicate =
267
Added:
let rec walk commits hash remaining =
268
Added:
if remaining <= 0 then Lwt_result.return (List.rev commits)
164
269
else
165
Removed:
let* commit = of_id repo hash in
166
Removed:
match commit.parents with
167
Removed:
| parent_hash :: _ -> walk (commit :: acc) parent_hash (count - 1)
168
Removed:
| [] -> Lwt_result.return (List.rev (commit :: acc))
270
Added:
let* commit = of_id repository hash in
271
Added:
let commits, remaining =
272
Added:
if predicate commit then (commit :: commits, remaining - 1)
273
Added:
else (commits, remaining)
274
Added:
in
275
Added:
if remaining <= 0 then Lwt_result.return (List.rev commits)
276
Added:
else
277
Added:
match commit.parents with
278
Added:
| parent_hash :: _ -> walk commits parent_hash remaining
279
Added:
| [] -> Lwt_result.return (List.rev commits)
169
280
in
170
Removed:
walk [] head_commit.hash n
281
Added:
walk [] hash count
282
Added:
283
Added:
let recent_from repository hash count =
284
Added:
recent_matching_from repository hash count (Fun.const true)
285
Added:
286
Added:
let recent_matching repository count predicate =
287
Added:
let* head_hash = resolve_head_hash repository in
288
Added:
recent_matching_from repository
289
Added:
(Store.Hash.to_hex head_hash)
290
Added:
count predicate
291
Added:
292
Added:
let recent repository count =
293
Added:
recent_matching repository count (Fun.const true)
171
294
end
172
295
173
296
module Reference = struct
@@ -182,51 +305,27 @@
182
305
183
306
let branch_name name = drop_prefix ~prefix:"refs/heads/" name
184
307
let tag_name name = drop_prefix ~prefix:"refs/tags/" name
185
Removed:
186
Removed:
let to_t (reference, hash) =
187
Removed:
{ name = Git.Reference.to_string reference; hash = Store.Hash.to_hex hash }
188
Removed:
189
308
let to_t_with_name name (_, hash) = { name; hash = Store.Hash.to_hex hash }
190
309
191
Removed:
let all repo =
192
Removed:
let* store = store repo in
310
Added:
let refs_by_prefix repository name_of_reference =
193
311
let open Lwt.Syntax in
194
Removed:
let* references = Store.Ref.list store in
195
Removed:
let references = List.map to_t references in
196
Removed:
Lwt_result.return references
312
Added:
let* references = Store.Ref.list repository.store in
313
Added:
references
314
Added:
|> List.filter_map (fun ((reference, _) as raw) ->
315
Added:
Git.Reference.to_string reference
316
Added:
|> name_of_reference
317
Added:
|> Option.map (fun name -> to_t_with_name name raw))
318
Added:
|> List.sort (fun left right -> String.compare left.name right.name)
319
Added:
|> Lwt_result.return
197
320
198
Removed:
let branches repo =
199
Removed:
let* store = store repo in
200
Removed:
let open Lwt.Syntax in
201
Removed:
let* references = Store.Ref.list store in
202
Removed:
let branches =
203
Removed:
references
204
Removed:
|> List.filter_map (fun ((reference, _) as raw) ->
205
Removed:
Git.Reference.to_string reference
206
Removed:
|> branch_name
207
Removed:
|> Option.map (fun name -> to_t_with_name name raw))
208
Removed:
in
209
Removed:
Lwt_result.return branches
321
Added:
let branches repository = refs_by_prefix repository branch_name
322
Added:
let tags repository = refs_by_prefix repository tag_name
210
323
211
Removed:
let tags repo =
212
Removed:
let* store = store repo in
213
Removed:
let open Lwt.Syntax in
214
Removed:
let* references = Store.Ref.list store in
215
Removed:
let tags =
216
Removed:
references
217
Removed:
|> List.filter_map (fun ((reference, _) as raw) ->
218
Removed:
Git.Reference.to_string reference
219
Removed:
|> tag_name
220
Removed:
|> Option.map (fun name -> to_t_with_name name raw))
221
Removed:
in
222
Removed:
Lwt_result.return tags
223
Removed:
224
Removed:
let of_id repo id =
225
Removed:
let* branches = branches repo in
226
Removed:
let branch = branches |> List.find_opt (fun branch -> branch.name = id) in
227
Removed:
match branch with
324
Added:
let of_id repository id =
325
Added:
let* branches = branches repository in
326
Added:
match List.find_opt (fun branch -> branch.name = id) branches with
228
327
| Some branch -> Lwt_result.return branch
229
Removed:
| None -> Lwt_result.fail @@ `Msg ("no reference matches id " ^ id)
328
Added:
| None -> Lwt_result.fail (Not_found ("no reference matches id " ^ id))
230
329
end
231
330
232
331
let mode_of_perm : Git.Tree.perm -> int = function
@@ -238,229 +337,154 @@
238
337
| `Normal -> 0o100644
239
338
240
339
module Entry = struct
241
Removed:
type t = { hash : string; name : string; perm : int }
340
Added:
type perm = Dir | File | Exec | Link | Submodule
341
Added:
type t = { hash : string; name : string; perm : perm }
242
342
343
Added:
let perm_of_git : Git.Tree.perm -> perm = function
344
Added:
| `Dir -> Dir
345
Added:
| `Exec -> Exec
346
Added:
| `Link -> Link
347
Added:
| `Commit -> Submodule
348
Added:
| `Normal | `Everybody -> File
349
Added:
243
350
let to_t (entry : Store.Value.Tree.entry) =
244
Removed:
let hash = Store.Hash.to_hex entry.node in
245
Removed:
let name = entry.name in
246
Removed:
let perm = mode_of_perm entry.perm in
247
Removed:
{ hash; name; perm }
351
Added:
{
352
Added:
hash = Store.Hash.to_hex entry.node;
353
Added:
name = entry.name;
354
Added:
perm = perm_of_git entry.perm;
355
Added:
}
248
356
249
357
let is_readme { name; _ } =
250
358
String.(lowercase_ascii name |> starts_with ~prefix:"readme")
251
359
end
252
360
253
361
module Tree = struct
254
Removed:
type t = { hash : string; path : string; entries : Entry.t list }
362
Added:
type t = { entries : Entry.t list }
255
363
364
Added:
type preloaded_entry = {
365
Added:
entry : Entry.t;
366
Added:
children : preloaded_entry list option;
367
Added:
}
368
Added:
256
369
let to_t tree =
257
Removed:
let hash = Store.Value.Tree.hash tree |> Int.to_string in
258
Removed:
let path = "/" in
259
Removed:
let entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t in
260
Removed:
{ hash; path; entries }
370
Added:
{ entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t }
261
371
262
Removed:
let of_id repo id =
263
Removed:
let* store = store repo in
264
Removed:
let* hash = hash_of_hex id in
265
Removed:
Lwt_result.bind (Store.read store hash) @@ function
372
Added:
let of_hash repository hash =
373
Added:
Lwt_result.bind (read_value repository hash) @@ function
266
374
| Git.Value.Tree tree -> Lwt_result.return (to_t tree)
267
Removed:
| _ -> Lwt_result.fail @@ `Msg ("no tree matches id " ^ id)
375
Added:
| _ ->
376
Added:
Store.Hash.to_hex hash |> Printf.sprintf "no tree matches id %s"
377
Added:
|> fun message -> Lwt_result.fail (Not_found message)
268
378
269
Removed:
let head repo =
270
Removed:
let* store = store repo in
271
Removed:
let* hash = resolve_head_hash store in
272
Removed:
Lwt_result.bind (Store.read store hash) @@ function
379
Added:
let head_tree_hash repository =
380
Added:
let* hash = resolve_head_hash repository in
381
Added:
Lwt_result.bind (read_value repository hash) @@ function
273
382
| Git.Value.Commit commit ->
274
Removed:
let tree_id = Store.Value.Commit.tree commit |> Store.Hash.to_hex in
275
Removed:
of_id repo tree_id
276
Removed:
| _ -> Lwt_result.fail @@ `Msg "HEAD reference does not point to a commit"
383
Added:
Lwt_result.return (Store.Value.Commit.tree commit)
384
Added:
| _ -> Lwt_result.fail (Internal "HEAD does not point to a commit")
385
Added:
386
Added:
let head repository =
387
Added:
let* hash = head_tree_hash repository in
388
Added:
of_hash repository hash
389
Added:
390
Added:
let preload repository tree =
391
Added:
let rec preload_entry (entry : Entry.t) =
392
Added:
if entry.perm <> Entry.Dir then
393
Added:
Lwt_result.return { entry; children = None }
394
Added:
else collapse_single_subdirs entry.name entry.hash
395
Added:
and collapse_single_subdirs prefix hash_hex =
396
Added:
let* hash = hash_of_hex hash_hex in
397
Added:
let* subtree =
398
Added:
Lwt_result.bind (read_value repository hash) @@ function
399
Added:
| Git.Value.Tree t -> Lwt_result.return (to_t t)
400
Added:
| _ -> Lwt_result.return { entries = [] }
401
Added:
in
402
Added:
let entries = subtree.entries in
403
Added:
match entries with
404
Added:
| [ single ] when single.perm = Entry.Dir ->
405
Added:
(* Single subdir — collapse into parent name and recurse *)
406
Added:
let combined_name = prefix ^ "/" ^ single.name in
407
Added:
collapse_single_subdirs combined_name single.hash
408
Added:
| _ ->
409
Added:
let count = List.length entries in
410
Added:
let collapsed_entry =
411
Added:
{ Entry.hash = hash_hex; name = prefix; perm = Entry.Dir }
412
Added:
in
413
Added:
if count >= 10 then
414
Added:
Lwt_result.return { entry = collapsed_entry; children = Some [] }
415
Added:
else
416
Added:
let* children = preload_entries entries in
417
Added:
Lwt_result.return
418
Added:
{ entry = collapsed_entry; children = Some children }
419
Added:
and preload_entries entries =
420
Added:
let sorted =
421
Added:
List.sort
422
Added:
(fun (a : Entry.t) (b : Entry.t) ->
423
Added:
match (a.perm, b.perm) with
424
Added:
| (Entry.Dir, Entry.Dir | _, _) when a.perm = b.perm ->
425
Added:
String.compare a.name b.name
426
Added:
| Entry.Dir, _ -> -1
427
Added:
| _, Entry.Dir -> 1
428
Added:
| _, _ -> String.compare a.name b.name)
429
Added:
entries
430
Added:
in
431
Added:
let rec go acc = function
432
Added:
| [] -> Lwt_result.return (List.rev acc)
433
Added:
| e :: rest ->
434
Added:
let* pe = preload_entry e in
435
Added:
go (pe :: acc) rest
436
Added:
in
437
Added:
go [] sorted
438
Added:
in
439
Added:
preload_entries tree.entries
440
Added:
441
Added:
let find_path repository target_hash =
442
Added:
let* target = hash_of_hex target_hash in
443
Added:
let* root = head_tree_hash repository in
444
Added:
if Store.Hash.equal root target then Lwt_result.return []
445
Added:
else
446
Added:
let rec search trail tree_hash =
447
Added:
Lwt_result.bind (read_value repository tree_hash) @@ function
448
Added:
| Git.Value.Tree tree ->
449
Added:
let rec try_entries = function
450
Added:
| [] -> Lwt_result.return None
451
Added:
| (entry : Store.Value.Tree.entry) :: rest ->
452
Added:
let step = (entry.name, Store.Hash.to_hex entry.node) in
453
Added:
if Store.Hash.equal entry.node target then
454
Added:
Lwt_result.return (Some (List.rev (step :: trail)))
455
Added:
else if entry.perm = `Dir then
456
Added:
let* found = search (step :: trail) entry.node in
457
Added:
match found with
458
Added:
| Some _ -> Lwt_result.return found
459
Added:
| None -> try_entries rest
460
Added:
else try_entries rest
461
Added:
in
462
Added:
try_entries (Store.Value.Tree.to_list tree)
463
Added:
| _ -> Lwt_result.return None
464
Added:
in
465
Added:
let* result = search [] root in
466
Added:
match result with
467
Added:
| Some trail -> Lwt_result.return trail
468
Added:
| None ->
469
Added:
Lwt_result.fail
470
Added:
(Not_found ("object is not reachable from HEAD: " ^ target_hash))
277
471
end
278
472
279
473
module Blob = struct
280
474
type t = { content : string }
281
475
282
476
let to_t blob = { content = Store.Value.Blob.to_string blob }
283
Removed:
284
Removed:
let of_id repo id =
285
Removed:
let* store = store repo in
286
Removed:
let* hash = hash_of_hex id in
287
Removed:
Lwt_result.bind (Store.read store hash) @@ function
288
Removed:
| Git.Value.Blob blob -> Lwt_result.return (to_t blob)
289
Removed:
| _ -> Lwt_result.fail @@ `Msg ("no blob matches id " ^ id)
290
477
end
291
478
292
479
module Diff = struct
293
480
module Path_map = Map.Make (String)
481
Added:
include Diff
294
482
295
Removed:
type line_kind = Context | Addition | Deletion
296
Removed:
297
Removed:
type line = {
298
Removed:
kind : line_kind;
299
Removed:
old_number : int option;
300
Removed:
new_number : int option;
301
Removed:
text : string;
302
Removed:
}
303
Removed:
304
Removed:
type hunk = {
305
Removed:
old_start : int;
306
Removed:
old_count : int;
307
Removed:
new_start : int;
308
Removed:
new_count : int;
309
Removed:
lines : line list;
310
Removed:
}
311
Removed:
312
Removed:
type file = {
313
Removed:
path : string;
314
Removed:
old_hash : string option;
315
Removed:
new_hash : string option;
316
Removed:
old_mode : int option;
317
Removed:
new_mode : int option;
318
Removed:
binary : bool;
319
Removed:
hunks : hunk list;
320
Removed:
}
321
Removed:
322
483
type tree_file = { hash : string; perm : Git.Tree.perm }
323
484
324
Removed:
let split_lines content =
325
Removed:
match String.split_on_char '\n' content with
326
Removed:
| [] -> []
327
Removed:
| lines ->
328
Removed:
if content = "" then []
329
Removed:
else if String.ends_with ~suffix:"\n" content then
330
Removed:
List.rev lines |> List.tl |> List.rev
331
Removed:
else lines
332
Removed:
333
Removed:
let line_diff old_content new_content =
334
Removed:
let old_lines = Array.of_list (split_lines old_content) in
335
Removed:
let new_lines = Array.of_list (split_lines new_content) in
336
Removed:
let old_length = Array.length old_lines in
337
Removed:
let new_length = Array.length new_lines in
338
Removed:
let matrix_size = old_length * new_length in
339
Removed:
let rec all_deletions index acc =
340
Removed:
if index = old_length then List.rev acc
341
Removed:
else
342
Removed:
all_deletions (index + 1)
343
Removed:
({
344
Removed:
kind = Deletion;
345
Removed:
old_number = Some (index + 1);
346
Removed:
new_number = None;
347
Removed:
text = old_lines.(index);
348
Removed:
}
349
Removed:
:: acc)
350
Removed:
in
351
Removed:
let rec all_additions index acc =
352
Removed:
if index = new_length then List.rev acc
353
Removed:
else
354
Removed:
all_additions (index + 1)
355
Removed:
({
356
Removed:
kind = Addition;
357
Removed:
old_number = None;
358
Removed:
new_number = Some (index + 1);
359
Removed:
text = new_lines.(index);
360
Removed:
}
361
Removed:
:: acc)
362
Removed:
in
363
Removed:
if matrix_size > 4_000_000 then all_deletions 0 [] @ all_additions 0 []
364
Removed:
else
365
Removed:
let lengths = Array.make_matrix (old_length + 1) (new_length + 1) 0 in
366
Removed:
for old_index = old_length - 1 downto 0 do
367
Removed:
for new_index = new_length - 1 downto 0 do
368
Removed:
lengths.(old_index).(new_index) <-
369
Removed:
(if old_lines.(old_index) = new_lines.(new_index) then
370
Removed:
lengths.(old_index + 1).(new_index + 1) + 1
371
Removed:
else
372
Removed:
max
373
Removed:
lengths.(old_index + 1).(new_index)
374
Removed:
lengths.(old_index).(new_index + 1))
375
Removed:
done
376
Removed:
done;
377
Removed:
let rec build old_index new_index acc =
378
Removed:
if old_index = old_length then List.rev acc @ all_additions new_index []
379
Removed:
else if new_index = new_length then
380
Removed:
List.rev acc @ all_deletions old_index []
381
Removed:
else if old_lines.(old_index) = new_lines.(new_index) then
382
Removed:
build (old_index + 1) (new_index + 1)
383
Removed:
({
384
Removed:
kind = Context;
385
Removed:
old_number = Some (old_index + 1);
386
Removed:
new_number = Some (new_index + 1);
387
Removed:
text = old_lines.(old_index);
388
Removed:
}
389
Removed:
:: acc)
390
Removed:
else if
391
Removed:
lengths.(old_index + 1).(new_index)
392
Removed:
>= lengths.(old_index).(new_index + 1)
393
Removed:
then
394
Removed:
build (old_index + 1) new_index
395
Removed:
({
396
Removed:
kind = Deletion;
397
Removed:
old_number = Some (old_index + 1);
398
Removed:
new_number = None;
399
Removed:
text = old_lines.(old_index);
400
Removed:
}
401
Removed:
:: acc)
402
Removed:
else
403
Removed:
build old_index (new_index + 1)
404
Removed:
({
405
Removed:
kind = Addition;
406
Removed:
old_number = None;
407
Removed:
new_number = Some (new_index + 1);
408
Removed:
text = new_lines.(new_index);
409
Removed:
}
410
Removed:
:: acc)
411
Removed:
in
412
Removed:
build 0 0 []
413
Removed:
414
Removed:
let hunks ?(context = 3) lines =
415
Removed:
let lines = Array.of_list lines in
416
Removed:
let length = Array.length lines in
417
Removed:
let changed =
418
Removed:
Array.to_list (Array.mapi (fun index line -> (index, line.kind)) lines)
419
Removed:
|> List.filter_map (function
420
Removed:
| index, (Addition | Deletion) -> Some index
421
Removed:
| _, Context -> None)
422
Removed:
in
423
Removed:
let ranges =
424
Removed:
let add_range ranges index =
425
Removed:
let first = max 0 (index - context) in
426
Removed:
let last = min (length - 1) (index + context) in
427
Removed:
match ranges with
428
Removed:
| (range_first, range_last) :: rest when first <= range_last + 1 ->
429
Removed:
(range_first, max range_last last) :: rest
430
Removed:
| _ -> (first, last) :: ranges
431
Removed:
in
432
Removed:
List.fold_left add_range [] changed |> List.rev
433
Removed:
in
434
Removed:
let number_or_zero get_number slice =
435
Removed:
List.find_map get_number slice |> Option.value ~default:0
436
Removed:
in
437
Removed:
let make_hunk (first, last) =
438
Removed:
let rec slice index acc =
439
Removed:
if index > last then List.rev acc
440
Removed:
else slice (index + 1) (lines.(index) :: acc)
441
Removed:
in
442
Removed:
let lines = slice first [] in
443
Removed:
{
444
Removed:
old_start = number_or_zero (fun line -> line.old_number) lines;
445
Removed:
old_count =
446
Removed:
List.fold_left
447
Removed:
(fun count line ->
448
Removed:
if Option.is_some line.old_number then count + 1 else count)
449
Removed:
0 lines;
450
Removed:
new_start = number_or_zero (fun line -> line.new_number) lines;
451
Removed:
new_count =
452
Removed:
List.fold_left
453
Removed:
(fun count line ->
454
Removed:
if Option.is_some line.new_number then count + 1 else count)
455
Removed:
0 lines;
456
Removed:
lines;
457
Removed:
}
458
Removed:
in
459
Removed:
List.map make_hunk ranges
460
Removed:
461
Removed:
let rec flatten_tree store prefix tree_hash files =
485
Added:
let rec flatten_tree repository prefix tree_hash files =
462
486
let* hash = hash_of_hex tree_hash in
463
Removed:
Lwt_result.bind (Store.read store hash) @@ function
487
Added:
Lwt_result.bind (read_value repository hash) @@ function
464
488
| Git.Value.Tree tree ->
465
489
let rec add_entries files = function
466
490
| [] -> Lwt_result.return files
@@ -472,41 +496,39 @@
472
496
let hash = Store.Hash.to_hex entry.node in
473
497
let* files =
474
498
match entry.perm with
475
Removed:
| `Dir -> flatten_tree store path hash files
499
Added:
| `Dir -> flatten_tree repository path hash files
476
500
| (`Commit | `Everybody | `Exec | `Link | `Normal) as perm ->
477
501
Lwt_result.return (Path_map.add path { hash; perm } files)
478
502
in
479
503
add_entries files entries
480
504
in
481
505
add_entries files (Store.Value.Tree.to_list tree)
482
Removed:
| _ -> Lwt_result.fail (`Msg ("no tree matches id " ^ tree_hash))
506
Added:
| _ -> Lwt_result.fail (Not_found ("no tree matches id " ^ tree_hash))
483
507
484
Removed:
let read_file store = function
508
Added:
let read_file repository = function
485
509
| None -> Lwt_result.return ""
486
510
| Some { hash; perm = `Commit } ->
487
511
Lwt_result.return ("Subproject commit " ^ hash ^ "\n")
488
512
| Some { hash; _ } -> (
489
513
let* hash = hash_of_hex hash in
490
Removed:
Lwt_result.bind (Store.read store hash) @@ function
514
Added:
Lwt_result.bind (read_value repository hash) @@ function
491
515
| Git.Value.Blob blob ->
492
516
Lwt_result.return (Store.Value.Blob.to_string blob)
493
Removed:
| _ -> Lwt_result.fail (`Msg "file entry does not point to a blob"))
517
Added:
| _ -> Lwt_result.fail (Internal "file entry does not point to a blob"))
494
518
495
Removed:
let of_commit repo (commit : Commit.t) =
496
Removed:
let* store = store repo in
497
Removed:
let* new_files = flatten_tree store "" commit.tree Path_map.empty in
519
Added:
let of_commit repository (commit : Commit.t) =
520
Added:
let* new_files = flatten_tree repository "" commit.tree Path_map.empty in
498
521
let* old_files =
499
522
match commit.parents with
500
523
| [] -> Lwt_result.return Path_map.empty
501
524
| parent :: _ -> (
502
525
let* parent_hash = hash_of_hex parent in
503
Removed:
Lwt_result.bind (Store.read store parent_hash) @@ function
526
Added:
Lwt_result.bind (read_value repository parent_hash) @@ function
504
527
| Git.Value.Commit parent_commit ->
505
Removed:
let tree =
506
Removed:
Store.Value.Commit.tree parent_commit |> Store.Hash.to_hex
507
Removed:
in
508
Removed:
flatten_tree store "" tree Path_map.empty
509
Removed:
| _ -> Lwt_result.fail (`Msg ("parent is not a commit " ^ parent)))
528
Added:
Store.Value.Commit.tree parent_commit |> Store.Hash.to_hex
529
Added:
|> fun tree -> flatten_tree repository "" tree Path_map.empty
530
Added:
| _ -> Lwt_result.fail (Internal ("parent is not a commit " ^ parent))
531
Added:
)
510
532
in
511
533
let changed_files =
512
534
Path_map.merge
@@ -521,11 +543,11 @@
521
543
old_files new_files
522
544
|> Path_map.bindings
523
545
in
524
Removed:
let rec build acc = function
525
Removed:
| [] -> Lwt_result.return (List.rev acc)
526
Removed:
| (path, (old_file, new_file)) :: files ->
527
Removed:
let* old_content = read_file store old_file in
528
Removed:
let* new_content = read_file store new_file in
546
Added:
let rec build files = function
547
Added:
| [] -> Lwt_result.return (List.rev files)
548
Added:
| (path, (old_file, new_file)) :: rest ->
549
Added:
let* old_content = read_file repository old_file in
550
Added:
let* new_content = read_file repository new_file in
529
551
let binary =
530
552
String.contains old_content '\x00'
531
553
|| String.contains new_content '\x00'
@@ -542,35 +564,30 @@
542
564
binary;
543
565
hunks =
544
566
(if binary then []
545
Removed:
else line_diff old_content new_content |> hunks);
567
Added:
else Diff.line_diff old_content new_content |> Diff.hunks);
546
568
}
547
569
in
548
Removed:
build (file :: acc) files
570
Added:
build (file :: files) rest
549
571
in
550
572
build [] changed_files
551
573
end
552
574
553
Removed:
let blob_or_tree repo id =
554
Removed:
let* store = store repo in
575
Added:
let blob_or_tree repository id =
555
576
let* hash = hash_of_hex id in
556
Removed:
Lwt_result.bind (Store.read store hash) @@ function
557
Removed:
| Git.Value.Tree tree -> Lwt_result.return @@ `Tree (Tree.to_t tree)
558
Removed:
| Git.Value.Blob blob -> Lwt_result.return @@ `Blob (Blob.to_t blob)
559
Removed:
| _ -> Lwt_result.fail @@ `Msg ("No tree or blob matches id " ^ id)
577
Added:
Lwt_result.bind (read_value repository hash) @@ function
578
Added:
| Git.Value.Tree tree -> Lwt_result.return (`Tree (Tree.to_t tree))
579
Added:
| Git.Value.Blob blob -> Lwt_result.return (`Blob (Blob.to_t blob))
580
Added:
| _ -> Lwt_result.fail (Not_found ("no tree or blob matches id " ^ id))
560
581
561
582
module Repo = struct
562
Removed:
let has_readme repo =
563
Removed:
let* tree = Tree.head repo in
564
Removed:
Lwt_result.return @@ List.exists Entry.is_readme tree.entries
565
Removed:
566
Removed:
let readme repo =
567
Removed:
let* tree = Tree.head repo in
583
Added:
let readme repository =
584
Added:
let* tree = Tree.head repository in
568
585
match List.find_opt Entry.is_readme tree.entries with
569
586
| None -> Lwt_result.return None
570
587
| Some readme -> (
571
Removed:
let* store = store repo in
572
588
let* hash = hash_of_hex readme.hash in
573
Removed:
Lwt_result.bind (Store.read store hash) @@ function
574
Removed:
| Git.Value.Blob blob -> Lwt_result.return @@ Some (Blob.to_t blob)
575
Removed:
| _ -> Lwt_result.fail @@ `Msg ("couldn't read file " ^ readme.name))
589
Added:
Lwt_result.bind (read_value repository hash) @@ function
590
Added:
| Git.Value.Blob blob -> Lwt_result.return (Some (Blob.to_t blob))
591
Added:
| _ -> Lwt_result.fail (Internal ("could not read file " ^ readme.name))
592
Added:
)
576
593
end
lib/resolvers.mli
@@ -0,0 +1,128 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
(** Git data access layer. *)
4
Added:
5
Added:
module Store = Git_unix.Store
6
Added:
7
Added:
type error =
8
Added:
| Bad_request of string
9
Added:
| Not_found of string
10
Added:
| Store_error of Store.error
11
Added:
| Internal of string
12
Added:
13
Added:
val pp_error : Format.formatter -> error -> unit
14
Added:
15
Added:
(** {1 Validation} *)
16
Added:
17
Added:
val is_valid_hash_hex : string -> bool
18
Added:
val is_valid_repo_name : string -> bool
19
Added:
20
Added:
(** {1 Repository discovery and context} *)
21
Added:
22
Added:
type repository_layout = { worktree : string; git_dir : string }
23
Added:
type repository
24
Added:
25
Added:
val is_repository : string -> bool
26
Added:
val repository_layout : string -> repository_layout option
27
Added:
val repositories : Config.t -> (string list, error) result
28
Added:
val open_repository : Config.t -> string -> (repository, error) Lwt_result.t
29
Added:
val repository_name : repository -> string
30
Added:
val repository_description : repository -> string
31
Added:
val close_repository : repository -> unit Lwt.t
32
Added:
33
Added:
val head_commit_date :
34
Added:
repository -> (int64 * Git.User.tz_offset option) option Lwt.t
35
Added:
36
Added:
(** {1 Repository metadata} *)
37
Added:
38
Added:
val default_repo_description : string
39
Added:
val read_description_file : string -> string
40
Added:
val short_hash : string -> string
41
Added:
val fallback_branch_candidates : Config.t -> string list
42
Added:
43
Added:
(** {1 Commits} *)
44
Added:
45
Added:
module Commit : sig
46
Added:
type user = Git.User.t
47
Added:
48
Added:
type t = {
49
Added:
hash : string;
50
Added:
tree : string;
51
Added:
parents : string list;
52
Added:
author : user;
53
Added:
committer : user;
54
Added:
message : string option;
55
Added:
}
56
Added:
57
Added:
val of_id : repository -> string -> (t, error) Lwt_result.t
58
Added:
val head : repository -> (t, error) Lwt_result.t
59
Added:
val recent_from : repository -> string -> int -> (t list, error) Lwt_result.t
60
Added:
61
Added:
val recent_matching :
62
Added:
repository -> int -> (t -> bool) -> (t list, error) Lwt_result.t
63
Added:
64
Added:
val recent : repository -> int -> (t list, error) Lwt_result.t
65
Added:
end
66
Added:
67
Added:
(** {1 References} *)
68
Added:
69
Added:
module Reference : sig
70
Added:
type t = { name : string; hash : string }
71
Added:
72
Added:
val branch_name : string -> string option
73
Added:
val tag_name : string -> string option
74
Added:
val branches : repository -> (t list, error) Lwt_result.t
75
Added:
val tags : repository -> (t list, error) Lwt_result.t
76
Added:
val of_id : repository -> string -> (t, error) Lwt_result.t
77
Added:
end
78
Added:
79
Added:
(** {1 Entries and Trees} *)
80
Added:
81
Added:
module Entry : sig
82
Added:
type perm = Dir | File | Exec | Link | Submodule
83
Added:
type t = { hash : string; name : string; perm : perm }
84
Added:
85
Added:
val is_readme : t -> bool
86
Added:
end
87
Added:
88
Added:
module Tree : sig
89
Added:
type t = { entries : Entry.t list }
90
Added:
91
Added:
type preloaded_entry = {
92
Added:
entry : Entry.t;
93
Added:
children : preloaded_entry list option;
94
Added:
}
95
Added:
96
Added:
val head : repository -> (t, error) Lwt_result.t
97
Added:
val preload : repository -> t -> (preloaded_entry list, error) Lwt_result.t
98
Added:
99
Added:
val find_path :
100
Added:
repository -> string -> ((string * string) list, error) Lwt_result.t
101
Added:
end
102
Added:
103
Added:
(** {1 Blobs} *)
104
Added:
105
Added:
module Blob : sig
106
Added:
type t = { content : string }
107
Added:
end
108
Added:
109
Added:
(** {1 Diffs} *)
110
Added:
111
Added:
module Diff : sig
112
Added:
include module type of Diff
113
Added:
114
Added:
val of_commit : repository -> Commit.t -> (file list, error) Lwt_result.t
115
Added:
end
116
Added:
117
Added:
(** {1 Composite lookups} *)
118
Added:
119
Added:
val blob_or_tree :
120
Added:
repository ->
121
Added:
string ->
122
Added:
([> `Blob of Blob.t | `Tree of Tree.t ], error) Lwt_result.t
123
Added:
124
Added:
(** {1 Repository helpers} *)
125
Added:
126
Added:
module Repo : sig
127
Added:
val readme : repository -> (Blob.t option, error) Lwt_result.t
128
Added:
end
lib/routes.ml
@@ -4,22 +4,28 @@
4
4
| Root
5
5
| Repo of string
6
6
| Commits of string
7
Added:
| Commits_branch of string * string
7
8
| Commit of string * string
8
9
| Files of string
9
10
| File of string * string
10
11
| Branches of string
11
12
| Tags of string
12
13
| Readme of string
14
Added:
| Raw_file of string * string
13
15
14
16
let%path root_path = "/"
17
Added:
let%path repo_root_path = "/%s/"
15
18
let%path repo_path = "/%s/summary/"
16
19
let%path commits_path = "/%s/commits/"
20
Added:
let%path commits_branch_path = "/%s/commits/%s"
17
21
let%path commit_path = "/%s/commit/%s"
18
22
let%path files_path = "/%s/files/"
19
23
let%path file_path = "/%s/file/%s"
20
24
let%path branches_path = "/%s/branches/"
21
25
let%path tags_path = "/%s/tags/"
22
26
let%path readme_path = "/%s/README"
27
Added:
let%path raw_file_path = "/%s/raw/%s"
28
Added:
let%path static_path = "/static/%*s"
23
29
24
30
let link_to route ?(other_attrs = []) contents =
25
31
let open Dream_html in
@@ -28,11 +34,14 @@
28
34
| Root -> path_attr href root_path
29
35
| Repo repo -> path_attr href repo_path repo
30
36
| Commits repo -> path_attr href commits_path repo
37
Added:
| Commits_branch (repo, branch) ->
38
Added:
path_attr href commits_branch_path repo branch
31
39
| Commit (repo, commit) -> path_attr href commit_path repo commit
32
40
| Files repo -> path_attr href files_path repo
33
41
| File (repo, hash) -> path_attr href file_path repo hash
34
42
| Branches repo -> path_attr href branches_path repo
35
43
| Tags repo -> path_attr href tags_path repo
36
44
| Readme repo -> path_attr href readme_path repo
45
Added:
| Raw_file (repo, hash) -> path_attr href raw_file_path repo hash
37
46
in
38
47
a (path route :: other_attrs) [ contents ]
lib/static/styles.css
@@ -2,34 +2,152 @@
2
2
3
3
body {
4
4
font-family: Inter, sans-serif;
5
Removed:
max-width: 50em;
5
Added:
max-width: 80rem;
6
6
margin: auto;
7
Removed:
padding: 0 1em;
7
Added:
padding: 0;
8
8
background-color: #181818;
9
9
color: white;
10
10
}
11
11
12
Added:
#page-header {
13
Added:
display: flex;
14
Added:
align-items: center;
15
Added:
gap: 1em;
16
Added:
padding: 0.5em 1em;
17
Added:
}
18
Added:
19
Added:
#page-header .site-logo {
20
Added:
width: 2.5em;
21
Added:
height: 2.5em;
22
Added:
}
23
Added:
24
Added:
#page-header h1 {
25
Added:
margin: 0;
26
Added:
padding: 0;
27
Added:
}
28
Added:
29
Added:
#page-header p {
30
Added:
margin: 0;
31
Added:
color: #b0b0b0;
32
Added:
}
33
Added:
34
Added:
#page-header .subtitle {
35
Added:
margin: 0;
36
Added:
color: #b0b0b0;
37
Added:
}
38
Added:
39
Added:
.skip-link {
40
Added:
position: absolute;
41
Added:
top: -100%;
42
Added:
left: 0;
43
Added:
padding: 0.5em 1em;
44
Added:
background: white;
45
Added:
color: black;
46
Added:
z-index: 100;
47
Added:
text-decoration: none;
48
Added:
font-weight: bold;
49
Added:
}
50
Added:
51
Added:
.skip-link:focus {
52
Added:
top: 0;
53
Added:
}
54
Added:
55
Added:
:focus-visible {
56
Added:
outline: 2px solid skyblue;
57
Added:
outline-offset: 2px;
58
Added:
}
59
Added:
60
Added:
.sr-only {
61
Added:
position: absolute;
62
Added:
width: 1px;
63
Added:
height: 1px;
64
Added:
padding: 0;
65
Added:
margin: -1px;
66
Added:
overflow: hidden;
67
Added:
clip: rect(0, 0, 0, 0);
68
Added:
white-space: nowrap;
69
Added:
border: 0;
70
Added:
}
71
Added:
12
72
nav#top {
13
73
background-color: black;
14
74
border-radius: 0.25rem;
75
Added:
position: sticky;
76
Added:
top: 0;
77
Added:
z-index: 10;
78
Added:
display: flex;
79
Added:
align-items: center;
15
80
}
16
81
82
Added:
.nav-toggle {
83
Added:
position: absolute;
84
Added:
opacity: 0;
85
Added:
width: 0;
86
Added:
height: 0;
87
Added:
pointer-events: none;
88
Added:
}
89
Added:
90
Added:
.nav-hamburger {
91
Added:
display: none;
92
Added:
}
93
Added:
94
Added:
.nav-home {
95
Added:
display: flex;
96
Added:
align-items: center;
97
Added:
color: white;
98
Added:
text-decoration: none;
99
Added:
padding: 0.5em 1em;
100
Added:
min-height: 44px;
101
Added:
border-radius: 0.25rem;
102
Added:
font-family: monospace;
103
Added:
box-sizing: border-box;
104
Added:
}
105
Added:
106
Added:
.nav-home:hover {
107
Added:
background-color: white;
108
Added:
color: black;
109
Added:
}
110
Added:
111
Added:
.nav-logo {
112
Added:
display: flex;
113
Added:
align-items: center;
114
Added:
padding: 0.5em;
115
Added:
min-height: 44px;
116
Added:
border-radius: 0.25rem;
117
Added:
box-sizing: border-box;
118
Added:
}
119
Added:
120
Added:
.nav-logo:hover {
121
Added:
background-color: #333;
122
Added:
}
123
Added:
124
Added:
.nav-logo .site-logo {
125
Added:
width: 2em;
126
Added:
height: 2em;
127
Added:
}
128
Added:
17
129
nav#top ul {
18
130
display: flex;
19
131
flex-wrap: wrap;
20
132
list-style-type: none;
21
133
padding: 0;
134
Added:
margin: 0;
135
Added:
margin-left: auto;
22
136
}
23
137
24
138
nav#top ul li {
25
Removed:
padding: 0.5em 0;
26
139
border-radius: 0.25rem;
27
140
}
28
141
29
142
nav#top ul li a {
143
Added:
display: flex;
144
Added:
align-items: center;
30
145
color: white;
31
146
text-decoration: none;
32
147
padding: 0.5em 1em;
148
Added:
min-height: 44px;
149
Added:
border-radius: 0.25rem;
150
Added:
box-sizing: border-box;
33
151
}
34
152
35
153
nav#top ul li a:hover {
@@ -37,17 +155,21 @@
37
155
color: black;
38
156
}
39
157
40
Removed:
nav#top ul li#active {
158
Added:
nav#top ul li[aria-current="page"] {
41
159
border-radius: 0.25rem;
42
160
background-color: rgb(194, 79, 30);
43
161
}
44
162
45
Removed:
nav#top ul li#active a:hover {
163
Added:
nav#top ul li[aria-current="page"] a:hover {
46
164
border-radius: 0.25rem;
47
165
background-color: rgb(132, 40, 0);
48
166
color: white;
49
167
}
50
168
169
Added:
div#main {
170
Added:
padding: 0 1em;
171
Added:
}
172
Added:
51
173
div#main ul {
52
174
padding-left: 0;
53
175
list-style: none;
@@ -57,56 +179,380 @@
57
179
border: 1px solid #303030;
58
180
}
59
181
60
Removed:
div#main ul li a {
61
Removed:
display: block;
182
Added:
div#main .tree-nested li {
183
Added:
border: none;
184
Added:
border-top: 1px solid #252525;
185
Added:
}
186
Added:
187
Added:
div#main .tree-nested li:first-child {
188
Added:
border-top: none;
189
Added:
}
190
Added:
191
Added:
/* File/branch/tag list items (still use li > a wrapping pattern) */
192
Added:
193
Added:
div#main ul li > a {
194
Added:
display: flex;
195
Added:
align-items: center;
196
Added:
justify-content: space-between;
197
Added:
gap: 1em;
62
198
color: white;
63
199
text-decoration: none;
64
Removed:
padding: 0.5em;
200
Added:
padding: 0.75em;
201
Added:
min-height: 44px;
202
Added:
box-sizing: border-box;
65
203
}
66
204
67
Removed:
div#main a:hover {
205
Added:
div#main ul li > a:hover {
68
206
background-color: white;
69
207
color: black;
70
208
text-decoration: revert;
71
209
}
72
210
73
Removed:
h1 {
74
Removed:
/* position: sticky; */
75
Removed:
/* top: 0; */
76
Removed:
/* background: inherit; */
211
Added:
/* Commit list items — anchors live inside pill and title spans */
212
Added:
213
Added:
div#main ul li:has(.commit-left) {
214
Added:
display: flex;
215
Added:
align-items: center;
216
Added:
justify-content: space-between;
217
Added:
line-height: 1.5rem;
218
Added:
padding: 0.5em 0.75em;
219
Added:
min-height: 44px;
220
Added:
box-sizing: border-box;
221
Added:
gap: 1em;
222
Added:
}
223
Added:
224
Added:
.commit-left {
225
Added:
display: flex;
226
Added:
align-items: center;
227
Added:
gap: 0.5em;
228
Added:
flex: 1;
229
Added:
min-width: 0;
230
Added:
overflow: hidden;
231
Added:
}
232
Added:
233
Added:
.commit-left a {
234
Added:
color: white;
235
Added:
text-decoration: none;
236
Added:
border-radius: 0.25rem;
237
Added:
line-height: 1.5rem;
238
Added:
}
239
Added:
240
Added:
.commit-left a:hover {
241
Added:
background-color: white;
242
Added:
color: black;
243
Added:
text-decoration: underline;
244
Added:
}
245
Added:
246
Added:
.commit-ago {
247
Added:
flex-shrink: 0;
248
Added:
font-size: 0.85em;
249
Added:
color: #b0b0b0;
250
Added:
white-space: nowrap;
251
Added:
}
252
Added:
253
Added:
.commit-author {
254
Added:
flex-shrink: 0;
255
Added:
font-family: monospace;
256
Added:
font-size: 0.85em;
257
Added:
color: #b0b0b0;
258
Added:
white-space: nowrap;
259
Added:
}
260
Added:
261
Added:
.commit-identity {
262
Added:
color: skyblue;
263
Added:
text-decoration: underline;
264
Added:
text-underline-offset: 0.15em;
265
Added:
border-radius: 0.2rem;
266
Added:
}
267
Added:
268
Added:
.commit-identity:visited {
269
Added:
color: skyblue;
270
Added:
}
271
Added:
272
Added:
.commit-identity:hover {
273
Added:
color: black;
274
Added:
background-color: white;
275
Added:
}
276
Added:
277
Added:
.commit-meta .commit-identity,
278
Added:
.commit-meta time {
279
Added:
font-family: monospace;
280
Added:
}
281
Added:
282
Added:
.commit-pill {
283
Added:
display: inline-flex;
284
Added:
align-items: center;
285
Added:
flex-shrink: 0;
286
Added:
padding: 0.4em 0.9em;
287
Added:
border-radius: 9999px;
288
Added:
font-size: 0.8em;
289
Added:
font-weight: 600;
290
Added:
text-transform: uppercase;
291
Added:
vertical-align: middle;
292
Added:
}
293
Added:
294
Added:
.commit-pill a {
295
Added:
color: inherit;
296
Added:
padding: 0.1em 0;
297
Added:
}
298
Added:
299
Added:
.commit-pill a:hover {
300
Added:
background-color: transparent;
301
Added:
color: inherit;
302
Added:
text-decoration: underline;
303
Added:
}
304
Added:
305
Added:
.commit-title {
306
Added:
flex: 1;
307
Added:
min-width: 0;
308
Added:
overflow: hidden;
309
Added:
text-overflow: ellipsis;
310
Added:
white-space: nowrap;
311
Added:
}
312
Added:
313
Added:
.commit-title a {
314
Added:
display: inline;
315
Added:
}
316
Added:
317
Added:
/* Pill color variants — WCAG AA contrast against their backgrounds */
318
Added:
319
Added:
.commit-pill-feat {
320
Added:
background-color: #1a4d2e;
321
Added:
color: #86efac;
322
Added:
}
323
Added:
324
Added:
.commit-pill-fix {
325
Added:
background-color: #4d1a1a;
326
Added:
color: #fca5a5;
327
Added:
}
328
Added:
329
Added:
.commit-pill-docs {
330
Added:
background-color: #1a3a4d;
331
Added:
color: #93dbfd;
332
Added:
}
333
Added:
334
Added:
.commit-pill-style {
335
Added:
background-color: #3d1a4d;
336
Added:
color: #e0c4ff;
337
Added:
}
338
Added:
339
Added:
.commit-pill-refactor {
340
Added:
background-color: #4d3a1a;
341
Added:
color: #fcd34d;
342
Added:
}
343
Added:
344
Added:
.commit-pill-perf {
345
Added:
background-color: #4d2d1a;
346
Added:
color: #fdba74;
347
Added:
}
348
Added:
349
Added:
.commit-pill-test {
350
Added:
background-color: #1a2e4d;
351
Added:
color: #a5d0fe;
352
Added:
}
353
Added:
354
Added:
.commit-pill-build {
355
Added:
background-color: #2d2d2d;
356
Added:
color: #c0c0c0;
357
Added:
}
358
Added:
359
Added:
.commit-pill-ci {
360
Added:
background-color: #2d2d2d;
361
Added:
color: #c0c0c0;
362
Added:
}
363
Added:
364
Added:
.commit-pill-chore {
365
Added:
background-color: #2d2d2d;
366
Added:
color: #c0c0c0;
367
Added:
}
368
Added:
369
Added:
.commit-pill-revert {
370
Added:
background-color: #4d1a3a;
371
Added:
color: #fbb6d0;
372
Added:
}
373
Added:
374
Added:
/* Toolbar — persistent bar between navbar and content in commits/files views */
375
Added:
376
Added:
.toolbar {
377
Added:
display: flex;
378
Added:
align-items: center;
379
Added:
gap: 0.75em;
380
Added:
min-height: 44px;
381
Added:
box-sizing: border-box;
382
Added:
position: sticky;
383
Added:
top: 44px;
384
Added:
z-index: 9;
385
Added:
background-color: #181818;
77
386
padding: 0.5em 0;
387
Added:
overflow-x: auto;
388
Added:
scrollbar-width: none;
389
Added:
flex-wrap: nowrap;
78
390
}
79
391
392
Added:
.toolbar::-webkit-scrollbar {
393
Added:
display: none;
394
Added:
}
395
Added:
396
Added:
.toolbar-filter {
397
Added:
display: inline-flex;
398
Added:
align-items: center;
399
Added:
gap: 0.35em;
400
Added:
flex-shrink: 0;
401
Added:
}
402
Added:
403
Added:
.toolbar-filter-value {
404
Added:
display: inline-flex;
405
Added:
align-items: center;
406
Added:
padding: 0.4em 0.9em;
407
Added:
border-radius: 9999px;
408
Added:
font-family: monospace;
409
Added:
font-size: 0.8em;
410
Added:
color: white;
411
Added:
background-color: #2d2d2d;
412
Added:
}
413
Added:
414
Added:
.toolbar-dismiss {
415
Added:
position: relative;
416
Added:
display: inline-flex;
417
Added:
align-items: center;
418
Added:
justify-content: center;
419
Added:
width: 1.2em;
420
Added:
height: 1.2em;
421
Added:
padding: 0;
422
Added:
color: #b0b0b0;
423
Added:
background-color: #3a3a3a;
424
Added:
text-decoration: none;
425
Added:
font-size: 0.8em;
426
Added:
line-height: 1;
427
Added:
border-radius: 50%;
428
Added:
box-sizing: border-box;
429
Added:
}
430
Added:
431
Added:
.toolbar-dismiss::before {
432
Added:
content: "";
433
Added:
position: absolute;
434
Added:
inset: -10px;
435
Added:
min-width: 44px;
436
Added:
min-height: 44px;
437
Added:
}
438
Added:
439
Added:
.toolbar-dismiss:hover {
440
Added:
background-color: #555;
441
Added:
color: white;
442
Added:
}
443
Added:
444
Added:
.toolbar-raw-link {
445
Added:
display: inline-flex;
446
Added:
align-items: center;
447
Added:
justify-content: center;
448
Added:
min-width: 44px;
449
Added:
min-height: 44px;
450
Added:
padding: 0.4em 0.75em;
451
Added:
border-radius: 0.25rem;
452
Added:
font-family: monospace;
453
Added:
font-size: 0.85em;
454
Added:
color: white;
455
Added:
background-color: #2a2a2a;
456
Added:
text-decoration: none;
457
Added:
box-sizing: border-box;
458
Added:
}
459
Added:
460
Added:
.toolbar-raw-link:hover {
461
Added:
background-color: white;
462
Added:
color: black;
463
Added:
}
464
Added:
465
Added:
/* Pagination controls */
466
Added:
467
Added:
.pagination {
468
Added:
display: flex;
469
Added:
align-items: center;
470
Added:
justify-content: flex-end;
471
Added:
gap: 0.5em;
472
Added:
padding: 0.5em 0;
473
Added:
}
474
Added:
475
Added:
.pagination-btn {
476
Added:
display: inline-flex;
477
Added:
align-items: center;
478
Added:
justify-content: center;
479
Added:
min-width: 44px;
480
Added:
min-height: 44px;
481
Added:
padding: 0.4em 0.75em;
482
Added:
border-radius: 0.25rem;
483
Added:
font-size: 1.1em;
484
Added:
font-weight: 600;
485
Added:
text-decoration: none;
486
Added:
color: white;
487
Added:
background-color: #2a2a2a;
488
Added:
box-sizing: border-box;
489
Added:
}
490
Added:
491
Added:
.pagination-btn:hover {
492
Added:
background-color: white;
493
Added:
color: black;
494
Added:
}
495
Added:
496
Added:
.pagination-disabled {
497
Added:
color: #555;
498
Added:
background-color: #1e1e1e;
499
Added:
cursor: default;
500
Added:
}
501
Added:
502
Added:
.pagination-disabled:hover {
503
Added:
color: #555;
504
Added:
background-color: #1e1e1e;
505
Added:
}
506
Added:
507
Added:
.pagination-page {
508
Added:
font-size: 0.9em;
509
Added:
color: #ccc;
510
Added:
min-width: 44px;
511
Added:
text-align: center;
512
Added:
}
513
Added:
514
Added:
h1 {
515
Added:
padding: 0;
516
Added:
}
517
Added:
80
518
.timestamp {
81
519
font-family: monospace;
520
Added:
color: #b0b0b0;
521
Added:
font-size: 0.85em;
82
522
}
83
523
84
Removed:
#blob {
524
Added:
#blob,
525
Added:
.blob {
85
526
display: grid;
86
527
column-gap: 1.5em;
87
528
row-gap: 0.2em;
88
529
grid-template-columns: 3em auto;
89
530
font-family: monospace;
531
Added:
overflow-x: auto;
90
532
}
91
533
92
Removed:
#blob a.line-anchor {
93
Removed:
color: grey;
534
Added:
#blob a.line-anchor,
535
Added:
.blob a.line-anchor {
536
Added:
color: #b0b0b0;
94
537
text-decoration: none;
95
538
text-align: right;
96
539
}
97
540
98
Removed:
#blob a.line-anchor:target {
541
Added:
#blob a.line-anchor:target,
542
Added:
.blob a.line-anchor:target {
99
543
color: white;
100
544
background-color: grey;
101
545
}
102
546
103
Removed:
#blob a.line-anchor:hover {
547
Added:
#blob a.line-anchor:hover,
548
Added:
.blob a.line-anchor:hover {
104
549
color: skyblue;
105
550
background-color: inherit;
106
551
text-decoration: none;
107
552
}
108
553
109
Removed:
#blob span.line {
554
Added:
#blob span.line,
555
Added:
.blob span.line {
110
556
white-space: preserve-spaces;
111
557
}
112
558
@@ -117,7 +563,7 @@
117
563
}
118
564
119
565
.commit-meta dt {
120
Removed:
color: #aaa;
566
Added:
color: #b0b0b0;
121
567
}
122
568
123
569
.commit-meta dd {
@@ -125,13 +571,194 @@
125
571
overflow-wrap: anywhere;
126
572
}
127
573
574
Added:
.commit-body {
575
Added:
font-family: monospace;
576
Added:
white-space: pre;
577
Added:
overflow-x: auto;
578
Added:
background: #1e1e1e;
579
Added:
padding: 0.75em 1em;
580
Added:
border-radius: 0.25rem;
581
Added:
border: 1px solid #303030;
582
Added:
}
583
Added:
584
Added:
/* Path pill — breadcrumb trail as a single rounded pill */
585
Added:
586
Added:
.path-pill {
587
Added:
display: inline-flex;
588
Added:
align-items: center;
589
Added:
flex-shrink: 0;
590
Added:
padding: 0.4em 0.9em;
591
Added:
border-radius: 9999px;
592
Added:
font-size: 0.85em;
593
Added:
font-family: monospace;
594
Added:
background-color: #1a3a4d;
595
Added:
color: #93dbfd;
596
Added:
}
597
Added:
598
Added:
.path-pill a {
599
Added:
color: inherit;
600
Added:
text-decoration: none;
601
Added:
}
602
Added:
603
Added:
.path-pill a:hover {
604
Added:
text-decoration: underline;
605
Added:
}
606
Added:
607
Added:
.path-pill-link {
608
Added:
color: inherit;
609
Added:
text-decoration: none;
610
Added:
padding: 0.1em 0.2em;
611
Added:
border-radius: 0.25rem;
612
Added:
}
613
Added:
614
Added:
.path-pill-link:hover {
615
Added:
background-color: rgba(255, 255, 255, 0.15);
616
Added:
text-decoration: underline;
617
Added:
}
618
Added:
619
Added:
.path-pill-sep {
620
Added:
color: #6ab0d4;
621
Added:
margin: 0 0.1em;
622
Added:
}
623
Added:
624
Added:
/* Tree directory expand/collapse */
625
Added:
626
Added:
.tree-dir {
627
Added:
padding: 0;
628
Added:
}
629
Added:
630
Added:
.tree-dir > details {
631
Added:
width: 100%;
632
Added:
}
633
Added:
634
Added:
.tree-toggle {
635
Added:
display: flex;
636
Added:
align-items: center;
637
Added:
cursor: pointer;
638
Added:
list-style: none;
639
Added:
padding: 0.75em;
640
Added:
min-height: 44px;
641
Added:
box-sizing: border-box;
642
Added:
gap: 0;
643
Added:
}
644
Added:
645
Added:
details[open] > .tree-toggle {
646
Added:
position: sticky;
647
Added:
top: 88px;
648
Added:
z-index: 8;
649
Added:
background-color: #181818;
650
Added:
}
651
Added:
652
Added:
.tree-toggle::-webkit-details-marker {
653
Added:
display: none;
654
Added:
}
655
Added:
656
Added:
.tree-toggle::marker {
657
Added:
content: "";
658
Added:
}
659
Added:
660
Added:
.tree-chevron {
661
Added:
display: inline-flex;
662
Added:
align-items: center;
663
Added:
justify-content: center;
664
Added:
width: 1.6em;
665
Added:
height: 1.6em;
666
Added:
font-size: 1.1em;
667
Added:
color: #b0b0b0;
668
Added:
background-color: #2a2a2a;
669
Added:
border-radius: 50%;
670
Added:
flex-shrink: 0;
671
Added:
margin-right: 0.5em;
672
Added:
transition: transform 0.15s ease;
673
Added:
}
674
Added:
675
Added:
details[open] > .tree-toggle > .tree-chevron {
676
Added:
transform: rotate(90deg);
677
Added:
}
678
Added:
679
Added:
.tree-chevron:hover {
680
Added:
background-color: #444;
681
Added:
color: white;
682
Added:
}
683
Added:
684
Added:
.tree-link {
685
Added:
color: white;
686
Added:
text-decoration: none;
687
Added:
padding: 0.2em 0.4em;
688
Added:
border-radius: 0.25rem;
689
Added:
}
690
Added:
691
Added:
.tree-link:hover {
692
Added:
background-color: white;
693
Added:
color: black;
694
Added:
text-decoration: underline;
695
Added:
}
696
Added:
697
Added:
.tree-nested {
698
Added:
padding-left: 2.1em;
699
Added:
list-style: none;
700
Added:
margin: 0;
701
Added:
padding-top: 0;
702
Added:
padding-bottom: 0;
703
Added:
}
704
Added:
705
Added:
.tree-nested li {
706
Added:
padding-left: 0.75em;
707
Added:
}
708
Added:
709
Added:
.tree-hidden {
710
Added:
font-style: italic;
711
Added:
opacity: 0.6;
712
Added:
}
713
Added:
714
Added:
.tree-overflow {
715
Added:
padding: 0.5em 0.75em;
716
Added:
}
717
Added:
718
Added:
.tree-overflow a {
719
Added:
color: #b0b0b0;
720
Added:
text-decoration: none;
721
Added:
font-style: italic;
722
Added:
}
723
Added:
724
Added:
.tree-overflow a:hover {
725
Added:
color: white;
726
Added:
text-decoration: underline;
727
Added:
}
728
Added:
729
Added:
/* Inline README display at bottom of directory listings */
730
Added:
731
Added:
.readme-inline {
732
Added:
margin-top: 1.5em;
733
Added:
border: 1px solid #3a3a3a;
734
Added:
border-radius: 0.25rem;
735
Added:
overflow-x: auto;
736
Added:
}
737
Added:
738
Added:
.readme-inline h3 {
739
Added:
margin: 0;
740
Added:
padding: 0.6em 1em;
741
Added:
background-color: #242424;
742
Added:
font-size: 0.9em;
743
Added:
color: #b0b0b0;
744
Added:
border-bottom: 1px solid #3a3a3a;
745
Added:
}
746
Added:
747
Added:
.readme-inline .blob {
748
Added:
padding: 0.5em 0;
749
Added:
}
750
Added:
128
751
.diff-file {
129
752
margin: 1.5em 0;
130
753
border: 1px solid #3a3a3a;
131
754
border-radius: 0.25rem;
132
Removed:
overflow-x: auto;
755
Added:
overflow: hidden;
133
756
}
134
757
758
Added:
.diff-hunk {
759
Added:
border-top: 1px solid #3a3a3a;
760
Added:
}
761
Added:
135
762
.diff-file-header,
136
763
.diff-meta,
137
764
.hunk-header {
@@ -142,28 +769,60 @@
142
769
143
770
.diff-file-header {
144
771
background: #242424;
772
Added:
cursor: pointer;
773
Added:
list-style: none;
145
774
}
146
775
776
Added:
.diff-file-header::-webkit-details-marker {
777
Added:
display: none;
778
Added:
}
779
Added:
780
Added:
.diff-file-header::marker {
781
Added:
content: "";
782
Added:
}
783
Added:
147
784
.diff-meta {
148
Removed:
color: #aaa;
785
Added:
color: #b0b0b0;
149
786
border-top: 1px solid #3a3a3a;
150
787
}
151
788
152
789
.hunk-header {
153
790
color: #b7c9ff;
154
791
background: #252535;
792
Added:
cursor: pointer;
793
Added:
list-style: none;
155
794
}
156
795
157
Removed:
.diff-line {
796
Added:
.hunk-header::-webkit-details-marker {
797
Added:
display: none;
798
Added:
}
799
Added:
800
Added:
.hunk-header::marker {
801
Added:
content: "";
802
Added:
}
803
Added:
804
Added:
.diff-lines-scroll {
805
Added:
max-width: 100%;
806
Added:
overflow-x: auto;
807
Added:
overscroll-behavior-inline: contain;
808
Added:
}
809
Added:
810
Added:
.diff-lines {
158
811
display: grid;
159
Removed:
grid-template-columns: 4em 4em 1.25em minmax(max-content, 1fr);
160
Removed:
min-height: 1.35em;
812
Added:
width: max-content;
813
Added:
min-width: 100%;
814
Added:
grid-template-columns: max-content max-content max-content minmax(max-content, 1fr);
161
815
font-family: monospace;
816
Added:
grid-auto-rows: minmax(1.35em, auto);
162
817
}
163
818
819
Added:
.diff-line {
820
Added:
display: contents;
821
Added:
}
822
Added:
164
823
.diff-line .line-number {
165
824
padding-right: 0.6em;
166
Removed:
color: #888;
825
Added:
color: #b0b0b0;
167
826
text-align: right;
168
827
user-select: none;
169
828
border-right: 1px solid #3a3a3a;
@@ -179,11 +838,11 @@
179
838
white-space: pre;
180
839
}
181
840
182
Removed:
.diff-line.addition {
841
Added:
.diff-line.addition > * {
183
842
background: #17351f;
184
843
}
185
844
186
Removed:
.diff-line.deletion {
845
Added:
.diff-line.deletion > * {
187
846
background: #3b1d1d;
188
847
}
189
848
@@ -194,21 +853,86 @@
194
853
195
854
footer {
196
855
margin: 1em;
856
Added:
padding: 0 1em;
197
857
text-align: center;
198
858
}
199
859
200
Removed:
@media (max-width: 400px) {
201
Removed:
body {
202
Removed:
padding: 0;
860
Added:
@media (max-width: 600px) {
861
Added:
#page-header {
862
Added:
padding: 0.5em 0.5em;
203
863
}
204
864
205
Removed:
#blob {
206
Removed:
column-gap: 1em;
207
Removed:
row-gap: 0em;
208
Removed:
grid-template-columns: max-content auto;
865
Added:
div#main {
866
Added:
padding: 0 0.5em;
209
867
}
210
868
211
Removed:
.diff-line {
212
Removed:
grid-template-columns: 3em 3em 1em minmax(max-content, 1fr);
869
Added:
.timestamp {
870
Added:
display: none;
871
Added:
}
872
Added:
873
Added:
.commit-author {
874
Added:
display: none;
875
Added:
}
876
Added:
877
Added:
footer {
878
Added:
padding: 0 0.5em;
879
Added:
}
880
Added:
881
Added:
.nav-hamburger {
882
Added:
display: flex;
883
Added:
align-items: center;
884
Added:
justify-content: center;
885
Added:
width: 44px;
886
Added:
height: 44px;
887
Added:
cursor: pointer;
888
Added:
border-radius: 0.25rem;
889
Added:
font-size: 1.5em;
890
Added:
color: white;
891
Added:
}
892
Added:
893
Added:
.nav-hamburger:hover {
894
Added:
background-color: #333;
895
Added:
}
896
Added:
897
Added:
nav#top {
898
Added:
display: flex;
899
Added:
flex-wrap: wrap;
900
Added:
align-items: center;
901
Added:
justify-content: initial;
902
Added:
margin: 0;
903
Added:
border-radius: 0;
904
Added:
}
905
Added:
906
Added:
nav#top .nav-home {
907
Added:
margin-right: auto;
908
Added:
}
909
Added:
910
Added:
nav#top ul {
911
Added:
display: none;
912
Added:
width: 100%;
913
Added:
flex-direction: column;
914
Added:
margin-left: 0;
915
Added:
}
916
Added:
917
Added:
nav#top .nav-toggle:checked ~ ul {
918
Added:
display: flex;
919
Added:
}
920
Added:
921
Added:
nav#top ul li a {
922
Added:
padding: 0.75em 1em;
923
Added:
font-size: 0.9em;
924
Added:
width: 100%;
925
Added:
}
926
Added:
927
Added:
#blob,
928
Added:
.blob {
929
Added:
column-gap: 0.75em;
930
Added:
row-gap: 0;
931
Added:
grid-template-columns: max-content auto;
932
Added:
font-size: 0.85em;
933
Added:
}
934
Added:
935
Added:
.diff-lines {
936
Added:
font-size: 0.85em;
213
937
}
214
938
}
lib/static_handler.ml
@@ -0,0 +1,17 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
let content_type_of_ext = function
4
Added:
| ".css" -> "text/css; charset=utf-8"
5
Added:
| ".svg" -> "image/svg+xml"
6
Added:
| ".html" -> "text/html; charset=utf-8"
7
Added:
| ".js" -> "application/javascript"
8
Added:
| ".png" -> "image/png"
9
Added:
| ".ico" -> "image/x-icon"
10
Added:
| _ -> "application/octet-stream"
11
Added:
12
Added:
let handler _request _captured_length path =
13
Added:
match Static_assets.read path with
14
Added:
| Some content ->
15
Added:
let content_type = Filename.extension path |> content_type_of_ext in
16
Added:
Dream.respond ~headers:[ ("Content-Type", content_type) ] content
17
Added:
| None -> Dream.respond ~status:`Not_Found "Not found"
lib/views.ml
@@ -1,357 +1,24 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
open Dream_html
4
Removed:
open Config
3
Added:
(** View layer — re-exports layout and page modules. *)
5
4
6
Removed:
type page = Summary | Commits | Files | Branches | Tags | Readme
5
Added:
let error_page = Layout.error_page
6
Added:
let root = Root.render
7
7
8
Removed:
type body_data = {
9
Removed:
title : string;
10
Removed:
repo : string option;
11
Removed:
subtitle : string;
12
Removed:
active : page;
13
Removed:
content : node list;
14
Removed:
}
15
Removed:
16
Removed:
let page_to_nav_item repo = function
17
Removed:
| Summary -> (Routes.Repo repo, "Summary", Summary)
18
Removed:
| Commits -> (Routes.Commits repo, "Commits", Commits)
19
Removed:
| Files -> (Routes.Files repo, "Files", Files)
20
Removed:
| Branches -> (Routes.Branches repo, "Branches", Branches)
21
Removed:
| Tags -> (Routes.Tags repo, "Tags", Tags)
22
Removed:
| Readme -> (Routes.Readme repo, "README", Readme)
23
Removed:
24
Removed:
module Components = struct
25
Removed:
let topnav ?(active = Summary) repo =
26
Removed:
let nav_items =
27
Removed:
List.map (page_to_nav_item repo)
28
Removed:
[ Summary; Commits; Files; Branches; Tags; Readme ]
29
Removed:
in
30
Removed:
let li_of_item (route, text, path) =
31
Removed:
let is_active = path = active in
32
Removed:
let attrs = if is_active then [ HTML.id "active" ] else [] in
33
Removed:
HTML.li attrs [ Routes.link_to route (txt "%s" text) ]
34
Removed:
in
35
Removed:
HTML.(nav [ id "top" ] [ ul [] @@ List.map li_of_item nav_items ])
36
Removed:
end
37
Removed:
38
Removed:
module Page = struct
39
Removed:
let page_header header1 header2 =
40
Removed:
let header2 =
41
Removed:
if String.starts_with ~prefix:"Unnamed repository" header2 then ""
42
Removed:
else header2
43
Removed:
in
44
Removed:
HTML.(null [ h1 [] [ txt "%s" header1 ]; h2 [] [ txt "%s" header2 ] ])
45
Removed:
46
Removed:
let page_footer () =
47
Removed:
let now = Unix.(time () |> localtime) in
48
Removed:
let year = string_of_int (now.tm_year + 1900) in
49
Removed:
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
50
Removed:
HTML.footer [] [ txt "%s" footer_text ]
51
Removed:
52
Removed:
let head page_title =
53
Removed:
let open HTML in
54
Removed:
head []
55
Removed:
[
56
Removed:
title [] "%s" page_title;
57
Removed:
meta [ name "viewport"; content "width=device-width, initial-scale=1" ];
58
Removed:
link [ rel "stylesheet"; href "/static/styles.css" ];
59
Removed:
link [ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
60
Removed:
]
61
Removed:
62
Removed:
let body bd =
63
Removed:
let open HTML in
64
Removed:
body []
65
Removed:
[
66
Removed:
page_header bd.title bd.subtitle;
67
Removed:
(match bd.repo with
68
Removed:
| None -> HTML.null []
69
Removed:
| Some repo -> Components.topnav ~active:bd.active repo);
70
Removed:
div [ id "main" ] bd.content;
71
Removed:
page_footer ();
72
Removed:
]
73
Removed:
74
Removed:
let render ?(page_title = "Ogit") body_data =
75
Removed:
HTML.html [] [ head page_title; body body_data ]
76
Removed:
end
77
Removed:
78
Removed:
let error_page message =
79
Removed:
let open HTML in
80
Removed:
respond
81
Removed:
@@ html []
82
Removed:
[
83
Removed:
Page.head "Fatal Error";
84
Removed:
body []
85
Removed:
[
86
Removed:
h1 [] [ txt "Fatal Error" ];
87
Removed:
div
88
Removed:
[ id "main" ]
89
Removed:
[
90
Removed:
p [] [ b [] [ txt "%s" message ] ];
91
Removed:
p []
92
Removed:
[
93
Removed:
txt
94
Removed:
"Your best course of action is to press the 'back' \
95
Removed:
button in your browser.";
96
Removed:
];
97
Removed:
];
98
Removed:
];
99
Removed:
]
100
Removed:
101
Removed:
let root () =
102
Removed:
try
103
Removed:
let all_repositories =
104
Removed:
(* Ignore hidden directories. *)
105
Removed:
let repos =
106
Removed:
Sys.readdir config.git_project_root
107
Removed:
|> Array.to_list
108
Removed:
|> List.filter (fun name ->
109
Removed:
(not (name.[0] = '.'))
110
Removed:
&& Resolvers.is_repository
111
Removed:
(Filename.concat config.git_project_root name))
112
Removed:
|> List.sort String.compare
113
Removed:
in
114
Removed:
let li_of_repo repo =
115
Removed:
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
116
Removed:
in
117
Removed:
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
118
Removed:
in
119
Removed:
respond
120
Removed:
@@ Page.render
121
Removed:
{
122
Removed:
title = "Ogit";
123
Removed:
repo = None;
124
Removed:
subtitle = "Repositories for " ^ config.user;
125
Removed:
active = Summary;
126
Removed:
content = [ all_repositories ];
127
Removed:
}
128
Removed:
with Sys_error message -> error_page message
129
Removed:
130
8
module Repo = struct
131
Removed:
let page_title repo =
132
Removed:
Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
9
Added:
type commit_message = Repo.commit_message = {
10
Added:
summary : string;
11
Added:
body : string;
12
Added:
}
133
13
134
Removed:
let li_of_author (author : Resolvers.Commit.user) =
135
Removed:
HTML.(li [] [ txt "%s" author.name ])
136
Removed:
137
Removed:
let li_of_branch repo (branch : Resolvers.Reference.t) =
138
Removed:
HTML.(li [] [ Routes.link_to (Branches repo) (txt "%s" branch.name) ])
139
Removed:
140
Removed:
let li_of_tag repo (tag : Resolvers.Reference.t) =
141
Removed:
HTML.(li [] [ Routes.link_to (Tags repo) (txt "%s" tag.name) ])
142
Removed:
143
Removed:
let li_of_commit repo (commit : Resolvers.Commit.t) =
144
Removed:
let timestamp (date, _) =
145
Removed:
let tm = date |> Int64.to_float |> Unix.localtime in
146
Removed:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.tm_year + 1900)
147
Removed:
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min
148
Removed:
in
149
Removed:
let timestamp_span =
150
Removed:
(* HTML.(span [ class_ "commit-hash" ] [ txt "%s" commit.datetime ]) *)
151
Removed:
HTML.(
152
Removed:
span [ class_ "timestamp" ] [ txt "%s" (timestamp commit.author.date) ])
153
Removed:
in
154
Removed:
let description =
155
Removed:
match commit.message with
156
Removed:
| None -> HTML.null []
157
Removed:
| Some msg -> txt " %s" msg
158
Removed:
in
159
Removed:
let route = Routes.Commit (repo, commit.hash) in
160
Removed:
let node = HTML.null [ timestamp_span; description ] in
161
Removed:
HTML.li [] [ Routes.link_to route node ]
162
Removed:
163
Removed:
let li_of_entry repo (entry : Resolvers.Entry.t) =
164
Removed:
let route = Routes.File (repo, entry.hash) in
165
Removed:
let text =
166
Removed:
txt "%s" (if entry.perm = 0o040000 then entry.name ^ "/" else entry.name)
167
Removed:
in
168
Removed:
HTML.(li [] [ Routes.link_to route text ])
169
Removed:
170
Removed:
let summary repo branches commits =
171
Removed:
respond
172
Removed:
@@ Page.render ~page_title:(page_title repo)
173
Removed:
{
174
Removed:
repo = Some repo;
175
Removed:
title = repo;
176
Removed:
subtitle = Resolvers.repo_description repo;
177
Removed:
active = Summary;
178
Removed:
content =
179
Removed:
HTML.
180
Removed:
[
181
Removed:
h3 [] [ txt "Branches" ];
182
Removed:
ul [] (List.map (li_of_branch repo) branches);
183
Removed:
h3 [] [ txt "Latest commits" ];
184
Removed:
ul [] (List.map (li_of_commit repo) commits);
185
Removed:
(* h3 [] [ txt "Authors" ]; *)
186
Removed:
(* ul [] (List.map li_of_author authors); *)
187
Removed:
];
188
Removed:
}
189
Removed:
190
Removed:
let commits repo commits =
191
Removed:
respond
192
Removed:
@@ Page.render ~page_title:(page_title repo)
193
Removed:
{
194
Removed:
repo = Some repo;
195
Removed:
title = repo;
196
Removed:
subtitle = Resolvers.repo_description repo;
197
Removed:
active = Commits;
198
Removed:
content = HTML.[ ul [] @@ List.map (li_of_commit repo) commits ];
199
Removed:
}
200
Removed:
201
Removed:
let files repo (tree : Resolvers.Tree.t) =
202
Removed:
respond
203
Removed:
@@ Page.render ~page_title:(page_title repo)
204
Removed:
{
205
Removed:
repo = Some repo;
206
Removed:
title = repo;
207
Removed:
subtitle = Resolvers.repo_description repo;
208
Removed:
active = Files;
209
Removed:
content = HTML.[ ul [] @@ List.map (li_of_entry repo) tree.entries ];
210
Removed:
}
211
Removed:
212
Removed:
let file repo (blob : Resolvers.Blob.t) =
213
Removed:
let to_numbered_line number line =
214
Removed:
let n = number + 1 in
215
Removed:
HTML.
216
Removed:
[
217
Removed:
a [ id "%d" n; class_ "line-anchor"; href "#%d" n ] [ txt "%d" n ];
218
Removed:
span [ class_ "line" ] [ txt "\t%s\n" line ];
219
Removed:
]
220
Removed:
in
221
Removed:
let formatted_blob =
222
Removed:
String.split_on_char '\n' blob.content
223
Removed:
|> List.mapi to_numbered_line |> List.flatten
224
Removed:
in
225
Removed:
respond
226
Removed:
@@ Page.render ~page_title:(page_title repo)
227
Removed:
{
228
Removed:
repo = Some repo;
229
Removed:
title = repo;
230
Removed:
subtitle = Resolvers.repo_description repo;
231
Removed:
active = Files;
232
Removed:
content = HTML.[ div [ id "blob" ] formatted_blob ];
233
Removed:
}
234
Removed:
235
Removed:
let commit repo (commit : Resolvers.Commit.t) diff =
236
Removed:
let message = match commit.message with Some msg -> msg | None -> "" in
237
Removed:
let number = function Some number -> string_of_int number | None -> "" in
238
Removed:
let line (line : Resolvers.Diff.line) =
239
Removed:
let class_name, marker =
240
Removed:
match line.kind with
241
Removed:
| Resolvers.Diff.Context -> ("context", " ")
242
Removed:
| Resolvers.Diff.Addition -> ("addition", "+")
243
Removed:
| Resolvers.Diff.Deletion -> ("deletion", "-")
244
Removed:
in
245
Removed:
HTML.(
246
Removed:
div
247
Removed:
[ class_ "diff-line %s" class_name ]
248
Removed:
[
249
Removed:
span [ class_ "line-number" ] [ txt "%s" (number line.old_number) ];
250
Removed:
span [ class_ "line-number" ] [ txt "%s" (number line.new_number) ];
251
Removed:
span [ class_ "diff-marker" ] [ txt "%s" marker ];
252
Removed:
span [ class_ "diff-text" ] [ txt "%s" line.text ];
253
Removed:
])
254
Removed:
in
255
Removed:
let hunk (hunk : Resolvers.Diff.hunk) =
256
Removed:
HTML.
257
Removed:
[
258
Removed:
div
259
Removed:
[ class_ "hunk-header" ]
260
Removed:
[
261
Removed:
txt "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
262
Removed:
hunk.new_start hunk.new_count;
263
Removed:
];
264
Removed:
null (List.map line hunk.lines);
265
Removed:
]
266
Removed:
in
267
Removed:
let mode = function
268
Removed:
| None -> "000000"
269
Removed:
| Some mode -> Printf.sprintf "%06o" mode
270
Removed:
in
271
Removed:
let hash = function
272
Removed:
| None -> "00000000"
273
Removed:
| Some hash -> Resolvers.short_hash hash
274
Removed:
in
275
Removed:
let file (file : Resolvers.Diff.file) =
276
Removed:
let file_body =
277
Removed:
if file.binary then
278
Removed:
HTML.[ p [ class_ "binary-diff" ] [ txt "Binary files differ" ] ]
279
Removed:
else List.concat_map hunk file.hunks
280
Removed:
in
281
Removed:
HTML.(
282
Removed:
section
283
Removed:
[ class_ "diff-file" ]
284
Removed:
([
285
Removed:
h4 [ class_ "diff-file-header" ] [ txt "%s" file.path ];
286
Removed:
div
287
Removed:
[ class_ "diff-meta" ]
288
Removed:
[
289
Removed:
txt "index %s..%s %s..%s" (hash file.old_hash)
290
Removed:
(hash file.new_hash) (mode file.old_mode)
291
Removed:
(mode file.new_mode);
292
Removed:
];
293
Removed:
]
294
Removed:
@ file_body))
295
Removed:
in
296
Removed:
let diff_content =
297
Removed:
match diff with
298
Removed:
| [] -> HTML.[ p [] [ txt "No file changes in this commit." ] ]
299
Removed:
| files -> List.map file files
300
Removed:
in
301
Removed:
respond
302
Removed:
@@ Page.render ~page_title:(page_title repo)
303
Removed:
{
304
Removed:
repo = Some repo;
305
Removed:
title =
306
Removed:
Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash;
307
Removed:
subtitle = Resolvers.repo_description repo;
308
Removed:
active = Summary;
309
Removed:
content =
310
Removed:
HTML.(
311
Removed:
[
312
Removed:
h3 [] [ txt "%s" message ];
313
Removed:
dl
314
Removed:
[ class_ "commit-meta" ]
315
Removed:
[
316
Removed:
dt [] [ txt "Commit" ];
317
Removed:
dd [] [ txt "%s" commit.hash ];
318
Removed:
dt [] [ txt "Author" ];
319
Removed:
dd []
320
Removed:
[ txt "%s <%s>" commit.author.name commit.author.email ];
321
Removed:
];
322
Removed:
]
323
Removed:
@ diff_content);
324
Removed:
}
325
Removed:
326
Removed:
let branches repo branches =
327
Removed:
let content =
328
Removed:
match branches with
329
Removed:
| [] -> HTML.[ p [] [ txt "No branches for repo %s" repo ] ]
330
Removed:
| branches -> HTML.[ ul [] @@ List.map (li_of_branch repo) branches ]
331
Removed:
in
332
Removed:
respond
333
Removed:
@@ Page.render ~page_title:(page_title repo)
334
Removed:
{
335
Removed:
repo = Some repo;
336
Removed:
title = repo;
337
Removed:
subtitle = Resolvers.repo_description repo;
338
Removed:
active = Branches;
339
Removed:
content;
340
Removed:
}
341
Removed:
342
Removed:
let tags repo tags =
343
Removed:
let content =
344
Removed:
match tags with
345
Removed:
| [] -> HTML.[ p [] [ txt "No tags for repo %s" repo ] ]
346
Removed:
| tags -> HTML.[ ul [] @@ List.map (li_of_tag repo) tags ]
347
Removed:
in
348
Removed:
respond
349
Removed:
@@ Page.render ~page_title:(page_title repo)
350
Removed:
{
351
Removed:
repo = Some repo;
352
Removed:
title = repo;
353
Removed:
subtitle = Resolvers.repo_description repo;
354
Removed:
active = Tags;
355
Removed:
content;
356
Removed:
}
14
Added:
let context = Repo.context
15
Added:
let parse_commit_message = Repo.parse_commit_message
16
Added:
let parse_conventional = Repo.parse_conventional
17
Added:
let summary = Repo.summary
18
Added:
let commits = Repo.commits
19
Added:
let files = Repo.files
20
Added:
let file = Repo.file
21
Added:
let commit = Repo.commit
22
Added:
let branches = Repo.branches
23
Added:
let tags = Repo.tags
357
24
end
lib/views/layout.ml
@@ -0,0 +1,167 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
5
Added:
type page = Summary | Commits | Files | Branches | Tags | Readme
6
Added:
7
Added:
type body_data = {
8
Added:
title : string;
9
Added:
repo : string option;
10
Added:
subtitle : string;
11
Added:
active : page;
12
Added:
content : node list;
13
Added:
}
14
Added:
15
Added:
let page_to_nav_item repo = function
16
Added:
| Summary -> (Routes.Repo repo, "Summary", Summary)
17
Added:
| Commits -> (Routes.Commits repo, "Commits", Commits)
18
Added:
| Files -> (Routes.Files repo, "Files", Files)
19
Added:
| Branches -> (Routes.Branches repo, "Branches", Branches)
20
Added:
| Tags -> (Routes.Tags repo, "Tags", Tags)
21
Added:
| Readme -> (Routes.Readme repo, "README", Readme)
22
Added:
23
Added:
let rootnav ~title:nav_title =
24
Added:
HTML.(
25
Added:
nav
26
Added:
[ id "top"; Aria.label "Site navigation" ]
27
Added:
[
28
Added:
a
29
Added:
[ href "https://git-scm.com"; class_ "nav-logo" ]
30
Added:
[ img [ src "/static/git_icon.svg"; alt "Git"; class_ "site-logo" ] ];
31
Added:
span [ class_ "nav-home" ] [ txt "%s" nav_title ];
32
Added:
])
33
Added:
34
Added:
let topnav ?(active = Summary) repo =
35
Added:
let nav_items =
36
Added:
List.map (page_to_nav_item repo)
37
Added:
[ Summary; Commits; Files; Branches; Tags; Readme ]
38
Added:
in
39
Added:
let li_of_item (route, text, page) =
40
Added:
let attrs = if page = active then [ Aria.current `page ] else [] in
41
Added:
HTML.li attrs [ Routes.link_to route (txt "%s" text) ]
42
Added:
in
43
Added:
HTML.(
44
Added:
nav
45
Added:
[ id "top"; Aria.label "Repository navigation" ]
46
Added:
[
47
Added:
Routes.link_to Root
48
Added:
~other_attrs:[ class_ "nav-logo" ]
49
Added:
(img [ src "/static/git_icon.svg"; alt "Home"; class_ "site-logo" ]);
50
Added:
Routes.link_to (Repo repo)
51
Added:
~other_attrs:[ class_ "nav-home" ]
52
Added:
(txt "%s" repo);
53
Added:
input [ type_ "checkbox"; id "nav-toggle"; class_ "nav-toggle" ];
54
Added:
label
55
Added:
[ for_ "nav-toggle"; class_ "nav-hamburger"; Aria.label "Menu" ]
56
Added:
[ txt "\xe2\x8b\xae" ];
57
Added:
ul [] (List.map li_of_item nav_items);
58
Added:
])
59
Added:
60
Added:
let page_header ~has_repo page_title subtitle =
61
Added:
let subtitle =
62
Added:
if String.starts_with ~prefix:"Unnamed repository" subtitle then ""
63
Added:
else subtitle
64
Added:
in
65
Added:
if has_repo then
66
Added:
if subtitle = "" then HTML.null []
67
Added:
else HTML.(header [ id "page-header" ] [ p [] [ txt "%s" subtitle ] ])
68
Added:
else
69
Added:
HTML.(
70
Added:
header
71
Added:
[ id "page-header" ]
72
Added:
([
73
Added:
img
74
Added:
[
75
Added:
src "/static/git_icon.svg";
76
Added:
alt "";
77
Added:
role `presentation;
78
Added:
class_ "site-logo";
79
Added:
];
80
Added:
h1 [] [ txt "%s" page_title ];
81
Added:
]
82
Added:
@
83
Added:
if subtitle = "" then []
84
Added:
else [ p [ class_ "subtitle" ] [ txt "%s" subtitle ] ]))
85
Added:
86
Added:
let page_footer user =
87
Added:
let now = Unix.(time () |> localtime) in
88
Added:
let year = string_of_int (now.tm_year + 1900) in
89
Added:
HTML.footer [] [ txt "Copyright %s %s" year user ]
90
Added:
91
Added:
let head page_title =
92
Added:
let open HTML in
93
Added:
head []
94
Added:
[
95
Added:
title [] "%s" page_title;
96
Added:
meta [ name "viewport"; content "width=device-width, initial-scale=1" ];
97
Added:
link [ rel "stylesheet"; href "/static/styles.css" ];
98
Added:
link
99
Added:
[
100
Added:
rel "stylesheet";
101
Added:
href
102
Added:
"https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.11.1/styles/github-dark.min.css";
103
Added:
];
104
Added:
link [ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
105
Added:
script
106
Added:
[
107
Added:
src
108
Added:
"https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.11.1/highlight.min.js";
109
Added:
defer;
110
Added:
]
111
Added:
"";
112
Added:
]
113
Added:
114
Added:
let body ~user ~root_title page_data =
115
Added:
let open HTML in
116
Added:
body []
117
Added:
[
118
Added:
a [ href "#main"; class_ "skip-link" ] [ txt "Skip to content" ];
119
Added:
(match page_data.repo with
120
Added:
| None -> rootnav ~title:root_title
121
Added:
| Some repo -> topnav ~active:page_data.active repo);
122
Added:
(match page_data.repo with
123
Added:
| None -> HTML.null []
124
Added:
| Some _ -> page_header ~has_repo:true page_data.title page_data.subtitle);
125
Added:
div [ id "main" ] page_data.content;
126
Added:
page_footer user;
127
Added:
script []
128
Added:
{|document.addEventListener("DOMContentLoaded",function(){var b=document.getElementById("blob");if(!b||typeof hljs==="undefined")return;var cls=b.className.match(/language-([\w-]+)/);if(!cls)return;var lang=cls[1];b.querySelectorAll("span.line").forEach(function(el){var r=hljs.highlight(el.textContent,{language:lang,ignoreIllegals:true});el.innerHTML=r.value})});|};
129
Added:
]
130
Added:
131
Added:
let render ?(page_title = "Ogit") ~user ~root_title body_data =
132
Added:
HTML.html
133
Added:
[ HTML.lang "en" ]
134
Added:
[ head page_title; body ~user ~root_title body_data ]
135
Added:
136
Added:
let error_page ?(title = "Request failed") ?(status = `Internal_Server_Error)
137
Added:
message =
138
Added:
let page_title = title in
139
Added:
let open HTML in
140
Added:
respond ~status
141
Added:
@@ html []
142
Added:
[
143
Added:
head []
144
Added:
[
145
Added:
HTML.title [] "%s" page_title;
146
Added:
meta
147
Added:
[
148
Added:
name "viewport"; content "width=device-width, initial-scale=1";
149
Added:
];
150
Added:
link [ rel "stylesheet"; href "/static/styles.css" ];
151
Added:
];
152
Added:
body []
153
Added:
[
154
Added:
h1 [] [ txt "%s" page_title ];
155
Added:
div
156
Added:
[ id "main" ]
157
Added:
[
158
Added:
p [] [ b [] [ txt "%s" message ] ];
159
Added:
p []
160
Added:
[
161
Added:
txt
162
Added:
"Your best course of action is to press the 'back' \
163
Added:
button in your browser.";
164
Added:
];
165
Added:
];
166
Added:
];
167
Added:
]
lib/views/repo.ml
@@ -0,0 +1,871 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
5
Added:
type context = {
6
Added:
repo : string;
7
Added:
description : string;
8
Added:
user : string;
9
Added:
root_title : string;
10
Added:
}
11
Added:
12
Added:
type commit_message = { summary : string; body : string }
13
Added:
14
Added:
let context ~user ~root_title ~repo ~description =
15
Added:
{ repo; description; user; root_title }
16
Added:
17
Added:
let language_of_filename name =
18
Added:
match Filename.extension name |> String.lowercase_ascii with
19
Added:
| ".ml" | ".mli" -> Some "ocaml"
20
Added:
| ".c" | ".h" -> Some "c"
21
Added:
| ".cpp" | ".cc" | ".cxx" | ".hpp" -> Some "cpp"
22
Added:
| ".cs" -> Some "csharp"
23
Added:
| ".css" -> Some "css"
24
Added:
| ".diff" | ".patch" -> Some "diff"
25
Added:
| ".el" | ".lisp" | ".cl" -> Some "lisp"
26
Added:
| ".erl" -> Some "erlang"
27
Added:
| ".ex" | ".exs" -> Some "elixir"
28
Added:
| ".go" -> Some "go"
29
Added:
| ".hs" -> Some "haskell"
30
Added:
| ".html" | ".htm" -> Some "xml"
31
Added:
| ".java" -> Some "java"
32
Added:
| ".js" | ".mjs" | ".cjs" -> Some "javascript"
33
Added:
| ".json" -> Some "json"
34
Added:
| ".kt" -> Some "kotlin"
35
Added:
| ".lua" -> Some "lua"
36
Added:
| ".md" -> Some "markdown"
37
Added:
| ".nix" -> Some "nix"
38
Added:
| ".php" -> Some "php"
39
Added:
| ".pl" | ".pm" | ".t" -> Some "perl"
40
Added:
| ".py" -> Some "python"
41
Added:
| ".r" -> Some "r"
42
Added:
| ".rb" -> Some "ruby"
43
Added:
| ".rs" -> Some "rust"
44
Added:
| ".scala" -> Some "scala"
45
Added:
| ".sh" | ".bash" | ".zsh" -> Some "bash"
46
Added:
| ".sql" -> Some "sql"
47
Added:
| ".swift" -> Some "swift"
48
Added:
| ".toml" -> Some "ini"
49
Added:
| ".ts" | ".tsx" -> Some "typescript"
50
Added:
| ".xml" | ".svg" | ".xsl" -> Some "xml"
51
Added:
| ".yaml" | ".yml" -> Some "yaml"
52
Added:
| ".zig" -> Some "zig"
53
Added:
| _ -> None
54
Added:
55
Added:
let language_of_shebang line =
56
Added:
if not (String.starts_with ~prefix:"#!" line) then None
57
Added:
else
58
Added:
(* Extract the last path component, ignoring env and arguments *)
59
Added:
let rest = String.sub line 2 (String.length line - 2) in
60
Added:
let parts = String.split_on_char ' ' (String.trim rest) in
61
Added:
let interpreter =
62
Added:
match parts with
63
Added:
| [] -> ""
64
Added:
| cmd :: args ->
65
Added:
let base = Filename.basename cmd in
66
Added:
if base = "env" then
67
Added:
(* /usr/bin/env python3 — take next non-flag argument *)
68
Added:
List.find_opt (fun s -> s <> "" && s.[0] <> '-') args
69
Added:
|> Option.value ~default:"" |> Filename.basename
70
Added:
else base
71
Added:
in
72
Added:
(* Strip version suffixes: python3.11 -> python, ruby3.2 -> ruby *)
73
Added:
let interpreter =
74
Added:
match String.split_on_char '.' interpreter with
75
Added:
| [] -> ""
76
Added:
| base :: _ ->
77
Added:
(* Also strip trailing digits: python3 -> python *)
78
Added:
let len = String.length base in
79
Added:
let i = ref (len - 1) in
80
Added:
while !i >= 0 && base.[!i] >= '0' && base.[!i] <= '9' do
81
Added:
decr i
82
Added:
done;
83
Added:
if !i < 0 then base else String.sub base 0 (!i + 1)
84
Added:
in
85
Added:
match String.lowercase_ascii interpreter with
86
Added:
| "sh" | "bash" | "dash" | "ash" | "zsh" -> Some "bash"
87
Added:
| "python" -> Some "python"
88
Added:
| "ruby" -> Some "ruby"
89
Added:
| "perl" -> Some "perl"
90
Added:
| "node" | "deno" | "bun" -> Some "javascript"
91
Added:
| "lua" -> Some "lua"
92
Added:
| "php" -> Some "php"
93
Added:
| "elixir" -> Some "elixir"
94
Added:
| "awk" | "gawk" | "mawk" -> Some "awk"
95
Added:
| "ocaml" -> Some "ocaml"
96
Added:
| _ -> None
97
Added:
98
Added:
let language_of_emacs_prop line =
99
Added:
let find_between s prefix suffix =
100
Added:
let plen = String.length prefix in
101
Added:
let slen = String.length suffix in
102
Added:
let total = String.length s in
103
Added:
let rec find_start i =
104
Added:
if i > total - plen then None
105
Added:
else if String.sub s i plen = prefix then
106
Added:
let after = i + plen in
107
Added:
let rec find_end j =
108
Added:
if j > total - slen then None
109
Added:
else if String.sub s j slen = suffix then
110
Added:
Some (String.sub s after (j - after) |> String.trim)
111
Added:
else find_end (j + 1)
112
Added:
in
113
Added:
find_end after
114
Added:
else find_start (i + 1)
115
Added:
in
116
Added:
find_start 0
117
Added:
in
118
Added:
let extract_mode between =
119
Added:
let props = String.split_on_char ';' between in
120
Added:
let mode_prop =
121
Added:
List.find_map
122
Added:
(fun prop ->
123
Added:
match String.split_on_char ':' (String.trim prop) with
124
Added:
| [ key; value ]
125
Added:
when String.trim (String.lowercase_ascii key) = "mode" ->
126
Added:
Some (String.trim value)
127
Added:
| _ -> None)
128
Added:
props
129
Added:
in
130
Added:
match mode_prop with
131
Added:
| Some _ -> mode_prop
132
Added:
| None ->
133
Added:
if
134
Added:
(not (String.contains between ':'))
135
Added:
&& not (String.contains between ';')
136
Added:
then Some (String.trim between)
137
Added:
else None
138
Added:
in
139
Added:
let normalize_mode mode =
140
Added:
match String.lowercase_ascii mode with
141
Added:
| "tuareg" | "caml" | "ocaml" -> Some "ocaml"
142
Added:
| "emacs-lisp" | "lisp" | "elisp" -> Some "lisp"
143
Added:
| "shell-script" | "sh" | "bash" -> Some "bash"
144
Added:
| "python" -> Some "python"
145
Added:
| "ruby" -> Some "ruby"
146
Added:
| "perl" | "cperl" -> Some "perl"
147
Added:
| "c" -> Some "c"
148
Added:
| "c++" -> Some "cpp"
149
Added:
| "javascript" | "js" -> Some "javascript"
150
Added:
| "typescript" -> Some "typescript"
151
Added:
| "rust" -> Some "rust"
152
Added:
| "go" -> Some "go"
153
Added:
| "haskell" -> Some "haskell"
154
Added:
| "lua" -> Some "lua"
155
Added:
| "sql" -> Some "sql"
156
Added:
| "yaml" -> Some "yaml"
157
Added:
| "nix" -> Some "nix"
158
Added:
| "makefile" -> Some "makefile"
159
Added:
| m -> Some m
160
Added:
in
161
Added:
find_between line "-*-" "-*-"
162
Added:
|> Fun.flip Option.bind extract_mode
163
Added:
|> Fun.flip Option.bind normalize_mode
164
Added:
165
Added:
let language_of_vim_modeline line =
166
Added:
let contains_substring s sub =
167
Added:
let slen = String.length s in
168
Added:
let sublen = String.length sub in
169
Added:
let rec check i =
170
Added:
if i > slen - sublen then false
171
Added:
else if String.sub s i sublen = sub then true
172
Added:
else check (i + 1)
173
Added:
in
174
Added:
sublen <= slen && check 0
175
Added:
in
176
Added:
let l = String.lowercase_ascii line in
177
Added:
let has_vim_prefix =
178
Added:
contains_substring l "vim:"
179
Added:
|| contains_substring l "vi:" || contains_substring l "ex:"
180
Added:
in
181
Added:
if not has_vim_prefix then None
182
Added:
else
183
Added:
let find_value prefix s =
184
Added:
let plen = String.length prefix in
185
Added:
let slen = String.length s in
186
Added:
let rec find_at i =
187
Added:
if i > slen - plen then None
188
Added:
else if String.sub s i plen = prefix then
189
Added:
let vstart = i + plen in
190
Added:
let rec scan_end j =
191
Added:
if j >= slen || s.[j] = ' ' || s.[j] = ':' || s.[j] = '\t' then j
192
Added:
else scan_end (j + 1)
193
Added:
in
194
Added:
let vend = scan_end vstart in
195
Added:
Some (String.sub s vstart (vend - vstart))
196
Added:
else find_at (i + 1)
197
Added:
in
198
Added:
find_at 0
199
Added:
in
200
Added:
let ft =
201
Added:
match find_value "ft=" l with
202
Added:
| Some _ as r -> r
203
Added:
| None -> find_value "filetype=" l
204
Added:
in
205
Added:
match ft with
206
Added:
| None -> None
207
Added:
| Some ft -> (
208
Added:
match ft with
209
Added:
| "sh" | "bash" | "zsh" -> Some "bash"
210
Added:
| "python" -> Some "python"
211
Added:
| "ruby" -> Some "ruby"
212
Added:
| "perl" -> Some "perl"
213
Added:
| "javascript" | "js" -> Some "javascript"
214
Added:
| "typescript" -> Some "typescript"
215
Added:
| "ocaml" -> Some "ocaml"
216
Added:
| "c" -> Some "c"
217
Added:
| "cpp" -> Some "cpp"
218
Added:
| "rust" -> Some "rust"
219
Added:
| "go" -> Some "go"
220
Added:
| "haskell" -> Some "haskell"
221
Added:
| "lua" -> Some "lua"
222
Added:
| "make" | "makefile" -> Some "makefile"
223
Added:
| "yaml" -> Some "yaml"
224
Added:
| "sql" -> Some "sql"
225
Added:
| "nix" -> Some "nix"
226
Added:
| other -> Some other)
227
Added:
228
Added:
let language_of_content content =
229
Added:
let lines = String.split_on_char '\n' content in
230
Added:
let len = List.length lines in
231
Added:
let first_lines =
232
Added:
let n = min 5 len in
233
Added:
List.filteri (fun i _ -> i < n) lines
234
Added:
in
235
Added:
let last_lines =
236
Added:
let start = max 0 (len - 5) in
237
Added:
List.filteri (fun i _ -> i >= start) lines
238
Added:
in
239
Added:
let try_lines detector lines = List.find_map detector lines in
240
Added:
match first_lines with
241
Added:
| [] -> None
242
Added:
| first :: _ -> (
243
Added:
match language_of_shebang first with
244
Added:
| Some _ as result -> result
245
Added:
| None -> (
246
Added:
match try_lines language_of_emacs_prop first_lines with
247
Added:
| Some _ as result -> result
248
Added:
| None -> (
249
Added:
match try_lines language_of_vim_modeline first_lines with
250
Added:
| Some _ as result -> result
251
Added:
| None -> try_lines language_of_vim_modeline last_lines)))
252
Added:
253
Added:
let page_title context = context.repo ^ " — " ^ context.description
254
Added:
255
Added:
let render_page ?heading context ~active content =
256
Added:
respond
257
Added:
@@ Layout.render ~user:context.user ~root_title:context.root_title
258
Added:
~page_title:(page_title context)
259
Added:
{
260
Added:
repo = Some context.repo;
261
Added:
title = Option.value heading ~default:context.repo;
262
Added:
subtitle = context.description;
263
Added:
active;
264
Added:
content;
265
Added:
}
266
Added:
267
Added:
let li_of_branch repo (branch : Resolvers.Reference.t) =
268
Added:
HTML.(
269
Added:
li []
270
Added:
[
271
Added:
Routes.link_to
272
Added:
(Commits_branch (repo, branch.name))
273
Added:
(txt "%s" branch.name);
274
Added:
])
275
Added:
276
Added:
let li_of_tag repo (tag : Resolvers.Reference.t) =
277
Added:
HTML.(li [] [ Routes.link_to (Tags repo) (txt "%s" tag.name) ])
278
Added:
279
Added:
let parse_commit_message = function
280
Added:
| None -> { summary = ""; body = "" }
281
Added:
| Some message -> (
282
Added:
match String.split_on_char '\n' message with
283
Added:
| [] -> { summary = ""; body = "" }
284
Added:
| summary :: rest ->
285
Added:
{ summary; body = String.concat "\n" rest |> String.trim })
286
Added:
287
Added:
let conventional_commit_types =
288
Added:
[
289
Added:
"feat";
290
Added:
"fix";
291
Added:
"docs";
292
Added:
"style";
293
Added:
"refactor";
294
Added:
"perf";
295
Added:
"test";
296
Added:
"build";
297
Added:
"ci";
298
Added:
"chore";
299
Added:
"revert";
300
Added:
]
301
Added:
302
Added:
let parse_conventional summary =
303
Added:
match String.index_opt summary ':' with
304
Added:
| None -> (None, summary)
305
Added:
| Some colon_pos ->
306
Added:
let prefix = String.sub summary 0 colon_pos in
307
Added:
let type_name =
308
Added:
match String.index_opt prefix '(' with
309
Added:
| Some paren_pos -> String.sub prefix 0 paren_pos
310
Added:
| None -> prefix
311
Added:
in
312
Added:
let type_lower = String.lowercase_ascii type_name in
313
Added:
if List.mem type_lower conventional_commit_types then
314
Added:
let rest =
315
Added:
String.sub summary (colon_pos + 1)
316
Added:
(String.length summary - colon_pos - 1)
317
Added:
|> String.trim
318
Added:
in
319
Added:
(Some type_lower, rest)
320
Added:
else (None, summary)
321
Added:
322
Added:
let timestamp (date, _) =
323
Added:
let tm = date |> Int64.to_float |> Unix.localtime in
324
Added:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
325
Added:
tm.tm_mday tm.tm_hour tm.tm_min
326
Added:
327
Added:
let detailed_timestamp (date, timezone) =
328
Added:
let offset_seconds, suffix =
329
Added:
match timezone with
330
Added:
| None -> (0, "Z")
331
Added:
| Some (offset : Git.User.tz_offset) ->
332
Added:
let direction = match offset.sign with `Plus -> 1 | `Minus -> -1 in
333
Added:
let seconds = direction * ((offset.hours * 60) + offset.minutes) * 60 in
334
Added:
let sign = match offset.sign with `Plus -> "+" | `Minus -> "-" in
335
Added:
(seconds, Printf.sprintf "%s%02d:%02d" sign offset.hours offset.minutes)
336
Added:
in
337
Added:
let adjusted = Int64.add date (Int64.of_int offset_seconds) in
338
Added:
let tm = adjusted |> Int64.to_float |> Unix.gmtime in
339
Added:
let date =
340
Added:
Printf.sprintf "%04d-%02d-%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
341
Added:
tm.tm_mday
342
Added:
in
343
Added:
let clock = Printf.sprintf "%02d:%02d:%02d" tm.tm_hour tm.tm_min tm.tm_sec in
344
Added:
( Printf.sprintf "%sT%s%s" date clock suffix,
345
Added:
Printf.sprintf "%s %s %s" date clock suffix )
346
Added:
347
Added:
let time_node date =
348
Added:
let machine_time, display_time = detailed_timestamp date in
349
Added:
HTML.(time [ datetime "%s" machine_time ] [ txt "%s" display_time ])
350
Added:
351
Added:
let commits_url ?filter_type ?author ?committer ?(page = 1) repo =
352
Added:
let params =
353
Added:
(if page > 1 then [ ("page", string_of_int page) ] else [])
354
Added:
@ (match filter_type with Some value -> [ ("type", value) ] | None -> [])
355
Added:
@ (match author with Some value -> [ ("author", value) ] | None -> [])
356
Added:
@ match committer with Some value -> [ ("committer", value) ] | None -> []
357
Added:
in
358
Added:
let base = Printf.sprintf "/%s/commits/" repo in
359
Added:
match params with
360
Added:
| [] -> base
361
Added:
| _ -> base ^ "?" ^ Dream.to_form_urlencoded params
362
Added:
363
Added:
let identity_link ?filter_type ?author ?committer ?(show_email = false) ~role
364
Added:
repo (user : Resolvers.Commit.user) =
365
Added:
let url, role_label =
366
Added:
match role with
367
Added:
| `Author ->
368
Added:
(commits_url ?filter_type ~author:user.email ?committer repo, "author")
369
Added:
| `Committer ->
370
Added:
( commits_url ?filter_type ?author ~committer:user.email repo,
371
Added:
"committer" )
372
Added:
in
373
Added:
let link_text =
374
Added:
if show_email then Printf.sprintf "%s <%s>" user.name user.email
375
Added:
else user.name
376
Added:
in
377
Added:
HTML.(
378
Added:
a
379
Added:
[
380
Added:
href "%s" url;
381
Added:
class_ "commit-identity";
382
Added:
Aria.label "Filter commits by %s %s" role_label user.name;
383
Added:
]
384
Added:
[ txt "%s" link_text ])
385
Added:
386
Added:
let li_of_commit ?filter_type ?author ?committer ?(hide_pill = false) repo
387
Added:
(commit : Resolvers.Commit.t) =
388
Added:
let message = parse_commit_message commit.message in
389
Added:
let commit_type, commit_title = parse_conventional message.summary in
390
Added:
let commit_route = Routes.Commit (repo, commit.hash) in
391
Added:
let timestamp_span =
392
Added:
HTML.(
393
Added:
span [ class_ "timestamp" ] [ txt "%s" (timestamp commit.author.date) ])
394
Added:
in
395
Added:
let pill =
396
Added:
match commit_type with
397
Added:
| _ when hide_pill -> HTML.null []
398
Added:
| None -> HTML.null []
399
Added:
| Some ct ->
400
Added:
HTML.(
401
Added:
span
402
Added:
[ class_ "commit-pill commit-pill-%s" ct ]
403
Added:
[
404
Added:
a
405
Added:
[
406
Added:
href "%s"
407
Added:
(commits_url ~filter_type:ct ?author ?committer repo);
408
Added:
]
409
Added:
[ txt "%s" ct ];
410
Added:
])
411
Added:
in
412
Added:
let title_span =
413
Added:
HTML.(
414
Added:
span
415
Added:
[ class_ "commit-title" ]
416
Added:
[ Routes.link_to commit_route (txt "%s" commit_title) ])
417
Added:
in
418
Added:
let ago_span =
419
Added:
HTML.(
420
Added:
span
421
Added:
[ class_ "commit-ago" ]
422
Added:
[ txt "%s" (Time_fmt.relative_time commit.author.date) ])
423
Added:
in
424
Added:
let author_span =
425
Added:
HTML.(
426
Added:
span
427
Added:
[ class_ "commit-author" ]
428
Added:
[
429
Added:
identity_link ?filter_type ?author ?committer ~role:`Author repo
430
Added:
commit.author;
431
Added:
])
432
Added:
in
433
Added:
HTML.(
434
Added:
li []
435
Added:
[
436
Added:
span [ class_ "commit-left" ] [ timestamp_span; pill; title_span ];
437
Added:
ago_span;
438
Added:
author_span;
439
Added:
])
440
Added:
441
Added:
let rec li_of_preloaded repo (pe : Resolvers.Tree.preloaded_entry) =
442
Added:
let entry = pe.entry in
443
Added:
let route = Routes.File (repo, entry.hash) in
444
Added:
let is_hidden = String.length entry.name > 0 && entry.name.[0] = '.' in
445
Added:
let hidden_class = if is_hidden then " tree-hidden" else "" in
446
Added:
match pe.children with
447
Added:
| None ->
448
Added:
(* Regular file *)
449
Added:
HTML.(
450
Added:
li
451
Added:
[ class_ "tree-file%s" hidden_class ]
452
Added:
[ Routes.link_to route (txt "%s" entry.name) ])
453
Added:
| Some [] ->
454
Added:
(* Directory with 10+ items — show teaser *)
455
Added:
HTML.(
456
Added:
li
457
Added:
[ class_ "tree-dir%s" hidden_class ]
458
Added:
[
459
Added:
details []
460
Added:
[
461
Added:
summary
462
Added:
[ class_ "tree-toggle" ]
463
Added:
[
464
Added:
span [ class_ "tree-chevron" ] [ txt "\xe2\x80\xba" ];
465
Added:
Routes.link_to route
466
Added:
~other_attrs:[ class_ "tree-link" ]
467
Added:
(txt "%s/" entry.name);
468
Added:
];
469
Added:
ul
470
Added:
[ class_ "tree-nested" ]
471
Added:
[
472
Added:
li
473
Added:
[ class_ "tree-overflow" ]
474
Added:
[
475
Added:
Routes.link_to route
476
Added:
(txt
477
Added:
"Directory contains more than 10 items\xe2\x80\xa6");
478
Added:
];
479
Added:
];
480
Added:
];
481
Added:
])
482
Added:
| Some children ->
483
Added:
(* Directory with <10 items — fully preloaded *)
484
Added:
HTML.(
485
Added:
li
486
Added:
[ class_ "tree-dir%s" hidden_class ]
487
Added:
[
488
Added:
details []
489
Added:
[
490
Added:
summary
491
Added:
[ class_ "tree-toggle" ]
492
Added:
[
493
Added:
span [ class_ "tree-chevron" ] [ txt "\xe2\x80\xba" ];
494
Added:
Routes.link_to route
495
Added:
~other_attrs:[ class_ "tree-link" ]
496
Added:
(txt "%s/" entry.name);
497
Added:
];
498
Added:
ul
499
Added:
[ class_ "tree-nested" ]
500
Added:
(List.map (li_of_preloaded repo) children);
501
Added:
];
502
Added:
])
503
Added:
504
Added:
let summary context branches commits =
505
Added:
render_page context ~active:Summary
506
Added:
HTML.
507
Added:
[
508
Added:
h3 [] [ txt "Branches" ];
509
Added:
ul [] (List.map (li_of_branch context.repo) branches);
510
Added:
h3 [] [ txt "Latest commits" ];
511
Added:
ul [] (List.map (li_of_commit context.repo) commits);
512
Added:
]
513
Added:
514
Added:
let toolbar ?(filters = []) content =
515
Added:
let filter_el (filter_name, display, dismiss_href, value_class) =
516
Added:
HTML.(
517
Added:
span
518
Added:
[ class_ "toolbar-filter" ]
519
Added:
[
520
Added:
span [ class_ "%s" value_class ] [ txt "%s" display ];
521
Added:
a
522
Added:
[
523
Added:
href "%s" dismiss_href;
524
Added:
class_ "toolbar-dismiss";
525
Added:
Aria.label "Remove %s filter" filter_name;
526
Added:
]
527
Added:
[ txt "\xc3\x97" ];
528
Added:
])
529
Added:
in
530
Added:
let children = content @ List.map filter_el filters in
531
Added:
HTML.(
532
Added:
div [ class_ "toolbar"; role `toolbar; Aria.label "View toolbar" ] children)
533
Added:
534
Added:
let commits ?filter_type ?author ?committer ~page ~has_prev ~has_next context
535
Added:
commits =
536
Added:
let hide_pill = Option.is_some filter_type in
537
Added:
let filters =
538
Added:
(match filter_type with
539
Added:
| None -> []
540
Added:
| Some commit_type ->
541
Added:
[
542
Added:
( "commit type",
543
Added:
commit_type,
544
Added:
commits_url ?author ?committer context.repo,
545
Added:
"commit-pill commit-pill-" ^ commit_type );
546
Added:
])
547
Added:
@ (match author with
548
Added:
| None -> []
549
Added:
| Some email ->
550
Added:
[
551
Added:
( "author",
552
Added:
"Author: " ^ email,
553
Added:
commits_url ?filter_type ?committer context.repo,
554
Added:
"toolbar-filter-value" );
555
Added:
])
556
Added:
@
557
Added:
match committer with
558
Added:
| None -> []
559
Added:
| Some email ->
560
Added:
[
561
Added:
( "committer",
562
Added:
"Committer: " ^ email,
563
Added:
commits_url ?filter_type ?author context.repo,
564
Added:
"toolbar-filter-value" );
565
Added:
]
566
Added:
in
567
Added:
let tb = match filters with [] -> HTML.null [] | _ -> toolbar ~filters [] in
568
Added:
let page_url page =
569
Added:
commits_url ?filter_type ?author ?committer ~page context.repo
570
Added:
in
571
Added:
let show_pagination = has_prev || has_next in
572
Added:
let pagination =
573
Added:
if not show_pagination then HTML.null []
574
Added:
else
575
Added:
HTML.(
576
Added:
nav
577
Added:
[ class_ "pagination"; Aria.label "Pagination" ]
578
Added:
[
579
Added:
(if has_prev then
580
Added:
a
581
Added:
[
582
Added:
href "%s" (page_url (page - 1));
583
Added:
class_ "pagination-btn";
584
Added:
Aria.label "Previous page";
585
Added:
]
586
Added:
[ txt "<" ]
587
Added:
else
588
Added:
span
589
Added:
[
590
Added:
class_ "pagination-btn pagination-disabled"; Aria.hidden true;
591
Added:
]
592
Added:
[ txt "<" ]);
593
Added:
span
594
Added:
[ class_ "pagination-page"; Aria.current `page ]
595
Added:
[ txt "%d" page ];
596
Added:
(if has_next then
597
Added:
a
598
Added:
[
599
Added:
href "%s" (page_url (page + 1));
600
Added:
class_ "pagination-btn";
601
Added:
Aria.label "Next page";
602
Added:
]
603
Added:
[ txt ">" ]
604
Added:
else
605
Added:
span
606
Added:
[
607
Added:
class_ "pagination-btn pagination-disabled"; Aria.hidden true;
608
Added:
]
609
Added:
[ txt ">" ]);
610
Added:
])
611
Added:
in
612
Added:
render_page context ~active:Commits
613
Added:
HTML.
614
Added:
[
615
Added:
tb;
616
Added:
pagination;
617
Added:
ul []
618
Added:
(List.map
619
Added:
(li_of_commit ~hide_pill ?filter_type ?author ?committer
620
Added:
context.repo)
621
Added:
commits);
622
Added:
pagination;
623
Added:
]
624
Added:
625
Added:
let breadcrumb_pill repo (trail : (string * string) list) =
626
Added:
let root_anchor =
627
Added:
Routes.link_to (Files repo)
628
Added:
~other_attrs:[ HTML.class_ "path-pill-link" ]
629
Added:
(txt "root")
630
Added:
in
631
Added:
let segments =
632
Added:
List.map
633
Added:
(fun (entry_name, hash) ->
634
Added:
HTML.(
635
Added:
null
636
Added:
[
637
Added:
span [ class_ "path-pill-sep" ] [ txt "/" ];
638
Added:
Routes.link_to
639
Added:
(File (repo, hash))
640
Added:
~other_attrs:[ class_ "path-pill-link" ]
641
Added:
(txt "%s" entry_name);
642
Added:
]))
643
Added:
trail
644
Added:
in
645
Added:
HTML.(span [ class_ "path-pill" ] (root_anchor :: segments))
646
Added:
647
Added:
let files context trail ?readme (entries : Resolvers.Tree.preloaded_entry list)
648
Added:
=
649
Added:
let pill = breadcrumb_pill context.repo trail in
650
Added:
let tb = toolbar [ pill ] in
651
Added:
let readme_section =
652
Added:
match readme with
653
Added:
| None -> HTML.null []
654
Added:
| Some (blob : Resolvers.Blob.t) ->
655
Added:
let formatted =
656
Added:
String.split_on_char '\n' blob.content
657
Added:
|> List.mapi (fun number line ->
658
Added:
let line_number = number + 1 in
659
Added:
HTML.
660
Added:
[
661
Added:
a
662
Added:
[
663
Added:
id "readme-%d" line_number;
664
Added:
class_ "line-anchor";
665
Added:
href "#readme-%d" line_number;
666
Added:
Aria.label "Line %d" line_number;
667
Added:
]
668
Added:
[ txt "%d" line_number ];
669
Added:
span [ class_ "line" ] [ txt "\t%s\n" line ];
670
Added:
])
671
Added:
|> List.concat
672
Added:
in
673
Added:
HTML.(
674
Added:
section
675
Added:
[ class_ "readme-inline" ]
676
Added:
[ h3 [] [ txt "README" ]; div [ class_ "blob" ] formatted ])
677
Added:
in
678
Added:
render_page context ~active:Files
679
Added:
HTML.
680
Added:
[
681
Added:
tb;
682
Added:
ul [] (List.map (li_of_preloaded context.repo) entries);
683
Added:
readme_section;
684
Added:
]
685
Added:
686
Added:
let file ?(active = Layout.Files) context trail (blob : Resolvers.Blob.t) =
687
Added:
let language =
688
Added:
let from_filename =
689
Added:
match List.rev trail with
690
Added:
| (name, _) :: _ -> language_of_filename name
691
Added:
| [] -> None
692
Added:
in
693
Added:
match from_filename with
694
Added:
| Some _ -> from_filename
695
Added:
| None -> language_of_content blob.content
696
Added:
in
697
Added:
let blob_attrs =
698
Added:
match language with
699
Added:
| Some lang -> [ HTML.id "blob"; HTML.class_ "language-%s" lang ]
700
Added:
| None -> [ HTML.id "blob" ]
701
Added:
in
702
Added:
let to_numbered_line number line =
703
Added:
let line_number = number + 1 in
704
Added:
HTML.
705
Added:
[
706
Added:
a
707
Added:
[
708
Added:
id "%d" line_number;
709
Added:
class_ "line-anchor";
710
Added:
href "#%d" line_number;
711
Added:
Aria.label "Line %d" line_number;
712
Added:
]
713
Added:
[ txt "%d" line_number ];
714
Added:
span [ class_ "line" ] [ txt "\t%s\n" line ];
715
Added:
]
716
Added:
in
717
Added:
let formatted_blob =
718
Added:
String.split_on_char '\n' blob.content
719
Added:
|> List.mapi to_numbered_line |> List.concat
720
Added:
in
721
Added:
let raw_link =
722
Added:
match List.rev trail with
723
Added:
| (_, hash) :: _ ->
724
Added:
HTML.(
725
Added:
Routes.link_to
726
Added:
(Raw_file (context.repo, hash))
727
Added:
~other_attrs:[ class_ "toolbar-raw-link" ]
728
Added:
(txt "raw"))
729
Added:
| [] -> HTML.null []
730
Added:
in
731
Added:
render_page context ~active
732
Added:
HTML.
733
Added:
[
734
Added:
toolbar [ breadcrumb_pill context.repo trail; raw_link ];
735
Added:
div blob_attrs formatted_blob;
736
Added:
]
737
Added:
738
Added:
let commit context (commit : Resolvers.Commit.t) diff =
739
Added:
let message = parse_commit_message commit.message in
740
Added:
let number = function Some number -> string_of_int number | None -> "" in
741
Added:
let line (line : Resolvers.Diff.line) =
742
Added:
let class_name, marker, screen_reader_label =
743
Added:
match line.kind with
744
Added:
| Resolvers.Diff.Context -> ("context", " ", "")
745
Added:
| Resolvers.Diff.Addition -> ("addition", "+", "Added: ")
746
Added:
| Resolvers.Diff.Deletion -> ("deletion", "-", "Removed: ")
747
Added:
in
748
Added:
HTML.(
749
Added:
div
750
Added:
[ class_ "diff-line %s" class_name ]
751
Added:
[
752
Added:
span [ class_ "line-number" ] [ txt "%s" (number line.old_number) ];
753
Added:
span [ class_ "line-number" ] [ txt "%s" (number line.new_number) ];
754
Added:
span [ class_ "diff-marker"; Aria.hidden true ] [ txt "%s" marker ];
755
Added:
span [ class_ "sr-only" ] [ txt "%s" screen_reader_label ];
756
Added:
span [ class_ "diff-text" ] [ txt "%s" line.text ];
757
Added:
])
758
Added:
in
759
Added:
let hunk (hunk : Resolvers.Diff.hunk) =
760
Added:
HTML.
761
Added:
[
762
Added:
details
763
Added:
[ class_ "diff-hunk"; open_ ]
764
Added:
[
765
Added:
summary
766
Added:
[ class_ "hunk-header" ]
767
Added:
[
768
Added:
txt "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
769
Added:
hunk.new_start hunk.new_count;
770
Added:
];
771
Added:
div
772
Added:
[ class_ "diff-lines-scroll" ]
773
Added:
[ div [ class_ "diff-lines" ] (List.map line hunk.lines) ];
774
Added:
];
775
Added:
]
776
Added:
in
777
Added:
let mode = function
778
Added:
| None -> "000000"
779
Added:
| Some mode -> Printf.sprintf "%06o" mode
780
Added:
in
781
Added:
let hash = function
782
Added:
| None -> "00000000"
783
Added:
| Some hash -> Resolvers.short_hash hash
784
Added:
in
785
Added:
let file (file : Resolvers.Diff.file) =
786
Added:
let file_body =
787
Added:
if file.binary then
788
Added:
HTML.[ p [ class_ "binary-diff" ] [ txt "Binary files differ" ] ]
789
Added:
else List.concat_map hunk file.hunks
790
Added:
in
791
Added:
HTML.(
792
Added:
details
793
Added:
[ class_ "diff-file"; open_ ]
794
Added:
(summary [ class_ "diff-file-header" ] [ txt "%s" file.path ]
795
Added:
:: div
796
Added:
[ class_ "diff-meta" ]
797
Added:
[
798
Added:
txt "index %s..%s %s..%s" (hash file.old_hash)
799
Added:
(hash file.new_hash) (mode file.old_mode) (mode file.new_mode);
800
Added:
]
801
Added:
:: file_body))
802
Added:
in
803
Added:
let diff_content =
804
Added:
match diff with
805
Added:
| [] -> HTML.[ p [] [ txt "No file changes in this commit." ] ]
806
Added:
| files -> List.map file files
807
Added:
in
808
Added:
let commit_type, commit_title = parse_conventional message.summary in
809
Added:
let pill =
810
Added:
match commit_type with
811
Added:
| None -> HTML.null []
812
Added:
| Some ct ->
813
Added:
HTML.(
814
Added:
span
815
Added:
[ class_ "commit-pill commit-pill-%s" ct ]
816
Added:
[
817
Added:
a
818
Added:
[ href "%s" (commits_url ~filter_type:ct context.repo) ]
819
Added:
[ txt "%s" ct ];
820
Added:
])
821
Added:
in
822
Added:
let content =
823
Added:
HTML.(
824
Added:
[ h3 [] [ pill; txt " %s" commit_title ] ]
825
Added:
@ (if message.body = "" then []
826
Added:
else [ p [ class_ "commit-body" ] [ txt "%s" message.body ] ])
827
Added:
@ [
828
Added:
dl
829
Added:
[ class_ "commit-meta" ]
830
Added:
[
831
Added:
dt [] [ txt "Commit" ];
832
Added:
dd [] [ txt "%s" commit.hash ];
833
Added:
dt [] [ txt "Author" ];
834
Added:
dd []
835
Added:
[
836
Added:
identity_link ~show_email:true ~role:`Author context.repo
837
Added:
commit.author;
838
Added:
];
839
Added:
dt [] [ txt "Author date" ];
840
Added:
dd [] [ time_node commit.author.date ];
841
Added:
dt [] [ txt "Committer" ];
842
Added:
dd []
843
Added:
[
844
Added:
identity_link ~show_email:true ~role:`Committer context.repo
845
Added:
commit.committer;
846
Added:
];
847
Added:
dt [] [ txt "Committer date" ];
848
Added:
dd [] [ time_node commit.committer.date ];
849
Added:
];
850
Added:
]
851
Added:
@ diff_content)
852
Added:
in
853
Added:
render_page
854
Added:
~heading:(context.repo ^ " : " ^ Resolvers.short_hash commit.hash)
855
Added:
context ~active:Summary content
856
Added:
857
Added:
let branches context branches =
858
Added:
let content =
859
Added:
match branches with
860
Added:
| [] -> HTML.[ p [] [ txt "No branches for repo %s" context.repo ] ]
861
Added:
| branches -> HTML.[ ul [] (List.map (li_of_branch context.repo) branches) ]
862
Added:
in
863
Added:
render_page context ~active:Branches content
864
Added:
865
Added:
let tags context tags =
866
Added:
let content =
867
Added:
match tags with
868
Added:
| [] -> HTML.[ p [] [ txt "No tags for repo %s" context.repo ] ]
869
Added:
| tags -> HTML.[ ul [] (List.map (li_of_tag context.repo) tags) ]
870
Added:
in
871
Added:
render_page context ~active:Tags content
lib/views/root.ml
@@ -0,0 +1,35 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
5
Added:
let render ~user ~root_title repositories =
6
Added:
let li_of_repo (repo_name, date) =
7
Added:
let ago_span =
8
Added:
match date with
9
Added:
| None -> HTML.null []
10
Added:
| Some d ->
11
Added:
HTML.(
12
Added:
span [ class_ "commit-ago" ] [ txt "%s" (Time_fmt.relative_time d) ])
13
Added:
in
14
Added:
HTML.(
15
Added:
li []
16
Added:
[
17
Added:
span
18
Added:
[ class_ "commit-left" ]
19
Added:
[ Routes.link_to (Routes.Repo repo_name) (txt "%s" repo_name) ];
20
Added:
ago_span;
21
Added:
])
22
Added:
in
23
Added:
let all_repositories =
24
Added:
HTML.(
25
Added:
div [ id "repositories" ] [ ul [] (List.map li_of_repo repositories) ])
26
Added:
in
27
Added:
respond
28
Added:
@@ Layout.render ~user ~root_title
29
Added:
{
30
Added:
title = root_title;
31
Added:
repo = None;
32
Added:
subtitle = "";
33
Added:
active = Summary;
34
Added:
content = [ all_repositories ];
35
Added:
}
lib/views/time_fmt.ml
@@ -0,0 +1,21 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
(** Human-readable relative timestamps. *)
4
Added:
5
Added:
let relative_time (date, _) =
6
Added:
let seconds = Unix.time () -. Int64.to_float date |> int_of_float in
7
Added:
let minutes = seconds / 60 in
8
Added:
let hours = minutes / 60 in
9
Added:
let days = hours / 24 in
10
Added:
let months = days / 30 in
11
Added:
let years = months / 12 in
12
Added:
let quantity value singular =
13
Added:
Printf.sprintf "%d %s%s ago" value singular (if value = 1 then "" else "s")
14
Added:
in
15
Added:
match seconds with
16
Added:
| s when s < 60 -> "just now"
17
Added:
| _ when minutes < 60 -> quantity minutes "minute"
18
Added:
| _ when hours < 24 -> quantity hours "hour"
19
Added:
| _ when days < 30 -> quantity days "day"
20
Added:
| _ when months < 12 -> quantity months "month"
21
Added:
| _ -> quantity years "year"
ogit.opam
@@ -8,13 +8,15 @@
8
8
tags: ["git" "web interface"]
9
9
doc: "https://url/to/documentation"
10
10
depends: [
11
Removed:
"dune" {>= "3.24"}
11
Added:
"dune" {>= "3.20"}
12
12
"ocaml" {= "5.2.1"}
13
13
"dream" {>= "1.0.0~alpha8"}
14
14
"dream-html" {>= "3.11.2"}
15
15
"git" {>= "3.18.0"}
16
16
"git-unix" {>= "3.18.0"}
17
Added:
"crunch" {>= "4.0.0"}
17
18
"ocamlformat" {with-dev-setup & = "0.29.0"}
19
Added:
"alcotest" {with-test & >= "1.7.0"}
18
20
"toml" {>= "7.1.0"}
19
21
"odoc" {with-doc}
20
22
]
scripts/build-release.sh
@@ -0,0 +1,80 @@
1
Added:
#!/bin/sh
2
Added:
# Build a statically-linked ogit binary using musl.
3
Added:
#
4
Added:
# Prerequisites:
5
Added:
# - opam (>= 2.1)
6
Added:
# - musl-gcc (install musl-tools on Debian/Ubuntu, sys-libs/musl on Gentoo)
7
Added:
# - A C compiler (gcc or clang)
8
Added:
#
9
Added:
# This script creates a dedicated opam switch with static musl compilation,
10
Added:
# installs dependencies, builds, strips, and copies the binary to dist/.
11
Added:
#
12
Added:
# Usage:
13
Added:
# ./scripts/build-release.sh
14
Added:
15
Added:
set -eu
16
Added:
17
Added:
SWITCH_NAME="ogit-static"
18
Added:
PROJECT_ROOT="$(cd "$(dirname "$0")/.." && pwd)"
19
Added:
OCAML_VERSION="$(
20
Added:
awk '/\(ocaml \(= / {
21
Added:
version = $3
22
Added:
gsub(/[()]/, "", version)
23
Added:
print version
24
Added:
exit
25
Added:
}' "${PROJECT_ROOT}/dune-project"
26
Added:
)"
27
Added:
DIST_DIR="${PROJECT_ROOT}/dist"
28
Added:
29
Added:
if [ -z "${OCAML_VERSION}" ]; then
30
Added:
echo "ERROR: Could not determine the OCaml version from dune-project."
31
Added:
exit 1
32
Added:
fi
33
Added:
34
Added:
# Verify musl-gcc is available
35
Added:
if ! command -v musl-gcc >/dev/null 2>&1; then
36
Added:
echo "ERROR: musl-gcc not found."
37
Added:
echo " Debian/Ubuntu: apt install musl-tools"
38
Added:
echo " Gentoo: emerge sys-libs/musl"
39
Added:
echo " Fedora: dnf install musl-gcc"
40
Added:
exit 1
41
Added:
fi
42
Added:
43
Added:
# Verify opam is available
44
Added:
if ! command -v opam >/dev/null 2>&1; then
45
Added:
echo "ERROR: opam not found. Install from https://opam.ocaml.org/doc/Install.html"
46
Added:
exit 1
47
Added:
fi
48
Added:
49
Added:
echo "==> Creating opam switch '${SWITCH_NAME}' (if not exists)..."
50
Added:
if ! opam switch list 2>/dev/null | grep -q "${SWITCH_NAME}"; then
51
Added:
opam switch create "${SWITCH_NAME}" \
52
Added:
--packages="ocaml-variants.${OCAML_VERSION}+options,ocaml-option-static,ocaml-option-musl" \
53
Added:
--no-install
54
Added:
fi
55
Added:
56
Added:
echo "==> Installing dependencies..."
57
Added:
opam install --switch="${SWITCH_NAME}" --deps-only --yes "${PROJECT_ROOT}"
58
Added:
59
Added:
echo "==> Building..."
60
Added:
opam exec --switch="${SWITCH_NAME}" -- dune build --root="${PROJECT_ROOT}" --force
61
Added:
62
Added:
BINARY="${PROJECT_ROOT}/_build/default/bin/main.exe"
63
Added:
64
Added:
if [ ! -f "${BINARY}" ]; then
65
Added:
echo "ERROR: Build produced no binary at ${BINARY}"
66
Added:
exit 1
67
Added:
fi
68
Added:
69
Added:
echo "==> Stripping binary..."
70
Added:
strip "${BINARY}"
71
Added:
72
Added:
echo "==> Copying to dist/..."
73
Added:
mkdir -p "${DIST_DIR}"
74
Added:
cp "${BINARY}" "${DIST_DIR}/ogit"
75
Added:
76
Added:
echo ""
77
Added:
echo "Done. Binary at: ${DIST_DIR}/ogit"
78
Added:
echo ""
79
Added:
file "${DIST_DIR}/ogit"
80
Added:
ls -lh "${DIST_DIR}/ogit"
test/dune
@@ -1,3 +1,3 @@
1
1
(test
2
2
(name test_ogit)
3
Removed:
(libraries ogit unix))
3
Added:
(libraries ogit alcotest unix lwt.unix))
test/test_commit_parsing.ml
@@ -0,0 +1,92 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
(** Tests for commit message parsing and conventional commit type extraction.
4
Added:
These functions drive both the pill display and the commit type filter. *)
5
Added:
6
Added:
open Ogit.Views.Repo
7
Added:
8
Added:
let test_parse_message_none () =
9
Added:
let msg = parse_commit_message None in
10
Added:
Alcotest.(check string) "summary" "" msg.summary;
11
Added:
Alcotest.(check string) "body" "" msg.body
12
Added:
13
Added:
let test_parse_message_single_line () =
14
Added:
let msg = parse_commit_message (Some "single line") in
15
Added:
Alcotest.(check string) "summary" "single line" msg.summary;
16
Added:
Alcotest.(check string) "body" "" msg.body
17
Added:
18
Added:
let test_parse_message_with_body () =
19
Added:
let msg = parse_commit_message (Some "summary\n\nbody paragraph") in
20
Added:
Alcotest.(check string) "summary" "summary" msg.summary;
21
Added:
Alcotest.(check string) "body" "body paragraph" msg.body
22
Added:
23
Added:
let test_parse_message_body_trimmed () =
24
Added:
let msg = parse_commit_message (Some "title\n\n indented\n\n") in
25
Added:
Alcotest.(check string) "summary" "title" msg.summary;
26
Added:
Alcotest.(check string) "body trimmed" "indented" msg.body
27
Added:
28
Added:
let test_conventional_feat () =
29
Added:
let typ, rest = parse_conventional "feat: add login" in
30
Added:
Alcotest.(check (option string)) "type" (Some "feat") typ;
31
Added:
Alcotest.(check string) "rest" "add login" rest
32
Added:
33
Added:
let test_conventional_with_scope () =
34
Added:
let typ, rest = parse_conventional "fix(auth): handle timeout" in
35
Added:
Alcotest.(check (option string)) "type" (Some "fix") typ;
36
Added:
Alcotest.(check string) "rest" "handle timeout" rest
37
Added:
38
Added:
let test_conventional_uppercase () =
39
Added:
let typ, rest = parse_conventional "FEAT: uppercase" in
40
Added:
Alcotest.(check (option string)) "type" (Some "feat") typ;
41
Added:
Alcotest.(check string) "rest" "uppercase" rest
42
Added:
43
Added:
let test_conventional_unknown_type () =
44
Added:
let typ, rest = parse_conventional "unknown: something" in
45
Added:
Alcotest.(check (option string)) "type" None typ;
46
Added:
Alcotest.(check string) "rest" "unknown: something" rest
47
Added:
48
Added:
let test_conventional_no_colon () =
49
Added:
let typ, rest = parse_conventional "just a message" in
50
Added:
Alcotest.(check (option string)) "type" None typ;
51
Added:
Alcotest.(check string) "rest" "just a message" rest
52
Added:
53
Added:
let test_conventional_empty () =
54
Added:
let typ, rest = parse_conventional "" in
55
Added:
Alcotest.(check (option string)) "type" None typ;
56
Added:
Alcotest.(check string) "rest" "" rest
57
Added:
58
Added:
let test_conventional_all_types () =
59
Added:
List.iter
60
Added:
(fun expected_type ->
61
Added:
let input = expected_type ^ ": msg" in
62
Added:
let typ, _ = parse_conventional input in
63
Added:
Alcotest.(check (option string)) expected_type (Some expected_type) typ)
64
Added:
[
65
Added:
"feat";
66
Added:
"fix";
67
Added:
"docs";
68
Added:
"style";
69
Added:
"refactor";
70
Added:
"perf";
71
Added:
"test";
72
Added:
"build";
73
Added:
"ci";
74
Added:
"chore";
75
Added:
"revert";
76
Added:
]
77
Added:
78
Added:
let suite =
79
Added:
( "commit parsing",
80
Added:
[
81
Added:
Alcotest.test_case "None message" `Quick test_parse_message_none;
82
Added:
Alcotest.test_case "single line" `Quick test_parse_message_single_line;
83
Added:
Alcotest.test_case "with body" `Quick test_parse_message_with_body;
84
Added:
Alcotest.test_case "body trimmed" `Quick test_parse_message_body_trimmed;
85
Added:
Alcotest.test_case "feat type" `Quick test_conventional_feat;
86
Added:
Alcotest.test_case "scoped type" `Quick test_conventional_with_scope;
87
Added:
Alcotest.test_case "uppercase" `Quick test_conventional_uppercase;
88
Added:
Alcotest.test_case "unknown type" `Quick test_conventional_unknown_type;
89
Added:
Alcotest.test_case "no colon" `Quick test_conventional_no_colon;
90
Added:
Alcotest.test_case "empty string" `Quick test_conventional_empty;
91
Added:
Alcotest.test_case "all known types" `Quick test_conventional_all_types;
92
Added:
] )
test/test_config.ml
@@ -0,0 +1,143 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Test_helpers
4
Added:
5
Added:
let test_round_trip () =
6
Added:
with_temp_file "ogit" ".toml" (fun file ->
7
Added:
let config =
8
Added:
Ogit.Config.
9
Added:
{
10
Added:
user = "alice";
11
Added:
default_branch = "main";
12
Added:
git_project_root = "/srv/git";
13
Added:
commits_max_displayed = 25;
14
Added:
title = "";
15
Added:
host = "127.0.0.1";
16
Added:
port = 9000;
17
Added:
}
18
Added:
in
19
Added:
Ogit.Config.write_file ~file (Ogit.Config.to_table config);
20
Added:
match Ogit.Config.read_file ~file () with
21
Added:
| Ok config' ->
22
Added:
Alcotest.(check string) "user" config.user config'.user;
23
Added:
Alcotest.(check string)
24
Added:
"branch" config.default_branch config'.default_branch;
25
Added:
Alcotest.(check string)
26
Added:
"root" config.git_project_root config'.git_project_root;
27
Added:
Alcotest.(check int)
28
Added:
"commits" config.commits_max_displayed config'.commits_max_displayed;
29
Added:
Alcotest.(check string) "host" config.host config'.host;
30
Added:
Alcotest.(check int) "port" config.port config'.port
31
Added:
| Error error -> fail_config_error error)
32
Added:
33
Added:
let test_backward_compat () =
34
Added:
with_temp_file "ogit" ".toml" (fun file ->
35
Added:
Out_channel.with_open_text file (fun channel ->
36
Added:
Printf.fprintf channel
37
Added:
"user = \"bob\"\n\
38
Added:
default_branch = \"main\"\n\
39
Added:
git_project_root = \"/srv/git\"\n\
40
Added:
commits_max_displayed = 10\n");
41
Added:
match Ogit.Config.read_file ~file () with
42
Added:
| Ok config ->
43
Added:
Alcotest.(check string) "default host" "127.0.0.1" config.host;
44
Added:
Alcotest.(check int) "default port" 8081 config.port
45
Added:
| Error error -> fail_config_error error)
46
Added:
47
Added:
let test_malformed () =
48
Added:
with_temp_file "ogit-malformed" ".toml" (fun file ->
49
Added:
Out_channel.with_open_text file (fun channel ->
50
Added:
output_string channel "user = [\n");
51
Added:
match Ogit.Config.read_file ~file () with
52
Added:
| Error (Ogit.Config.Parse_error _) -> ()
53
Added:
| Error error -> fail_config_error error
54
Added:
| Ok _ -> Alcotest.fail "malformed configuration was accepted")
55
Added:
56
Added:
let test_invalid_value () =
57
Added:
with_temp_file "ogit-invalid" ".toml" (fun file ->
58
Added:
let invalid = Ogit.Config.{ default with commits_max_displayed = 0 } in
59
Added:
Ogit.Config.write_file ~file (Ogit.Config.to_table invalid);
60
Added:
match Ogit.Config.read_file ~file () with
61
Added:
| Error (Ogit.Config.Invalid_value _) -> ()
62
Added:
| Error error -> fail_config_error error
63
Added:
| Ok _ -> Alcotest.fail "invalid commit limit was accepted")
64
Added:
65
Added:
let test_invalid_port_high () =
66
Added:
with_temp_file "ogit-port-high" ".toml" (fun file ->
67
Added:
let invalid = Ogit.Config.{ default with port = 65536 } in
68
Added:
Ogit.Config.write_file ~file (Ogit.Config.to_table invalid);
69
Added:
match Ogit.Config.read_file ~file () with
70
Added:
| Error (Ogit.Config.Invalid_value _) -> ()
71
Added:
| Error error -> fail_config_error error
72
Added:
| Ok _ -> Alcotest.fail "port 65536 was accepted")
73
Added:
74
Added:
let test_invalid_port_zero () =
75
Added:
with_temp_file "ogit-port-zero" ".toml" (fun file ->
76
Added:
let invalid = Ogit.Config.{ default with port = 0 } in
77
Added:
Ogit.Config.write_file ~file (Ogit.Config.to_table invalid);
78
Added:
match Ogit.Config.read_file ~file () with
79
Added:
| Error (Ogit.Config.Invalid_value _) -> ()
80
Added:
| Error error -> fail_config_error error
81
Added:
| Ok _ -> Alcotest.fail "port 0 was accepted")
82
Added:
83
Added:
let test_directory_rejected () =
84
Added:
with_temp_directory "ogit-config-directory" (fun directory ->
85
Added:
match Ogit.Config.read_file ~file:directory () with
86
Added:
| Error (Ogit.Config.Io_error _) -> ()
87
Added:
| Error error -> fail_config_error error
88
Added:
| Ok _ -> Alcotest.fail "a directory was accepted as a config file")
89
Added:
90
Added:
let test_invalid_implicit () =
91
Added:
with_temp_directory "ogit-xdg" (fun config_home ->
92
Added:
let directory = Filename.concat config_home "ogit" in
93
Added:
Unix.mkdir directory 0o755;
94
Added:
let file = Filename.concat directory "config.toml" in
95
Added:
Out_channel.with_open_text file (fun channel ->
96
Added:
output_string channel "user = [\n");
97
Added:
with_environment "OGIT_CONFIG" "" (fun () ->
98
Added:
with_environment "XDG_CONFIG_HOME" config_home (fun () ->
99
Added:
match Ogit.Config.load () with
100
Added:
| Error (Ogit.Config.Parse_error _) -> ()
101
Added:
| Error error -> fail_config_error error
102
Added:
| Ok _ -> Alcotest.fail "invalid implicit config should fail")))
103
Added:
104
Added:
let test_explicit_missing () =
105
Added:
let missing = Filename.temp_file "ogit-missing" ".toml" in
106
Added:
Sys.remove missing;
107
Added:
with_environment "OGIT_CONFIG" missing (fun () ->
108
Added:
match Ogit.Config.load () with
109
Added:
| Error (Ogit.Config.Not_found file) ->
110
Added:
Alcotest.(check string) "path" missing file
111
Added:
| Error error -> fail_config_error error
112
Added:
| Ok _ -> Alcotest.fail "explicitly missing config should fail")
113
Added:
114
Added:
let test_location () =
115
Added:
with_environment "OGIT_CONFIG" "" (fun () ->
116
Added:
with_environment "XDG_CONFIG_HOME" "/tmp/xdg-config" (fun () ->
117
Added:
let expected =
118
Added:
Filename.concat
119
Added:
(Filename.concat "/tmp/xdg-config" "ogit")
120
Added:
"config.toml"
121
Added:
in
122
Added:
Alcotest.(check string)
123
Added:
"XDG path" expected
124
Added:
(Ogit.Config.locate_config_file ())));
125
Added:
with_environment "OGIT_CONFIG" "/tmp/custom-ogit.toml" (fun () ->
126
Added:
Alcotest.(check string)
127
Added:
"explicit path" "/tmp/custom-ogit.toml"
128
Added:
(Ogit.Config.locate_config_file ()))
129
Added:
130
Added:
let suite =
131
Added:
( "config",
132
Added:
[
133
Added:
Alcotest.test_case "round trip" `Quick test_round_trip;
134
Added:
Alcotest.test_case "backward compat" `Quick test_backward_compat;
135
Added:
Alcotest.test_case "malformed" `Quick test_malformed;
136
Added:
Alcotest.test_case "invalid value" `Quick test_invalid_value;
137
Added:
Alcotest.test_case "port too high" `Quick test_invalid_port_high;
138
Added:
Alcotest.test_case "port zero" `Quick test_invalid_port_zero;
139
Added:
Alcotest.test_case "directory rejected" `Quick test_directory_rejected;
140
Added:
Alcotest.test_case "invalid implicit" `Quick test_invalid_implicit;
141
Added:
Alcotest.test_case "explicit missing" `Quick test_explicit_missing;
142
Added:
Alcotest.test_case "location" `Quick test_location;
143
Added:
] )
test/test_diff.ml
@@ -0,0 +1,133 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
(** Tests for the line-level diff algorithm and hunk generation. *)
4
Added:
5
Added:
let test_line_diff () =
6
Added:
let open Ogit.Resolvers.Diff in
7
Added:
match line_diff "first\nold\nlast\n" "first\nnew\nlast\n" with
8
Added:
| [ ctx1; del; add; ctx2 ] ->
9
Added:
Alcotest.(check string) "ctx1 text" "first" ctx1.text;
10
Added:
Alcotest.(check string) "del text" "old" del.text;
11
Added:
Alcotest.(check string) "add text" "new" add.text;
12
Added:
Alcotest.(check string) "ctx2 text" "last" ctx2.text
13
Added:
| lines -> Alcotest.failf "expected 4 lines, got %d" (List.length lines)
14
Added:
15
Added:
let test_empty_vs_empty () =
16
Added:
let open Ogit.Resolvers.Diff in
17
Added:
let lines = line_diff "" "" in
18
Added:
Alcotest.(check int) "no lines" 0 (List.length lines);
19
Added:
let hunks = hunks lines in
20
Added:
Alcotest.(check int) "no hunks" 0 (List.length hunks)
21
Added:
22
Added:
let test_identical_content () =
23
Added:
let open Ogit.Resolvers.Diff in
24
Added:
let content = "line1\nline2\nline3\n" in
25
Added:
let lines = line_diff content content in
26
Added:
List.iter
27
Added:
(fun line -> Alcotest.(check bool) "all context" true (line.kind = Context))
28
Added:
lines;
29
Added:
let hunks = hunks lines in
30
Added:
Alcotest.(check int) "no hunks for identical" 0 (List.length hunks)
31
Added:
32
Added:
let test_entirely_new_file () =
33
Added:
let open Ogit.Resolvers.Diff in
34
Added:
let lines = line_diff "" "new1\nnew2\n" in
35
Added:
Alcotest.(check int) "2 additions" 2 (List.length lines);
36
Added:
List.iter
37
Added:
(fun line ->
38
Added:
Alcotest.(check bool) "all additions" true (line.kind = Addition))
39
Added:
lines
40
Added:
41
Added:
let test_entirely_deleted_file () =
42
Added:
let open Ogit.Resolvers.Diff in
43
Added:
let lines = line_diff "old1\nold2\n" "" in
44
Added:
Alcotest.(check int) "2 deletions" 2 (List.length lines);
45
Added:
List.iter
46
Added:
(fun line ->
47
Added:
Alcotest.(check bool) "all deletions" true (line.kind = Deletion))
48
Added:
lines
49
Added:
50
Added:
let test_trailing_newline_handling () =
51
Added:
let open Ogit.Resolvers.Diff in
52
Added:
let with_newline = line_diff "a\n" "a\n" in
53
Added:
let without_newline = line_diff "a" "a" in
54
Added:
Alcotest.(check int) "with newline: 1 line" 1 (List.length with_newline);
55
Added:
Alcotest.(check int) "without newline: 1 line" 1 (List.length without_newline);
56
Added:
Alcotest.(check string) "text matches" "a" (List.hd with_newline).text;
57
Added:
Alcotest.(check string) "text matches" "a" (List.hd without_newline).text
58
Added:
59
Added:
let test_no_trailing_newline_diff () =
60
Added:
let open Ogit.Resolvers.Diff in
61
Added:
let lines = line_diff "a\nb" "a\nc" in
62
Added:
Alcotest.(check int) "3 lines" 3 (List.length lines);
63
Added:
let kinds = List.map (fun l -> l.kind) lines in
64
Added:
Alcotest.(check bool)
65
Added:
"context+del+add" true
66
Added:
(kinds = [ Context; Deletion; Addition ])
67
Added:
68
Added:
let test_hunks () =
69
Added:
let open Ogit.Resolvers.Diff in
70
Added:
let old_content = List.init 12 (fun i -> string_of_int (i + 1)) in
71
Added:
let new_content =
72
Added:
List.mapi (fun i l -> if i = 5 then "changed" else l) old_content
73
Added:
in
74
Added:
match
75
Added:
hunks
76
Added:
(line_diff
77
Added:
(String.concat "\n" old_content)
78
Added:
(String.concat "\n" new_content))
79
Added:
with
80
Added:
| [ hunk ] ->
81
Added:
Alcotest.(check int) "old_start" 3 hunk.old_start;
82
Added:
Alcotest.(check int) "old_count" 7 hunk.old_count;
83
Added:
Alcotest.(check int) "new_start" 3 hunk.new_start;
84
Added:
Alcotest.(check int) "new_count" 7 hunk.new_count
85
Added:
| hunks -> Alcotest.failf "expected 1 hunk, got %d" (List.length hunks)
86
Added:
87
Added:
let test_multiple_hunks () =
88
Added:
let open Ogit.Resolvers.Diff in
89
Added:
let old_content = List.init 20 (fun i -> string_of_int (i + 1)) in
90
Added:
let new_content =
91
Added:
List.mapi (fun i l -> if i = 2 || i = 17 then "changed" else l) old_content
92
Added:
in
93
Added:
let result =
94
Added:
hunks
95
Added:
(line_diff
96
Added:
(String.concat "\n" old_content)
97
Added:
(String.concat "\n" new_content))
98
Added:
in
99
Added:
Alcotest.(check int) "2 hunks" 2 (List.length result)
100
Added:
101
Added:
let test_large_file_fallback () =
102
Added:
let open Ogit.Resolvers.Diff in
103
Added:
(* 2001 * 2001 = 4_004_001 > 4_000_000 threshold *)
104
Added:
let old_content = String.concat "\n" (List.init 2001 string_of_int) in
105
Added:
let new_content =
106
Added:
String.concat "\n" (List.init 2001 (fun i -> string_of_int (i + 1000)))
107
Added:
in
108
Added:
let lines = line_diff old_content new_content in
109
Added:
let has_deletions = List.exists (fun l -> l.kind = Deletion) lines in
110
Added:
let has_additions = List.exists (fun l -> l.kind = Addition) lines in
111
Added:
Alcotest.(check bool) "has deletions" true has_deletions;
112
Added:
Alcotest.(check bool) "has additions" true has_additions;
113
Added:
(* No context lines in fallback mode *)
114
Added:
let has_context = List.exists (fun l -> l.kind = Context) lines in
115
Added:
Alcotest.(check bool) "no context in fallback" false has_context
116
Added:
117
Added:
let suite =
118
Added:
( "diff",
119
Added:
[
120
Added:
Alcotest.test_case "basic line diff" `Quick test_line_diff;
121
Added:
Alcotest.test_case "empty vs empty" `Quick test_empty_vs_empty;
122
Added:
Alcotest.test_case "identical content" `Quick test_identical_content;
123
Added:
Alcotest.test_case "entirely new file" `Quick test_entirely_new_file;
124
Added:
Alcotest.test_case "entirely deleted file" `Quick
125
Added:
test_entirely_deleted_file;
126
Added:
Alcotest.test_case "trailing newline" `Quick
127
Added:
test_trailing_newline_handling;
128
Added:
Alcotest.test_case "no trailing newline diff" `Quick
129
Added:
test_no_trailing_newline_diff;
130
Added:
Alcotest.test_case "single hunk" `Quick test_hunks;
131
Added:
Alcotest.test_case "multiple hunks" `Quick test_multiple_hunks;
132
Added:
Alcotest.test_case "large file fallback" `Quick test_large_file_fallback;
133
Added:
] )
test/test_discovery.ml
@@ -0,0 +1,122 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Test_helpers
4
Added:
5
Added:
let test_description_missing () =
6
Added:
with_temp_file "ogit-description" ".txt" (fun file ->
7
Added:
Sys.remove file;
8
Added:
Alcotest.(check string)
9
Added:
"missing file" Ogit.Resolvers.default_repo_description
10
Added:
(Ogit.Resolvers.read_description_file file))
11
Added:
12
Added:
let test_description_empty () =
13
Added:
with_temp_file "ogit-description" ".txt" (fun file ->
14
Added:
Out_channel.with_open_text file (fun _ -> ());
15
Added:
Alcotest.(check string)
16
Added:
"empty file" Ogit.Resolvers.default_repo_description
17
Added:
(Ogit.Resolvers.read_description_file file))
18
Added:
19
Added:
let test_description_content () =
20
Added:
with_temp_file "ogit-description" ".txt" (fun file ->
21
Added:
Out_channel.with_open_text file (fun channel ->
22
Added:
output_string channel "A useful repository\n");
23
Added:
Alcotest.(check string)
24
Added:
"content" "A useful repository"
25
Added:
(Ogit.Resolvers.read_description_file file))
26
Added:
27
Added:
let test_layout_bare () =
28
Added:
with_temp_directory "ogit-repos" (fun root ->
29
Added:
let bare = Filename.concat root "bare.git" in
30
Added:
make_git_directory bare;
31
Added:
Alcotest.(check bool)
32
Added:
"is_repository" true
33
Added:
(Ogit.Resolvers.is_repository bare);
34
Added:
match Ogit.Resolvers.repository_layout bare with
35
Added:
| Some { worktree; git_dir } ->
36
Added:
Alcotest.(check string) "worktree" bare worktree;
37
Added:
Alcotest.(check string) "git_dir" bare git_dir
38
Added:
| None -> Alcotest.fail "expected bare layout")
39
Added:
40
Added:
let test_layout_non_bare () =
41
Added:
with_temp_directory "ogit-repos" (fun root ->
42
Added:
let clone = Filename.concat root "clone" in
43
Added:
Unix.mkdir clone 0o755;
44
Added:
make_git_directory (Filename.concat clone ".git");
45
Added:
Alcotest.(check bool)
46
Added:
"is_repository" true
47
Added:
(Ogit.Resolvers.is_repository clone);
48
Added:
match Ogit.Resolvers.repository_layout clone with
49
Added:
| Some { worktree; git_dir } ->
50
Added:
Alcotest.(check string) "worktree" clone worktree;
51
Added:
Alcotest.(check string)
52
Added:
"git_dir"
53
Added:
(Filename.concat clone ".git")
54
Added:
git_dir
55
Added:
| None -> Alcotest.fail "expected non-bare layout")
56
Added:
57
Added:
let test_layout_not_a_repo () =
58
Added:
with_temp_directory "ogit-repos" (fun root ->
59
Added:
let directory = Filename.concat root "not-a-repository" in
60
Added:
Unix.mkdir directory 0o755;
61
Added:
Alcotest.(check bool)
62
Added:
"not a repository" false
63
Added:
(Ogit.Resolvers.is_repository directory))
64
Added:
65
Added:
let test_layout_non_bare_with_shadowing_files () =
66
Added:
with_temp_directory "ogit-repos" (fun root ->
67
Added:
let repo = Filename.concat root "TAOH" in
68
Added:
Unix.mkdir repo 0o755;
69
Added:
make_git_directory (Filename.concat repo ".git");
70
Added:
(* Create HEAD file and objects/ directory in the worktree that could
71
Added:
confuse bare-repository detection. *)
72
Added:
Out_channel.with_open_text (Filename.concat repo "HEAD") (fun ch ->
73
Added:
output_string ch "ref: refs/heads/master\n");
74
Added:
Unix.mkdir (Filename.concat repo "objects") 0o755;
75
Added:
Alcotest.(check bool)
76
Added:
"is_repository" true
77
Added:
(Ogit.Resolvers.is_repository repo);
78
Added:
match Ogit.Resolvers.repository_layout repo with
79
Added:
| Some { worktree; git_dir } ->
80
Added:
Alcotest.(check string) "worktree" repo worktree;
81
Added:
Alcotest.(check string)
82
Added:
"git_dir uses .git"
83
Added:
(Filename.concat repo ".git")
84
Added:
git_dir
85
Added:
| None -> Alcotest.fail "expected non-bare layout")
86
Added:
87
Added:
let test_listing () =
88
Added:
with_temp_directory "ogit-listing" (fun root ->
89
Added:
make_git_directory (Filename.concat root "visible.git");
90
Added:
make_git_directory (Filename.concat root ".hidden.git");
91
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
92
Added:
match Ogit.Resolvers.repositories config with
93
Added:
| Ok repositories ->
94
Added:
Alcotest.(check (list string))
95
Added:
"visible only" [ "visible.git" ] repositories
96
Added:
| Error error -> Alcotest.failf "%a" Ogit.Resolvers.pp_error error)
97
Added:
98
Added:
let test_fallback_branches () =
99
Added:
let config = Ogit.Config.{ default with default_branch = "trunk" } in
100
Added:
Alcotest.(check (list string))
101
Added:
"trunk first"
102
Added:
[ "trunk"; "main"; "master" ]
103
Added:
(Ogit.Resolvers.fallback_branch_candidates config);
104
Added:
let main = Ogit.Config.{ config with default_branch = "main" } in
105
Added:
Alcotest.(check (list string))
106
Added:
"main deduped" [ "main"; "master" ]
107
Added:
(Ogit.Resolvers.fallback_branch_candidates main)
108
Added:
109
Added:
let suite =
110
Added:
( "repository discovery",
111
Added:
[
112
Added:
Alcotest.test_case "description missing" `Quick test_description_missing;
113
Added:
Alcotest.test_case "description empty" `Quick test_description_empty;
114
Added:
Alcotest.test_case "description content" `Quick test_description_content;
115
Added:
Alcotest.test_case "bare layout" `Quick test_layout_bare;
116
Added:
Alcotest.test_case "non-bare layout" `Quick test_layout_non_bare;
117
Added:
Alcotest.test_case "non-bare with shadowing files" `Quick
118
Added:
test_layout_non_bare_with_shadowing_files;
119
Added:
Alcotest.test_case "not a repository" `Quick test_layout_not_a_repo;
120
Added:
Alcotest.test_case "listing" `Quick test_listing;
121
Added:
Alcotest.test_case "fallback branches" `Quick test_fallback_branches;
122
Added:
] )
test/test_helpers.ml
@@ -0,0 +1,48 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
(** Shared test fixtures. *)
4
Added:
5
Added:
let rec remove_path path =
6
Added:
try
7
Added:
if Sys.is_directory path then (
8
Added:
Sys.readdir path
9
Added:
|> Array.iter (fun name -> remove_path (Filename.concat path name));
10
Added:
Unix.rmdir path)
11
Added:
else Sys.remove path
12
Added:
with Sys_error _ -> ()
13
Added:
14
Added:
let with_temp_file prefix suffix test =
15
Added:
let file = Filename.temp_file prefix suffix in
16
Added:
Fun.protect ~finally:(fun () -> remove_path file) (fun () -> test file)
17
Added:
18
Added:
let with_temp_directory prefix test =
19
Added:
with_temp_file prefix "" (fun root ->
20
Added:
Sys.remove root;
21
Added:
Unix.mkdir root 0o755;
22
Added:
test root)
23
Added:
24
Added:
let with_environment name value test =
25
Added:
let previous = Sys.getenv_opt name in
26
Added:
Unix.putenv name value;
27
Added:
Fun.protect
28
Added:
~finally:(fun () -> Unix.putenv name (Option.value previous ~default:""))
29
Added:
test
30
Added:
31
Added:
let make_git_directory path =
32
Added:
Unix.mkdir path 0o755;
33
Added:
Out_channel.with_open_text (Filename.concat path "HEAD") (fun _ -> ());
34
Added:
Unix.mkdir (Filename.concat path "objects") 0o755
35
Added:
36
Added:
let git arguments =
37
Added:
let command = "git" in
38
Added:
let arguments = Array.of_list (command :: arguments) in
39
Added:
let channel = Unix.open_process_args_in command arguments in
40
Added:
let output = In_channel.input_all channel |> String.trim in
41
Added:
match Unix.close_process_in channel with
42
Added:
| Unix.WEXITED 0 -> output
43
Added:
| Unix.WEXITED code -> Alcotest.failf "git exited with %d" code
44
Added:
| Unix.WSIGNALED signal | Unix.WSTOPPED signal ->
45
Added:
Alcotest.failf "git stopped by signal %d" signal
46
Added:
47
Added:
let fail_config_error error =
48
Added:
Alcotest.fail (Ogit.Config.load_error_to_string error)
test/test_ogit.ml
@@ -1,139 +1,14 @@
1
Removed:
let test_config_round_trip () =
2
Removed:
let file = Filename.temp_file "ogit" ".toml" in
3
Removed:
let config =
4
Removed:
Ogit.Config.
5
Removed:
{
6
Removed:
user = "alice";
7
Removed:
default_branch = "main";
8
Removed:
git_project_root = "/srv/git";
9
Removed:
commits_max_displayed = 25;
10
Removed:
}
11
Removed:
in
12
Removed:
Ogit.Config.write_file ~file (Ogit.Config.to_table config);
13
Removed:
match Ogit.Config.read_file ~file () with
14
Removed:
| Ok config' -> assert (config' = config)
15
Removed:
| Error message -> failwith message
1
Added:
(* -*- mode: tuareg; -*- *)
16
2
17
Removed:
let test_config_location () =
18
Removed:
if Sys.getenv_opt "OGIT_CONFIG" = None then (
19
Removed:
Unix.putenv "XDG_CONFIG_HOME" "/tmp/xdg-config";
20
Removed:
assert (
21
Removed:
Ogit.Config.locate_config_file ()
22
Removed:
= Filename.concat (Filename.concat "/tmp/xdg-config" "ogit") "config.toml"));
23
Removed:
Unix.putenv "OGIT_CONFIG" "/tmp/custom-ogit.toml";
24
Removed:
assert (Ogit.Config.locate_config_file () = "/tmp/custom-ogit.toml")
25
Removed:
26
Removed:
let test_description_reader () =
27
Removed:
let file = Filename.temp_file "ogit-description" ".txt" in
28
Removed:
Sys.remove file;
29
Removed:
assert (
30
Removed:
Ogit.Resolvers.read_description_file file
31
Removed:
= Ogit.Resolvers.default_repo_description);
32
Removed:
Out_channel.with_open_text file (fun oc -> output_string oc "\n");
33
Removed:
assert (
34
Removed:
Ogit.Resolvers.read_description_file file
35
Removed:
= Ogit.Resolvers.default_repo_description);
36
Removed:
Out_channel.with_open_text file (fun oc ->
37
Removed:
output_string oc "A useful repository\n");
38
Removed:
assert (Ogit.Resolvers.read_description_file file = "A useful repository")
39
Removed:
40
Removed:
let make_git_directory path =
41
Removed:
Unix.mkdir path 0o755;
42
Removed:
Out_channel.with_open_text (Filename.concat path "HEAD") (fun _ -> ());
43
Removed:
Unix.mkdir (Filename.concat path "objects") 0o755
44
Removed:
45
Removed:
let test_repository_layout () =
46
Removed:
let root = Filename.temp_file "ogit-repositories" "" in
47
Removed:
Sys.remove root;
48
Removed:
Unix.mkdir root 0o755;
49
Removed:
let bare = Filename.concat root "bare.git" in
50
Removed:
make_git_directory bare;
51
Removed:
let clone = Filename.concat root "clone" in
52
Removed:
Unix.mkdir clone 0o755;
53
Removed:
make_git_directory (Filename.concat clone ".git");
54
Removed:
let ordinary_directory = Filename.concat root "not-a-repository" in
55
Removed:
Unix.mkdir ordinary_directory 0o755;
56
Removed:
assert (Ogit.Resolvers.is_repository bare);
57
Removed:
assert (Ogit.Resolvers.is_repository clone);
58
Removed:
assert (not (Ogit.Resolvers.is_repository ordinary_directory));
59
Removed:
(match Ogit.Resolvers.repository_layout bare with
60
Removed:
| Some { worktree; git_dir } ->
61
Removed:
assert (worktree = bare);
62
Removed:
assert (git_dir = bare)
63
Removed:
| None -> failwith "expected a bare repository layout");
64
Removed:
match Ogit.Resolvers.repository_layout clone with
65
Removed:
| Some { worktree; git_dir } ->
66
Removed:
assert (worktree = clone);
67
Removed:
assert (git_dir = Filename.concat clone ".git")
68
Removed:
| None -> failwith "expected a non-bare repository layout"
69
Removed:
70
Removed:
let test_fallback_branch_candidates () =
71
Removed:
let names = Ogit.Resolvers.fallback_branch_candidates () in
72
Removed:
assert (List.length names >= 2);
73
Removed:
assert (List.mem "main" names);
74
Removed:
assert (List.mem "master" names);
75
Removed:
assert (List.length (List.sort_uniq String.compare names) = List.length names)
76
Removed:
77
Removed:
let test_line_diff () =
78
Removed:
let open Ogit.Resolvers.Diff in
79
Removed:
match line_diff "first\nold\nlast\n" "first\nnew\nlast\n" with
80
Removed:
| [
81
Removed:
{ kind = Context; old_number = Some 1; new_number = Some 1; text = "first" };
82
Removed:
{ kind = Deletion; old_number = Some 2; new_number = None; text = "old" };
83
Removed:
{ kind = Addition; old_number = None; new_number = Some 2; text = "new" };
84
Removed:
{ kind = Context; old_number = Some 3; new_number = Some 3; text = "last" };
85
Removed:
] ->
86
Removed:
()
87
Removed:
| _ -> failwith "unexpected line diff"
88
Removed:
89
Removed:
let test_diff_hunks () =
90
Removed:
let open Ogit.Resolvers.Diff in
91
Removed:
let old_content = List.init 12 (fun index -> string_of_int (index + 1)) in
92
Removed:
let new_content =
93
Removed:
List.mapi
94
Removed:
(fun index line -> if index = 5 then "changed" else line)
95
Removed:
old_content
96
Removed:
in
97
Removed:
match
98
Removed:
hunks
99
Removed:
(line_diff
100
Removed:
(String.concat "\n" old_content)
101
Removed:
(String.concat "\n" new_content))
102
Removed:
with
103
Removed:
| [ hunk ] ->
104
Removed:
assert (hunk.old_start = 3);
105
Removed:
assert (hunk.old_count = 7);
106
Removed:
assert (hunk.new_start = 3);
107
Removed:
assert (hunk.new_count = 7)
108
Removed:
| _ -> failwith "expected one diff hunk"
109
Removed:
110
3
let () =
111
Removed:
assert (Ogit.Resolvers.is_valid_repo_name "project.git");
112
Removed:
assert (Ogit.Resolvers.is_valid_repo_name "project");
113
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name ""));
114
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name ".hidden"));
115
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name "."));
116
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name ".."));
117
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name "../outside"));
118
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name "nested/repo"));
119
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name "nested\\repo"));
120
Removed:
assert (not (Ogit.Resolvers.is_valid_repo_name "bad\x00repo"));
121
Removed:
assert (Ogit.Resolvers.is_valid_hash_hex (String.make 40 'a'));
122
Removed:
assert (Ogit.Resolvers.is_valid_hash_hex (String.make 40 'A'));
123
Removed:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a')));
124
Removed:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 41 'a')));
125
Removed:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a' ^ "x")));
126
Removed:
assert (Ogit.Resolvers.Reference.branch_name "refs/heads/main" = Some "main");
127
Removed:
assert (
128
Removed:
Ogit.Resolvers.Reference.branch_name "refs/heads/feature/topic"
129
Removed:
= Some "feature/topic");
130
Removed:
assert (Ogit.Resolvers.Reference.branch_name "HEAD" = None);
131
Removed:
assert (Ogit.Resolvers.Reference.tag_name "refs/tags/v1.0.0" = Some "v1.0.0");
132
Removed:
assert (Ogit.Resolvers.Reference.tag_name "refs/heads/v1.0.0" = None);
133
Removed:
test_config_round_trip ();
134
Removed:
test_config_location ();
135
Removed:
test_description_reader ();
136
Removed:
test_repository_layout ();
137
Removed:
test_fallback_branch_candidates ();
138
Removed:
test_line_diff ();
139
Removed:
test_diff_hunks ()
4
Added:
Alcotest.run "ogit"
5
Added:
[
6
Added:
Test_validation.suite;
7
Added:
Test_commit_parsing.suite;
8
Added:
Test_config.suite;
9
Added:
Test_discovery.suite;
10
Added:
Test_tree_paths.suite;
11
Added:
Test_router.suite;
12
Added:
Test_diff.suite;
13
Added:
Test_views.suite;
14
Added:
]
test/test_router.ml
@@ -0,0 +1,68 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Test_helpers
4
Added:
5
Added:
let test_invalid_repo_name () =
6
Added:
with_temp_directory "ogit-router" (fun root ->
7
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
8
Added:
let request = Dream.test (Dream.router (Ogit.Handlers.routes config)) in
9
Added:
let status =
10
Added:
Dream.request ~target:"/.hidden/summary/" "" |> request |> Dream.status
11
Added:
in
12
Added:
Alcotest.(check int) "400" 400 (Dream.status_to_int status))
13
Added:
14
Added:
let test_missing_repo () =
15
Added:
with_temp_directory "ogit-router" (fun root ->
16
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
17
Added:
let request = Dream.test (Dream.router (Ogit.Handlers.routes config)) in
18
Added:
let status =
19
Added:
Dream.request ~target:"/missing/summary/" "" |> request |> Dream.status
20
Added:
in
21
Added:
Alcotest.(check int) "404" 404 (Dream.status_to_int status))
22
Added:
23
Added:
let test_invalid_hash () =
24
Added:
with_temp_directory "ogit-router" (fun root ->
25
Added:
let name = "project" in
26
Added:
let path = Filename.concat root name in
27
Added:
Unix.mkdir path 0o755;
28
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
29
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
30
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
31
Added:
Out_channel.with_open_text (Filename.concat path "f.txt") (fun ch ->
32
Added:
output_string ch "x\n");
33
Added:
ignore (git [ "-C"; path; "add"; "." ]);
34
Added:
ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]);
35
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
36
Added:
let request = Dream.test (Dream.router (Ogit.Handlers.routes config)) in
37
Added:
let status =
38
Added:
Dream.request ~target:"/project/commit/not-a-hash" ""
39
Added:
|> request |> Dream.status
40
Added:
in
41
Added:
Alcotest.(check int) "400" 400 (Dream.status_to_int status))
42
Added:
43
Added:
let test_missing_object () =
44
Added:
with_temp_directory "ogit-router" (fun root ->
45
Added:
let name = "project" in
46
Added:
let path = Filename.concat root name in
47
Added:
Unix.mkdir path 0o755;
48
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
49
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
50
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
51
Added:
Out_channel.with_open_text (Filename.concat path "f.txt") (fun ch ->
52
Added:
output_string ch "x\n");
53
Added:
ignore (git [ "-C"; path; "add"; "." ]);
54
Added:
ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]);
55
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
56
Added:
let request = Dream.test (Dream.router (Ogit.Handlers.routes config)) in
57
Added:
let target = "/project/commit/" ^ String.make 40 'a' in
58
Added:
let status = Dream.request ~target "" |> request |> Dream.status in
59
Added:
Alcotest.(check int) "404" 404 (Dream.status_to_int status))
60
Added:
61
Added:
let suite =
62
Added:
( "router",
63
Added:
[
64
Added:
Alcotest.test_case "invalid repo name" `Slow test_invalid_repo_name;
65
Added:
Alcotest.test_case "missing repo" `Slow test_missing_repo;
66
Added:
Alcotest.test_case "invalid hash" `Slow test_invalid_hash;
67
Added:
Alcotest.test_case "missing object" `Slow test_missing_object;
68
Added:
] )
test/test_tree_paths.ml
@@ -0,0 +1,116 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Test_helpers
4
Added:
5
Added:
let test_root_tree () =
6
Added:
with_temp_directory "ogit-paths" (fun root ->
7
Added:
let name = "project" in
8
Added:
let path = Filename.concat root name in
9
Added:
Unix.mkdir path 0o755;
10
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
11
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
12
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
13
Added:
Out_channel.with_open_text (Filename.concat path "file.txt") (fun ch ->
14
Added:
output_string ch "data\n");
15
Added:
ignore (git [ "-C"; path; "add"; "." ]);
16
Added:
ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]);
17
Added:
let root_tree = git [ "-C"; path; "rev-parse"; "HEAD^{tree}" ] in
18
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
19
Added:
let repository =
20
Added:
match Lwt_main.run (Ogit.Resolvers.open_repository config name) with
21
Added:
| Ok r -> r
22
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
23
Added:
in
24
Added:
Fun.protect
25
Added:
~finally:(fun () ->
26
Added:
Lwt_main.run (Ogit.Resolvers.close_repository repository))
27
Added:
(fun () ->
28
Added:
match
29
Added:
Lwt_main.run (Ogit.Resolvers.Tree.find_path repository root_tree)
30
Added:
with
31
Added:
| Ok trail ->
32
Added:
Alcotest.(check (list (pair string string)))
33
Added:
"empty trail" [] trail
34
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e))
35
Added:
36
Added:
let test_nested () =
37
Added:
with_temp_directory "ogit-paths" (fun root ->
38
Added:
let name = "project" in
39
Added:
let path = Filename.concat root name in
40
Added:
Unix.mkdir path 0o755;
41
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
42
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
43
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
44
Added:
let dir = Filename.concat path "dir" in
45
Added:
Unix.mkdir dir 0o755;
46
Added:
Out_channel.with_open_text (Filename.concat dir "nested.txt") (fun ch ->
47
Added:
output_string ch "nested\n");
48
Added:
ignore (git [ "-C"; path; "add"; "." ]);
49
Added:
ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]);
50
Added:
let nested_tree = git [ "-C"; path; "rev-parse"; "HEAD:dir" ] in
51
Added:
let nested_blob =
52
Added:
git [ "-C"; path; "rev-parse"; "HEAD:dir/nested.txt" ]
53
Added:
in
54
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
55
Added:
let repository =
56
Added:
match Lwt_main.run (Ogit.Resolvers.open_repository config name) with
57
Added:
| Ok r -> r
58
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
59
Added:
in
60
Added:
Fun.protect
61
Added:
~finally:(fun () ->
62
Added:
Lwt_main.run (Ogit.Resolvers.close_repository repository))
63
Added:
(fun () ->
64
Added:
match
65
Added:
Lwt_main.run (Ogit.Resolvers.Tree.find_path repository nested_blob)
66
Added:
with
67
Added:
| Ok trail ->
68
Added:
Alcotest.(check (list (pair string string)))
69
Added:
"nested trail"
70
Added:
[ ("dir", nested_tree); ("nested.txt", nested_blob) ]
71
Added:
trail
72
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e))
73
Added:
74
Added:
let test_unreachable () =
75
Added:
with_temp_directory "ogit-paths" (fun root ->
76
Added:
let name = "project" in
77
Added:
let path = Filename.concat root name in
78
Added:
Unix.mkdir path 0o755;
79
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
80
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
81
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
82
Added:
Out_channel.with_open_text (Filename.concat path "file.txt") (fun ch ->
83
Added:
output_string ch "data\n");
84
Added:
ignore (git [ "-C"; path; "add"; "." ]);
85
Added:
ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]);
86
Added:
let dangling_file = Filename.concat root "dangling.txt" in
87
Added:
Out_channel.with_open_text dangling_file (fun ch ->
88
Added:
output_string ch "dangling\n");
89
Added:
let dangling_blob =
90
Added:
git [ "-C"; path; "hash-object"; "-w"; dangling_file ]
91
Added:
in
92
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
93
Added:
let repository =
94
Added:
match Lwt_main.run (Ogit.Resolvers.open_repository config name) with
95
Added:
| Ok r -> r
96
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
97
Added:
in
98
Added:
Fun.protect
99
Added:
~finally:(fun () ->
100
Added:
Lwt_main.run (Ogit.Resolvers.close_repository repository))
101
Added:
(fun () ->
102
Added:
match
103
Added:
Lwt_main.run
104
Added:
(Ogit.Resolvers.Tree.find_path repository dangling_blob)
105
Added:
with
106
Added:
| Error (Ogit.Resolvers.Not_found _) -> ()
107
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
108
Added:
| Ok _ -> Alcotest.fail "unreachable object should return Not_found"))
109
Added:
110
Added:
let suite =
111
Added:
( "tree paths",
112
Added:
[
113
Added:
Alcotest.test_case "root tree" `Slow test_root_tree;
114
Added:
Alcotest.test_case "nested path" `Slow test_nested;
115
Added:
Alcotest.test_case "unreachable object" `Slow test_unreachable;
116
Added:
] )
test/test_validation.ml
@@ -0,0 +1,83 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
let test_valid_repo_names () =
4
Added:
Alcotest.(check bool)
5
Added:
"project.git" true
6
Added:
(Ogit.Resolvers.is_valid_repo_name "project.git");
7
Added:
Alcotest.(check bool)
8
Added:
"project" true
9
Added:
(Ogit.Resolvers.is_valid_repo_name "project")
10
Added:
11
Added:
let test_invalid_repo_names () =
12
Added:
List.iter
13
Added:
(fun name ->
14
Added:
Alcotest.(check bool)
15
Added:
(Printf.sprintf "reject %S" name)
16
Added:
false
17
Added:
(Ogit.Resolvers.is_valid_repo_name name))
18
Added:
[
19
Added:
"";
20
Added:
".hidden";
21
Added:
".";
22
Added:
"..";
23
Added:
"../outside";
24
Added:
"nested/repo";
25
Added:
"nested\\repo";
26
Added:
"bad\x00repo";
27
Added:
]
28
Added:
29
Added:
let test_valid_hash_hex () =
30
Added:
Alcotest.(check bool)
31
Added:
"40 lowercase hex" true
32
Added:
(Ogit.Resolvers.is_valid_hash_hex (String.make 40 'a'));
33
Added:
Alcotest.(check bool)
34
Added:
"40 uppercase hex" true
35
Added:
(Ogit.Resolvers.is_valid_hash_hex (String.make 40 'A'))
36
Added:
37
Added:
let test_invalid_hash_hex () =
38
Added:
Alcotest.(check bool)
39
Added:
"39 chars" false
40
Added:
(Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a'));
41
Added:
Alcotest.(check bool)
42
Added:
"41 chars" false
43
Added:
(Ogit.Resolvers.is_valid_hash_hex (String.make 41 'a'));
44
Added:
Alcotest.(check bool)
45
Added:
"non-hex char" false
46
Added:
(Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a' ^ "x"))
47
Added:
48
Added:
let test_short_hash () =
49
Added:
Alcotest.(check string) "short input" "abc" (Ogit.Resolvers.short_hash "abc");
50
Added:
Alcotest.(check string)
51
Added:
"long input" "01234567"
52
Added:
(Ogit.Resolvers.short_hash "0123456789")
53
Added:
54
Added:
let test_branch_name () =
55
Added:
Alcotest.(check (option string))
56
Added:
"main" (Some "main")
57
Added:
(Ogit.Resolvers.Reference.branch_name "refs/heads/main");
58
Added:
Alcotest.(check (option string))
59
Added:
"feature/topic" (Some "feature/topic")
60
Added:
(Ogit.Resolvers.Reference.branch_name "refs/heads/feature/topic");
61
Added:
Alcotest.(check (option string))
62
Added:
"HEAD" None
63
Added:
(Ogit.Resolvers.Reference.branch_name "HEAD")
64
Added:
65
Added:
let test_tag_name () =
66
Added:
Alcotest.(check (option string))
67
Added:
"v1.0.0" (Some "v1.0.0")
68
Added:
(Ogit.Resolvers.Reference.tag_name "refs/tags/v1.0.0");
69
Added:
Alcotest.(check (option string))
70
Added:
"not a tag" None
71
Added:
(Ogit.Resolvers.Reference.tag_name "refs/heads/v1.0.0")
72
Added:
73
Added:
let suite =
74
Added:
( "validation",
75
Added:
[
76
Added:
Alcotest.test_case "valid repo names" `Quick test_valid_repo_names;
77
Added:
Alcotest.test_case "invalid repo names" `Quick test_invalid_repo_names;
78
Added:
Alcotest.test_case "valid hash hex" `Quick test_valid_hash_hex;
79
Added:
Alcotest.test_case "invalid hash hex" `Quick test_invalid_hash_hex;
80
Added:
Alcotest.test_case "short hash" `Quick test_short_hash;
81
Added:
Alcotest.test_case "branch name" `Quick test_branch_name;
82
Added:
Alcotest.test_case "tag name" `Quick test_tag_name;
83
Added:
] )
test/test_views.ml
@@ -0,0 +1,12 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
let test_error_page_status () =
4
Added:
let response =
5
Added:
Ogit.Views.error_page ~status:`Not_Found ~title:"Not found" "missing"
6
Added:
|> Lwt_main.run
7
Added:
in
8
Added:
Alcotest.(check int) "404" 404 (Dream.status response |> Dream.status_to_int)
9
Added:
10
Added:
let suite =
11
Added:
( "views",
12
Added:
[ Alcotest.test_case "error page status" `Quick test_error_page_status ] )