(ns datascript.pull-parser
  (:require
   [datascript.db :as db #?(:cljs :refer-macros :clj :refer) [raise]]))

(defrecord PullSpec [wildcard? attrs])

(defprotocol IPullSpecComponent
  (-as-spec [this]))

(defrecord PullAttrName [attr]
  IPullSpecComponent
  (-as-spec [this]
    [attr {:attr attr}]))

(defrecord PullReverseAttrName [attr rattr]
  IPullSpecComponent
  (-as-spec [this]
    [rattr {:attr attr}]))

(defrecord PullLimitExpr [attr limit]
  IPullSpecComponent
  (-as-spec [this]
    (-> (-as-spec attr)
        (assoc-in [1 :limit] limit))))

(defrecord PullDefaultExpr [attr value]
  IPullSpecComponent
  (-as-spec [this]
    (-> (-as-spec attr)
        (assoc-in [1 :default] value))))

(defrecord PullWildcard [])

(defrecord PullRecursionLimit [limit]
  IPullSpecComponent
  (-as-spec [this]
    [:recursion limit]))

(defrecord PullMapSpecEntry [attr porrl]
  IPullSpecComponent
  (-as-spec [this]
    (-> (-as-spec attr)
        (update 1 conj (-as-spec porrl)))))

(defn- aggregate-specs
  [res part]
  (if (instance? PullWildcard part)
    (assoc res :wildcard? true)
    (update res :attrs conj! (-as-spec part))))

(defrecord PullPattern [specs]
  IPullSpecComponent
  (-as-spec [this]
    (let [init (PullSpec. false (transient {}))
          spec (reduce aggregate-specs init specs)]
      [:subpattern (update spec :attrs persistent!)])))

;; using defn instead of declare because of http://dev.clojure.org/jira/browse/CLJS-1871
(defn ^:declared parse-pattern [pattern])

(def ^:private wildcard? #{'* :* "*"})

(defn- parse-wildcard
  [spec]
  (when (wildcard? spec)
    (PullWildcard.)))

(defn- parse-attr-name
  [spec]
  (when (or (keyword? spec) (string? spec))
    (if (db/reverse-ref? spec)
      (PullReverseAttrName. (db/reverse-ref spec) spec)
      (PullAttrName. spec))))

(def ^:private unlimited-recursion? #{'... "..."})

(defn- parse-recursion-limit
  [spec]
  (cond
    (unlimited-recursion? spec)
    (PullRecursionLimit. nil)

    (and (number? spec) (pos? spec))
    (PullRecursionLimit. spec)))

(defn- maybe-attr-expr?
  [spec]
  (and (sequential? spec) (= 3 (count spec))))

(def ^:private limit? #{'limit :limit "limit"})

(defn- parse-limit-expr
  [spec]
  (let [[limit-sym attr-name-spec pos-num] spec]
    (when (limit? limit-sym)
      (if-let [attr-name (and (or (nil? pos-num)
                                  (and (number? pos-num) (pos? pos-num)))
                              (parse-attr-name attr-name-spec))]
        (PullLimitExpr. attr-name pos-num)
        (raise "Expected [\"limit\" attr-name (positive-number | nil)]"
               {:error :parser/pull, :fragment spec})))))

(def ^:private default? #{'default :default "default"})

(defn- parse-default-expr
  [spec]
  (let [[default-sym attr-name-spec default-val] spec]
    (when (default? default-sym)
      (if-let [attr-name (and (default? default-sym)
                              (parse-attr-name attr-name-spec))]
        (PullDefaultExpr. attr-name default-val)
        (raise "Expected [\"default\" attr-name any-value]"
               {:error :parser/pull, :fragment spec})))))

(defn- parse-map-spec-entry
  [[k v]]
  (if-let [attr-name (or (parse-attr-name k)
                         (when (maybe-attr-expr? k)
                           (parse-limit-expr k)))]
    (if-let [pattern-or-rec (or (parse-recursion-limit v)
                                (parse-pattern v))]
      (PullMapSpecEntry. attr-name pattern-or-rec)
      (raise "Expected (pattern | recursion-limit)"
             {:error :parser/pull, :fragment [k v]}))
    (raise "Expected (attr-name | limit-expr)"
           {:error :parser/pull, :fragment [k v]})))

(defn- parse-map-spec
  [spec]
  (when (map? spec)
    (assert (= 1 (count spec)) "Maps should contain exactly 1 entry")
    (parse-map-spec-entry (first spec))))

(defn- parse-attr-expr
  [spec]
  (when (maybe-attr-expr? spec)
    (or (parse-limit-expr spec)
        (parse-default-expr spec))))

(defn- parse-attr-spec
  [spec]
  (or (parse-attr-name spec)
      (parse-wildcard spec)
      (parse-map-spec spec)
      (parse-attr-expr spec)
      (raise "Cannot parse attr-spec, expected: (attr-name | wildcard | map-spec | attr-expr)"
             {:error :parser/pull, :fragment spec})))

(defn- pattern-clause-type
  [clause]
  (cond
    (map? clause)      :map
    (wildcard? clause) :wildcard
    :else              :other))

(defn- expand-map-clause
  [clause]
  (into [] (map #(conj {} %)) clause))

(defn- simplify-pattern-clauses
  [pattern]
  (let [groups (group-by pattern-clause-type pattern)
        base   (if (not-empty (get groups :wildcard))
                 ['*] [])]
    (-> base
        (into (get groups :other))
        (into (mapcat expand-map-clause) (get groups :map)))))

(defn parse-pattern
  "Parse an EDN pull pattern into a tree of records using the following
grammar:

```
pattern            = [attr-spec+]
attr-spec          = attr-name | wildcard | map-spec | attr-expr
attr-name          = an edn keyword that names an attr
wildcard           = \"*\" or '*'
map-spec           = { ((attr-name | limit-expr) (pattern | recursion-limit))+ }
attr-expr          = limit-expr | default-expr
limit-expr         = [\"limit\" attr-name (positive-number | nil)]
default-expr       = [\"default\" attr-name any-value]
recursion-limit    = positive-number | '...'
```"
  [pattern]
  (when (sequential? pattern)
    (->> pattern
         simplify-pattern-clauses
         (into [] (map parse-attr-spec))
         (PullPattern.))))

(defn pattern->spec
  "Convert a parsed tree of pull pattern records into a `PullSpec` instance,
a record type containing two keys:

* `:wildcard?` - a boolean indicating if the pattern contains a wildcard.
* `:attrs` - a map of attribute specifications.

The attribute specification map consists of keys which will become the keys
in the result map, and values which are themselves maps describing the
attribute:

* `:attr`       (required) - The attr name to pull; for reverse attributes
                             this will be the normalized attribute name.
* `:limit`      (optional) - If present, specifies a custom limit for this
                             attribute; Either `nil`, indicating no limit,
                             or a positive integer.
* `:default`    (optional) - If present, specifies a default value for this
                             attribute
* `:recursion`  (optional) - If present, specifies a recursion limit for this
                             attribute; Either `nil`, indicating no limit, or
                             a positive integer.
* `:subpattern` (optional) - If present, specifies a sub `PullSpec` instance
                             to be applied to entities matched by this
                             attribute."
  [pattern]
  (nth (-as-spec pattern) 1))

(defn parse-pull
  "Parse EDN pull `pattern` specification (see `parse-pattern`), and
convert the resulting tree into a `PullSpec` instance (see `pattern->spec`).
Throws an error if the supplied `pattern` cannot be parsed."
  [pattern]
  (or (some-> pattern parse-pattern pattern->spec)
      (raise "Cannot parse pull pattern, expected: [attr-spec+]"
             {:error :parser/pull, :fragment pattern})))