├── .DS_Store
├── .github
    └── workflows
    │   └── setup.yml
├── .gitignore
├── .vscode
    └── settings.json
├── Makefile
├── README.md
├── client
    ├── client.ml
    ├── dune
    ├── lib
    │   ├── dune
    │   ├── shared.ml
    │   └── shared.mli
    └── repo_data.ml
├── dune
├── dune-project
├── server
    ├── api
    │   ├── app.ml
    │   ├── app.mli
    │   └── dune
    ├── dune
    └── server.eml.ml
├── simple_mini_github.opam
└── static
    └── style.css


/.DS_Store:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/dinakajoy/mini_github_app_using_ocaml/6aecc2c93981c1f19f3b50bdd8ebf255560d1c50/.DS_Store


--------------------------------------------------------------------------------
/.github/workflows/setup.yml:
--------------------------------------------------------------------------------
 1 | name: simple_mini_github
 2 | on: [push]
 3 | 
 4 | jobs:
 5 |   build:
 6 |     strategy:
 7 |       fail-fast: false
 8 |       matrix:
 9 |         os:
10 |           - ubuntu-latest
11 |         ocaml-compiler:
12 |           - 4.13.1
13 | 
14 |     runs-on: ${{ matrix.os }}
15 | 
16 |     steps:
17 |       - name: Checkout code
18 |         uses: actions/checkout@v2
19 | 
20 |       - name: Use OCaml ${{ matrix.ocaml-compiler }}
21 |         uses: ocaml/setup-ocaml@v2
22 |         with:
23 |           ocaml-compiler: ${{ matrix.ocaml-compiler }}
24 | 
25 |       - name: Install project dependencies
26 |         run: opam install . --deps-only
27 | 
28 |       - name: Install project dependencies
29 |         run: opam exec -- dune build
30 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | _build/ 
2 | repos 
3 | static/client.js 
4 | static/repo_data.js 
5 | 


--------------------------------------------------------------------------------
/.vscode/settings.json:
--------------------------------------------------------------------------------
1 | {
2 |   "ocaml.sandbox": {
3 |     "kind": "opam",
4 |     "switch": "4.13.1"
5 |   }
6 | }
7 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | install:
 2 | 	opam install . --deps-only    
 3 | 
 4 | build:
 5 | 	rm -rf repos/
 6 | 	dune build  
 7 | 
 8 | start: 
 9 | 	rm -rf repos/
10 | 	dune build  
11 | 	dune exec ./server/server.exe 
12 | 
13 | run-server-only:  
14 | 	rm -rf repos/
15 | 	dune exec ./server/server.exe 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # simple_mini_github
 2 | 
 3 | A simple app to test out `irmin-graphql`, `dream` and `js_of_ocaml`
 4 | 
 5 | ## How to setup the project
 6 | - clone the repository
 7 | - Run `make install` to install all project dependencies
 8 | - Run `make start` to start the application 
 9 | - Open `localhost:8080` in the browser to view the project frontend
10 | - Open `http://localhost:8080/graphiql` in the browser to view graphiql
11 | 
12 | ## To test
13 | - Paste in a github repository in the input box on the frontend
14 | - Run this sample query on graphiql to see result 
15 | ```
16 |   {
17 |     branches {
18 |       name
19 |       head {
20 |         info {
21 |           date
22 |           author
23 |           message
24 |         }
25 |       }
26 |     }
27 |     master {
28 |       name
29 |       tree {
30 |         get_contents(key: "README.md") {
31 |           key
32 |           metadata
33 |           value
34 |           hash
35 |         }
36 |       }
37 |     }
38 |   }
39 | ```


--------------------------------------------------------------------------------
/client/client.ml:
--------------------------------------------------------------------------------
 1 | open Brr
 2 | 
 3 | let submit_btn = (Document.find_el_by_id G.document) (Jstr.v "submit")
 4 | 
 5 | let format_result data = 
 6 |   match data with
 7 |   | Some _ -> Window.set_location G.window (Uri.v (Jstr.v "http://localhost:8080/repo-data"))
 8 |   | None -> Shared.display_text "There was an error"
 9 | 
