impl zd/rename, fix layout, impl backlinks sorting

src/zd/api.clj

@@ -79,28 +79,34 @@
   ;; TODO emit zen event
   (println :zd.api/save-doc id)
   (let [lines (slurp (:body req))
-        content (->> lines
+        lineseq (->> lines
                      (StringReader.)
                      (io/reader)
-                     (line-seq)
+                     (line-seq))
+        content (->> lineseq
                      (remove #(str/starts-with? % ":zd/docname"))
+                     (remove #(str/starts-with? % ":zd/rename"))
                      (str/join "\n"))
         doc (->> (reader/parse ztx {:req req} lines)
                  (meta/append-meta ztx)
                  (meta/validate-doc ztx))
+        ;; TODO check if coerce is needed
         docname (str (:zd/docname doc))]
     (if-let [errs (seq (get-in doc [:zd/meta :errors]))]
       {:status 422 :body {:message "document validation failed"
                           :docname docname
                           :root r
                           :errors errs}}
-      (do (zen/pub ztx 'zd.events/on-doc-save {:docname docname :content content :root r})
-          {:status 200 :body (str "/" docname)}))))
+      (do (zen/pub ztx 'zd.events/on-doc-save {:docname docname
+                                               :rename-to (:zd/rename doc)
+                                               :content content
+                                               :root r})
+          {:status 200 :body (str "/" (or (:zd/rename doc) docname))}))))
 
 (defmethod zen/op 'zd/delete-doc
-  [ztx _cfg {{:keys [id]} :route-params r :zd/root :as req} & opts]
-  (println :delete id)
-  (let [parts (str/split id #"\.")
+  [ztx _cfg {{:keys [id]} :route-params :as req} & opts]
+  (let [{r :root} (zendoc-config ztx)
+        parts (str/split id #"\.")
         redirect
         (if-let [parent (seq (butlast parts))]
           (str "/" (str/join "." parent))

src/zd/blocks/timeline.clj

@@ -73,6 +73,7 @@
   [ztx {ps :paths :as ctx} block]
   (let [gh-idx (gh-index ztx)]
     [:div
+     ;; TODO show file deletion separately
      (for [[date ls] (->> (get-history)
                           (sort-by first)
                           (reverse))]

src/zd/blocks/zd.clj

@@ -30,7 +30,8 @@
 (defmethod methods/renderkey :zd/index
   [ztx ctx block]
   (let [docs (->> '{:find [?docname]
-                    :where [[?e :meta/docname ?docname]]
+                    :where [[?e :meta/docname ?docname]
+                            [?e :title ?title]]
                     :order-by [[?docname :asc]]}
                   (d/query ztx)
                   (map (fn [v] {:s (first v)
@@ -41,7 +42,7 @@
                          (concat h t))))]
     [:div {:class (c :flex :flex-wrap [:w "100%"])}
      (for [gr docs]
-       [:div {:class (c [:py 2] :text-sm :flex-col :flex)}
+       [:div {:class (c [:py 2] [:pr 10] :text-sm :flex-col :flex)}
         (for [{:keys [s ps]} gr]
           [:div (conj (indent-item ps)
                       (link/symbol-link ztx s))])])]))
@@ -55,6 +56,15 @@
    [:div {:class (c [:px 2] [:py 0.5] :inline-block :text-sm)}
     data]])
 
+(defmethod methods/renderkey :zd/rename
+  [ztx ctx {data :data :as block}]
+  [:div {:class (str "badge " (name (c :border [:my 1] [:mr 2]  :inline-flex :rounded [:p 0])))}
+   [:div {:class (c :inline-block [:px 2] [:bg :gray-100] [:py 0.5] :text-sm [:text :gray-700]
+                    {:font-weight "400" :padding-top ".3rem"})}
+    [:i.fas.fa-arrow-right]]
+   [:div {:class (c [:px 2] [:py 0.5] :inline-block :text-sm)}
+    data]])
+
 (defmethod methods/renderkey :zd/backlinks
   [ztx {{{dn :docname} :zd/meta} :doc {qs :query-string} :request r :root :as ctx} {:keys [data] :as block}]
   (let [summary-keys (meta/get-group ztx :zd/summary)
@@ -70,7 +80,11 @@
                                 (str/join ".")
                                 (str ":"))}))
              (sort-by (juxt :parent :path :doc))
-             (group-by :parent))]
+             (group-by :parent)
+             (map (fn [[p links]]
+                    [p (sort-by (fn [{d :doc}]
+                                  (:title (memstore/get-doc ztx d)))
+                                links)])))]
     (for [[parent links] links]
       (let [*parent (or parent r)]
         [:div {:class (c [:py 4] #_[:text :gray-600])}
@@ -79,7 +93,7 @@
            [:span {:class (c :text-sm)}
             [:i.fas.fa-regular.fa-link]]
            [:a {:id (str "backlinks-" *parent) :class (c :uppercase {:font-weight "600"})}
-            *parent]
+            (str *parent ".*")]
            [:span {:class (c [:pl 2] :text-sm [:text :gray-500])}
             (str/join ", " (set (map :path links)))]]
           [:a {:class (c :block [:p 1] :text-lg :cursor-pointer [:hover [:text :green-600]])

src/zd/datalog.clj

@@ -28,6 +28,7 @@
         (merge meta)
         (assoc :xt/id (str (:docname m))))))
 
+;; TODO rename to zd.datalog
 (defmethod zen/op 'zd/query
   [ztx config params & [session]]
   (query ztx params))

src/zd/fs.clj

@@ -1,11 +1,12 @@
 (ns zd.fs
   (:require
-   [clojure.core.async :refer [<! timeout]]
+   [zd.datalog :as d]
    [zd.meta :as meta]
    [zd.memstore :as memstore]
    [clojure.string :as str]
    [zd.gitsync :as gitsync]
    [zd.utils :as utils :refer [safecall]]
+   [zd.fs.utils :as futils]
    [clojure.java.io :as io]
    [zen.core :as zen]))
 
@@ -55,6 +56,17 @@
   ;; TODO think about return value
   'ok)
 
+(defn fs-delete [ztx {:keys [filepath docname]}]
+  (let [{r :root pths :paths} (get-state ztx)
+        fs-delete*
+        (fn [ag]
+          (io/delete-file filepath)
+          (when-let [repo (get-gistate ztx)]
+            (gitsync/delete-doc ztx repo {:docpath filepath :docname docname}))
+          ;; TODO impl delta delete
+          (reload ztx r pths))]
+    (utils/safecall ztx fs-delete* {:type 'zd.fs/delete-doc-error})))
+
 (defmethod zen/op 'zd.events/fs-delete
   [ztx config {_ev :ev {docname :docname} :params} & [_session]]
   (println :zd.fs/delete docname)
@@ -64,53 +76,64 @@
         (str (first pths)
              "/"
              (str/join "/" parts)
-             ".zd")
-        fs-delete (utils/safecall ztx
-                                  (fn [ag]
-                                    (io/delete-file filepath)
-                                    (when-let [repo (get-gistate ztx)]
-                                      (gitsync/delete-doc ztx repo {:docpath filepath :docname docname}))
-                                    ;; TODO implement deletion of a single document
-                                    (reload ztx r pths))
-                                  {:type 'zd.fs/delete-doc-error})]
-    (send-off queue fs-delete)
+             ".zd")]
+    (send-off queue (fs-delete ztx {:filepath filepath :docname docname}))
+    ;; TODO remove await
     (await queue)))
 
+(defn fs-save [ztx {dn :docname cnt :content :keys [rename-to]} {:keys [resource-path dirname filepath prev-filepath]}]
+  (let [{r :root pths :paths :as st} (get-state ztx)
+        fs-save*
+        (fn [ag]
+          (.mkdirs (io/file dirname))
+          (spit filepath cnt)
+          ;; when rename delete old doc
+          (when (symbol? rename-to)
+            ((fs-delete ztx {:filepath prev-filepath :docname dn}) ag)
+            (d/evict ztx (str dn))
+            ;; TODO when awaits are gone
+            #_(zen/pub ztx 'zd.events/on-doc-delete {:docname dn :root r}))
+          ;; when schema edit initiate full reload
+          (if (str/includes? filepath "_schema")
+            (reload ztx r pths)
+            (do (memstore/load-document! ztx {:path filepath
+                                              :root r
+                                              :resource-path resource-path
+                                              :content cnt})
+                (memstore/load-links! ztx)))
+          'ok)]
+    (utils/safecall ztx fs-save* {:type :zd.fs/save-error})))
+
+(defn fs-commit [ztx {:keys [docname]} {:keys [filepath]}]
+  (let [fs-commit* (fn [ag]
+                     (when-let [repo (get-gistate ztx)]
+                       (gitsync/commit-doc ztx repo {:docpath filepath :docname docname}))
+                     (memstore/eval-macros! ztx)
+                     'ok)]
+    (utils/safecall ztx fs-commit* {:type :zd.fs/reload-error})))
+
 (defmethod zen/op 'zd.events/fs-save
-  [ztx config {_ev :ev {docname :docname cnt :content} :params} & [_session]]
-  ;; TODO emit zen event
-  (println :zd.fs/save docname)
-  (let [{r :root pths :paths} (get-state ztx)
-        dirname
-        (->> (str/split docname #"\.")
-             butlast
-             (str/join "/")
-             (str (first pths) "/"))
-        docpath (str (str/replace docname "." "/") ".zd")
-        filepath (str (first pths) "/" docpath)
-        fs-save (utils/safecall ztx
-                                (fn [ag]
-                                  (.mkdirs (io/file dirname))
-                                  (spit filepath cnt)
-                                  (if (str/includes? docname "_schema")
-                                    (reload ztx r pths)
-                                    (memstore/load-document! ztx {:path filepath
-                                                                  :root r
-                                                                  :resource-path docpath
-                                                                  :content cnt}))
-                                  (memstore/load-links! ztx)
-                                  'ok)
-                                {:type :zd.fs/save-error})
-        fs-reload (utils/safecall ztx
-                                  (fn [ag]
-                                    (when-let [repo (get-gistate ztx)]
-                                      (gitsync/commit-doc ztx repo {:docpath filepath :docname docname}))
-                                    (memstore/eval-macros! ztx)
-                                    'ok)
-                                  {:type :zd.fs/reload-error})]
-    (send-off queue fs-save)
+  [ztx config {_ev :ev {dn :docname rename :rename-to :as ev} :params} & [_session]]
+  (zen/pub ztx 'zd.events/fs-save {:docname dn :rename rename})
+  (let [{pths :paths :as st} (get-state ztx)
+        docname (if (symbol? rename)
+                  (str rename)
+                  (str dn))
+        ;; TODO scan multiple file paths
+        arg
+        {:filepath (str (first pths) "/" (futils/docpath docname))
+         :dirname (->> (str/split docname #"\.")
+                       butlast
+                       (str/join "/")
+                       (str (first pths) "/"))
+         ;; TODO check if resource path is needed
+         :resource-path (futils/docpath docname)
+         :prev-filepath (when (symbol? rename)
+                          (str (first pths) "/" (futils/docpath dn)))}]
+    (send-off queue (fs-save ztx ev arg))
+    ;; TODO remove await
     (await queue)
-    (send-off queue fs-reload)))
+    (send-off queue (fs-commit ztx ev arg))))
 
 (defmethod zen/start 'zd.engines/fs
   [ztx {zd-config :zendoc :as config} & args]

src/zd/fs/utils.clj

@@ -0,0 +1,5 @@
+(ns zd.fs.utils
+  (:require [clojure.string :as str]))
+
+(defn docpath [docname]
+  (str (str/replace (str docname) "." "/") ".zd"))

src/zd/gitsync.clj

@@ -11,7 +11,7 @@
       (doseq [m (into untracked modified)]
         (when (str/includes? p m)
           (let [uname (or (.getString git-config "user" nil "name") "unknown editor")
-                email (or (.getString git-config "user" nil "email") "unknown-editor@example.com")]
+                email (or (.getString git-config "user" nil "email") "unknown-editor@zendoc.me")]
             (git/git-add repo m)
             (let [msg (if (contains? untracked m)
                         (str "Create " d)

src/zd/render.clj

@@ -145,7 +145,7 @@
                      (distinct))
         root (c :flex :flex-col :text-sm [:p 6] [:bg "white"] [:w-max "16rem"])
         col  (c :flex :flex-col [:py 2])
-        head (c :uppercase [:py 1])
+        head (c :uppercase [:pb 3])
         item (c [:py 0.6])]
     [:div {:class root}
      (when (seq dockeys)

test/zd/api_test.clj

@@ -1,17 +1,22 @@
 (ns zd.api-test
   (:require
+   [xtdb.api :as xtdb]
    [clojure.string :as str]
+   [zd.datalog :as d]
+   [zd.fs :as fs]
+   [zd.memstore :as memstore]
    [zd.api]
    [matcho.core :as matcho]
    [clojure.test :refer [deftest is testing]]
    [zd.test-utils :as tutils]
    [zen.core :as zen]
    [zen-web.core :as web]))
 
+;; TODO impl memstore -> str test util
+
 (defonce ztx (zen/new-context {}))
 
-(deftest crud-workflow
-  "basic document creation flow works"
+(deftest create-delete
 
   (zen/stop-system ztx)
 
@@ -63,3 +68,86 @@
     (is (nil? (tutils/read-doc "testdoc.zd"))))
 
   (zen/stop-system ztx))
+
+(deftest document-rename
+
+  (zen/stop-system ztx)
+
+  (zen/read-ns ztx 'zd)
+
+  (zen/read-ns ztx 'zd.test)
+
+  (zen/start-system ztx 'zd.test/system)
+
+  (def to-rename
+    ;; TODO for some reason whitespace is required after :desc /\n
+    ":zd/docname testdoc\n:title \"testdoc\"\n:tags #{}\n:desc /\n #testdoc2 link")
+
+  (def to-link
+    ":zd/docname testdoc2\n:title \"testdoc2\"\n:tags #{}\n:desc /")
+
+  (matcho/assert
+   {:status 200 :body string?}
+   (web/handle ztx 'zd/api
+               {:uri "/testdoc/edit"
+                :request-method :put
+                :body (tutils/req-body to-link)}))
+
+  (is (seq (tutils/read-doc "testdoc2.zd")))
+
+  (matcho/assert
+   {:status 200 :body string?}
+   (web/handle ztx 'zd/api
+               {:uri "/testdoc/edit"
+                :request-method :put
+                :body (tutils/req-body to-rename)}))
+
+  (is (not (str/blank? (tutils/read-doc "testdoc.zd"))))
+
+  (def renamed
+    (str to-rename "\n:zd/rename newdoc"))
+
+  ;; old file deleted, new added
+  ;; links are re calculated
+
+  (matcho/assert
+   {:status 200 :body "/newdoc"}
+   (web/handle ztx 'zd/api
+               {:uri "/testdoc/edit"
+                :request-method :put
+                :body (tutils/req-body renamed)}))
+
+  ;; TODO think checkpoint api call
+  (await fs/queue)
+  (xtdb/sync (:node (d/get-state ztx)))
+
+  (testing "on rename old file is deleted"
+    (is (nil? (tutils/read-doc "testdoc.zd")))
+    (is (not (str/blank? (tutils/read-doc "newdoc.zd")))))
+
+  (testing "backlinks are reloaded"
+    ;; TODO use designated api op
+    (matcho/assert
+     {:zd/meta {:backlinks #{'{:to testdoc2, :path [:desc], :doc newdoc}}}}
+     (memstore/get-doc ztx 'testdoc2)))
+
+  (testing "old file is removed from storage"
+    ;; TODO use designated api op
+    (is (empty? (zen/op-call ztx 'zd/query '{:find [?e]
+                                             :where [[?e :xt/id ?id]
+                                                     [(= ?id "testdoc")]]}))))
+  ;; cleanup
+
+  (matcho/assert
+   {:status 200 :body string?}
+   (web/handle ztx 'zd/api {:uri "/newdoc"
+                            :request-method :delete}))
+
+  ;; TODO for some reason root is nil
+  (matcho/assert
+   {:status 200 :body string?}
+   (web/handle ztx 'zd/api {:uri "/testdoc2"
+                            :request-method :delete}))
+
+  (is (nil? (tutils/read-doc "testdoc2.zd")))
+  (is (nil? (tutils/read-doc "newdoc.zd"))))