clojure-demos/src/clojure_demo/core.cljs

521 lines
23 KiB
Clojure

(ns clojure-demo.core
(:require
["@codemirror/language" :refer [LanguageSupport StreamLanguage]]
["@codemirror/legacy-modes/mode/yaml" :refer [yaml]]
["@codemirror/state" :as cm-state :refer [EditorState Transaction]]
["@codemirror/theme-one-dark" :refer [oneDark]]
["@codemirror/view" :as cm-view :refer [EditorView ViewUpdate]]
["@nextjournal/lang-clojure" :refer [clojure]]
["react-dom/client" :refer [createRoot]]
["tarts" :as tarts]
[ajax.core :refer [GET raw-response-format]]
[cl-eorg.html :as h :refer [body headers org->replacements]]
[cl-eorg.parser :as o :refer [parse]]
[cl-eorg.themes.tachyon :refer [tachyon-theme]]
[clojure.string :as str]
[honey.sql :as sql]
[honey.sql.helpers :as sqlh]
[reagent.core :as reagent]
[reitit.coercion.spec :as rss]
[reitit.frontend :as rf]
[reitit.frontend.easy :as rfe]
[reitit.frontend.history :refer [ignore-anchor-click?]]
[sci.configs.reagent.reagent :as sci-reagent]
[sci.configs.tonsky.datascript :as sci-datascript]
[sci.core :as sci]
[spec-tools.data-spec :as ds]))
(def languages
{"clojure" {:mode "clojure"}
"clojurescript" {:mode "clojure"}
"html" {:mode "html"}
"json" {:mode "json"}
"yaml" {:mode "yaml"}})
(def yaml-mode (LanguageSupport. (.define StreamLanguage yaml)))
;; https://github.com/babashka/sci.configs
(def rf-ns (sci/create-ns 'reitit.frontend nil))
(def rfe-ns (sci/create-ns 'reitit.frontend.easy nil))
(def rss-ns (sci/create-ns 'reitit.coercion.spec nil))
(def sql-ns (sci/create-ns 'honey.sql.core nil))
(def sqlh-ns (sci/create-ns 'honey.sql.helpers nil))
(def sci-ctx
(sci/init
{:classes {'js js/globalThis :allow :all}
:namespaces
{'reagent sci-reagent/reagent-namespace
;'h {'html (sci/copy-var h/html hc-ns)}
'd sci-datascript/core-namespace
'sql {'format (sci/copy-var sql/format sql-ns)
#_#_'raw (sci/copy-var sql/raw sql-ns)}
'sqlh {'select (sci/copy-var sqlh/select sqlh-ns)
'from (sci/copy-var sqlh/from sqlh-ns)
'limit (sci/copy-var sqlh/limit sqlh-ns)
'join (sci/copy-var sqlh/join sqlh-ns)
'values (sci/copy-var sqlh/values sqlh-ns)
'on-conflict (sci/copy-var sqlh/on-conflict sqlh-ns)
'do-update-set (sci/copy-var sqlh/do-update-set sqlh-ns)
'insert-into (sci/copy-var sqlh/insert-into sqlh-ns)
'order-by (sci/copy-var sqlh/order-by sqlh-ns)
'group-by (sci/copy-var sqlh/group-by sqlh-ns)
'where (sci/copy-var sqlh/where sqlh-ns)}
'rf {'router (sci/copy-var rf/router rf-ns)}
'rss {'coercion (sci/copy-var rss/coercion rss-ns)}
'rfe {'start! (sci/copy-var rfe/start! rfe-ns)
'href (sci/copy-var rfe/href rfe-ns)}}}))
;(def sci-ctx (sci/empty-environment))
(sci/alter-var-root sci/print-fn (constantly *print-fn*))
(defn slugify [s]
(when s
(str
(-> s
(str/lower-case)
(str/replace #"[^\w]+" "-")
(str/replace #"^-\\|-\\-$" "")))))
(defn fetch-selected-text
"Get the users selected text"
[updated-view transactions]
(reduce (fn [text t]
(if (= "select.pointer" (str (.annotation t (.-userEvent Transaction))))
(conj text
(.sliceDoc
^EditorState (.-state updated-view)
(.-from (.-main (.-selection t)))
(.-to (.-main (.-selection t)))))
text))
[]
transactions))
(defn err-boundary
"https://github.com/reagent-project/reagent/blob/master/doc/ReactFeatures.md#error-boundaries"
[children]
(let [err-state (reagent/atom nil)]
(reagent/create-class
{:display-name "Error Boundary"
; :component-did-catch (fn [this err info] #_(reset! err-state [err info]))
:get-derived-state-from-error (fn [e]
(reset! err-state e #_[err info])
#js {})
:reagent-render (fn [children]
(if @err-state
[:div (str @err-state)]
children
;(into [:<>] children)
))})))
(defn code-editor
[{:keys [exports class results]} content]
(let [language class
editor (atom nil)
evaled-result (reagent/atom nil)
update-timeout (reagent/atom nil)
update-fn (.of (.-updateListener EditorView)
(fn [^ViewUpdate view-update]
(when (some #(= language %) ["clojure" "clojurescript"])
(js/clearTimeout @update-timeout)
(reset! update-timeout
(js/setTimeout
(fn []
(let [selected-text (fetch-selected-text view-update (.-transactions view-update))
eval-code (if (seq selected-text)
(first selected-text)
(.-doc (.-state view-update)))]
(reset! evaled-result (sci/eval-string* sci-ctx
(.toString eval-code)))
(prn "updated delayed"))) 1000)))))
start-state
(.create EditorState
(clj->js {:doc content
:mode "text/x-clojure"
;:mode "text/yaml"
:extensions [(clojure) yaml-mode update-fn oneDark #_cm-keymap/of #_cm-commands/default-keymap]}))
view (atom nil)]
(reagent/create-class
{:component-did-mount
(fn [_]
(reset! view (EditorView.
(clj->js (merge {} #_(get languages language)
{:state start-state
;:mode "yaml"
:mode "clojure"
:updateListener prn
:parent @editor})))))
:component-will-unmount (fn [_] (.destroy @view))
:reagent-render (fn []
(if exports
nil ;[:<>]
[:div.mb2
[:div.ba.ma0.f5.b--black-05.pa2.overflow-auto.editor {:ref #(reset! editor %)}]
(when @evaled-result
[err-boundary
[:pre.ba.ma0.f6.code.b--black-05.pa2.pl4.overflow-auto
{:style {:white-space "pre-line"}}
;; See org mode :results key
(case results
"verbatim" (str @evaled-result)
"value" (str @evaled-result)
"output" @evaled-result
"silent" ""
@evaled-result)]])]))})))
(def theme
(merge tachyon-theme
{:SRC code-editor
:HEADER1 (fn [v _] [:h1.f2.fw6.f3-ns.lh-title.mt0.mb2 {:id (slugify v)} [:a {:name (slugify v)} v]])
:HEADER2 (fn [v _] [:h2.f3.fw6.f3-ns.lh-title.mt0.mb2 {:id (slugify v)} [:a {:name (slugify v)} v]])
:HEADER3 (fn [v _] [:h2.f4.fw6.f3-ns.lh-title.mt0.mb2 {:id (slugify v)} [:a {:name (slugify v)} v]])
:LINE :p.f5.f5-ns.lh-copy.mt0
:BULLETS :ul.mt0
:LINK :a #_link-handler}))
(def theme-toc
(merge tachyon-theme
{:HEADER1 (fn [v _] [:li [:a {:href (str "#" (slugify v))}
[:span.f4.fw6.f3-ns.lh-title.mt0.mb2 v]]])
:HEADER2 (fn [v _] [:li.ml2 [:a {:href (str "#" (slugify v))}
[:span.f4.fw6.f4-ns.lh-title.mt0.mb2 v]]])
:HEADER3 (fn [v _] [:li.ml4 [:a {:href (str "#" (slugify v))}
[:span.f5.fw6.f5-ns.lh-title.mt0.mb2 v]]])
:HEADER4 (fn [v _] [:li.ml6 [:a {:href (str "#" (slugify v))}
[:span.f6.fw6.f5-ns.lh-title.mt0.mb2 v]]])
:HEADER5 (fn [v _] [:li.ml8 [:a {:href (str "#" (slugify v))}
[:span.f6.fw6.f5-ns.lh-title.mt0.mb2 v]]])
:HEADER6 (fn [v _] [:li.ml10 [:a {:href (str "#" (slugify v))}
[:span.f6.fw6.f5-ns.lh-title.mt0.mb2 v]]])}))
;; put constant data here
(def site-data
{:homepage {:intro "Clojure tutorials examples and exploration"}
:dslpage {:intro "A domain-specific language (DSL) is a language designed to be used for a specific task or domain, clojure has a rich set of DSL some popular DSL's are listed on this page with example's on usage. "}
:lorem "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum."
:pages {:dialects {:title "Dialects & Interop"
:intro "Clojure has the ability to run on multiple technology stacks, this allows code reuse and consistency regardless of which eco system you want to make use of."
:key ::dialects
:demos [{:title "Clojure"
:description "The original language running on the jvm with access to the java eco system"
:page "clojure-info"}
{:title "Clojurescript"
:description "Clojure running in the browser or on top of node, with access to the js eco system."
:page "clojurescript-info"}
{:title "ClojureCLR"
:description "Clojure running on microsofts CLR with access to .net ecosystem"
:page "clojureclr-info"}
{:title "ClojureDart"
:description "Clojure for dart, use clojure to build apps using flutter"
:page "clojuredart-info"}]}
:devops {:title "Deployment & testing"
:intro "Running, Testing and deploying your software in a CI pipeline"
:key ::devops
:demos [{:title "CI Demo"
:description "Clojure in a CI pipeline, building artifacts running tests & deploying"
:page "ci-demo"
;;:link (rfe/href ::demo {:page "ci-demo"})
:icon-image "https://avatars.githubusercontent.com/u/2181346?s=200&v=4"}]}
:examples {:title "Examples"
:intro "Some example applications"
:key ::examples}
:terminology {:title "Terminology"
:intro ""
:key ::terminology}
:dsl {:title "DSL's"
:key ::dsl
:intro "A domain-specific language (DSL) is a language designed to be used for a specific task or domain, clojure has a rich set of DSL some popular DSL's are listed on this page with example's on usage. "
:demos [{:title "Hiccup HTML Demo"
:page "hiccup-dsl-demo"
; :link (rfe/href ::demo {:page "hiccup-dsl-demo"})
:icon-image "https://miro.medium.com/max/1400/1*CEYFj5R57UFyCXts2nsBqA.png"}
{:title "Honey SQL Demo"
:page "honey-sql-demo"
; :link (rfe/href ::demo {:page "honey-dsl-demo"})
:icon-image "https://miro.medium.com/max/1400/1*CEYFj5R57UFyCXts2nsBqA.png"}
{:title "Datalog Demo"
:page "datalog-demo"
; :link (rfe/href ::demo {:page "datalog-demo"})
:icon-image "https://raw.githubusercontent.com/tonsky/datascript/master/extras/logo.svg"}]}}
:demos
{:hiccup-dsl-demo
{:file "documents/hiccup-dsl-demo.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:datalog-demo
{:file "documents/datalog-demo.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:honey-sql-demo
{:file "documents/honey-sql-demo.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:reagent-demo
{:file "documents/reagent-reitit.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:clojure-basics
{:file "documents/clojure-basics.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:ci-demo
{:file "documents/ci-demo.org" :git-link "https://github.com/atomjuice/dsl-demo"}
:containers
{:file "documents/containers.org" :git-link "https://github.com/atomjuice/containers"}}})
;; Store site state
(defonce site-state (reagent/atom {}))
;; form one component to render an article
(defn article [{:keys [title description tagline]}]
[:article {:data-name "article-full-bleed-background"}
[:div.cf {:style {:background "url(http://placekitten.com/g/600/300)"
:no-repeat "center center fixed" :background-size "cover"}}
[:div.fl.pa3.pa4-ns.bg-white.black-70.measure-narrow.f3.times
[:header.b--black-70.pv4 {:class (when tagline "bb")}
[:h3.f2.fw7.ttu.tracked.lh-title.mt0.mb3.avenir title]
(when tagline [:h4.f3.fw4.i.lh-title.mt0 tagline])]
[:section.pt5.pb4 [:p.times.lh-copy.measure.f5.mt0 description]]]]])
;; form one component to render article tiles
(defn articles [{:keys [title body articles]}]
[:section.mw7.center.avenir
[:h2.baskerville.fw1.ph3.ph0-l title]
(when body [:p body])
(map (fn [{:keys [title author link description img-src img-alt]}]
[:article.bt.bb.b--black-10 {:key title}
[:a.db.pv4.ph3.ph0-l.no-underline.black.dim {:href link}
[:div.flex.flex-column.flex-row-ns
(when img-src
[:div.pr3-ns.mb4.mb0-ns.w-100.w-40-ns
[:img.db {:src img-src :alt img-alt}]])
[:div.w-100.w-60-ns.pl3-ns
[:h1.f3.fw1.baskerville.mt0.lh-title title]
[:p.f6.f5-l.lh-copy description]
[:p.f6.lh-copy.mv0 author]]]]])
articles)])
(defn circle [{:keys [img alt]}]
[:div.pa4.tc [:img.br-100.ba.h3.w3.dib {:src img :alt alt}]])
;; form one component to render a nav link
(defn navbar-link [{:keys [href title text key] :or {text nil title nil}}]
[:a.link.dim.white.dib.mr3 {:key (or key href) :href href :title title} text])
;; form one component to render a navbar
(defn navbar [links]
[:header.bg-black-90.w-100.ph3.pv3.pv4-ns.ph4-m.ph5-l
(into [:nav.f6.fw6.ttu.tracked] (mapv navbar-link links))])
(defn footer []
[:footer.bg-near-black.white-80.pv4.ph3.ph5-m.ph6-l.mid-gray.w-full
[:a.f6.dib.ph2.link.mid-gray.dim
{:target "_blank" :href "https://matrix.to/#/@oly:matrix.org"}
"Contact me"]])
;; form2 component notice the render function takes the same param as the component function
;; this is important, you can hit issues if you forget this in form 2 components.
(defn my-component [title value]
(let [local-state (reagent/atom value)]
(fn [title]
[:h1 {:class (when @local-state "hide")
:on-click (fn [] (swap! local-state inc))} (str title " " @local-state)])))
;; form one homepage component
(defn home-page []
[:<>
[articles
{:title "Clojure Demos"
:body (-> site-data :homepage :intro)
:articles
[{:title "Clojure Basics"
:description "Getting started with clojure syntax datatype's sequences conditions"
:link (rfe/href ::demo {:page "clojure-basics"})
:img-src "https://clojure.org/images/clojure-logo-120b.png"}
{:title "Reagent Demo"
:description "React application using reagent"
:link (rfe/href ::demo {:page "reagent-demo"})
:img-src "https://raw.githubusercontent.com/reagent-project/reagent/master/logo/logo-text.png"}]}]])
(defn grouped-page [route]
(let [group (keyword (name (:name (:data route))))]
[:<>
[articles
{:title (-> site-data :pages group :title)
:body (-> site-data :pages group :intro)
:articles
(mapv (fn fmt-map [demo]
{:title (:title demo)
:description (:description demo)
:link (rfe/href ::demo {:page (:page demo)})
:img-src (:icon-image demo)})
(-> site-data :pages group :demos))}]]))
(defn dialects-page [route]
[:<>
[grouped-page route #_ (keyword (name (:name (:data route))))]])
#_(defn dsl-page [route]
[:<>
[grouped-page route]
])
(def toc (partial contains? (into #{} (map keyword [:HEADER1 :HEADER2 :HEADER3 :HEADER4 :HEADER5 :HEADER6]))))
(def org-code (partial contains? (into #{} (map keyword [:SRC]))))
(defn build-file-tar [code-blocks]
(tarts (clj->js (mapv (fn [block] {:name (str (:tangle (second block)))
:content (str (last block))})
code-blocks))))
(defn build-file-tar-hm [code-blocks]
(tarts (clj->js code-blocks)))
(defn build-tarts-map [blocks]
(->> blocks
(group-by (fn [block] (:tangle (second block))))
(reduce (fn [m [k v]]
(conj m {:name (str k)
:content (str (str/join "\n\n" (mapv last v)))})) [])))
(defn org->split2
"Split out meta and body"
[dsl]
{:header (filter (fn filter-headers [tag] (headers (first tag))) dsl)
:toc (filter (fn filter-toc [tag] (toc (first tag))) dsl)
:code (filter (fn filter-code [tag] (org-code (first tag))) dsl)
:body (filter (fn filter-body [tag] (body (first tag))) dsl)})
;; form two component render demo
;;(h/org->split (parse document1))
(defn demo-page [route]
(let [demo-key (keyword (-> route :parameters :path :page))
content (reagent/atom {})]
(GET (str "/" (-> site-data :demos demo-key :file))
{:response-format (raw-response-format)
:handler (fn [response]
;;(prn (org->replacements theme (parse response) ))
;;[:LINE "" [:LINK {:href "https://github.com/weavejester/hiccup"} "https://github.com/weavejester/hiccup"]]
(->> response
parse
org->split2
(reset! content)))})
(fn [route]
(if @content
[:main.mt4.mw7.center.avenir
[:h1.f3.f2-ns (:content (last (first (:header @content))))]
[:div.mw7.center.avenir
(into [:ol] (org->replacements theme-toc (:toc @content)))]
[:p "The code in these examples is evaluated when modified, you can highlight a partial expression to evalute the selection, You can also download the code as a tar if you like and use it in your favourite editor."]
[:a.f6.link.dim.ph3.pv2.mb2.dib.white.bg-dark-blue
{:download (str (slugify (:content (last (first (:header @content))))) ".tar")
:title (:content (last (first (:header @content))))
:href (.createObjectURL
js/URL
(js/Blob. #js [(build-file-tar-hm
(build-tarts-map
(:code @content)))]
{:type "application/tar"}))}
"Download Code"]
[:div.mw7.center.avenir
(into [:div] (org->replacements theme (:body @content)))]]
[:<>]))))
;; form one render about page component
(defn about-page []
[:main.mt4
[:section.mw7.center.avenir
[:h1 "Clojure library examples to aid learning"]
[:p ""]
[article {:title "Example Article component"
:description (-> site-data :lorem)
:tagline "https://tachyons.io/components/"}]]])
;; define our page routes passed into reitit later on
(def routes
[["/"
{:name ::frontpage
:my-data "hi"
:view home-page}]
["/terminology/"
{:name ::terminology
:view grouped-page}]
["/dialects/"
{:name ::dialects
:view grouped-page}]
["/examples/"
{:name ::examples
:view grouped-page}]
["/devops/"
{:name ::devops
:view grouped-page}]
["/dsl/"
{:name ::dsl
:view grouped-page}]
["/about/"
{:name ::about
:view about-page}]
["/demo/:page"
{:name ::demo
:view demo-page
:parameters {:path {:page string?}
:query {(ds/opt :foo) keyword?}}}]])
;; top level component contains nav and adds in the select page into a containing element
;; we are adding in a style sheet but this will often be done in index.html
(defn current-page []
[:div
[navbar (concat
[{:href (rfe/href ::frontpage) :title "title here" :text "home" :key "homepage"}]
(mapv (fn build-nav [[key page]] {:href (rfe/href (:key page)) :text (:title page)}) (-> site-data :pages))
[;;{:href (rfe/href ::dsl) :text "DSL's" :key "dsl"}
{:title "Domain Specific Languages" :href (rfe/href ::about) :text "About" :key "about"}
#_{:href (rfe/href ::i-do-not-exist) :text "missing"}])]
[:main.ma4
(when-let [view (-> @site-state :current-route :data :view)] [view (-> @site-state :current-route)])]
[footer]])
;; This simply calls reagent render and puts the result in a div with the id of app
;; you can create your own index.html or figwheel provides one with the app id which will replace the default data
;; ^:after-load is meta data its not needed but informs figwheel to run this code after a page load
(defn mount-root-page []
;; this select the main node from the html file and injects your page content
(.render
(createRoot (.getElementById js/document "app"))
(reagent/as-element [err-boundary [current-page]])))
(defn ^:after-load render-site []
;; this select the main node from the html file and injects your page content
(mount-root-page))
(defn ^:dev/after-load startup! []
(rfe/start!
(rf/router routes {:data {:coercion rss/coercion}})
(fn [m] (swap! site-state assoc :current-route m))
;; set to false to enable HistoryAPI
{:use-fragment false
:ignore-anchor-click?
(fn [router e el uri]
;; Add additional check on top of the default checks\
(and
(ignore-anchor-click? router e el uri)
(not (let [href (or (.-href el) "")
result (str/includes? href "#")]
#_(when result
;(.preventDefault e)
#_(js/console.log "will prevent by href" href))
result))))})
(render-site))
;; we defonce the startup so that hot reloading does not reinitialize the state of the site
(def launch (do (startup!) true))
(comment
@site-state
(org->replacements tachyon-theme [[:SRC {:LANGUAGE "shell"} "hi"]])
(GET "/test.org" {:handler (fn [response] (swap! site-state assoc :content response))}))