10 | let save_repo req_body =
11 |   Shared.display_text "";
12 |   let url = "http://localhost:8080/repo" in
13 |   let req_body = Jstr.to_string (Jstr.lowercased (Jstr.of_string req_body)) in
14 |   Shared.post_data url req_body
15 | 
16 | let set_repo _ = 
17 |   let input =  (Document.find_el_by_id G.document) (Jstr.v "input") in
18 |   match input with
19 |   | Some element -> 
20 |     let users_repo = Jstr.to_string (El.prop El.Prop.value element) in
21 |     if (Jstr.is_empty (Jstr.of_string users_repo)) 
22 |       then Shared.display_text "Please paste in a valid git repository"
23 |     else 
24 |       let result = save_repo users_repo in
25 |       Fut.await result format_result;
26 |   | None -> ()
27 |   
28 | let () =
29 |   Shared.set_date ();
30 |   let submit =  submit_btn in
31 |   match submit with
32 |   | Some el ->  ignore(Ev.listen Ev.click set_repo (El.as_target el));
33 |   | None -> ()
34 | 


--------------------------------------------------------------------------------
/client/dune:
--------------------------------------------------------------------------------
1 | (executables
2 |  (names client repo_data)
3 |  (modes js)
4 |  (libraries shared js_of_ocaml-lwt yojson brr omd)
5 |  (preprocess (pps js_of_ocaml-ppx)))


--------------------------------------------------------------------------------
/client/lib/dune:
--------------------------------------------------------------------------------
1 | (library
2 |  (name shared)
3 |  (libraries js_of_ocaml-lwt brr))


--------------------------------------------------------------------------------
/client/lib/shared.ml:
--------------------------------------------------------------------------------
 1 | open Brr
 2 | open Brr_io
 3 | open Fut.Syntax
 4 | 
 5 | let set_date () = 
 6 |   let date_span =  (Document.find_el_by_id G.document) (Jstr.v "date") in
 7 |   match date_span with
 8 |   | Some v ->  El.set_prop (El.Prop.jstr (Jstr.v "innerHTML")) (Jstr.v "2022") v;
 9 |   | None -> ()
10 | 
11 | let display_text result = 
12 |   let result_element =  (Document.find_el_by_id G.document) (Jstr.v "result") in
13 |   match result_element with
14 |   | Some v -> El.set_prop (El.Prop.jstr (Jstr.v "innerHTML")) (Jstr.v result) v
15 |   | None -> ()
16 | 
17 | let display_element result = 
18 |   let result_element =  (Document.find_el_by_id G.document) (Jstr.v "result") in
19 |   match result_element with
20 |   | Some v -> El.append_children v result
21 |   | None -> ()
22 | 
23 | let get_response_data response =
24 |   let* data = Fetch.Body.text (Fetch.Response.as_body response) in
25 |   match data with
26 |   | Ok response -> Fut.return (Some response)
27 |   | Error error -> 
28 |     Console.error [ Jstr.v "Error!", Jv.Error.message error ];
29 |     Fut.return None
30 | 
31 | let post_data url req_query =
32 |   let req_url = Jstr.of_string url in 
33 |   let req_query = Jstr.of_string req_query in 
34 |   let init =
35 |     Fetch.Request.init
36 |       ~method':(Jstr.of_string "POST")
37 |       ~body:(Fetch.Body.of_jstr req_query)
38 |       ~headers:
39 |         (Fetch.Headers.of_assoc
40 |            [ Jstr.of_string "Content-Type", Jstr.of_string "application/json" ])
41 |       ()
42 |   in
43 |   let* result = Fetch.url ~init req_url in
44 |   match result with
45 |   | Ok response -> get_response_data response
46 |   | Error error -> 
47 |     Console.error [ Jstr.v "Err!", Jv.Error.message error ];
48 |     Fut.return None


