Example Saxon URI resolver that can talk to BaseX.

uri_resolver.clj

(ns rainbowfish.uri-resolver
  "Extends Saxon's standard URI resolver to open BaseX documents when an
  URI has the `basex://` scheme."
  (:gen-class
   :name rainbowfish.UriResolver
   :extends net.sf.saxon.lib.StandardURIResolver
   :exposes-methods {resolve resolveSuper})
  (:require [clojure.string :as str]
            [rainbowfish.xmldb :as xmldb])
  (:import java.io.ByteArrayInputStream
           javax.xml.transform.sax.SAXSource
           javax.xml.transform.Source
           org.xml.sax.InputSource))

(defn ^Source -resolve
  "Override `resolve` to handle `basex://` URIs"
  [this ^String href ^String base]
  (if (str/starts-with? href "basex://")
    (resolve-basex href base)
    (.resolveSuper this href base)))

(defn resolve-basex
  "Attempt to open a document from BaseX. href should contain a url like
  `basex://db-name/db-path`. `base` will typically be the .xq file
  where the document is being opened, and is ignored on this
  method (url should always include db name and be absolute)."
  [href base]
  (let [uri (java.net.URI. href)
        ;; Peform a BaseX query to retrieve the doc.  Unfortunatelly
        ;; this opens an additional network request but should be ok
        ;; for now.
        src (xmldb/query
             "declare variable $db external;
              declare variable $path external;
              db:open($db, $path)"
             [["$db" (.getHost uri)]
              ["$path" (.getPath uri)]])
        bais (ByteArrayInputStream. (.getBytes src "UTF-8"))
        is (InputSource. bais)]
    (doto (SAXSource. is)
      (.setSystemId href))))

xmldb.clj

(ns rainbowfish.xmldb
  (:require [clojure.string :as str])
  (:import [org.basex BaseXGUI BaseXServer]
           org.basex.api.client.ClientSession))

(def config
  {:host "localhost"
   :port 1984
   :user "admin"
   :password "admin"})

(defn create-session
  "Creates a network session to talk to BaseX server"
  []
  (let [{:keys [host port user password] config]
    (ClientSession. host port user password)))

(defn open
  "Opens a BaseX session and calls the callback with it"
  [callback]
  (with-open [session (create-session)]
    (callback session)))

(defn query
  "Runs a query.
  `(query
    \"...xquery...\"
    [[\"$extern-name\" value \"xs:string\"]]
    (fn [q] (.bind q \"$var\" \"42\" \"xs:integer\")
            (.execute q)))`"
  ([xq]
   (query xq [] (fn [q sess] (.execute q))))
  ([xq bindings]
   (query xq bindings (fn [q sess] (.execute q))))
  ([xq bindings callback]
   (open (fn [sess]
           (with-open [query (.query sess xq)]
             ; Bind any parameters.
             (run! (fn [[varname value typename]]
                     (.bind query
                            varname
                            value
                            (or typename "xs:string"))) bindings)
             (callback query sess))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce
  ^{:doc "Instance of the BaseX DB server for the lifetime of the program"}
  server
  (do
    (System/setProperty "org.basex.path" "/path/for/basex/data")
    ; Inform JAXP APIs of rainbowfish's XSLT factory before calling
    ; BaseX code.
    (System/setProperty
     "javax.xml.transform.TransformerFactory",
     "rainbowfish.XsltFactory")
    (atom nil)))

(defn stop
  "Stops the BaseX server, if it is running."
  []
  (swap! server
         (fn [old-server]
           (when old-server (.stop old-server))
           nil)))

(defn restart
  "Stops the server if there is one running, and starts it again"
  []
  (swap! server
         (fn [old-server]
           (when old-server (.stop old-server))
           (BaseXServer. (into-array [(str "-p" (:port (options)))]))))

  ; Ensures the DBs of every site exist.
  (let [db-names (distinct (map :xmldb (vals (:hosts (config/config)))))]
    (run! (fn [dbn] (fire (str "CHECK " dbn))) db-names)))
(restart)))

(defn launch-gui
  []
  (BaseXGUI. (make-array String 0)))

xslt_factory.clj

(ns rainbowfish.xslt-factory
  (:import [net.sf.saxon Configuration]
           [net.sf.saxon.lib Feature])
  (:gen-class
   :name rainbowfish.XsltFactory
   :extends net.sf.saxon.jaxp.SaxonTransformerFactory
   :post-init configure))

(defn -configure
  "Generated Java class will call this method right after
  construction. Here we get a chance to grab Saxon's processor for
  configuration purposes (for example, adding extension functions)."
  [this & args]
  (let [processor (.getProcessor this)]
    ; Configure URI Resolver.
    (.setConfigurationProperty
     processor
     Feature/URI_RESOLVER_CLASS
     "rainbowfish.UriResolver")))