├── .gitignore ├── .gitmodules ├── .ocamlformat ├── LICENSE ├── Makefile ├── README.md ├── doc └── editor.png ├── dune ├── dune-project ├── omditor.opam └── src ├── client ├── dune ├── index.ml └── store.ml └── server ├── assets └── dune ├── dune ├── html.eml └── main.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam 3 | .merlin 4 | .vscode -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "irmin-indexeddb"] 2 | path = irmin-indexeddb 3 | url = https://github.com/patricoferris/irmin-indexeddb 4 | branch = irmin.2.7 5 | [submodule "irmin"] 6 | path = irmin 7 | url = https://github.com/patricoferris/irmin.git 8 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.18.0 -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2021 Patrick Ferris 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build --profile release src/client/index.bc.js 3 | dune exec --profile release -- ./src/server/main.exe 4 | 5 | doc: 6 | dune runtest -p omditor --auto-promote 7 | 8 | fmt: 9 | dune build @fmt --auto -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Omditor 2 | 3 | *Status: WIP & Experimental & PoC* 4 | 5 | Omditor is an incredibly simple markdown editor that uses [Omd][omd] for the preview and [Irmin][irmin] for the client-server storage. Omditor is offline-first meaning even without a connection you can use the application to edit your markdown and later use Irmin to sync and push your changes (it isn't a [PWA](https://developer.mozilla.org/en-US/docs/Web/Progressive_web_apps) so this isn't quite true). Thanks to Irmin's mergeable and branchable structure we get a collaborative, offline-first web application almost for free. 6 | 7 | What follows is an explanation of this repository, bare in mind this is all proof-of-concept not some production service. It is a quick experiment and will likely remain that way. This approach is largely based on the very awesome [Cuekeeper](https://github.com/talex5/cuekeeper) so be sure to check that out. 8 | 9 | ## How it works? 10 | 11 | The client uses [Js_of_ocaml][jsoo] and [brr + note][brr] (my first foray into *functional reactive programming*). The server uses [cohttp][cohttp] and [crunches][crunch] the Javascript to be served. **Everything** uses [irmin][irmin]. The server holds the main store for the different markdown files (there are only three) and the clients push their changes once they're happy. Until then they are free to locally commit the changes and go and grab a coffee and go outside, knowing their content has been persistently saved to the browser's IndexedDB. 12 | 13 | ### Server 14 | 15 | The server has two main roles: to serve the web applications and to provide the HTTP endpoint for the [irmin][irmin] stores to communicate. Before doing that it first sets up a Unix, git, key-value store. 16 | 17 | 18 | ```ocaml 19 | module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String) 20 | module Sync = Irmin.Sync (Store) 21 | module Http = Irmin_http.Server (Cohttp_lwt_unix.Server) (Store) 22 | ``` 23 | 24 | Layered over this store is the HTTP server endpoint. To combine this with an existing server I've had to do a bit of Irmin hacking to expose the callback rather than the [cohttp][cohttp] server (hence [irmin][irmin] is submoduled). I don't think it is possible to combine two cohttp servers once they are set up (I could be wrong). With the callback in hand, we can set up the whole server callback which includes sending the web app down the line. 25 | 26 | 27 | ```ocaml 28 | let callback repo conn req body = 29 | let uri = Cohttp.Request.resource req in 30 | match uri with 31 | | "" | "/" | "/index.html" -> 32 | Server.respond_string ~status:`OK ~body:Html.html () 33 | | "/static/index.js" -> 34 | Server.respond_string ~status:`OK 35 | ~body:(Assets.read "index.js" |> Option.get) 36 | () 37 | | _irmin_path -> Http.callback repo conn req body 38 | ``` 39 | 40 | Whilst we're at it we can also pre-populate the [irmin][irmin] store with some **simple** data. 41 | 42 | 43 | ```ocaml 44 | let store () = 45 | let config = Irmin_git.config ~bare:true repo in 46 | let* repo = Store.Repo.v config in 47 | let* t = Store.master repo in 48 | let* () = Store.set_exn ~info:(info "commit 1") t [ "hello.md" ] "# Hello!" in 49 | let* () = Store.set_exn ~info:(info "commit 2") t [ "salut.md" ] "# Salut!" in 50 | let+ () = Store.set_exn ~info:(info "commit 3") t [ "hola.md" ] "# Hola!" in 51 | repo 52 | ``` 53 | 54 | And finally we run the server at `http://localhost:8080`. 55 | 56 | 57 | ```ocaml 58 | let serve repo = Server.create (Server.make ~callback:(callback repo) ()) 59 | 60 | let main () = 61 | let* repo = store () in 62 | serve repo 63 | 64 | let () = Lwt_main.run @@ main () 65 | ``` 66 | 67 | ### Client 68 | 69 | #### Overview 70 | 71 | The client is quite a bit more complicated for two main reasons: 72 | 73 | 1. The [irmin][irmin] store is now dealing with a local view of the data and also trying to synchronise and merge updates from the server. 74 | 2. The application is reactive so it is built with [brr and note][brr]. 75 | 76 | The idea is fairly simple however. We want to have a local, persistent store where we can make changes, commit them and return to them later. At some point we want to then push these changes up to the server and also sync with whatever is up there. 77 | 78 | For the sake of making this PoC projeect simple and as short as possible, we're using `Irmin.Contents.String` which has the `idempotent` default merging tactic. A future version would do something cleverer over the `Omd` abstract syntax tree (I made a start of this [on this branch](https://github.com/patricoferris/omditor/tree/omd-repr) but it needed to extend `repr` and also we need an `Omd.doc -> string` function for the client, and it [turns out that's pretty challenging](https://github.com/patricoferris/omd/tree/omd-print)) 79 | 80 | #### Store 81 | 82 | The first thing we need is a git-store, backed by the browser's IndexedDB. With the right functor magic this is straight-forward enough. I encounter some issues with `irmin-indexeddb` (see [this repo for more details](https://github.com/patricoferris/irmin-http-repro)). 83 | 84 | 85 | ```ocaml 86 | module Store = 87 | Irmin_git.Generic 88 | (Irmin_indexeddb.Content_store) 89 | (Irmin_indexeddb.Branch_store) 90 | (Irmin.Contents.String) 91 | (Irmin.Path.String_list) 92 | (Irmin.Branch.String) 93 | ``` 94 | 95 | Now we need to create the http client to get the remote information. You might be wondering why we need to do this? Irmin (more specifically ocaml-git) doesn't support being a [git server just yet](https://github.com/mirage/ocaml-git/issues/15) so we can't actually pull from it. In the future when this is implemented it will reduce the complexity and amount of data used in this approach by requiring only two stores. 96 | 97 | 98 | ```ocaml 99 | (* No ocaml-git server... so using HTTP remote... *) 100 | module Remote = Irmin_http.Client (Client) (Store) 101 | module Sync = Irmin.Sync (Store) 102 | ``` 103 | 104 | From here we can then implement a `sync` function which fetches the main branch from the server for the client and optionally merges this branch into the staging branch. The staging branch is where we do the local work until we are ready to push things to the server. We're using [irmin's][irmin] built-in `Irmin.remote_store` functionality along with the `Http` store to make this possible. 105 | 106 | 107 | ```ocaml 108 | let sync ?(merge = true) t = 109 | let config = Irmin_http.config t.uri in 110 | let main = t.main in 111 | Remote.Repo.v config >>= fun repo -> 112 | Remote.master repo >>= fun remote -> 113 | Sync.pull_exn main ~depth:1 (Irmin.remote_store (module Remote) remote) `Set 114 | >>= fun _ -> 115 | if merge then ( 116 | Brr.Console.log [ Jstr.v "Merging" ]; 117 | Store.merge_into ~info:(info "update staging") ~into:t.staging main >>= function 118 | | Ok () -> Lwt.return @@ Ok () 119 | | Error (`Conflict s) -> 120 | (* Of course in practice we'd be more clever here... *) 121 | Store.Head.get main >>= fun head -> 122 | Lwt_result.ok @@ Store.Branch.set (Store.repo t.staging) "staging" head 123 | ) 124 | else Lwt_result.return () 125 | ``` 126 | 127 | As the code makes clear, we're not doing anything particularly smart if we encounter a merge conflict. A common example of when this will occur, is when we have two clients `A` and `B`. 128 | 129 | 1. `A` makes some changes and hits the `commit` button so they are now locally committed to `A`'s `staging` branch. 130 | 2. `B` makes some changes and hits the `commit` button so they are now locally committed to `B`'s `staging` branch. 131 | 3. `A` is happy with their changes and hits `push` to put them on the server. 132 | 4. `B` wants the latest changes so hits `sync` which fetches the main branch with no problem, but when trying to merge into `staging`... *conflict*! 133 | 134 | As mentioned, using a cleverer merging strategy (either based on a diffing algorithm or the `omd` AST) would be a better choice here. 135 | 136 | The `push` and `init` functions for the store are fairly similar. The `init` function looks to see if there are fresh commits on the main branch so if `staging` is behind the idea would be to let the client know (this functionality is not implemented yet). 137 | 138 | #### Application 139 | 140 | ![The Omditor with a textual editor on the left and the rendered markdown on the right with commit, sync and push buttons](./doc/editor.png) 141 | 142 | I won't go into too much detail of the client-side reactive code because I'm not terribly confident with FRP just yet, but the basic idea is that the client has some model of data and you define actions that move the model from one state to another. The "HTML" is built on top of this model (but as a *signal*) so when something changes the relevant parts are re-rendered. 143 | 144 | The model is pretty simple here: the current `file`, a list of possible `files` and the text being edited. The actions we can take are: updating the text (the `bool` is whether we should update the `contenteditable` div which we only do on a page load or a file change). A local commit, push, sync and file change should all be fairly understandable. 145 | 146 | 147 | ```ocaml 148 | (* Model *) 149 | type t = { file : string; files : string list; editor : Jstr.t } 150 | 151 | type action = 152 | [ `Update of bool * Jstr.t 153 | | `LocalCommit 154 | | `Push 155 | | `Sync 156 | | `ChangeFile of string ] 157 | ``` 158 | 159 | If we have a look at one example, the `ChangeFile` action: 160 | 161 | 162 | ```ocaml 163 | let change_file store s t = 164 | let open Lwt.Infix in 165 | let f = { t with file = s } in 166 | Lwt_js_events.async (fun () -> 167 | Store.local_get store [ s ] >|= fun l -> 168 | refresh_send (`Update (true, Jstr.v l))); 169 | f 170 | ``` 171 | 172 | You can see we have a "local get" to the store for the file we're after and then asynchronously firing a new update event. The event (and event sender `refresh_send`) are global and I have a feeling this might be a bit of an anti-pattern... but it works! 173 | 174 | One thing we do before changing files, is to commit the content locally so we don't lose the work: 175 | 176 | 177 | ```ocaml 178 | let reducer (store : Store.t) (action : [> action ]) = 179 | match action with 180 | | `Update s -> update s 181 | | `LocalCommit -> commit store 182 | | `Push -> push store 183 | | `Sync -> sync store 184 | (* Changing the file first locally commits it so you don't lose your changes! *) 185 | | `ChangeFile file -> fun t -> change_file store file (commit store t) 186 | | `UpdateEditable -> update_editable 187 | ``` 188 | 189 | I'm not sure if there are race-conditions with `Lwt_js_events.async`, I haven't experienced them yet but may be worth looking into. 190 | 191 | The rest of the code is just for the UI and connecting up the different events, signal and elements. 192 | 193 | ### Conclusion 194 | 195 | This is a pretty fun approach to building web applications and feels quite powerful (see some of the extensions below). What's really exciting is the power of OCaml's portable code like [irmin][irmin] which started off life being for [MirageOS][mirage] but this approach to being in control of your implementation unlocks the ability to putting your code in lots of interesting places (laptops, browsers, phones, micro-controllers etc.!). 196 | 197 | If you made it this far thanks for reading. I threw this together in just under a week so don't expect production-ready code or anything close to that. I encourage you to have a go with [irmin][irmin] though and see what you can build and let people know about it! 198 | 199 | ### Extensions 200 | 201 | - As already mentioned a better merging strategy would unleash the full power of [irmin][irmin] and this approach to building web applications. 202 | - Making the app into a PWA would also make it truly offline-first. 203 | - The UX is not great, the buttons to provide any feedback, there's no way to toggle between your local content and what's on the server, or diff these two. That would be quite a nice experience. 204 | - Could you do peer-to-peer connections rather than relying directly on the server? 205 | - Better UI, writing bindings for CodeMirror shouldn't be too hard and would be better than a `contenteditable` `
`... 206 | - Full file hierarchy and file creation too, right now you only get the three files at the start. 207 | - An example where the initial git store is pulled from somewhere (e.g. Github) and periodically pushes the changes from the server back to there. 208 | - [Unikernel-ise the server](https://mirage.io/) because why not. 209 | 210 | [irmin]: https://github.com/mirage/irmin 211 | [cohttp]: https://github.com/mirage/ocaml-cohttp 212 | [brr]: https://erratique.ch/software/brr 213 | [jsoo]: https://github.com/ocsigen/js_of_ocaml 214 | [omd]: https://github.com/ocaml/omd 215 | [crunch]: https://github.com/mirage/ocaml-crunch 216 | [mirage]: https://mirage.io 217 | -------------------------------------------------------------------------------- /doc/editor.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/patricoferris/omditor/b0e7ff9c0c07e6ea0db51694823161a290d4e6c9/doc/editor.png -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (package omditor) 3 | (files README.md)) 4 | 5 | (vendored_dirs irmin irmin-indexeddb) -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | 3 | (name omditor) 4 | 5 | (using mdx 0.1) 6 | 7 | (source 8 | (github patricoferris/omditor)) 9 | 10 | (license MIT) 11 | 12 | (authors "Patrick Ferris") 13 | 14 | (maintainers "pf341@patricoferris.com") 15 | 16 | (generate_opam_files true) 17 | 18 | (package 19 | (name omditor) 20 | (synopsis "OCaml Markdown Editor") 21 | (description "A markdown client-server editor built with Irmin") 22 | (depends 23 | brr 24 | dream 25 | js_of_ocaml 26 | js_of_ocaml-lwt 27 | omd 28 | crunch 29 | cohttp-lwt-unix 30 | (cohttp-lwt-jsoo (>= 4.0.0)) 31 | (irmin (>= 2.7.1)) 32 | irmin-unix 33 | irmin-http 34 | irmin-indexeddb 35 | irmin-git)) 36 | 37 | -------------------------------------------------------------------------------- /omditor.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml Markdown Editor" 4 | description: "A markdown client-server editor built with Irmin" 5 | maintainer: ["pf341@patricoferris.com"] 6 | authors: ["Patrick Ferris"] 7 | license: "MIT" 8 | homepage: "https://github.com/patricoferris/omditor" 9 | bug-reports: "https://github.com/patricoferris/omditor/issues" 10 | depends: [ 11 | "dune" {>= "2.9"} 12 | "brr" 13 | "dream" 14 | "js_of_ocaml" 15 | "js_of_ocaml-lwt" 16 | "omd" 17 | "crunch" 18 | "cohttp-lwt-unix" 19 | "cohttp-lwt-jsoo" {>= "4.0.0"} 20 | "irmin" {>= "2.7.1"} 21 | "irmin-unix" 22 | "irmin-http" 23 | "irmin-indexeddb" 24 | "irmin-git" 25 | "odoc" {with-doc} 26 | ] 27 | build: [ 28 | ["dune" "subst"] {dev} 29 | [ 30 | "dune" 31 | "build" 32 | "-p" 33 | name 34 | "-j" 35 | jobs 36 | "--promote-install-files=false" 37 | "@install" 38 | "@runtest" {with-test} 39 | "@doc" {with-doc} 40 | ] 41 | ["dune" "install" "-p" name "--create-install-files" name] 42 | ] 43 | dev-repo: "git+https://github.com/patricoferris/omditor.git" 44 | -------------------------------------------------------------------------------- /src/client/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name index) 3 | (modes js) 4 | (libraries 5 | js_of_ocaml 6 | js_of_ocaml-lwt 7 | brr 8 | omd 9 | brr.note 10 | digestif.ocaml 11 | checkseum.ocaml 12 | cohttp-lwt-jsoo 13 | unix 14 | irmin 15 | irmin.mem 16 | irmin-http 17 | irmin-indexeddb 18 | irmin-git)) 19 | -------------------------------------------------------------------------------- /src/client/index.ml: -------------------------------------------------------------------------------- 1 | (* Name clash with Brr.Uri *) 2 | module URI = Uri 3 | open Brr 4 | open Brr_note 5 | open Note 6 | open Js_of_ocaml_lwt [@@part "0"] 7 | 8 | [@@@part "0"] 9 | (* Model *) 10 | type t = { file : string; files : string list; editor : Jstr.t } 11 | 12 | type action = 13 | [ `Update of bool * Jstr.t 14 | | `LocalCommit 15 | | `Push 16 | | `Sync 17 | | `ChangeFile of string ] 18 | 19 | [@@@part "1"] 20 | (* Async update event -- are global events like this a bad idea? I 21 | need something to trigger on async calls like to the Irmin store? *) 22 | let (refresh : action event), refresh_send = E.create () 23 | 24 | let update_editable t = 25 | match Document.find_el_by_id G.document @@ Jstr.v "editor" with 26 | | Some editable -> 27 | El.to_jv editable |> fun jv -> 28 | Jv.set jv "innerText" (Jv.of_jstr t.editor); 29 | t 30 | | _ -> t 31 | 32 | let update (b, s) t = 33 | let t = { t with editor = s } in 34 | if b then update_editable t else t 35 | 36 | let commit s t = 37 | Lwt_js_events.async (fun () -> 38 | Store.local_commit s [ t.file ] (t.editor |> Jstr.to_string)); 39 | t 40 | 41 | let sync store t = 42 | Lwt_js_events.async (fun () -> Lwt.map ignore @@ Store.sync ~merge:true store); 43 | t 44 | 45 | let push store t = 46 | Lwt_js_events.async (fun () -> Lwt.map ignore @@ Store.push store); 47 | t 48 | 49 | [@@@part "2"] 50 | let change_file store s t = 51 | let open Lwt.Infix in 52 | let f = { t with file = s } in 53 | Lwt_js_events.async (fun () -> 54 | Store.local_get store [ s ] >|= fun l -> 55 | refresh_send (`Update (true, Jstr.v l))); 56 | f 57 | 58 | [@@@part "3"] 59 | let reducer (store : Store.t) (action : [> action ]) = 60 | match action with 61 | | `Update s -> update s 62 | | `LocalCommit -> commit store 63 | | `Push -> push store 64 | | `Sync -> sync store 65 | (* Changing the file first locally commits it so you don't lose your changes! *) 66 | | `ChangeFile file -> fun t -> change_file store file (commit store t) 67 | | `UpdateEditable -> update_editable 68 | 69 | [@@@part "4"] 70 | (* Rendering *) 71 | let set_inner_html el s = 72 | let jv = El.to_jv el in 73 | Jv.set jv "innerHTML" (Jv.of_jstr s) 74 | 75 | let editor_ui t = 76 | let open Brr_note_kit in 77 | let (commit, commit_btn) : [> action ] event * El.t = 78 | let btn = Ui.Button.v (S.const [ El.txt' "Commit" ]) "commit" in 79 | let action = E.map (fun _ -> `LocalCommit) @@ Ui.Button.action btn in 80 | (action, Ui.Button.el btn) 81 | in 82 | let (sync, sync_btn) : [> action ] event * El.t = 83 | let btn = Ui.Button.v (S.const [ El.txt' "Sync" ]) "sync" in 84 | let action = E.map (fun _ -> `Sync) @@ Ui.Button.action btn in 85 | (action, Ui.Button.el btn) 86 | in 87 | let (push, push_btn) : [> action ] event * El.t = 88 | let btn = Ui.Button.v (S.const [ El.txt' "Push" ]) "push" in 89 | let action = E.map (fun _ -> `Push) @@ Ui.Button.action btn in 90 | (action, Ui.Button.el btn) 91 | in 92 | let (file, file_sel) : [> action ] event * El.t = 93 | let sel = 94 | Ui.Value_selector.Menu.v Jstr.v (S.const t.files) (S.const t.file) 95 | in 96 | let action = 97 | E.filter_map (fun s -> if s = t.file then None else Some (`ChangeFile s)) 98 | @@ Ui.Value_selector.Menu.action sel 99 | in 100 | (action, Ui.Value_selector.Menu.el sel) 101 | in 102 | (E.select [ commit; file; sync; push ], [ file_sel; commit_btn; sync_btn; push_btn ]) 103 | 104 | let editor t = 105 | match Document.find_el_by_id G.document @@ Jstr.v "editor" with 106 | | Some editable -> 107 | let editor_actions, editor_hdr = editor_ui t in 108 | let get_inner tgt = 109 | El.to_jv tgt |> fun t -> Jv.get t "innerText" |> Jv.to_jstr 110 | in 111 | let keys = Evr.on_el Ev.keyup Evr.unit editable in 112 | let str = E.map (fun _ -> `Update (false, get_inner editable)) keys in 113 | let viewer = El.div ~at:[ At.class' @@ Jstr.v "markdown" ] [] in 114 | let () = 115 | set_inner_html viewer 116 | (Jstr.v @@ Omd.to_html (Omd.of_string (Jstr.to_string t.editor))) 117 | in 118 | (E.select [ str; editor_actions ], editor_hdr @ [ viewer ]) 119 | | _ -> failwith "arf!" 120 | 121 | let main ed = 122 | let make_editor s = editor s in 123 | S.l1 ~eq:( == ) make_editor ed 124 | 125 | let ui : store:Store.t -> initial:t -> t signal * El.t = 126 | fun ~store ~initial -> 127 | let def editor = 128 | let main = main editor in 129 | let action = E.swap @@ S.map ~eq:( == ) fst main in 130 | let action = E.select [ action; refresh ] in 131 | let items = S.map ~eq:( == ) snd main in 132 | let el = El.div ~at:[ At.class' @@ Jstr.v "markdown" ] [] in 133 | let () = Elr.def_children el items in 134 | let do_action = E.map (reducer store) action in 135 | let counter' = S.accum (S.value editor) do_action in 136 | (counter', (counter', el)) 137 | in 138 | S.fix initial def 139 | 140 | let editor ~store ~initial = 141 | let f, children = ui ~store ~initial in 142 | Logr.(hold @@ S.log f (fun _ -> ())); 143 | children 144 | 145 | let init () = Store.init (URI.of_string "http://localhost:8080") 146 | 147 | let app () = 148 | let open Lwt.Infix in 149 | let id = Jstr.v "app" in 150 | match Document.find_el_by_id G.document id with 151 | | None -> Console.(error [ str "No element with id '%s' found"; id ]) 152 | | Some el -> 153 | let editable = 154 | El.div 155 | ~at: 156 | [ 157 | At.class' @@ Jstr.v "text-editor"; 158 | At.id @@ Jstr.v "editor"; 159 | At.contenteditable true; 160 | ] 161 | [] 162 | in 163 | let start () = 164 | init () >>= fun store -> 165 | Store.list store >>= fun files -> 166 | let file = List.hd files in 167 | Store.local_get store [ file ] >>= fun content -> 168 | El.set_children editable [ El.txt' content ]; 169 | El.set_children el [ editable ]; 170 | let initial = { file; files; editor = Jstr.v content } in 171 | El.append_children el [ editor ~store ~initial ]; 172 | Lwt.return () 173 | in 174 | Lwt_js_events.async start 175 | 176 | let () = app () 177 | -------------------------------------------------------------------------------- /src/client/store.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | 3 | [@@@part "0"] 4 | 5 | (* ~~~ Irmin Store ~~~~ *) 6 | module Client = struct 7 | include Cohttp_lwt_jsoo.Client 8 | 9 | let ctx () = None 10 | end 11 | 12 | [@@@part "1"] 13 | 14 | module Store = 15 | Irmin_git.Generic 16 | (Irmin_indexeddb.Content_store) 17 | (Irmin_indexeddb.Branch_store) 18 | (Irmin.Contents.String) 19 | (Irmin.Path.String_list) 20 | (Irmin.Branch.String) 21 | 22 | [@@@part "2"] 23 | 24 | (* No ocaml-git server... so using HTTP remote... *) 25 | module Remote = Irmin_http.Client (Client) (Store) 26 | module Sync = Irmin.Sync (Store) 27 | 28 | [@@@part "3"] 29 | 30 | type t = { main : Store.t; staging : Store.t; uri : Uri.t } 31 | 32 | let info message () = 33 | Irmin.Info.v 34 | ~date:(Unix.gettimeofday () |> Int64.of_float) 35 | ~author:"omditor-client" message 36 | 37 | let local_commit t k v = 38 | Store.set ~info:(info "some message goes here") t.staging k v >|= function 39 | | Ok () -> Brr.Console.log [ Jstr.v "Successful commit" ] 40 | | Error _ -> Brr.Console.warn [ Jstr.v "Set error" ] 41 | 42 | let local_get t k = Store.get t.staging k 43 | 44 | [@@@part "4"] 45 | let sync ?(merge = true) t = 46 | let config = Irmin_http.config t.uri in 47 | let main = t.main in 48 | Remote.Repo.v config >>= fun repo -> 49 | Remote.master repo >>= fun remote -> 50 | Sync.pull_exn main ~depth:1 (Irmin.remote_store (module Remote) remote) `Set 51 | >>= fun _ -> 52 | if merge then ( 53 | Brr.Console.log [ Jstr.v "Merging" ]; 54 | Store.merge_into ~info:(info "update staging") ~into:t.staging main >>= function 55 | | Ok () -> Lwt.return @@ Ok () 56 | | Error (`Conflict _s) -> 57 | (* Of course in practice we'd be more clever here... *) 58 | Store.Head.get main >>= fun head -> 59 | Lwt_result.ok @@ Store.Branch.set (Store.repo t.staging) "staging" head 60 | ) 61 | else Lwt_result.return () 62 | 63 | [@@@part "5"] 64 | (* We're only using a one-level hierarchy so this is sufficient *) 65 | let list t = 66 | Store.list t.staging [] >>= fun lst -> Lwt.return @@ List.map fst lst 67 | 68 | let push ?(message = "merge") t = 69 | let config = Irmin_http.config t.uri in 70 | Remote.Repo.v config >>= fun repo -> 71 | Remote.master repo >>= fun remote -> 72 | sync ~merge:false t >>= fun _ -> 73 | let main = t.main in 74 | Store.merge_into ~info:(info message) ~into:main t.staging >>= fun _ -> 75 | Sync.push_exn main (Irmin.remote_store (module Remote) remote) 76 | 77 | let repo = "/tmp/irmin-adventures" 78 | 79 | let compare_commit a b = 80 | let a = Store.Commit.info a in 81 | let b = Store.Commit.info b in 82 | Int64.compare (Irmin.Info.date a) (Irmin.Info.date b) 83 | 84 | let init uri = 85 | let config = 86 | Irmin_git.config ~bare:true 87 | ~config:(Irmin_indexeddb.config "client-db") 88 | repo 89 | in 90 | Store.Repo.v config >>= fun repo -> 91 | Store.master repo >>= fun main -> 92 | (* Abusing the API here a little for this one off case... *) 93 | sync ~merge:false { main; staging = main; uri } >>= fun _ -> 94 | Store.Branch.find repo "staging" >>= fun commit -> 95 | match commit with 96 | | None -> 97 | Store.clone ~src:main ~dst:"staging" >>= fun staging -> 98 | Lwt.return { main; staging; uri } 99 | | Some c -> 100 | Store.of_branch repo "staging" >>= fun staging -> 101 | Store.Head.get main >>= fun head -> 102 | if compare_commit head c < 0 then Lwt.return { main; staging; uri } 103 | else Lwt.return { main; staging; uri } 104 | -------------------------------------------------------------------------------- /src/server/assets/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (alias default) 3 | (deps ../../client/index.bc.js) 4 | (targets index.js) 5 | (action 6 | (copy %{deps} %{targets}))) 7 | -------------------------------------------------------------------------------- /src/server/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries dream irmin-unix)) 4 | 5 | (rule 6 | (targets assets.ml) 7 | (deps ./assets/index.js) 8 | (action 9 | (with-stdout-to 10 | %{null} 11 | (run %{bin:ocaml-crunch} -e js -m plain ./assets -o %{targets})))) 12 | 13 | (rule 14 | (targets html.ml) 15 | (deps html.eml) 16 | (action 17 | (run dream_eml %{deps} --workspace %{workspace_root}))) 18 | -------------------------------------------------------------------------------- /src/server/html.eml: -------------------------------------------------------------------------------- 1 | let html = 2 | 3 | 4 | 5 | 6 | Omd-itor 7 | 49 | 50 | 51 |
52 |

Omd-itor

53 |
54 |
55 |
56 | 57 | 58 | -------------------------------------------------------------------------------- /src/server/main.ml: -------------------------------------------------------------------------------- 1 | (* ~~~ Irmin Store ~~~ *) 2 | open Lwt.Syntax 3 | open Cohttp_lwt_unix 4 | 5 | let info = Irmin_unix.info 6 | 7 | [@@@part "0"] 8 | 9 | module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String) 10 | module Sync = Irmin.Sync (Store) 11 | module Http = Irmin_http.Server (Cohttp_lwt_unix.Server) (Store) 12 | 13 | [@@@part "1"] 14 | 15 | let repo = "/tmp/irmin-adventures" 16 | 17 | [@@@part "2"] 18 | 19 | let store () = 20 | let config = Irmin_git.config ~bare:true repo in 21 | let* repo = Store.Repo.v config in 22 | let* t = Store.master repo in 23 | let* () = Store.set_exn ~info:(info "commit 1") t [ "hello.md" ] "# Hello!" in 24 | let* () = Store.set_exn ~info:(info "commit 2") t [ "salut.md" ] "# Salut!" in 25 | let+ () = Store.set_exn ~info:(info "commit 3") t [ "hola.md" ] "# Hola!" in 26 | repo 27 | 28 | [@@@part "3"] 29 | 30 | let callback repo conn req body = 31 | let uri = Cohttp.Request.resource req in 32 | match uri with 33 | | "" | "/" | "/index.html" -> 34 | Server.respond_string ~status:`OK ~body:Html.html () 35 | | "/static/index.js" -> 36 | Server.respond_string ~status:`OK 37 | ~body:(Assets.read "index.js" |> Option.get) 38 | () 39 | | _irmin_path -> Http.callback repo conn req body 40 | 41 | [@@@part "4"] 42 | 43 | let serve repo = Server.create (Server.make ~callback:(callback repo) ()) 44 | 45 | let main () = 46 | let* repo = store () in 47 | serve repo 48 | 49 | let () = Lwt_main.run @@ main () 50 | --------------------------------------------------------------------------------