--------------------------------------------------------------------------------
/client/lib/shared.mli:
--------------------------------------------------------------------------------
1 | open Brr
2 | 
3 | val set_date: unit -> unit
4 | 
5 | val display_text : string -> unit
6 | 
7 | val display_element : El.t list -> unit
8 | 
9 | val post_data: string -> string -> Jstr.t option Fut.t


--------------------------------------------------------------------------------
/client/repo_data.ml:
--------------------------------------------------------------------------------
  1 | open Brr
  2 | open Yojson.Basic
  3 | 
  4 | let get_string key l =
  5 |   match List.assoc key l with `String s -> s | _ -> raise Not_found
  6 | 
  7 | let find t path =
  8 |   let rec aux j p = match p, j with
  9 |     | [], j -> j
 10 |     | h::tl, `Assoc o -> aux (List.assoc h o) tl
 11 |     | _ -> raise Not_found in
 12 |   aux t path
 13 | 
 14 | let display_data data text = 
 15 |   let span = El.span [El.txt (Jstr.v text)] in 
 16 |   match data with
 17 |   | `String mydata -> 
 18 |     let elem_class = Jstr.v "myclass" in 
 19 |     let content = [El.txt (Jstr.v mydata)] in 
 20 |     let h2 = El.h2 ~at:At.[class' elem_class] content in 
 21 |     let div = El.div ~at:At.[class' (Jstr.v  "wrapper")] [] in
 22 |     El.append_children div [span; h2];
 23 |     Shared.display_element [div]
 24 |   | _ -> 
 25 |     let txt = "Error! Expected a string!" in
 26 |     let elem_class = Jstr.v "error" in 
 27 |     let p_content = [El.txt (Jstr.v txt)] in 
 28 |     let p = El.p ~at:At.[class' elem_class] p_content in 
 29 |     let div = El.div ~at:At.[class' (Jstr.v  "wrapper")] [] in
 30 |     El.append_children div [span; p];
 31 |     Shared.display_element [div]
 32 | 
 33 | let style_result repo_data = 
 34 |   let data = Jstr.to_string repo_data in 
 35 |   let json = from_string data in 
 36 |   let branches_json = find json [ "data"; "branches" ] in 
 37 |   match branches_json with 
 38 |   | `List [] -> Shared.display_text "Empty branch(es)!"
 39 |   | `List (branch :: _) -> 
 40 |     begin
 41 |       let date = find branch [ "head"; "info"; "date" ] in 
 42 |       display_data date "Date: ";
 43 |       let author = find branch [ "head"; "info"; "author" ] in 
 44 |       display_data author "Author: ";
 45 |       let message = find branch [ "head"; "info"; "message" ] in 
 46 |       display_data message "Message: "
 47 |     end
 48 |   | _ -> Shared.display_text "Error! Expected a list and got something else"
 49 | 
 50 | let style_result2 repo_data =
 51 |   let data = Jstr.to_string repo_data in 
 52 |   let json = from_string data in
 53 |   let readme = find json [ "data"; "main"; "tree"; "get_contents"; "value" ] in
 54 |   match readme with 
 55 |   | `String s -> 
 56 |     let elem_class = Jstr.v "readme" in 
 57 |     let p_content = [El.txt (Jstr.v s)] in 
 58 |     let p = El.p ~at:At.[class' elem_class] p_content in 
 59 |     Shared.display_element [p]
 60 |   | _ -> Shared.display_text "There was an error"
 61 | 
 62 | let format_result data = 
 63 |   match data with
 64 |   | Some data -> 
 65 |     style_result data;
 66 |     style_result2 data
 67 |   | None -> Shared.display_text "There was an error"
 68 | 
 69 | let repo_query = 
 70 |   let query = {|
 71 |     {
 72 |       branches {
 73 |         name
 74 |         head {
 75 |           info {
 76 |             date
 77 |             author
 78 |             message
 79 |           }
 80 |         }
 81 |       }
 82 |       main {
 83 |         tree {
 84 |           get_contents(path:"/README.md")
 85 |             metadata
 86 |             value
 87 |             hash
 88 |           }
 89 |         }
 90 |       }
 91 |     }
 92 |   |}
 93 |   in
 94 |   Yojson.Safe.to_string (`Assoc [ "query", `String query ])
 95 | 
 96 | let branches () = 
 97 |   Shared.display_text "";
 98 |   let url = "http://localhost:8080/graphql" in 
 99 |   let result = Shared.post_data url repo_query in 
