(ns protobuf.util
  (:import
    (clojure.lang IDeref
                  ISeq
                  IPersistentMap
                  IPersistentSet
                  IPersistentCollection))
  (:refer-clojure :exclude [update]))

(defn as-fn
  [x]
  (if (ifn? x) x, (constantly x)))

(defn into-set
  [set map]
  (if (map? map)
    (reduce (fn [set [k v]] ((if v conj disj) set k))
            set map)
    (into set map)))

(defn fix
  [x & clauses]
  (let [call #((as-fn %) x)]
    (first (or (seq (for [[pred & [transform :as exists?]] (partition-all 2 clauses)
                          :let [[pred transform] ;; handle odd number of clauses
                                (if exists? [pred transform] [true pred])]
                          :when (call pred)]
                      (call transform)))
               [x]))))

(defn to-fix
  [& clauses]
  (fn [x]
    (apply fix x clauses)))

(defmacro given
  [x & clauses]
  (let [[clauses default] (if (even? (count clauses))
                            [clauses `identity]
                            [(butlast clauses) (last clauses)])]
    `(fix ~x ~@(for [[pred transform] (partition 2 clauses)
                     arg [pred `#(-> % ~transform)]]
                 arg)
          ~default)))

(defmacro map-entry
  [a b]
  `(clojure.lang.MapEntry. ~a ~b))

(defn update-in*
  [m keys f & args]
  (if-let [[k & ks] (seq keys)]
    (let [old (get m k)
          new (apply update-in* old ks f args)]
      (if (identical? old new)
        m
        (assoc m k new)))
     (apply f m args)))

(defn update
  [m key f & args]
  (apply update-in* m [key] f args))

(defn map-vals
  [m f & args]
  (when m
    (into {}
          (for [[k v] m]
            (map-entry k (apply f v args))))))

(defprotocol Combiner
  (combine-onto [left right]
  "Merge two data structures by combining the contents. For maps, merge recursively by
  adjoining values with the same key. For collections, combine the right and left using
  into or conj. If the left value is a set and the right value is a map, the right value
  is assumed to be an existence map where the value determines whether the key is in the
  merged set. This makes sets unique from other collections because items can be deleted
  from them."))

(extend-protocol Combiner
  IPersistentMap
  (combine-onto [this other]
    (merge-with combine-onto this other))

  IPersistentSet
  (combine-onto [this other]
    (into-set this other))

  ISeq
  (combine-onto [this other]
    (concat this other))

  IPersistentCollection
  (combine-onto [this other]
    (into this other))

  Object
  (combine-onto [this other]
    other)

  nil
  (combine-onto [this other]
    other))

(defn combine
  [a b]
  (combine-onto a b))

(defn catbytes
  [& args]
  (let [out-buf (byte-array (loop [len 0, args (seq args)]
                              (if-let [[arg & args] args]
                                (recur (+ len (alength ^bytes arg)) args)
                                len)))]
    (loop [offset 0, args args]
      (if-let [[^bytes array & more] (seq args)]
        (let [size (alength array)]
          (System/arraycopy array 0
                            out-buf offset size)
          (recur (+ size offset) more))
        out-buf))))

(defn walk
  [inner outer schema]
  (outer
   (case (:type schema)
     :struct           (update schema :fields map-vals inner)
     (:set :list :map) (-> schema
                           (given :values (update :values inner))
                           (given :keys   (update :keys   inner)))
     schema)))

(defn postwalk
  [f schema]
  (walk (partial postwalk f) f schema))

(defn prewalk
  [f schema]
  (walk (partial prewalk f) identity (f schema)))

(defn dissoc-fields
  [schema & fields]
  (prewalk (to-fix #(= :struct (:type %))
                   #(apply update % :fields dissoc fields))
           schema))

(ns protobuf.impl.flatland.schema
  (:require
    [clojure.string :as string]
    [protobuf.util :as util])
  (:import
    (protobuf Extensions
              PersistentProtocolBufferMap
              PersistentProtocolBufferMap$Def )
    (com.google.protobuf Descriptors$Descriptor
                         Descriptors$FieldDescriptor
                         Descriptors$FieldDescriptor$Type)))

(defn extension
  [ext ^Descriptors$FieldDescriptor field]
  (-> (.getOptions field)
      (.getExtension ext)
      (util/fix string? not-empty)))

(defn field-type
  [field]
  (condp instance? field
    Descriptors$FieldDescriptor
    (if (.isRepeated ^Descriptors$FieldDescriptor field)
      (condp extension field
        (Extensions/counter)    :counter
        (Extensions/succession) :succession
        (Extensions/map)        :map
        (Extensions/mapBy)      :map-by
        (Extensions/set)        :set
        :list)
      :basic)
    Descriptors$Descriptor
    :struct))

(defmulti field-schema
  (fn [field _ & _] (field-type field)))

(defn struct-schema
  [^Descriptors$Descriptor struct
   ^PersistentProtocolBufferMap$Def map-def
   & [parents]]
  (let [struct-name (.getFullName struct)]
    (into {:type :struct
           :name struct-name}
          (when (not-any? (partial = struct-name) parents)
            {:fields (into {}
                           (for [^Descriptors$FieldDescriptor field (.getFields struct)]
                             [(.intern map-def (.getName field))
                              (field-schema field map-def (conj parents struct-name))]))}))))

(defn basic-schema
  [^Descriptors$FieldDescriptor field
   ^PersistentProtocolBufferMap$Def map-def
   & [parents]]
  (let [java-type   (keyword (string/lower-case (.name (.getJavaType field))))
        meta-string (extension (Extensions/meta) field)]
    (merge (case java-type
             :message (struct-schema (.getMessageType field) map-def parents)
             :enum    {:type   :enum
                       :values (set (map #(.clojureEnumValue map-def %)
                                         (.. field getEnumType getValues)))}
             {:type java-type})
           (when (.hasDefaultValue field)
             {:default (.getDefaultValue field)})
           (when meta-string
             (read-string meta-string)))))

(defn subfield
  [^Descriptors$FieldDescriptor field field-name]
  (.findFieldByName (.getMessageType field) (name field-name)))

(defmethod field-schema :basic
  [field map-def & [parents]]
  (basic-schema field map-def parents))

(defmethod field-schema :list
  [field map-def & [parents]]
  {:type   :list
   :values (basic-schema field map-def parents)})

(defmethod field-schema :succession
  [field map-def & [parents]]
  (assoc (basic-schema field map-def parents)
    :succession true))

(defmethod field-schema :counter
  [field map-def & [parents]]
  (assoc (basic-schema field map-def parents)
    :counter true))

(defmethod field-schema :set
  [field map-def & [parents]]
  {:type   :set
   :values (field-schema (subfield field :item) map-def parents)})

(defmethod field-schema :map
  [field map-def & [parents]]
  {:type   :map
   :keys   (field-schema (subfield field :key) map-def parents)
   :values (field-schema (subfield field :val) map-def parents)})

(defmethod field-schema :map-by
  [field map-def & [parents]]
  (let [map-by (extension (Extensions/mapBy) field)]
    {:type   :map
     :keys   (field-schema (subfield field map-by) map-def parents)
     :values (basic-schema field map-def parents)}))

(defmethod field-schema :struct
  [field map-def & [parents]]
  (struct-schema field map-def parents))

(ns protobuf.impl.flatland.codec
  (:require
    [clojure.java.io :as io]
    ;; flatland.io extends Seqable so we can concat InputStream from
    ;; ByteBuffer sequences.
    [flatland.io.core]
    [gloss.core :as gloss]
    [gloss.core.formats :as gloss-formats]
    [gloss.io :as gloss-io]
    [gloss.core.protocols :as gloss-protocols]
    [protobuf.impl.flatland.mapdef :as protobuf]
    [protobuf.impl.flatland.map :as protobuf-map]
    [protobuf.util :as util]))

(declare create)

(def ^{:private true} len-key :proto_length)
(def ^{:private true} reset-key :codec_reset)

(defn length-prefix
  [proto]
  (let [proto (protobuf/mapdef proto)
        min   (alength (protobuf/->bytes proto {len-key 0}))
        max   (alength (protobuf/->bytes proto {len-key Integer/MAX_VALUE}))]
    (letfn [(check [test msg]
              (when-not test
                (throw (Exception. (format "In %s: %s %s"
                                           (.getFullName proto) (name len-key) msg)))))]
      (check (pos? min)
             "field is required for repeated protobufs")
      (check (= min max)
             "must be of type fixed32 or fixed64"))
    (gloss/compile-frame (gloss/finite-frame max (create proto))
                         #(hash-map len-key %)
                         len-key)))

(defn create
  [proto & {:keys [validator repeated]}]
  (let [proto (protobuf/mapdef proto)]
    (-> (reify
          ;; Reader method
          gloss-protocols/Reader
          (read-bytes [this buf-seq]
            [true (protobuf/parse proto (io/input-stream buf-seq)) nil])
          ;; Writer method
          gloss-protocols/Writer
          (sizeof [this] nil)
          (write-bytes [this _ val]
            (when (and validator (not (validator val)))
              (throw (IllegalStateException.
                      "Invalid value in #'protobuf.impl.flatland.codec/create")))
            (gloss-formats/to-buf-seq
              (protobuf-map/->bytes
                (if (protobuf-map/map? val)
                  val
                  (protobuf/create proto val))))))
        (util/fix
          repeated
          #(gloss/repeated (gloss/finite-frame (length-prefix proto) %)
                           :prefix :none)))))

(def ^{:doc 
       :deprecated "3.5.1-v1.0"}
  protobuf-codec #'create)

(def 
  encode #'gloss-io/encode)

(def 
  decode #'gloss-io/decode)

(defn codec-schema
  [proto]
  (util/dissoc-fields (protobuf/mapdef->schema proto)
                      len-key
                      reset-key))

(ns protobuf.impl.flatland.core
  (:require
    [protobuf.common :as common]
    [protobuf.impl.flatland.map :as protobuf-map]
    [protobuf.impl.flatland.mapdef :as protobuf])
  (:gen-class
    :name protobuf.impl.flatland.core.FlatlandProtoBuf
    :implements [clojure.lang.Associative
                 clojure.lang.ILookup
                 clojure.lang.IPersistentCollection
                 clojure.lang.IPersistentMap
                 clojure.lang.Seqable
                 java.lang.Iterable]
    :init init
    :constructors {[java.lang.Class
                    clojure.lang.APersistentMap]
                   []}
    :methods [^:static [schema [Object] Object]]
    :state contents
    :main false))

(defn -init
  [protobuf-class data]
  (let [wrapper (protobuf/mapdef protobuf-class)]
    [[] {:instance (protobuf/create wrapper data)
         :java-wrapper wrapper
         :protobuf-class protobuf-class}]))

(def -containsKey (:containsKey common/associative-behaviour))
(def -entryAt (:entryAt common/associative-behaviour))

(def -valAt (:valAt common/lookup-behaviour))

(def -cons (:cons common/persistent-collection-behaviour))
(def -count (:count common/persistent-collection-behaviour))
(def -empty (:empty common/persistent-collection-behaviour))
(def -equiv (:equiv common/persistent-collection-behaviour))

(defn -assoc
  [this k v]
  (new protobuf.impl.flatland.core.FlatlandProtoBuf
    (common/get-class this)
    ((:assoc common/persistent-map-behaviour) this k v)))

(def -assocEx (:assocEx common/persistent-map-behaviour))

(defn -without
  [this k]
  (new protobuf.impl.flatland.core.FlatlandProtoBuf
    (common/get-class this)
    ((:without common/persistent-map-behaviour) this k)))

(def -seq (:seq common/seqable-behaviour))

(def -forEach (:forEach common/iterable-behaviour))
(def -iterator (:iterator common/iterable-behaviour))
(def -spliterator (:spliterator common/iterable-behaviour))

(def -toString (:toString common/printable-behaviour))

(defn -schema
  [protobuf-class]
  (protobuf/mapdef->schema
   (protobuf/mapdef protobuf-class)))

(def behaviour
  {:->bytes (fn [this]
             (protobuf-map/->bytes (common/get-instance this)))
   :->schema (fn [this]
             (protobuf/mapdef->schema (common/get-wrapper this)))
   :bytes-> (fn [this bytes]
             (new protobuf.impl.flatland.core.FlatlandProtoBuf
               (common/get-class this)
               (protobuf/parse (common/get-wrapper this) bytes)))
   :read (fn [this in]
          (new protobuf.impl.flatland.core.FlatlandProtoBuf
            (common/get-class this)
            (first
              (protobuf/read (common/get-wrapper this) in))))
   :write (fn [this out]
           (protobuf/write out (common/get-instance this)))})

(ns protobuf.impl.flatland.map
  (:import
    (protobuf PersistentProtocolBufferMap))
  (:refer-clojure :exclude [map?]))

(defn map?
  [obj]
  (instance? PersistentProtocolBufferMap obj))

(defn ^"[B" ->bytes
  [^PersistentProtocolBufferMap p]
  (.toByteArray p))

(defn get-raw
  [^PersistentProtocolBufferMap p key]
  (.getValAt p key false))

(ns protobuf.impl.flatland.mapdef
  (:require
    [clojure.java.io :as io]
    [protobuf.impl.flatland.map :as protobuf-map]
    [protobuf.impl.flatland.schema :as protobuf-schema]
    [protobuf.util :as util])
  (:import
    (clojure.lang Reflector)
    (com.google.protobuf CodedInputStream
                         Descriptors$Descriptor
                         GeneratedMessage)
    (java.io InputStream OutputStream)
    (protobuf Extensions
              PersistentProtocolBufferMap
              PersistentProtocolBufferMap$Def
              PersistentProtocolBufferMap$Def$NamingStrategy))
  (:refer-clojure :exclude [map? read]))

(defn mapdef?
  [obj]
  (instance? PersistentProtocolBufferMap$Def obj))

(defn ^PersistentProtocolBufferMap$Def mapdef
  ([map-def]
     (if (or (mapdef? map-def) (nil? map-def))
       map-def
       (mapdef map-def {})))
  ([map-def opts]
     (when map-def
       (let [{:keys [^PersistentProtocolBufferMap$Def$NamingStrategy naming-strategy
                     size-limit]
              :or {naming-strategy PersistentProtocolBufferMap$Def/convertUnderscores
                   size-limit 67108864}} opts ;; 64MiB
             ^Descriptors$Descriptor descriptor
             (if (instance? Descriptors$Descriptor map-def)
               map-def
               (Reflector/invokeStaticMethod ^Class map-def "getDescriptor" (to-array nil)))]
         (PersistentProtocolBufferMap$Def/create descriptor naming-strategy size-limit)))))

(defn create
  ([^PersistentProtocolBufferMap$Def map-def]
     (PersistentProtocolBufferMap/construct map-def {}))
  ([^PersistentProtocolBufferMap$Def map-def m]
     (PersistentProtocolBufferMap/construct map-def m))
  ([^PersistentProtocolBufferMap$Def map-def k v & kvs]
     (PersistentProtocolBufferMap/construct map-def (apply array-map k v kvs))))

(defn mapdef->schema
  [& args]
  (let [^PersistentProtocolBufferMap$Def map-def (apply mapdef args)]
    (protobuf-schema/field-schema (.getMessageType map-def) map-def)))

(defmulti parse
  (fn [map-def data & _]
    (type data)))

(defmethod parse (Class/forName "[B")
  ([^PersistentProtocolBufferMap$Def map-def data]
     (when data
       (PersistentProtocolBufferMap/create map-def data)))
  ([^PersistentProtocolBufferMap$Def map-def data ^Integer offset ^Integer length]
     (when data
       (let [^CodedInputStream in (CodedInputStream/newInstance data offset length)]
         (PersistentProtocolBufferMap/parseFrom map-def in)))))

(defmethod parse InputStream
  [^PersistentProtocolBufferMap$Def map-def stream]
  (when stream
    (let [^CodedInputStream in (CodedInputStream/newInstance stream)]
      (PersistentProtocolBufferMap/parseFrom map-def in))))

(defn ^"[B" ->bytes
  [^PersistentProtocolBufferMap$Def map-def m]
  (protobuf-map/->bytes (PersistentProtocolBufferMap/construct map-def m)))

(defn read
  [^PersistentProtocolBufferMap$Def map-def in]
  (lazy-seq
   (io!
    (let [^InputStream in (io/input-stream in)]
      (if-let [p (PersistentProtocolBufferMap/parseDelimitedFrom map-def in)]
        (cons p (read map-def in))
        (.close in))))))

(defn write
  [out & ps]
  (io!
   (let [^OutputStream out (io/output-stream out)]
     (doseq [^PersistentProtocolBufferMap p ps]
       (.writeDelimitedTo p out))
     (.flush out))))

(extend-protocol util/Combiner
  PersistentProtocolBufferMap
  (combine-onto [^PersistentProtocolBufferMap this other]
    (.append this other)))

(def 
  combine #'util/combine)

(ns protobuf.core
  (:require
    [protobuf.impl.flatland.core :as flatland])
  (:import
    (protobuf.impl.flatland.core FlatlandProtoBuf))
  (:refer-clojure :exclude [map? read]))

(defprotocol ProtoBufAPI
  (->bytes [this])
  (->schema [this])
  (bytes-> [this bytes])
  (read [this in])
  (write [this out]))

(extend FlatlandProtoBuf
        ProtoBufAPI
        flatland/behaviour)

(def default-impl-name "flatland")

(defn get-impl
  []
  (keyword (or (System/getProperty "protobuf.impl")
               default-impl-name)))

(defn schema
  [protobuf-class]
  (case (get-impl)
    :flatland (FlatlandProtoBuf/schema protobuf-class)))

(defn create
  ([protobuf-class]
    (create protobuf-class {}))
  ([protobuf-class data]
    (case (get-impl)
      :flatland (new FlatlandProtoBuf protobuf-class data))))

(ns protobuf.common)

(defn get-class
  [this]
  (:protobuf-class (.contents this)))

(defn get-instance
  [this]
  (:instance (.contents this)))

(defn get-wrapper
  [this]
  (:java-wrapper (.contents this)))

(def associative-behaviour
  {:containsKey (fn [this data] (.containsKey (get-instance this) data))
   :entryAt (fn [this data] (.entryAt (get-instance this) data))})

(def iterable-behaviour
  {:forEach (fn [this consumer] (.forEach (get-instance this) consumer))
   :iterator (fn [this] (.iterator (get-instance this)))
   :spliterator (fn [this] (.spliterator (get-instance this)))})

(def lookup-behaviour
  {:valAt (fn ([this k] (.valAt (get-instance this) k))
              ([this k fallback] (.valAt (get-instance this) k fallback)))})

(def persistent-collection-behaviour
  {:cons (fn [this o] (.cons (get-instance this) o))
   :count (fn [this] (.count (get-instance this)))
   :empty (fn [this] (.empty (get-instance this)))
   :equiv (fn [this o]
           (and (= (get-class this) (get-class o))
                (.equiv (get-instance this) (get-instance o))))})

(def persistent-map-behaviour
  {:assoc (fn [this k v] (.assoc (get-instance this) k v))
   :assocEx (fn [m k v] (throw (new Exception)))
   :without (fn [this k] (.without (get-instance this) k))})

(def printable-behaviour
  {:toString (fn [this] (.toString (get-instance this)))})

(def seqable-behaviour
  {:seq (fn [this] (.seq (get-instance this)))})