├── .gitignore ├── LICENSE ├── README.md ├── boot.properties ├── build.boot ├── dev └── user.clj ├── resources ├── config.edn ├── logback.xml ├── public │ └── wiki.css └── templates │ └── wiki │ ├── _diff.html │ ├── _editor.html │ ├── _wrapper.html │ ├── conflict.html │ ├── create.html │ ├── edit.html │ ├── history.html │ ├── index.html │ ├── revision.html │ └── show.html └── src ├── edge ├── entrypoint.clj ├── main.clj ├── selmer.clj ├── system.clj └── web_server.clj └── net └── thegeez └── wiki ├── datomic.clj ├── diff.clj ├── fixtures.clj ├── fs2.clj ├── migrations.clj ├── migrator.clj └── wiki.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-* 10 | .hgignore 11 | .hg/ 12 | /out 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright © 2016 JUXT LTD. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | 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, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clj-wiki 2 | 3 | A wiki made with Clojure, Yada and Datomic Client. 4 | 5 | More info in this blogpost: [http://thegeez.net/2017/01/04/wiki_clojure_yada_datomic_client.html](http://thegeez.net/2017/01/04/wiki_clojure_yada_datomic_client.html) 6 | 7 | This is based on the [Edge](https://github.com/juxt/edge) example project. See that projects README for more instructions. 8 | 9 | ## Libraries 10 | - [Yada](https://github.com/juxt/yada) 11 | - [Datomic Client](http://www.datomic.com/) 12 | - [SimpleMDE](https://simplemde.com/) Markdown editor 13 | - [google-diff-match-patch](https://bitbucket.org/cowwoc/google-diff-match-patch/wiki/Home) for diff and patches 14 | 15 | 16 | ## Running locally 17 | 18 | ### Datomic Client 19 | Get Datomic Pro from [datomic.com](http://www.datomic.com/). 20 | Run a Datomic peer server: 21 | ``` 22 | datomic-pro-0.9.5544/bin/run -m datomic.peer-server -p 8998 -a wiki,wiki -d wiki,datomic:mem://wiki 23 | ``` 24 | Make sure the used settings are the same as in `resources/config.edn`. 25 | 26 | ### Create a location for the file server 27 | Make sure the directory in `resources/config.edn` under the `[:fs2 :private-path]` path points to a folder that is writeable. 28 | 29 | ### Run the webserver 30 | ``` 31 | boot dev 32 | ``` 33 | See the [Edge README.md](https://github.com/juxt/edge/blob/master/README.md) for helpfull tips for repl and CIDER support. 34 | 35 | ## Copyright & License 36 | 37 | The MIT License (MIT) 38 | 39 | Edge: Copyright © 2016 JUXT LTD. 40 | clj-wiki: Copyright © 2017 TheGeez.net. 41 | 42 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 43 | 44 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 45 | 46 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 47 | -------------------------------------------------------------------------------- /boot.properties: -------------------------------------------------------------------------------- 1 | BOOT_EMIT_TARGET=no 2 | BOOT_VERSION=2.6.0 3 | BOOT_CLOJURE_VERSION=1.9.0-alpha14 4 | -------------------------------------------------------------------------------- /build.boot: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | ;; A complete development environment for websites in Clojure and 4 | ;; ClojureScript. 5 | 6 | ;; Most users will use 'boot dev' from the command-line or via an IDE 7 | ;; (e.g. CIDER). 8 | 9 | ;; See README.md for more details. 10 | 11 | (require '[clojure.java.shell :as sh]) 12 | 13 | (defn next-version [version] 14 | (when version 15 | (let [[a b] (next (re-matches #"(.*?)([\d]+)" version))] 16 | (when (and a b) 17 | (str a (inc (Long/parseLong b))))))) 18 | 19 | (defn deduce-version-from-git 20 | "Avoid another decade of pointless, unnecessary and error-prone 21 | fiddling with version labels in source code." 22 | [] 23 | (let [[version commits hash dirty?] 24 | (next (re-matches #"(.*?)-(.*?)-(.*?)(-dirty)?\n" 25 | (:out (sh/sh "git" "describe" "--dirty" "--long" "--tags" "--match" "[0-9].*"))))] 26 | (cond 27 | dirty? (str (next-version version) "-" hash "-dirty") 28 | (pos? (Long/parseLong commits)) (str (next-version version) "-" hash) 29 | :otherwise version))) 30 | 31 | (def project "edge") 32 | (def version (deduce-version-from-git)) 33 | 34 | (set-env! 35 | :source-paths #{"src"} 36 | :resource-paths #{"resources" 37 | "src" ;; add sources to uberjar 38 | } 39 | :dependencies 40 | '[[reloaded.repl "0.2.1" :scope "test"] 41 | 42 | [org.clojure/clojure "1.9.0-alpha14"] 43 | 44 | [org.clojure/tools.nrepl "0.2.12"] 45 | 46 | ;; Server deps 47 | [aero "1.0.1"] 48 | [bidi "2.0.14"] 49 | [com.stuartsierra/component "0.3.1"] 50 | [org.clojure/tools.namespace "0.2.11"] 51 | ;;[prismatic/schema "1.0.4"] 52 | [selmer "1.0.4"] 53 | [yada "1.2.0" :exclusions [aleph manifold]] 54 | 55 | [aleph "0.4.2-alpha8"] 56 | [manifold "0.1.6-alpha1"] 57 | 58 | [org.bitbucket.cowwoc/diff-match-patch "1.1"] 59 | [markdown-clj "0.9.91"] 60 | [com.datomic/clj-client "0.8.606"] 61 | 62 | ;; Logging 63 | [org.clojure/tools.logging "0.3.1"] 64 | [org.slf4j/jcl-over-slf4j "1.7.21"] 65 | [org.slf4j/jul-to-slf4j "1.7.21"] 66 | [org.slf4j/log4j-over-slf4j "1.7.21"] 67 | [ch.qos.logback/logback-classic "1.1.5" 68 | :exclusions [org.slf4j/slf4j-api]]]) 69 | 70 | (require '[com.stuartsierra.component :as component] 71 | 'clojure.tools.namespace.repl 72 | '[edge.system :refer [new-system]]) 73 | 74 | (def repl-port 5600) 75 | 76 | (task-options! 77 | pom {:project (symbol project) 78 | :version version 79 | :description "A complete Clojure project you can leap from" 80 | :license {"The MIT License (MIT)" "http://opensource.org/licenses/mit-license.php"}} 81 | aot {:namespace #{'edge.entrypoint} 82 | } 83 | jar {:main 'edge.entrypoint 84 | :file (str project "-app.jar")}) 85 | 86 | (deftask dev-system 87 | "Develop the server backend. The system is automatically started in 88 | the dev profile." 89 | [] 90 | (require 'reloaded.repl) 91 | (let [go (resolve 'reloaded.repl/go)] 92 | (try 93 | (require 'user) 94 | (go) 95 | (catch Exception e 96 | (boot.util/fail "Exception while starting the system\n") 97 | (boot.util/print-ex e)))) 98 | identity) 99 | 100 | (deftask dev 101 | "This is the main development entry point." 102 | [] 103 | (set-env! :dependencies #(vec (concat % '[[reloaded.repl "0.2.1"]]))) 104 | (set-env! :source-paths #(conj % "dev")) 105 | 106 | ;; Needed by tools.namespace to know where the source files are 107 | (apply clojure.tools.namespace.repl/set-refresh-dirs (get-env :directories)) 108 | 109 | (comp 110 | (watch) 111 | (repl :server true 112 | :port repl-port 113 | :init-ns 'user) 114 | (dev-system) 115 | (target))) 116 | 117 | (deftask build 118 | [] 119 | (target :dir #{"static"})) 120 | 121 | (defn- run-system [profile] 122 | (println "Running system with profile" profile) 123 | (let [system (new-system profile)] 124 | (component/start system) 125 | (intern 'user 'system system) 126 | (with-pre-wrap fileset 127 | (assoc fileset :system system)))) 128 | 129 | (deftask run [p profile VAL kw "Profile"] 130 | (comp 131 | (repl :server true 132 | :port (case profile :prod 5601 :beta 5602 5600) 133 | :init-ns 'user) 134 | (run-system (or profile :prod)) 135 | (wait))) 136 | 137 | (deftask uberjar 138 | "Build an uberjar" 139 | [] 140 | (println "Building uberjar") 141 | (comp 142 | (aot) 143 | (pom) 144 | (uber) 145 | (jar) 146 | (target))) 147 | 148 | (deftask show-version "Show version" [] (println version)) 149 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | (ns user 4 | (:require 5 | [clojure.pprint :refer [pprint]] 6 | [clojure.test :refer [run-all-tests]] 7 | [clojure.reflect :refer [reflect]] 8 | [clojure.repl :refer [apropos dir doc find-doc pst source]] 9 | [clojure.tools.namespace.repl :refer [refresh refresh-all]] 10 | [clojure.java.io :as io] 11 | [com.stuartsierra.component :as component] 12 | [clojure.core.async :as a :refer [>! !! > system 35 | (reduce-kv 36 | (fn [acc k v] 37 | (assoc acc k (s/check (type v) v))) 38 | {}) 39 | (filter (comp some? second)))] 40 | 41 | (when (seq errors) (into {} errors)))) 42 | 43 | (defn test-all [] 44 | (run-all-tests #"edge.*test$")) 45 | 46 | (defn reset-and-test [] 47 | (reset) 48 | (time (test-all))) 49 | 50 | ;; REPL Convenience helpers 51 | -------------------------------------------------------------------------------- /resources/config.edn: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | ;; Aero configuration for Edge 4 | 5 | {:web-server 6 | #profile {:dev {:host "localhost:3000" 7 | :port 3000} 8 | :prod {:host "wiki.thegeez.net" 9 | :port 80}} 10 | 11 | :selmer 12 | {:template-caching? 13 | #profile {:dev false 14 | :test false 15 | :pre-prod true 16 | :prod true}} 17 | 18 | :datomic 19 | #profile {:dev 20 | {:args-map 21 | {:db-name "wiki" 22 | :access-key "wiki" 23 | :secret "wiki" 24 | :endpoint "localhost:8998"} 25 | :fixtures true 26 | :migrations true} 27 | :prod 28 | {:args-map 29 | {:db-name "wiki" 30 | :access-key "wiki" 31 | :secret "wiki" 32 | :endpoint "localhost:8998"} 33 | :fixtures true 34 | :migrations true}} 35 | 36 | :fs2 37 | #profile {:dev 38 | {:host "localhost" 39 | :port 4444 40 | :private-path "/tmp/fs2-storage"} 41 | :prod 42 | {:host "localhost" 43 | :port 5555 44 | :private-path "/home/ubuntu/fs2-storage"}}} 45 | -------------------------------------------------------------------------------- /resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 6 | UTF-8 7 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 8 | 9 | 10 | DEBUG 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /resources/public/wiki.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: sans-serif; 3 | } 4 | hr { 5 | background-color: #05a; 6 | height: 3px; 7 | border: 0px; 8 | } 9 | a.logo-link { 10 | color: #000; 11 | font-weight: bold; 12 | } 13 | ul.rev-nav { 14 | list-style: none; 15 | padding-left: 0px; 16 | } 17 | li.rev-prev { 18 | float: left; 19 | } 20 | li.rev-next { 21 | float: right; 22 | } 23 | 24 | ins { 25 | background: #249824; 26 | } 27 | 28 | del { 29 | background: #ff0e0e; 30 | } 31 | .editor-help { 32 | border: 1px solid grey; 33 | background-color: #ccc; 34 | padding: 4px; 35 | } 36 | div.editor-help i { 37 | color: #2c3e50; 38 | } 39 | table.diff { 40 | border: 1px solid grey; 41 | width: 100%; 42 | } 43 | table.diff td { 44 | border: 1px solid black; 45 | } 46 | table.diff tr.hide td{ 47 | line-height: 4px; 48 | background: grey; 49 | font-size: 0pt; 50 | } 51 | table.diff tr.hide td br { 52 | display: none; 53 | } 54 | h1.conflict { 55 | color: red; 56 | } 57 | 58 | -------------------------------------------------------------------------------- /resources/templates/wiki/_diff.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | {% for r in diff-trs %} 4 | 7 | {% endfor %} 8 |
This versionPrevious version
>{{r.left|safe}}{{r.right|safe}}
9 | 10 | -------------------------------------------------------------------------------- /resources/templates/wiki/_editor.html: -------------------------------------------------------------------------------- 1 |
2 | {% if rev %} 3 | 4 | {% endif %} 5 | Comment: 8 |
Editor tips: is 9 | preview, is side-by-side editor with 10 | live preview, is fullscreen, 11 | is save. Links to other articles are 12 | [Article Name](/wiki/Article_Name).
13 | 14 | 15 |
16 | 29 | -------------------------------------------------------------------------------- /resources/templates/wiki/_wrapper.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | WIKI {{title}} 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 |

clj-wiki | Create a new article: 15 | wiki/

17 |
18 | {% block body %} 19 |
20 | {% block main %} 21 | {% endblock %} 22 | 23 | 24 |
25 | 26 | {% endblock %} 27 | 28 | 33 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /resources/templates/wiki/conflict.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 |

Conflict

5 |

The article has changed since you started editing. The editor 6 | contains the newest version of the article. Your text and the 7 | changes are at the bottom of the page. Add your changes to the editor and save again to 8 | keep your changes. 9 |

{{article.article/title}}

10 |

Based on revision: {{article.article/rev}}

11 | {% with action=article.wiki/links.article/show 12 | rev=article.article/rev 13 | text=article.article/body 14 | comment=comment %} 15 | {% include "wiki/_editor.html" %} 16 | {% endwith %} 17 |

Diff

18 | {% include "wiki/_diff.html" %} 19 | 20 |

Your text:

21 | 22 | 23 | {% endblock %} 24 | -------------------------------------------------------------------------------- /resources/templates/wiki/create.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 |

{{title}}

5 | {% include "wiki/_editor.html" %} 6 | {% endblock %} 7 | -------------------------------------------------------------------------------- /resources/templates/wiki/edit.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 | 9 |

{{article.article/title}}

10 |

Based on revision: {{article.article/rev}}

11 | {% with action=article.wiki/links.article/show 12 | rev=article.article/rev 13 | text=article.article/body %} 14 | {% include "wiki/_editor.html" %} 15 | {% endwith %} 16 | {% endblock %} 17 | -------------------------------------------------------------------------------- /resources/templates/wiki/history.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 | 9 | 10 |

{{article.article/title}}

11 |

History

12 | 13 | 14 | {% for h in history %} 15 | 16 | 17 | 18 | 19 | 20 | {% endfor %} 21 |
RevisionTimeComment
{{forloop.revcounter0}}{{h.tx-instant}}{{h.comment}}
22 | {% endblock %} 23 | -------------------------------------------------------------------------------- /resources/templates/wiki/index.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 | 5 |

Welcome to clj-wiki

6 |

Create a new article or read or edit one of the existing articles:

7 | 12 | {% endblock %} 13 | -------------------------------------------------------------------------------- /resources/templates/wiki/revision.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 | 9 | 10 |

{{article.article/title}}

11 |

Article at revision: {{article.article/rev}}

12 |

Comment for this edit: {{comment}}

13 | 21 |
22 |
{{rev-body|safe}}
23 |

Diff

24 | {% if diff-trs %} 25 | {% include "wiki/_diff.html" %} 26 | {% else %} 27 |

This is the original version of this article, therefore there is no diff shown

28 | {% endif %} 29 | 30 | 38 |
39 | {% endblock %} 40 | -------------------------------------------------------------------------------- /resources/templates/wiki/show.html: -------------------------------------------------------------------------------- 1 | {% extends "wiki/_wrapper.html" %} 2 | 3 | {% block main %} 4 | 9 | 10 |

{{article.article/title}}

11 |
{{article.article/md-body|safe}}
12 | {% endblock %} 13 | -------------------------------------------------------------------------------- /src/edge/entrypoint.clj: -------------------------------------------------------------------------------- 1 | (ns edge.entrypoint 2 | "Entrypoint for production Uberjars" 3 | (:gen-class)) 4 | 5 | (def system nil) 6 | 7 | (defn -main 8 | [& args] 9 | (require 'edge.main) 10 | (apply (resolve 'edge.main/-main) args)) 11 | 12 | -------------------------------------------------------------------------------- /src/edge/main.clj: -------------------------------------------------------------------------------- 1 | (ns edge.main 2 | (:require [com.stuartsierra.component :as component] 3 | [edge.system :refer [new-system]])) 4 | 5 | (def system nil) 6 | 7 | (defn -main 8 | [& args] 9 | (let [system (new-system :prod)] 10 | (component/start system)) 11 | ;; All threads are daemon, so block forever: 12 | @(promise)) 13 | 14 | -------------------------------------------------------------------------------- /src/edge/selmer.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | (ns edge.selmer 4 | (:require 5 | [clojure.java.io :as io] 6 | [com.stuartsierra.component :refer [Lifecycle using]] 7 | [schema.core :as s] 8 | [hiccup.core :refer [html]] 9 | [selmer.parser :as selmer] 10 | [yada.yada :as yada])) 11 | 12 | (defn- make-uri-fn [k] 13 | (fn [args context-map] 14 | (when-let [ctx (:ctx context-map)] 15 | (get (yada/uri-info ctx 16 | (keyword "edge.resources" (first args)) 17 | {:route-params 18 | (reduce (fn [acc [k v]] (assoc acc (keyword k) v)) {} (partition 2 (rest args)))}) 19 | k)))) 20 | 21 | (defn add-url-tag! 22 | "Add a tag that gives access to yada's uri-info function in templates" 23 | [] 24 | (selmer/add-tag! :url (make-uri-fn :href)) 25 | (selmer/add-tag! :absurl (make-uri-fn :uri)) 26 | (selmer/add-tag! :source (fn [args context-map] 27 | (html [:tt [:a {:href (str "/sources/" (first args))} (first args)]])))) 28 | 29 | (s/defrecord Selmer [template-caching? :- s/Bool] 30 | Lifecycle 31 | (start [component] 32 | (selmer/set-resource-path! (io/resource "templates")) 33 | 34 | (if template-caching? 35 | (selmer.parser/cache-on!) 36 | (selmer.parser/cache-off!)) 37 | 38 | (add-url-tag!)) 39 | 40 | (stop [component] 41 | component)) 42 | 43 | (defn new-selmer [] 44 | (map->Selmer {})) 45 | -------------------------------------------------------------------------------- /src/edge/system.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | (ns edge.system 4 | "Components and their dependency relationships" 5 | (:require 6 | [aero.core :as aero] 7 | [clojure.java.io :as io] 8 | [com.stuartsierra.component :refer [system-map system-using]] 9 | [edge.selmer :refer [new-selmer]] 10 | [edge.web-server :refer [new-web-server]] 11 | [net.thegeez.wiki.datomic :as datomic] 12 | [net.thegeez.wiki.migrator :as migrator] 13 | [net.thegeez.wiki.migrations :as migrations] 14 | [net.thegeez.wiki.fixtures :as fixtures] 15 | [net.thegeez.wiki.fs2 :as fs2])) 16 | 17 | (defn config 18 | "Read EDN config, with the given profile. See Aero docs at 19 | https://github.com/juxt/aero for details." 20 | [profile] 21 | (aero/read-config (io/resource "config.edn") {:profile profile})) 22 | 23 | (defn configure-components 24 | "Merge configuration to its corresponding component (prior to the 25 | system starting). This is a pattern described in 26 | https://juxt.pro/blog/posts/aero.html" 27 | [system config] 28 | (merge-with merge system config)) 29 | 30 | (defn new-system-map 31 | "Create the system. See https://github.com/stuartsierra/component" 32 | [config] 33 | (apply system-map 34 | (cond-> [:web-server (new-web-server) 35 | :fs2 (fs2/new-storage-server) 36 | :selmer (new-selmer) 37 | :datomic (datomic/component) 38 | :migrator (migrator/component migrations/migrations)] 39 | (:fixtures (:datomic config)) 40 | (into [:fixtures (fixtures/component)])))) 41 | 42 | (defn new-dependency-map 43 | "Declare the dependency relationships between components. See 44 | https://github.com/stuartsierra/component" 45 | [] 46 | {}) 47 | 48 | (defn new-system 49 | "Construct a new system, configured with the given profile" 50 | [profile] 51 | (let [config (config profile)] 52 | (-> (new-system-map config) 53 | (configure-components config) 54 | (system-using (new-dependency-map))))) 55 | -------------------------------------------------------------------------------- /src/edge/web_server.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright © 2016, JUXT LTD. 2 | 3 | (ns edge.web-server 4 | (:require 5 | [bidi.bidi :refer [tag]] 6 | [bidi.vhosts :refer [make-handler vhosts-model]] 7 | [clojure.tools.logging :refer :all] 8 | [com.stuartsierra.component :refer [Lifecycle using]] 9 | [clojure.java.io :as io] 10 | [net.thegeez.wiki.wiki :as wiki] 11 | [schema.core :as s] 12 | [selmer.parser :as selmer] 13 | [yada.resources.webjar-resource :refer [new-webjar-resource]] 14 | [yada.yada :refer [resource] :as yada] 15 | [yada.handler :as handler] 16 | [clojure.walk :as walk])) 17 | 18 | (defn routes 19 | "Create the URI route structure for our application." 20 | [config] 21 | ["" 22 | [["/" (yada/redirect ::wiki/wiki-index)] 23 | 24 | (wiki/wiki-routes) 25 | 26 | ["/wiki.css" 27 | (-> (yada/as-resource (io/resource "public/wiki.css")) 28 | (assoc :id ::stylesheet))] 29 | 30 | ;; This is a backstop. Always produce a 404 if we ge there. This 31 | ;; ensures we never pass nil back to Aleph. 32 | [true (yada/handler nil)]]]) 33 | 34 | (s/defrecord WebServer [host :- s/Str 35 | port :- s/Int 36 | fs2 37 | listener 38 | datomic] 39 | Lifecycle 40 | (start [component] 41 | (if listener 42 | component ; idempotence 43 | (let [fs2-host (:url fs2) 44 | routes (routes {:port port}) 45 | routes (walk/postwalk 46 | (fn [node] 47 | (if (instance? yada.resource.Resource node) 48 | ;; used to be only prepend our interceptor, but since 0.1.46 the resource will not have any interceptors added yet at this point :( 49 | (assoc node :interceptor-chain 50 | (into [(fn [ctx] 51 | (assoc ctx 52 | :conn ((:get-conn datomic)) 53 | :fs2-host fs2-host))] 54 | yada/default-interceptor-chain)) 55 | node)) 56 | routes) 57 | vhosts-model 58 | (vhosts-model 59 | [{:scheme :http :host host} 60 | routes]) 61 | listener (yada/listener vhosts-model {:port port})] 62 | (infof "Started web-server on port %s" (:port listener)) 63 | (assoc component :listener listener)))) 64 | 65 | (stop [component] 66 | (when-let [close (get-in component [:listener :close])] 67 | (close)) 68 | (assoc component :listener nil))) 69 | 70 | (defn new-web-server [] 71 | (using 72 | (map->WebServer {}) 73 | [:fs2 :datomic :migrator])) 74 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/datomic.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.datomic 2 | (:require [clojure.tools.logging :as log] 3 | [datomic.client :as client] 4 | [clojure.core.async :as async] 5 | [com.stuartsierra.component :as component])) 6 | 7 | (defn make-conn [args-map] 8 | (let [conn (async/ args-map 27 | (assoc :cache-bust (java.util.UUID/randomUUID)) 28 | (update :attempts-left (fnil dec 5))))) 29 | conn 30 | ))))) 31 | 32 | (defrecord Datomic [args-map] 33 | component/Lifecycle 34 | (start [component] 35 | (let [args-map (assoc args-map 36 | :account-id client/PRO_ACCOUNT 37 | :region "none" 38 | :service "peer-server") 39 | _ (log/info "First connection to Datomic peer-server")] 40 | (assoc component :get-conn (fn [] 41 | (make-conn args-map))))) 42 | 43 | (stop [component] 44 | (assoc component :get-conn nil))) 45 | 46 | (defn component [] 47 | (map->Datomic {})) 48 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/diff.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.diff 2 | (:require [clojure.string :as str]) 3 | (:import (org.bitbucket.cowwoc.diffmatchpatch DiffMatchPatch 4 | DiffMatchPatch$Operation))) 5 | 6 | ;; google-diff-match-patch 7 | (defn diffs [left right] 8 | (let [left (or left "") 9 | right (or right "") 10 | dmp (DiffMatchPatch.) 11 | diffs (. dmp (diffMain left right)) 12 | _ (. dmp (diffCleanupSemantic diffs))] 13 | (for [diff diffs] 14 | [(condp = (.operation diff) 15 | DiffMatchPatch$Operation/INSERT 16 | :insert 17 | DiffMatchPatch$Operation/EQUAL 18 | :equal 19 | DiffMatchPatch$Operation/DELETE 20 | :delete) 21 | (.text diff)]))) 22 | 23 | (defn patch [left right] 24 | (let [left (or left "") 25 | right (or right "") 26 | left (str/replace left "\r\n" "\n") 27 | right (str/replace right "\r\n" "\n") 28 | dmp (DiffMatchPatch.) 29 | diffs (. dmp (diffMain left right)) 30 | _ (. dmp (diffCleanupSemantic diffs)) 31 | patch (. dmp (patchMake diffs))] 32 | (str/join "\n" patch))) 33 | 34 | (defn html-diff [left right] 35 | (let [dmp (DiffMatchPatch.) 36 | diffs (. dmp (diffMain left right)) 37 | _ (. dmp (diffCleanupSemantic diffs)) 38 | html-diffs (. dmp (diffPrettyHtml diffs))] 39 | html-diffs)) 40 | 41 | 42 | (defn diff-lines-to-chars [dmp left right] 43 | (let [m (some (fn [x] 44 | (when (.. x getName (equals "diffLinesToChars")) 45 | x)) 46 | (.. dmp getClass getDeclaredMethods))] 47 | (. m (setAccessible true)) 48 | (. m (invoke dmp (object-array [left right]))))) 49 | 50 | (defn diff-chars-to-lines [dmp diff line-array] 51 | (let [m (some (fn [x] 52 | (when (.. x getName (equals "diffCharsToLines")) 53 | x)) 54 | (.. dmp getClass getDeclaredMethods))] 55 | (. m (setAccessible true)) 56 | (. m (invoke dmp (object-array [diff line-array]))))) 57 | 58 | (defn line-diff [left right] 59 | ;; I don't know why all the reflection is required... 60 | (let [dmp (DiffMatchPatch.) 61 | l (diff-lines-to-chars dmp left right) 62 | 63 | [c1 c2 la] (for [field-name ["chars1" "chars2" "lineArray"]] 64 | (let [f (.. l getClass (getDeclaredField field-name))] 65 | (. f (setAccessible true)) 66 | (. f (get l)))) 67 | diffs (. dmp (diffMain c1 c2 false)) 68 | _ (diff-chars-to-lines dmp diffs la) 69 | _ (. dmp (diffCleanupSemantic diffs)) 70 | patch (. dmp (patchMake diffs))] 71 | patch)) 72 | 73 | (defn apply-patch [text patch-str] 74 | (let [dmp (DiffMatchPatch.) 75 | patch (. dmp (patchFromText patch-str))] 76 | (aget (. dmp (patchApply patch text)) 0))) 77 | 78 | (defn split-newlines [s] 79 | ;; return [line :newline line :newline] 80 | (cond-> (into [] 81 | (interpose :newline) 82 | (str/split-lines s)) 83 | (str/ends-with? s "\n") 84 | (conj :newline))) 85 | 86 | (defn upto-newline [xs] 87 | ;; post is everything after last newline, pre everything before 88 | (loop [xs xs 89 | post '()] 90 | (let [x (peek xs)] 91 | (if-not x 92 | [[] (vec post)] 93 | (if (= x :newline) 94 | [xs (vec post)] 95 | (recur (pop xs) 96 | (conj post x))))))) 97 | 98 | (defn diff-blocks [diffs] 99 | ;; put diffs into only inserts and equal on the left, and only deletes and equals on the right 100 | ;; prefer to end a block on a new line, this turns inserts and deletes into line diff from their char diffs 101 | (let [res (rest 102 | (reduce 103 | (fn [blocks [op txt]] 104 | (case op 105 | :equal 106 | (let [[pl pr :as prev-block] (peek blocks)] 107 | (if (= :newline (peek pl) (peek pr)) 108 | (let [lines (split-newlines txt)] 109 | (conj blocks [lines lines])) 110 | (let [[line nl & lines] (split-newlines txt) 111 | pad (cond 112 | (and line nl) [line nl] 113 | line [line] 114 | :else [])] 115 | (-> (pop blocks) 116 | (conj [(into pl pad) (into pr pad)]) 117 | (cond-> 118 | (seq lines) 119 | (conj [(vec lines) (vec lines)])))))) 120 | :insert 121 | (let [[pl pr :as prev-block] (peek blocks) 122 | lines (split-newlines txt) 123 | lines (-> [:ins-start] 124 | (into (replace {:newline :ins-newline})lines) 125 | (conj :ins-end))] 126 | (if (= :newline (peek pl) (peek pr)) 127 | (conj blocks [lines nil]) 128 | (let [[pl-pre pl-post] (upto-newline pl) 129 | [pr-pre pr-post] (upto-newline pr)] 130 | (-> (pop blocks) 131 | (cond-> 132 | (or (peek pl-pre) (peek pr-pre)) 133 | (conj [pl-pre pr-pre])) 134 | (conj [(into pl-post lines) 135 | pr-post]))))) 136 | :delete 137 | (let [[pl pr :as prev-block] (peek blocks) 138 | lines (split-newlines txt) 139 | lines (-> [:del-start] 140 | (into (replace {:newline :del-newline}) lines) 141 | (conj :del-end))] 142 | (if (= :newline (peek pl) (peek pr)) 143 | (conj blocks [nil lines]) 144 | (let [[pl-pre pl-post] (upto-newline pl) 145 | [pr-pre pr-post] (upto-newline pr)] 146 | (-> (pop blocks) 147 | (cond-> 148 | (or (peek pl-pre) (peek pr-pre)) 149 | (conj [pl-pre pr-pre])) 150 | (conj [pl-post 151 | (into pr-post lines)]))))))) 152 | [[[:newline] [:newline]]] 153 | diffs))] 154 | res)) 155 | 156 | (defn diff-trs-str [blocks] 157 | (let [to-cell (fn [cell] 158 | (when-let [cell (seq cell)] 159 | (let [sb (StringBuilder.)] 160 | (doseq [s cell] 161 | (case s 162 | :ins-start 163 | (.append sb "") 164 | :ins-end 165 | (.append sb "") 166 | :del-start 167 | (.append sb "") 168 | :del-end 169 | (.append sb "") 170 | (:newline :ins-newline :del-newline) 171 | (.append sb "¶
") 172 | (doseq [c s] 173 | (case c 174 | \< (.append sb "<") 175 | \> (.append sb ">") 176 | \" (.append sb """) 177 | \' (.append sb "'") 178 | \& (.append sb "&") 179 | (.append sb c))))) 180 | (str sb))))] 181 | (map 182 | (fn [[l r]] 183 | {:left (to-cell l) 184 | :right (to-cell r)}) 185 | blocks))) 186 | 187 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/fixtures.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.fixtures 2 | (:require [clojure.tools.logging :as log] 3 | [datomic.client :as client] 4 | [clojure.core.async :as async] 5 | [com.stuartsierra.component :as component] 6 | [aleph.http :as http] 7 | [net.thegeez.wiki.wiki :as wiki] 8 | [net.thegeez.wiki.diff :as diff])) 9 | 10 | (def fixtures [{:slug "About_this_wiki" 11 | :comment "Hello world" 12 | :text "This is a wiki build with Clojure" 13 | :diffs 14 | [{:comment "Markdown" 15 | :patch "@@ -12,13 +12,12 @@ 16 | iki 17 | -build 18 | +made 19 | wit 20 | 21 | @@ -25,8 +25,43 @@ 22 | Clojure 23 | +%0A%0AIt supports **Markdown** *markup*"} 24 | {:comment "Libraries" 25 | :patch "@@ -60,8 +60,145 @@ 26 | *markup* 27 | +%0A%0AThe wiki is made with the following libraries:%0A* %5BYada%5D(/wiki/Yada) web library%0A* %5BDatomic Client%5D(/wiki/Datomic_Client) database%0A* Tea"} 28 | {:comment "Tea is not a library" 29 | :patch "@@ -91,25 +91,20 @@ 30 | the 31 | - following librar 32 | +se technolog 33 | ies: 34 | 35 | @@ -190,10 +190,4 @@ 36 | base 37 | -%0A* Tea 38 | "} 39 | {:comment "Awesome helper libraries" 40 | :patch "@@ -186,8 +186,213 @@ 41 | database 42 | +%0A%0AWith some help from:%0A* %5BSimpleMDE%5D(https://simplemde.com/) SimpleMDE Markdown Editor%0A* %5Bgoogle-diff-patch-match%5D(https://bitbucket.org/cowwoc/google-diff-match-patch/wiki/Home) for edit diffs and patches"} 43 | {:comment "Conflict feature" 44 | :patch "@@ -391,8 +391,99 @@ 45 | patches 46 | +%0A%0AEdit conflicts lead to a conflict resolution page where the latest differences are shown. 47 | "} 48 | {:comment "History feature" 49 | :patch "@@ -482,8 +482,134 @@ 50 | e shown. 51 | +%0A%0ABrowsing through an article's %5Bhistory%5D(About_thiswiki/history) will show the differences between the versions through time. 52 | "} 53 | {:comment "Fix history url" 54 | :patch "@@ -524,16 +524,22 @@ 55 | istory%5D( 56 | +/wiki/ 57 | About_th 58 | 59 | @@ -540,16 +540,17 @@ 60 | out_this 61 | +_ 62 | wiki/his 63 | "}]} 64 | 65 | {:slug "Demo_Article" 66 | :comment "First article" 67 | :text "# Intro 68 | Go ahead, play around with the editor! Be sure to check out **bold** and *italic* styling, or even [links](https://google.com). You can type the Markdown syntax, use the toolbar, or use shortcuts like `cmd-b` or `ctrl-b`. 69 | 70 | ## Lists 71 | Unordered lists can be started using the toolbar or by typing `* `, `- `, or `+ `. Ordered lists can be started by typing `1. `. 72 | 73 | #### Unordered 74 | * Lists are a piece of cake 75 | * They even auto continue as you type 76 | * A double enter will end them 77 | * Tabs and shift-tabs work too 78 | 79 | #### Ordered 80 | 1. Numbered lists... 81 | 2. ...work too! 82 | 83 | ## What about images? 84 | ![Yes](https://i.imgur.com/sZlktY7.png)" 85 | :diffs 86 | [{:comment "Add item to list" 87 | :patch "@@ -505,16 +505,42 @@ 88 | work too 89 | +%0A* With an extra list item 90 | %0A%0A#### O"} 91 | {:comment "Cake" 92 | :patch "@@ -394,23 +394,42 @@ 93 | are 94 | -a piece of cake 95 | +easy to add, as cake one might say 96 | %0A* T"} 97 | {:comment "Insert & Delete" 98 | :patch "@@ -9,16 +9,29 @@ 99 | Go ahead 100 | + and have fun 101 | , play a 102 | 103 | @@ -412,37 +412,15 @@ 104 | asy 105 | -to add, as cake one might say 106 | +as cake 107 | %0A* T 108 | "}]} 109 | 110 | {:slug "Yada" 111 | :comment "Yada" 112 | :text "[Yada](https://github.com/juxt/yada) is a powerful Clojure web library made by [Juxt](https://juxt.pro) 113 | 114 | This wiki is based on the [Edge](https://github.com/juxt/edge) example application, also made by Juxt. 115 | 116 | Yada is currently at version 1.1.45" 117 | :diffs [{:comment "Version bump" 118 | :patch "@@ -237,8 +237,7 @@ 119 | n 1. 120 | -1.45 121 | +2.0 122 | "}]} 123 | {:slug "Datomic_Client" 124 | :comment "Datomic Client" 125 | :text "[Datomic](http://www.datomic.com/) supports: 126 | * Clojure API 127 | * Java API 128 | * REST API" 129 | :diffs 130 | [{:comment "Add Client API" 131 | :patch "@@ -69,12 +69,109 @@ 132 | I%0A* REST API 133 | +%0A* %5BClojure Client API%5D(http://blog.datomic.com/2016/11/datomic-update-client-api-unlimited.html) 134 | "}]}]) 135 | 136 | (defn load-fixtures [ctx] 137 | (doseq [f fixtures] 138 | (let [{:keys [slug comment text]} f 139 | title (wiki/slug->title slug) 140 | rev (wiki/next-rev-str slug)] 141 | (when @(wiki/create-article ctx slug title comment rev) 142 | @(wiki/upload-revision ctx rev text) 143 | (reduce 144 | (fn [[text rev] {:keys [comment patch]}] 145 | (let [next-rev (wiki/next-rev-str slug) 146 | text (diff/apply-patch text patch)] 147 | @(wiki/upload-revision ctx next-rev text) 148 | @(wiki/update-article ctx slug comment rev next-rev) 149 | [text next-rev])) 150 | [text rev] 151 | (:diffs f)))))) 152 | 153 | (defrecord Fixtures [datomic 154 | fs2] 155 | component/Lifecycle 156 | (start [component] 157 | (let [ctx {:fs2-host (:url fs2) 158 | :conn ((:get-conn datomic))}] 159 | (load-fixtures ctx) 160 | component)) 161 | 162 | (stop [component] 163 | component)) 164 | 165 | (defn component [] 166 | (component/using 167 | (map->Fixtures {}) 168 | [:datomic :fs2 :migrator])) 169 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/fs2.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.fs2 2 | (:require 3 | [bidi.vhosts :refer [make-handler vhosts-model]] 4 | [clojure.tools.logging :refer :all] 5 | [com.stuartsierra.component :as component] 6 | [yada.yada :as yada] 7 | [yada.consume :as consume] 8 | [clojure.java.io :as io])) 9 | 10 | (defn routes [private-path] 11 | ["/" 12 | ;; doesn't work without upload prefix :/ 13 | [[["upload/" :file-name] 14 | (yada/resource 15 | {:parameters {:path {:file-name String}} 16 | :methods 17 | {:post 18 | {:consumes "application/octet-stream" 19 | :consumer (fn [ctx _ body-stream] 20 | (let [file-name (get-in ctx [:parameters :path :file-name]) 21 | f (io/file private-path file-name)] 22 | (infof "Saving to file: %s" f) 23 | (consume/save-to-file 24 | ctx body-stream 25 | f))) 26 | :response (fn [ctx] 27 | (let [file-name (get-in ctx [:parameters :path :file-name]) 28 | uri (str file-name)] 29 | (java.net.URI. uri)) 30 | )}}})] 31 | ["" (-> (yada/as-resource (io/file private-path)) 32 | (assoc :id ::files))] 33 | 34 | ["" (yada/handler nil)]]]) 35 | 36 | (defrecord FlimsyStorageServer [host 37 | port 38 | private-path 39 | listener] 40 | component/Lifecycle 41 | (start [component] 42 | (let [_ (when (not (.exists (io/file private-path))) 43 | (throw (ex-info "Storage directory for fs2 does not exist" 44 | {:path private-path}))) 45 | routes (routes private-path) 46 | vhosts-model 47 | (vhosts-model 48 | [{:scheme :http :host (str host ":" port)} 49 | routes]) 50 | listener (yada/listener vhosts-model {:port port})] 51 | (infof "Started flimsy storage server on port %s" (:port listener)) 52 | (assoc component 53 | :listener listener 54 | :url (str "http://" host ":" port)))) 55 | 56 | (stop [component] 57 | (when-let [close (get-in component [:listener :close])] 58 | (close)) 59 | (assoc component :listener nil :host nil))) 60 | 61 | (defn new-storage-server [] 62 | (map->FlimsyStorageServer {})) 63 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/migrations.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.migrations) 2 | 3 | (def migrations 4 | [:wiki/schema-migrations 5 | [1 [{:db/ident :article/slug 6 | :db/valueType :db.type/string 7 | :db/unique :db.unique/value 8 | :db/cardinality :db.cardinality/one} 9 | {:db/ident :article/title 10 | :db/valueType :db.type/string 11 | :db/cardinality :db.cardinality/one}]] 12 | [2 [{:db/ident :article/rev 13 | :db/valueType :db.type/string 14 | :db/cardinality :db.cardinality/one}]]]) 15 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/migrator.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.migrator 2 | (:require [clojure.tools.logging :as log] 3 | [datomic.client :as client] 4 | [clojure.core.async :as async] 5 | [com.stuartsierra.component :as component] 6 | [clojure.spec :as s])) 7 | 8 | (defn increasing-versions? [v+m] 9 | (->> v+m 10 | :versions 11 | (map :version) 12 | (apply <))) 13 | 14 | (s/def ::schema-attr-map map?) 15 | (s/def ::version+maps 16 | (s/spec (s/cat :version long 17 | :changes (s/spec (s/+ ::schema-attr-map))))) 18 | (s/def ::attribute-for-version qualified-keyword?) 19 | (s/def ::migrations 20 | (s/& (s/cat :ident ::attribute-for-version 21 | :versions (s/* ::version+maps)) 22 | increasing-versions?)) 23 | 24 | (def version-attr-tx [{:db/ident :wiki.migrations/ident 25 | :db/valueType :db.type/keyword 26 | :db/unique :db.unique/identity 27 | :db/cardinality :db.cardinality/one} 28 | {:db/ident :wiki.migrations/version 29 | :db/valueType :db.type/long 30 | :db/cardinality :db.cardinality/one}]) 31 | 32 | (defrecord Migrator [datomic migrations] 33 | component/Lifecycle 34 | (start [component] 35 | (let [migrations (s/conform ::migrations migrations) 36 | _ (when (= migrations ::s/invalid) 37 | (throw (ex-info "migration definition fails spec" 38 | {:data (s/explain-data ::migrations migrations) 39 | :value migrations}))) 40 | migration-ident (:ident migrations) 41 | conn ((:get-conn datomic)) 42 | db (client/db conn) 43 | version-attr (async/Migrator {:migrations migrations}) 79 | [:datomic])) 80 | -------------------------------------------------------------------------------- /src/net/thegeez/wiki/wiki.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.wiki.wiki 2 | (:require 3 | [bidi.bidi :as bidi] 4 | [clojure.tools.logging :refer :all] 5 | [clojure.string :as str] 6 | [selmer.parser :as selmer] 7 | [schema.core :as s] 8 | [yada.yada :as yada] 9 | [net.thegeez.wiki.diff :as diff] 10 | [markdown.core :as md] 11 | [markdown.transformers :as mdt] 12 | [datomic.client :as client] 13 | [clojure.core.async :as async] 14 | [manifold.deferred :as d] 15 | [manifold.stream :as stream] 16 | [aleph.http :as http] 17 | [byte-streams :as bs])) 18 | 19 | (defn slug->title [slug] 20 | (str/replace slug "_" " ")) 21 | 22 | (defn next-rev-str [slug] 23 | (str slug "_" (.getTime (java.util.Date.)) "_" (java.util.UUID/randomUUID))) 24 | 25 | (defn with-article-links [ctx attr-map] 26 | (assoc attr-map 27 | :article/title (slug->title (:article/slug attr-map)) 28 | :wiki/links 29 | {:article/show (yada/url-for ctx ::article 30 | {:route-params 31 | {:slug (:article/slug attr-map)}}) 32 | :article/edit (yada/url-for ctx ::article-edit 33 | {:route-params 34 | {:slug (:article/slug attr-map)}}) 35 | :article/history (yada/url-for ctx ::article-history 36 | {:route-params 37 | {:slug (:article/slug attr-map)}})})) 38 | 39 | (defn async->manifold [c] 40 | ;; core async into manifold 41 | (let [d (d/deferred)] 42 | (async/take! c 43 | (fn [item] 44 | (d/success! d item))) 45 | d)) 46 | 47 | (defn async-log-remove-error [c] 48 | (async/pipe c 49 | (async/chan 1 50 | (halt-when 51 | (fn [i] 52 | (when (client/error? i) 53 | (info "Error in datomic result: " i) 54 | true)))))) 55 | 56 | (defn md-escape-html [text state] 57 | ;; https://github.com/yogthos/markdown-clj/issues/36 58 | [(clojure.string/escape text 59 | {\& "&" 60 | \< "<" 61 | \> ">" 62 | \" """ 63 | \' "'"}) 64 | state]) 65 | 66 | (defn md->html [md-str] 67 | (md/md-to-html-string md-str 68 | :replacement-transformers 69 | (cons md-escape-html mdt/transformer-vector))) 70 | 71 | (defn get-articles [ctx] 72 | (d/chain 73 | (let [conn (:conn ctx) 74 | db (client/db conn)] 75 | (-> (client/q conn {:query 76 | '{:find [(pull ?e [:*])] 77 | :where [[?e :article/slug]]} 78 | :limit -1 79 | :args [db]}) 80 | async-log-remove-error 81 | (async/pipe (async/chan 1 (comp 82 | cat ;; q results are "paged"/chuncked 83 | (map first) ;; unwrap datomic result tuples from [{..pull map..}] 84 | ))) 85 | (->> (async/into [])) 86 | async->manifold)) 87 | (fn [articles] 88 | (map 89 | (partial with-article-links ctx) 90 | articles)))) 91 | 92 | (defn get-article-by-slug [ctx slug] 93 | (d/chain 94 | (let [conn (:conn ctx) 95 | db (client/db conn)] 96 | (-> (client/q conn {:query 97 | '{:find [(pull ?e [:*])] 98 | :in [$ ?slug] 99 | :where [[?e :article/slug ?slug]]} 100 | :args [db slug]}) 101 | async-log-remove-error 102 | (async/pipe (async/chan 1 (comp 103 | cat ;; q results are "paged"/chuncked 104 | (map first) ;; unwrap datomic result tuples from [{..pull map..} rev] 105 | ))) 106 | async->manifold)) 107 | (fn [article] 108 | (when article 109 | (with-article-links ctx article))))) 110 | 111 | (defn get-article-history [ctx slug] 112 | (d/chain 113 | (let [conn (:conn ctx) 114 | db (client/db conn) 115 | db-hist (client/history db)] 116 | (-> (client/q conn 117 | {:query 118 | '{:find [?tx 119 | ?rev 120 | ?tx-instant 121 | ?tx-doc] 122 | :in [$ $hist ?slug] 123 | :where [[$ ?e :article/slug ?slug] 124 | [$hist ?e :article/rev ?rev ?tx true] 125 | [$ ?tx :db/txInstant ?tx-instant] 126 | [$ ?tx :db/doc ?tx-doc]]} 127 | :limit -1 128 | :args [db db-hist slug]}) 129 | async-log-remove-error 130 | (async/pipe (async/chan 1 131 | (comp 132 | cat ;; q results are "paged"/chuncked 133 | (map (fn [[tx rev tx-instant tx-doc txep]] 134 | {:tx tx 135 | :rev rev 136 | :tx-instant tx-instant 137 | :comment tx-doc 138 | :link (yada/url-for ctx 139 | ::article-rev 140 | {:route-params 141 | {:slug slug 142 | :rev rev}})}))))) 143 | (->> (async/into [])) 144 | async->manifold)) 145 | (fn [history] 146 | (when (seq history) 147 | (sort-by :tx > history))))) 148 | 149 | (defn get-article-revision [ctx rev] 150 | (let [conn (:conn ctx) 151 | db (client/db conn) 152 | db-hist (client/history db)] 153 | (-> (client/q conn {:query 154 | '{:find [?rev ?comment] 155 | :in [$hist ?rev] 156 | :where [[$hist ?e :article/rev ?rev ?tx-rev true] 157 | [$hist ?tx-rev :db/doc ?comment ?tx-rev true]]} 158 | :args [db-hist rev]}) 159 | async-log-remove-error 160 | (async/pipe (async/chan 1 (map 161 | (comp 162 | (fn [[rev comment]] 163 | {:rev rev 164 | :comment comment}) 165 | first)))) 166 | async->manifold))) 167 | 168 | (defn get-article-revision-relative [ctx rev query] 169 | (let [conn (:conn ctx) 170 | db (client/db conn) 171 | db-hist (client/history db)] 172 | (-> (client/q conn {:query query 173 | :args [db-hist rev]}) 174 | async-log-remove-error 175 | (async/pipe (async/chan 1 (comp 176 | (map first) 177 | (halt-when nil?) 178 | (map 179 | (fn [[tx-rel rev-rel doc-rel :as res]] 180 | (when res 181 | {:tx tx-rel 182 | :rev rev-rel 183 | :comment doc-rel})))))) 184 | async->manifold))) 185 | 186 | (defn get-article-revision-before [ctx rev] 187 | (get-article-revision-relative 188 | ctx rev 189 | '{:find [?tx-rel ?rev-rel ?doc-rel] 190 | :in [$hist ?rev] 191 | :where [[$hist ?e :article/rev ?rev ?tx-rev true] 192 | [$hist ?e :article/rev ?rev-rel ?tx-rev false] 193 | [$hist ?e :article/rev ?rev-rel ?tx-rel true] 194 | [(< ?tx-rel ?tx-rev)] 195 | [$hist ?tx-rel :db/doc ?doc-rel ?tx-rel true]]})) 196 | 197 | (defn get-article-revision-after [ctx rev] 198 | (get-article-revision-relative 199 | ctx rev 200 | '{:find [?tx-rel ?rev-rel ?doc-rel] 201 | :in [$hist ?rev] 202 | :where [[$hist ?e :article/rev ?rev ?tx-rev true] 203 | [$hist ?e :article/rev ?rev ?tx-rel false] 204 | [$hist ?e :article/rev ?rev-rel ?tx-rel true] 205 | [(< ?tx-rev ?tx-rel)] 206 | [$hist ?tx-rel :db/doc ?doc-rel ?tx-rel true]]} 207 | )) 208 | 209 | (defn update-article [ctx slug comment base-rev next-rev] 210 | (let [conn (:conn ctx) 211 | db (client/db conn)] 212 | (-> (client/transact conn 213 | {:tx-data [[:db.fn/cas [:article/slug slug] :article/rev base-rev next-rev] 214 | [:db/add "datomic.tx" :db/doc comment]]}) 215 | 216 | async-log-remove-error 217 | async->manifold 218 | ))) 219 | 220 | (defn create-article [ctx slug title comment next-rev] 221 | (let [conn (:conn ctx) 222 | db (client/db conn)] 223 | (-> (client/transact conn 224 | {:tx-data [{:db/id "tempid" 225 | :article/slug slug 226 | :article/title title 227 | :article/rev next-rev} 228 | [:db/add "datomic.tx" :db/doc comment]]}) 229 | async-log-remove-error 230 | async->manifold 231 | ))) 232 | 233 | (defn upload-revision [ctx rev text] 234 | (let [upload-blob-uri (java.net.URI. (str (:fs2-host ctx) "/upload/" rev))] 235 | (-> (http/post (str upload-blob-uri) 236 | {:headers {"Content-Type" "application/octet-stream"} 237 | :body text}) 238 | (d/catch (fn [x] 239 | (info "Upload error" x) 240 | x))))) 241 | 242 | 243 | (defn body-for-article [ctx article] 244 | (-> (d/chain (let [url (str (:fs2-host ctx) "/" (:article/rev article))] 245 | (http/get url 246 | {:headers {"Accept" "*/*"}})) 247 | (fn [resp] 248 | (when (= (:status resp) 200) 249 | (let [body (-> resp 250 | :body 251 | bs/to-string)] 252 | (assoc article :article/body body))))) 253 | (d/catch (fn [err] 254 | article)))) 255 | 256 | (defn redirect [ctx url] 257 | (assoc (:response ctx) 258 | :status 303 259 | :headers {"location" url})) 260 | 261 | (def index 262 | (yada/resource 263 | {:id ::wiki-index 264 | :properties (fn [ctx] 265 | (d/chain (get-articles ctx) 266 | (fn [articles] 267 | {:exists? true 268 | ::articles articles}))) 269 | :methods 270 | {:get 271 | {:produces 272 | {:media-type "text/html"} 273 | :response 274 | (fn [ctx] 275 | (let [articles (-> ctx :properties ::articles)] 276 | (selmer/render-file 277 | "wiki/index.html" 278 | {:index (yada/url-for ctx ::wiki-index) 279 | :articles articles})))}}})) 280 | 281 | (def article 282 | (yada/resource 283 | {:id ::article 284 | :produces "text/html" 285 | :parameters {:path {:slug String}} 286 | :properties (fn [ctx] 287 | (let [slug (get-in ctx [:parameters :path :slug])] 288 | (d/chain (get-article-by-slug ctx slug) 289 | (fn [article] 290 | (when article 291 | (body-for-article ctx article))) 292 | (fn [article] 293 | {:exists? true 294 | ::slug slug 295 | ::article article})))) 296 | :methods 297 | {:get {:response 298 | (fn [ctx] 299 | (if-let [article (get-in ctx [:properties ::article])] 300 | (selmer/render-file 301 | "wiki/show.html" 302 | {:index (yada/url-for ctx ::wiki-index) 303 | :title (:article/title article) 304 | :article (assoc article :article/md-body 305 | (md->html (:article/body article)))}) 306 | ;; article not found 307 | (redirect ctx (yada/url-for ctx ::article-edit 308 | {:route-params 309 | {:slug (get-in ctx [:properties ::slug])}}))))} 310 | :post {:parameters {:form {:text String 311 | :comment String 312 | (s/optional-key :rev) String}} 313 | :consumes #{"application/x-www-form-urlencoded"} 314 | :response (fn [ctx] 315 | (let [slug (get-in ctx [:parameters :path :slug]) 316 | comment (get-in ctx [:parameters :form :comment] "") 317 | next-text (-> (get-in ctx [:parameters :form :text] "") 318 | (str/replace "\r\n" "\n")) 319 | base-rev (get-in ctx [:parameters :form :rev])] 320 | (if (not (and slug next-text)) 321 | (throw (ex-info "" {:status 400 322 | :error (str next-text)})) 323 | (let [next-rev (next-rev-str slug)] 324 | (d/let-flow [upload (upload-revision ctx next-rev next-text) 325 | success? (if-not base-rev 326 | (let [title (slug->title slug)] 327 | (create-article ctx slug title comment next-rev)) 328 | (update-article ctx slug comment base-rev next-rev))] 329 | (if success? 330 | (redirect ctx 331 | (java.net.URI. ;; redirect 332 | (yada/url-for ctx ::article-rev 333 | {:route-params {:slug slug 334 | :rev next-rev}}))) 335 | 336 | ;; resolve conflict screen 337 | (d/let-flow [article (d/chain (get-article-by-slug ctx slug) 338 | (fn [article] 339 | (body-for-article ctx article)))] 340 | (selmer/render-file 341 | "wiki/conflict.html" 342 | {:index (yada/url-for ctx ::wiki-index) 343 | :title (:article/title article) 344 | :article article 345 | :comment comment 346 | :next-text next-text 347 | :diff-trs (let [diffs (diff/diffs (:article/body article) 348 | next-text)] 349 | (-> diffs 350 | diff/diff-blocks 351 | diff/diff-trs-str))}))))))) 352 | )}} 353 | :responses {400 {:produces #{"text/html"} 354 | :response (fn [ctx] 355 | (str "Something is wrong, here is the text you submitted: \n" (:error (ex-data (:error ctx)))))} 356 | }})) 357 | 358 | (def edit 359 | (yada/resource 360 | {:id ::article-edit 361 | :parameters {:path {:slug String}} 362 | :produces "text/html" 363 | :properties (fn [ctx] 364 | (let [slug (get-in ctx [:parameters :path :slug])] 365 | (d/chain (get-article-by-slug ctx slug) 366 | (fn [article] 367 | (when article 368 | (body-for-article ctx article))) 369 | (fn [article] 370 | {:exists? true 371 | ::slug slug 372 | ::article article})))) 373 | :methods 374 | {:get {:response 375 | (fn [ctx] 376 | (let [article (::article (:properties ctx))] 377 | (if article 378 | ;; edit existing 379 | (selmer/render-file 380 | "wiki/edit.html" 381 | {:index (yada/url-for ctx ::wiki-index) 382 | :title (:article/title article) 383 | :article article}) 384 | 385 | ;; creating new article 386 | (let [slug (get-in ctx [:properties ::slug]) 387 | title (slug->title slug)] 388 | (selmer/render-file 389 | "wiki/create.html" 390 | {:index (yada/url-for ctx ::wiki-index) 391 | :title title 392 | :action (yada/url-for ctx ::article 393 | {:route-params 394 | {:slug slug}})})) 395 | )))}}})) 396 | 397 | (def history 398 | (yada/resource 399 | {:id ::article-history 400 | :parameters {:path {:slug String}} 401 | :properties (fn [ctx] 402 | (let [slug (get-in ctx [:parameters :path :slug])] 403 | (d/let-flow [article (get-article-by-slug ctx slug) 404 | history (get-article-history ctx slug)] 405 | (if (and article history) 406 | {:exists? true 407 | ::article article 408 | ::history history} 409 | {:exists? false})))) 410 | :methods 411 | {:get {:produces "text/html" 412 | :response (fn [ctx] 413 | (let [article (::article (:properties ctx)) 414 | history (::history (:properties ctx))] 415 | (selmer/render-file 416 | "wiki/history.html" 417 | {:index (yada/url-for ctx ::wiki-index) 418 | :title (str (:article/title article) " history") 419 | :article article 420 | :history history})))}}})) 421 | 422 | (def revision 423 | (yada/resource 424 | {:id ::article-rev 425 | :parameters {:path {:slug String 426 | :rev String}} 427 | :produces #{"text/html" "diff/patch"} 428 | :properties (fn [ctx] 429 | (let [slug (get-in ctx [:parameters :path :slug]) 430 | revision (get-in ctx [:parameters :path :rev])] 431 | (d/let-flow [article (get-article-by-slug ctx slug) 432 | rev (get-article-revision ctx revision) 433 | prev (get-article-revision-before ctx revision) 434 | nrev (get-article-revision-after ctx revision) 435 | rev-body (body-for-article ctx {:article/rev (:rev rev)}) 436 | prev-body (when prev 437 | (body-for-article ctx {:article/rev (:rev prev)}))] 438 | (if (and article 439 | (:rev rev)) 440 | (cond-> 441 | {:exists? true 442 | ::slug slug 443 | ::article article 444 | ::rev-body rev-body 445 | ::comment (:comment rev)} 446 | (:rev prev) 447 | (assoc ::prev 448 | (yada/url-for ctx ::article-rev 449 | {:route-params 450 | {:slug slug 451 | :rev (:rev prev)}})) 452 | (:rev nrev) 453 | (assoc ::nrev 454 | (yada/url-for ctx ::article-rev 455 | {:route-params 456 | {:slug slug 457 | :rev (:rev nrev)}})) 458 | prev-body 459 | (assoc ::diff (diff/diffs (:article/body prev-body) 460 | (:article/body rev-body))) 461 | (= (get-in ctx [:request :headers "accept"]) "diff/patch") 462 | (assoc ::patch (diff/patch (:article/body prev-body) 463 | (:article/body rev-body)))) 464 | {:exists? false})))) 465 | :methods 466 | {:get {:response 467 | (fn [ctx] 468 | (let [slug (::slug (:properties ctx)) 469 | article (::article (:properties ctx))] 470 | (if-let [patch (-> ctx :properties ::patch)] 471 | patch 472 | (selmer/render-file 473 | "wiki/revision.html" 474 | {:index (yada/url-for ctx ::wiki-index) 475 | :article (assoc article :article/md-body 476 | (md->html (:article/body article))) 477 | :nav (let [props (:properties ctx)] 478 | {:prev (::prev props) 479 | :nrev (::nrev props)}) 480 | :rev-body (md->html (-> ctx :properties ::rev-body :article/body)) 481 | :comment (-> ctx :properties ::comment) 482 | :diff-trs (when-let [diffs (-> ctx :properties ::diff)] 483 | (-> diffs 484 | diff/diff-blocks 485 | diff/diff-trs-str))}))))}}})) 486 | 487 | (defn wiki-routes [] 488 | ["/wiki" 489 | [["" index] 490 | [["/" :slug] article] 491 | [["/" :slug "/edit"] edit] 492 | [["/" :slug "/history"] history] 493 | [["/" :slug "/rev/" :rev] revision]]]) 494 | 495 | --------------------------------------------------------------------------------