100 |   Fut.await result format_result
101 | 
102 | let () =
103 |   Shared.set_date ();
104 |   branches ()
105 | 


--------------------------------------------------------------------------------
/dune:
--------------------------------------------------------------------------------
 1 | (subdir static/
 2 |   (rule 
 3 |     (deps ../client/client.bc.js)
 4 |     (targets client.js)
 5 |     (mode promote)
 6 |     (action (copy %{deps} %{targets})))
 7 |   (rule 
 8 |     (deps ../client/repo_data.bc.js)
 9 |     (targets repo_data.js)
10 |     (mode promote)
11 |     (action (copy %{deps} %{targets}))))
12 | 
13 | (data_only_dirs repo)


--------------------------------------------------------------------------------
/dune-project:
--------------------------------------------------------------------------------
1 | (lang dune 2.8)
2 | 


--------------------------------------------------------------------------------
/server/api/app.ml:
--------------------------------------------------------------------------------
 1 | open Lwt.Syntax
 2 | 
 3 | (* Irmin store with string contents *)
 4 | module Store = Irmin_git_unix.FS.KV (Irmin.Contents.String)
 5 | 
 6 | (* Module to synchronize local store with remote store *)
 7 | module Sync = Irmin.Sync.Make (Store)
 8 | 
 9 | module Config = struct
10 |   type info =  Sync.info
11 |   let remote = None
12 | 
13 |   let info = Irmin_unix.info
14 | end
15 | 
16 | module Graphql_Server = Irmin_graphql.Server.Make (Cohttp_lwt_unix.Server) (Config) (Store)
17 | 
18 | let store_location = "./repos"
19 | 
20 | let config = Irmin_git.config ~bare:true store_location
21 | 
22 | (* There must only exist a single repository that we manipulate in order for
23 |    Grahpql schema to work. *)
24 | let repo () = Store.Repo.v config
25 | 
26 | let check_status = 
27 |   Dream.log "Sync status: %a" (Fmt.result ~ok:Sync.pp_status ~error:Sync.pp_pull_error)
28 | 
29 | (* Here we clear the underlying git store in preparation for a [Sync.pull], this ensures
30 |    the repository is empty before the pull otherwise if a different remote is given it will
31 |    not work. *)
32 | let clear_repo () =
33 |   let* store = Store.Git.v (Fpath.v store_location) in
34 |     match store with
35 |     | Ok t -> 
36 |       let* status = Store.Git.reset t in
37 |       Dream.log "Reset status: %a" (Fmt.result ~ok:(Fmt.any "success") ~error:Store.Git.pp_error) status;
38 |       Lwt.return_unit
39 |     | Error err -> 
40 |       Dream.log "Store error: %a" Store.Git.pp_error err;
41 |       failwith "err"
42 | 
43 | (* Syncing resets the repository and pulls in the new data from the specified remote. *)
44 | let sync repo path = 
45 |   let* () = clear_repo () in
46 |   let* t = Store.main repo in
47 |   let* remote = Store.remote path in
48 |   let* status = Sync.pull t remote `Set in
49 |   check_status status;
50 |   let+ readme = Store.get t [ "README.md" ] in
51 |   Printf.printf "%s\n%!" readme;
52 |   "Done"
53 | 
54 | (* To test why sync is not working *)
55 | let info = Irmin_git_unix.info
56 | let path2 = "git@github.com:dinakajoy/finance-tracker-app.git"
57 | 
58 | let test () =
59 |   let config2 = Irmin_git.config ~bare:true store_location in
60 |   let* repo2= Store.Repo.v config2 in
61 |   let* remote = Store.remote path2 in
62 |   let* t =  Store.main repo2 in
63 |   let* _ = Sync.pull_exn t remote `Set in
64 |   let* readme = Store.get t [ "README.md" ] in
65 |   let* tree = Store.get_tree t [] in
66 |   let* tree = Store.Tree.add tree [ "BAR.md" ] "Hoho!" in
67 |   let* tree = Store.Tree.add tree [ "FOO.md" ] "Hihi!" in
68 |   let+ () = Store.set_tree_exn t ~info:(info "merge") [] tree in
69 |   Printf.printf "%s\n%!" readme
70 | 
71 | let schema repo =
72 |   Lwt.return @@ Graphql_Server.schema repo
73 | 
74 | let () = Lwt_main.run (test ())


