(ns libpython-clj2.require

"Namespace implementing requiring python modules as Clojure namespaces. This works via

(:refer-clojure :exclude [fn? doc])

(:require [libpython-clj2.python :as py]

[libpython-clj2.metadata :as pymeta]

[clojure.datafy :refer [datafy nav]]

[clojure.tools.logging :as log]

[clojure.core.protocols :as clj-proto])

(:import (java.io File)))

(defn- parse-flags

"FSM style parser for flags. Designed to support both

[supported-flags reqs]

;; Ensure we error out when flags passed in are mistyped.

;; First attempt is to filter keywords and make sure any keywords are

;; in supported-flags

(let [total-flags (set (concat supported-flags [:as :refer :exclude

:* :all :bind-ns :path]))]

(when-let [missing-flags (->> reqs

(filter #(and (not (total-flags %))

(keyword? %)))

seq)]

(throw (Exception. (format "Unsupported flags: %s"

(set missing-flags))))))

;;Loop through reqs. If a keyword is found and it is a supported flag,

;;see if the next thing is a boolean with a default to true.

;;If the flag is enabled (as false could be passed in), conj (or disj) to flag set

;;Return reqs minus flags and booleans.

(loop [reqs reqs

retval-reqs []

retval-flags #{}]

(if (seq reqs)

(let [next-item (first reqs)

reqs (rest reqs)

[bool-flag reqs]

(if (and (supported-flags next-item)

(boolean? (first reqs)))

[(first reqs) (rest reqs)]

[true reqs])

retval-flags (if (supported-flags next-item)

(if bool-flag

(conj retval-flags next-item)

(disj retval-flags next-item))

retval-flags)

retval-reqs (if (not (supported-flags next-item))

(conj retval-reqs next-item)

retval-reqs)]

(recur reqs retval-reqs retval-flags))

retval-flags)))

(defn- extract-refer-symbols

[{:keys [refer this-module]} public-data]

(cond

;; include everything into the current namespace,

;; ignore __all__ directive

(or (refer :all)

(and (not (py/has-attr? this-module "__all__"))

(refer :*)))

(keys public-data)

;; only include that specfied by __all__ attribute

;; of python module if specified, else same as :all

(refer :*)

(->> (py/get-attr this-module "__all__")

(map (fn [item-name]

(let [item-sym (symbol item-name)]

(when (contains? public-data item-sym)

item-sym))))

(remove nil?))

;; [.. :refer [..]] behavior

:else

(do

(when-let [missing (->> refer

(remove (partial contains? public-data))

seq)]

(throw (Exception.

(format "'refer' symbols not found: %s"

(vec missing)))))

refer)))