--------------------------------------------------------------------------------
/server/api/app.mli:
--------------------------------------------------------------------------------
 1 | module Store: Irmin_git.S
 2 | 
 3 | val repo : unit -> Store.repo Lwt.t
 4 | (** Initialise the repository for storing the Github repo *)
 5 | 
 6 | val sync : Store.repo -> string -> string Lwt.t
 7 | (** [sync repo url] syncs the repository at [url] with the local store. *)
 8 | 
 9 | val schema : Store.repo -> unit Graphql_lwt.Schema.schema Lwt.t
10 | (** This schema allows to query and modify a git repository. *)


--------------------------------------------------------------------------------
/server/api/dune:
--------------------------------------------------------------------------------
1 | (library
2 |  (name app)
3 |  (libraries dream irmin-git.unix irmin-graphql.unix cohttp-lwt-unix lwt)
4 |  (preprocess
5 |   (pps ppx_irmin)))


--------------------------------------------------------------------------------
/server/dune:
--------------------------------------------------------------------------------
1 | (executable
2 |  (name server)
3 |  (libraries app dream))
4 | 
5 | (rule
6 |  (targets server.ml)
7 |  (deps server.eml.ml)
8 |  (action (run dream_eml %{deps} --workspace %{workspace_root})))
9 | 


--------------------------------------------------------------------------------
/server/server.eml.ml:
--------------------------------------------------------------------------------
 1 | open Lwt.Syntax
 2 | 
 3 | let home =
 4 |   <html>
 5 |     <head><link rel="stylesheet" href="/static/style.css"></head>
 6 |     <body id="body">
 7 |       <header class="header"><h1>Mini Github</h1></header>
 8 |       <main class="main">
 9 |         <p>Please paste in a git repository below: </p>
10 |         <div class="input">
11 |           <input type="text" id="input" />
12 |           <button type="submit" id="submit">Submit</button>
13 |         </div>
14 |         <div id="result" class="result"></div>
15 |       </main>
16 |       <footer  class="footer">&copy; <span id="date"></span></footer>
17 |       <script src="/static/client.js"></script>
18 |     </body>
19 |   </html>
20 | 
21 | let repo_result =
22 |   <html>
23 |     <head><link rel="stylesheet" href="/static/style.css"></head>
24 |     <body id="body">
25 |       <header class="header">Mini Github</header>
26 |       <main class="main">
27 |         <div><a href="/">Go Home</a></div>
28 |         <div id="result" class="result"></div>
29 |       </main>
30 |       <footer  class="footer">&copy; <span id="date"></span></footer>
31 |       <script src="/static/repo_data.js"></script>
32 |     </body>
33 |   </html>
34 | 
35 | let main () =
36 |   let* repo = App.repo () in
37 |   let* schema = App.schema repo in 
38 |   Dream.serve 
39 |   @@ Dream.logger 
40 |   @@ Dream.router [
41 |     Dream.get "/" (fun _ -> Dream.html home);
42 | 
43 |     Dream.get "/repo-data" (fun _ -> Dream.html repo_result);
44 | 
45 |     Dream.post "/repo" (fun request ->
46 |       let* body = Dream.body request in 
47 |       let+ res = App.sync repo body in
48 |       (Dream.response res));
49 |       
50 |     Dream.any "/graphql" (Dream.graphql (fun _ -> Lwt.return ()) schema);
51 |     Dream.get "/graphiql" (Dream.graphiql "/graphql");
52 | 
53 |     Dream.get "/static/**" (Dream.static "./static");
54 |   ]
55 |   (* @@ Dream.not_found *)
56 | 
57 | let () = Lwt_main.run (main ())
58 | 


--------------------------------------------------------------------------------
/simple_mini_github.opam:
--------------------------------------------------------------------------------
 1 | opam-version: "2.0"
 2 | 
 3 | synopsis: "A mini-github applicatio"
 4 | description: "This application is a sample project on how to combine irmin-graphql with dream and display queries on he browser using js_of_ocaml"
 5 | 
 6 | license: "MIT"
 7 | homepage: "https://github.com/dinakajoy/simple_mini_github"
 8 | bug-reports: "https://github.com/dinakajoy/simple_mini_github/issues"
 9 | 
10 | author: "Odinaka Joy <dinakajoy@gmail.com> and Patrick Ferris <pf341@patricoferris.com>"
11 | maintainer: "Odinaka Joy <dinakajoy@gmail.com> and Patrick Ferris <pf341@patricoferris.com>"
12 | 
13 | depends: [
14 |   "dream" {= "1.0.0~alpha2"}
15 |   "dune" {>= "2.8.0"} 
16 |   "js_of_ocaml-lwt" {= "3.11.0"}
17 |   "js_of_ocaml-ppx"
18 |   "yojson" {>= "1.7.0"}
19 |   "brr" {>= "0.0.2"}
20 |   "omd" {>= "2.0.0~alpha2"}
21 |   "irmin" {= "2.9.1"}
22 |   "irmin-unix" {= "2.9.1"}
23 |   "ocaml" {>= "4.13.1"}
24 | ]


--------------------------------------------------------------------------------
/static/style.css:
--------------------------------------------------------------------------------
 1 | 
 2 | *,
 3 | *::before,
 4 | *::after {
 5 |   margin: 0;
 6 |   padding: 0;
 7 |   outline: 0;
 8 |   box-sizing: border-box;
 9 | }
10 | 
11 | body {
12 |   background-color: #f4f4f4;
13 |   font-family:Verdana, Geneva, Tahoma, sans-serif
14 | }
15 | 
16 | h2 {
17 |   font-size: 1rem;
18 | }
19 | 
20 | .header {
21 |   text-align: center;
22 |   padding: 20px;
23 |   background-color: #000000c7;
24 |   color: #fff;
25 |   font-size: 2rem;
26 |   font-weight: 800;
27 | }
28 | 
29 | .footer {
30 |   text-align: center;
31 |   padding: 10px;
32 |   background-color: #000000c7;
33 |   color: #fff;
34 | }
35 | 
36 | .main {
37 |   width: 100%;
38 |   margin: 30px auto;
39 |   min-height: 73vh;
40 |   overflow-x: hidden;
41 |   overflow-y: auto;
42 |   display: flex;
43 |   flex-direction: column;
44 |   justify-content: flex-start;
45 |   align-items: center;
46 | }
47 | 
48 | .input {
49 |   width: 80%;
50 |   display: flex;
51 |   padding: 20px;
52 |   margin: 0 auto;
53 | }
54 | 
55 | .input input {
56 |   width: 80%;
57 |   margin: 0 auto;
58 |   padding: 10px;
59 |   background-color: #fff;
60 |   border: 1px solid #f4f4f4;
61 |   outline: 0;
62 | }
63 | 
64 | .input button {
65 |   cursor: pointer;
66 |   width: 20%;
67 |   margin: 0 auto;
68 |   padding: 10px;
69 |   color: #fff;
70 |   background-color: #0a0202;
71 |   border: 1px solid #0a0202;
72 |   outline: 0;
73 | }
74 | 
75 | .result {
76 |   width: 80%;
77 |   margin: 30px auto;
78 | }
79 | 
80 | .wrapper {
81 |   display: flex;
82 |   flex-direction: row;
83 |   width: 100%;
84 |   justify-content: space-between;
85 | }
86 | 
87 | .readme {
88 |   margin-top: 20px;
89 |   line-height: 1.8;
90 | }


--------------------------------------------------------------------------------