(defn- do-require-python

[reqs-vec]

(let [[module-name & etc] reqs-vec

supported-flags #{:reload :no-arglists :bind-ns}

flags (parse-flags supported-flags etc)

etc (->> etc

(remove supported-flags)

(remove boolean?))

_ (when-not (= 0 (rem (count etc) 2))

(throw (Exception. "Must have even number of entries")))

etc (->> etc (partition-all 2)

(map vec)

(into {}))

reload? (:reload flags)

no-arglists? (:no-arglists flags)

bind-ns? (:bind-ns flags)

alias-name (:as etc)

path (:path etc)

exclude (into #{} (:exclude etc))

refer-data (cond

(= :all (:refer etc)) #{:all}

(= :* (:refer etc)) #{:*}

:else (into #{} (:refer etc)))

pyobj (if path

(let [cwd (pymeta/py-getcwd)]

(try

(pymeta/py-chdir path)

(py/path->py-obj (str module-name) :reload? reload?)

(finally

(pymeta/py-chdir cwd))))

(py/path->py-obj (str module-name) :reload? reload?))

existing-py-ns? (find-ns module-name)]

(create-ns module-name)

(when bind-ns?

(let [import-name (or (not-empty (str alias-name))

(str module-name))

ns-dots (re-find #"[.]" import-name)]

(when (not (zero? (count ns-dots)))

(throw (Exception. (str "Cannot have periods in module/class"

"name. Please :alias "

import-name

" to something without periods."))))

(intern

(symbol (str *ns*))

(with-meta (symbol import-name)

{:file (pymeta/find-file pyobj)

:line 1})

pyobj)))

(when (or (not existing-py-ns?) reload?)

(pymeta/apply-static-metadata-to-namespace! module-name (datafy pyobj)

:no-arglists? no-arglists?))

(when-let [refer-symbols (->> (extract-refer-symbols {:refer refer-data

:this-module pyobj}

(ns-publics

(find-ns module-name)))

seq)]

(refer module-name :exclude exclude :only refer-symbols))

(when alias-name

(alias alias-name module-name))))

(defn ^:private req-transform

([req]

(if (symbol? req)

req

(let [base (first req)

reqs (rest req)]

(map (partial req-transform base) reqs))))

([prefix req]

(cond

(and (symbol? req)

(clojure.string/includes? (name req) ".") )

(throw (Exception.

(str "After removing prefix list, requirements cannot "

"contain periods. Please remove periods from " req)))

(symbol? req)

(symbol (str prefix "." req))

:else

(let [base (first req)

reqs (rest req)

alias? (reduce (fn [res [a b]]

(cond

(not b) nil

(= :as a) (reduced b)

:else nil))

nil

(partition 2 1 reqs))]

(if alias?

(into [(symbol (str prefix "." base))] reqs)

(into [(req-transform prefix base)] reqs))))))

(defn require-python

"## Basic usage ##

([req]

(py/with-gil

(cond

(list? req) ;; prefix list

(let [prefix-lists (req-transform req)]

(doseq [req prefix-lists] (require-python req)))

(symbol? req)

(require-python (vector req))

(vector? req)

(do-require-python req)

:else

(throw (Exception. "Invalid argument: %s" req))))

:ok)

([req & reqs]

(cond (and (map? req)

(contains? req :from)

(seq reqs))

(apply require-python (:from req) reqs)

(and (keyword? req)

(= :from req)

(string? (first reqs)))

(apply require-python (first reqs) (rest reqs))

(and (string? req)

(.isFile (File. req)))

(let [file (File. req)

cwd (pymeta/py-getcwd)]

(apply require-python (str (.getParent file)) reqs))

(and (string? req)

(.isDirectory (File. req)))

(let [cwd (pymeta/py-getcwd)]

(try

(pymeta/py-chdir req)

(apply require-python reqs)

(finally

(pymeta/py-chdir cwd))))

:else

(do

(require-python req)

(when (not-empty reqs)

(apply require-python reqs))))

:ok))

(defn import-python

"Loads python, python.list, python.dict, python.set, python.tuple,

[]

(require-python

'(builtins

[list :as python.list]

[dict :as python.dict]

[set :as python.set]

[tuple :as python.tuple]

[frozenset :as python.frozenset]

[str :as python.str])

'[builtins :as python])

:ok)

(def ^:private builtins (py/import-module "builtins"))

(def ^:private pytype (comp symbol str (py/get-attr builtins "type")))

(defmulti ^:no-doc pydafy

"Turn a Python object into Clojure data. Metadata of Clojure

pytype)

(defmulti ^:no-doc pynav

"Nav data from a Python object.

(fn [coll k v] (pytype coll)))

(defmethod pydafy :default [x]

(if (pymeta/pyclass? x)

(pymeta/datafy-module-or-class x)

(throw (ex-info (str "datafy not implemented for " (pytype x))

{:type (pytype x)}))))

(defmethod pynav :default [x]

(if (pymeta/pyclass? x)

(pymeta/nav-module x)

(throw (ex-info (str "nav not implemented for " (pytype x))

{:type (pytype x)}))))

(defmethod pydafy 'builtins.module [m]

(pymeta/datafy-module-or-class m))

(defmethod pynav 'builtins.module [coll k v]

(pymeta/nav-module coll k v))

(defmethod pydafy 'builtins.dict [x]

(py/->jvm x))

(defn ^:private py-datafy [item]

(let [res (pydafy item)

m (meta res)]

(try

(with-meta

res

(merge

{'clj-proto/nav pynav}

m))

(catch ClassCastException _

;; presumably metadata doesn't work for this type

res))))

(defn ^:private py-nav [coll k v]

(let [res (pynav coll k v)

m (meta res)]

(try

(with-meta

res

(merge

{'clj-proto/datafy pydafy}

m))

(catch ClassCastException _

;; presumably metadata doesn't work for this type

res))))

(defmacro ^:no-doc pydatafy [& types]

;; credit: Tom Spoon

;; https://clojurians.zulipchat.com/#narrow/stream/215609-libpython-clj-dev/topic/feature-requests/near/187056819

`(do ~@(for [t types]

`(extend-type ~t

clj-proto/Datafiable

(datafy [item#] (py-datafy item#))

clj-proto/Navigable

(nav [coll# k# v#] (py-nav coll# k# v#))))))