(ns pc.http.datomic.common
  (:require [clojure.set :as set]
            [datomic.api :as d]
            [pc.datomic.schema :as schema]
            [pc.datomic.web-peer :as web-peer]
            [pc.models.plan :as plan-model]))

;; TODO: is the transaction guaranteed to be the first? Can there be multiple?
(defn get-annotations [transaction]
  (let [txid (-> transaction :tx-data first :tx)]
    (d/entity (:db-after transaction) txid)))

(def read-only-outgoing-whitelist
  #{:layer/name
    :layer/uuid
    :layer/type
    :layer/start-x
    :layer/start-y
    :layer/end-x
    :layer/end-y
    :layer/rx
    :layer/ry
    :layer/fill
    :layer/stroke-width
    :layer/stroke-color
    :layer/opacity
    :layer/points-to
    :layer/font-family
    :layer/text
    :layer/font-size
    :layer/path
    :layer/child
    :layer/ui-id
    :layer/ui-target
    :layer/document

    :entity/type
    :session/uuid
    :document/uuid
    :document/name
    :document/creator
    :document/collaborators
    :document/privacy

    :chat/body
    :chat/color
    :chat/cust-name
    :chat/document
    :cust/uuid
    :cust/color-name
    :client/timestamp
    :server/timestamp})

(defn outgoing-whitelist [scope]
  (cond (= scope :read)
        read-only-outgoing-whitelist
        (= scope :admin)
        (set/union read-only-outgoing-whitelist
                   #{:permission/document
                     :permission/cust ;; translated
                     :permission/permits
                     :permission/grant-date
                     :permission/team

                     :access-grant/document
                     :access-grant/email
                     :access-grant/grant-date
                     :access-grant/team

                     :access-request/document
                     :access-request/cust ;; translated
                     :access-request/status
                     :access-request/create-date
                     :access-request/deny-date
                     :access-request/team

                     :team/plan

                     :plan/start
                     :plan/trial-end
                     :plan/credit-card
                     :plan/paid?
                     :plan/billing-email
                     :plan/active-custs
                     :plan/invoices
                     :plan/account-balance
                     :plan/next-period-start

                     :discount/start
                     :discount/coupon
                     :discount/end

                     :credit-card/exp-year
                     :credit-card/exp-month
                     :credit-card/last4
                     :credit-card/brand

                     :invoice/subtotal
                     :invoice/total
                     :invoice/date
                     :invoice/paid?
                     :invoice/attempted?
                     :invoice/next-payment-attempt
                     :invoice/description
                     })))

(defn translate-datom-dispatch-fn [db d] (:a d))

(defmulti translate-datom translate-datom-dispatch-fn)

(defmethod translate-datom :default [db d]
  d)

(defmethod translate-datom :permission/cust-ref [db d]
  (-> d
    (assoc :a :permission/cust)
    (update-in [:v] #(:cust/email (d/entity db %)))))

(defmethod translate-datom :access-request/cust-ref [db d]
  (-> d
    (assoc :a :access-request/cust)
    (update-in [:v] #(:cust/email (d/entity db %)))))

(defmethod translate-datom :permission/document-ref [db d]
  (-> d
    (assoc :a :permission/document)))

(defmethod translate-datom :access-request/document-ref [db d]
  (-> d
    (assoc :a :access-request/document)))

(defmethod translate-datom :access-grant/document-ref [db d]
  (-> d
    (assoc :a :access-grant/document)))

(defmethod translate-datom :permission/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :access-request/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :access-grant/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :layer/points-to [db d]
  (-> d
    (assoc :v (web-peer/client-id db (:v d)))))

(defmethod translate-datom :team/plan [db d]
  (-> d
    (assoc :v (web-peer/client-id db (:v d)))))

(defmethod translate-datom :plan/active-custs [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :discount/coupon [db d]
  (-> d
    (assoc :v (plan-model/coupon-read-api (d/ident db (:v d))))))

(defmethod translate-datom :plan/invoices [db d]
  (-> d
    (assoc :v (web-peer/client-id (d/entity db (:v d))))))

(defmethod translate-datom :vote/cust [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :comment/cust [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :issue/author [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :comment/parent [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defmethod translate-datom :issue/comments [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defmethod translate-datom :issue/votes [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defn datom-read-api [db datom]
  (let [{:keys [e a v tx added] :as d} datom
        a (schema/get-ident a)
        v (if (and (contains? (schema/enums) a)
                   (contains? (schema/ident-ids) v))
            (schema/get-ident v)
            v)
        e (web-peer/client-id db e)]
    (->> {:e e :a a :v v :tx tx :added added}
      (translate-datom db))))

(defn whitelisted? [scope datom]
  (contains? (outgoing-whitelist scope) (:a datom)))

(defn frontend-document-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)]
    (when (and (:transaction/document annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (->> transaction
                                 :tx-data
                                 (filter #(:frontend/id (d/entity (:db-after transaction) (:e %))))
                                 (map (partial datom-read-api (:db-after transaction)))
                                 (filter (partial whitelisted? :admin))
                                 seq)]
        {:admin-data (merge {:tx-data public-datoms}
                            annotations)
         :read-only-data (merge {:tx-data (filter (partial whitelisted? :read) public-datoms)}
                                annotations)}))))

(defn frontend-team-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)]
    (when (and (:transaction/team annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (->> transaction
                                 :tx-data
                                 (filter #(:frontend/id (d/entity (:db-after transaction) (:e %))))
                                 (map (partial datom-read-api (:db-after transaction)))
                                 (filter (partial whitelisted? :admin))
                                 seq)]
        {:admin-data (merge {:tx-data public-datoms}
                            annotations)
         :read-only-data (merge {:tx-data (filter (partial whitelisted? :read) public-datoms)}
                                annotations)}))))

(def issue-whitelist #{:vote/cust
                       :comment/body
                       :comment/cust
                       :comment/created-at
                       :comment/parent
                       :issue/title
                       :issue/description
                       :issue/author
                       :issue/document
                       :issue/created-at
                       :issue/votes
                       :issue/comments
                       :frontend/issue-id})

(defn issue-whitelisted? [datom]
  (contains? issue-whitelist (:a datom)))

(defn has-issue-frontend-id? [db frontend-id-memo datom]
  (frontend-id-memo db (:e datom)))

(defn issue-datom-read-api [db frontend-id-memo datom]
  (let [{:keys [e a v tx added] :as d} datom
        a (schema/get-ident a)
        v (if (and (contains? (schema/enums) a)
                   (contains? (schema/ident-ids) v))
            (schema/get-ident v)
            v)
        e (frontend-id-memo db e)]
    (->> {:e e :a a :v v :tx tx :added added}
      (translate-datom db))))

(defn frontend-issue-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)
        frontend-id-memo (memoize (fn [db e]
                                    (let [ent (d/entity db e)]
                                      (when-let [id (:frontend/issue-id e)]
                                        [:frontend/issue-id id]))))]
    (when (and (:transaction/issue-tx? annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (->> transaction
                                 :tx-data
                                 (filter (partial has-issue-frontend-id?
                                                  (:db-after transaction)
                                                  frontend-id-memo))
                                 (map (partial datom-read-api
                                               (:db-after transaction)
                                               frontend-id-memo))
                                 (filter issue-whitelisted?)
                                 seq)]
        (merge {:tx-data public-datoms}
               annotations)))))

(ns pc.http.datomic.common
  (:require [clojure.set :as set]
            [datomic.api :as d]
            [pc.datomic.schema :as schema]
            [pc.datomic.web-peer :as web-peer]
            [pc.models.plan :as plan-model]))

;; TODO: is the transaction guaranteed to be the first? Can there be multiple?
(defn get-annotations [transaction]
  (let [txid (-> transaction :tx-data first :tx)]
    (d/entity (:db-after transaction) txid)))

(def read-only-outgoing-whitelist
  #{:layer/name
    :layer/uuid
    :layer/type
    :layer/start-x
    :layer/start-y
    :layer/end-x
    :layer/end-y
    :layer/rx
    :layer/ry
    :layer/fill
    :layer/stroke-width
    :layer/stroke-color
    :layer/opacity
    :layer/points-to
    :layer/font-family
    :layer/text
    :layer/font-size
    :layer/path
    :layer/child
    :layer/ui-id
    :layer/ui-target
    :layer/document

    :entity/type
    :session/uuid
    :document/uuid
    :document/name
    :document/creator
    :document/collaborators
    :document/privacy

    :chat/body
    :chat/color
    :chat/cust-name
    :chat/document
    :cust/uuid
    :cust/color-name
    :client/timestamp
    :server/timestamp})

(defn outgoing-whitelist [scope]
  (cond (= scope :read)
        read-only-outgoing-whitelist
        (= scope :admin)
        (set/union read-only-outgoing-whitelist
                   #{:permission/document
                     :permission/cust ;; translated
                     :permission/permits
                     :permission/grant-date
                     :permission/team

                     :access-grant/document
                     :access-grant/email
                     :access-grant/grant-date
                     :access-grant/team

                     :access-request/document
                     :access-request/cust ;; translated
                     :access-request/status
                     :access-request/create-date
                     :access-request/deny-date
                     :access-request/team

                     :team/plan

                     :plan/start
                     :plan/trial-end
                     :plan/credit-card
                     :plan/paid?
                     :plan/billing-email
                     :plan/active-custs
                     :plan/invoices
                     :plan/account-balance
                     :plan/next-period-start

                     :discount/start
                     :discount/coupon
                     :discount/end

                     :credit-card/exp-year
                     :credit-card/exp-month
                     :credit-card/last4
                     :credit-card/brand

                     :invoice/subtotal
                     :invoice/total
                     :invoice/date
                     :invoice/paid?
                     :invoice/attempted?
                     :invoice/next-payment-attempt
                     :invoice/description
                     })))

(defn translate-datom-dispatch-fn [db d] (:a d))

(defmulti translate-datom translate-datom-dispatch-fn)

(defmethod translate-datom :default [db d]
  d)

(defmethod translate-datom :permission/cust-ref [db d]
  (-> d
    (assoc :a :permission/cust)
    (update-in [:v] #(:cust/email (d/entity db %)))))

(defmethod translate-datom :access-request/cust-ref [db d]
  (-> d
    (assoc :a :access-request/cust)
    (update-in [:v] #(:cust/email (d/entity db %)))))

(defmethod translate-datom :permission/document-ref [db d]
  (-> d
    (assoc :a :permission/document)))

(defmethod translate-datom :access-request/document-ref [db d]
  (-> d
    (assoc :a :access-request/document)))

(defmethod translate-datom :access-grant/document-ref [db d]
  (-> d
    (assoc :a :access-grant/document)))

(defmethod translate-datom :permission/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :access-request/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :access-grant/team [db d]
  (-> d
    (assoc :v (:team/uuid (d/entity db (:v d))))))

(defmethod translate-datom :layer/points-to [db d]
  (-> d
    (assoc :v (web-peer/client-id db (:v d)))))

(defmethod translate-datom :team/plan [db d]
  (-> d
    (assoc :v (web-peer/client-id db (:v d)))))

(defmethod translate-datom :plan/active-custs [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :discount/coupon [db d]
  (-> d
    (assoc :v (plan-model/coupon-read-api (d/ident db (:v d))))))

(defmethod translate-datom :plan/invoices [db d]
  (-> d
    (assoc :v (web-peer/client-id (d/entity db (:v d))))))

(defmethod translate-datom :vote/cust [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :comment/cust [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :issue/author [db d]
  (-> d
    (assoc :v (:cust/email (d/entity db (:v d))))))

(defmethod translate-datom :comment/parent [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defmethod translate-datom :issue/comments [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defmethod translate-datom :issue/votes [db d]
  (-> d
    (assoc :v [:frontend/issue-id (:frontend/issue-id (d/entity db (:v d)))])))

(defn datom-read-api [db datom]
  (let [{:keys [e a v tx added] :as d} datom
        a (schema/get-ident a)
        v (if (and (contains? (schema/enums) a)
                   (contains? (schema/ident-ids) v))
            (schema/get-ident v)
            v)
        e (web-peer/client-id db e)]
    (->> {:e e :a a :v v :tx tx :added added}
      (translate-datom db))))

(defn whitelisted? [scope datom]
  (contains? (outgoing-whitelist scope) (:a datom)))

(defn frontend-document-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)]
    (when (and (:transaction/document annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (->> transaction
                                 :tx-data
                                 (filter #(:frontend/id (d/entity (:db-after transaction) (:e %))))
                                 (map (partial datom-read-api (:db-after transaction)))
                                 (filter (partial whitelisted? :admin))
                                 seq)]
        {:admin-data (merge {:tx-data public-datoms}
                            annotations)
         :read-only-data (merge {:tx-data (filter (partial whitelisted? :read) public-datoms)}
                                annotations)}))))

(defn frontend-team-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)]
    (when (and (:transaction/team annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (->> transaction
                                 :tx-data
                                 (filter #(:frontend/id (d/entity (:db-after transaction) (:e %))))
                                 (map (partial datom-read-api (:db-after transaction)))
                                 (filter (partial whitelisted? :admin))
                                 seq)]
        {:admin-data (merge {:tx-data public-datoms}
                            annotations)
         :read-only-data (merge {:tx-data (filter (partial whitelisted? :read) public-datoms)}
                                annotations)}))))

(def issue-whitelist #{:vote/cust
                       :comment/body
                       :comment/cust
                       :comment/created-at
                       :comment/parent
                       :issue/title
                       :issue/description
                       :issue/author
                       :issue/document
                       :issue/created-at
                       :issue/votes
                       :issue/comments
                       :frontend/issue-id})

(defn issue-whitelisted? [datom]
  (contains? issue-whitelist (:a datom)))

(defn has-issue-frontend-id? [db frontend-id-memo datom]
  (frontend-id-memo db (:e datom)))

(defn issue-datom-read-api [db datom]
  (let [{:keys [e a v tx added] :as d} datom
        a (schema/get-ident a)
        v (if (and (contains? (schema/enums) a)
                   (contains? (schema/ident-ids) v))
            (schema/get-ident v)
            v)]
    (->> {:e e :a a :v v :tx tx :added added}
      (translate-datom db))))

(defn add-issue-frontend-ids
  "Converts eids to tempids that the frontend will understand and matches them up with
   issue ids"
  [frontend-id-memo db txes]
  (let [eid-map (zipmap (set (map :e txes))
                        (map (comp - inc) (range))) ; {eid-1 -1 eid-2 -2}
        ;; matches tempid with issue-id
        frontend-id-txes (map (fn [[eid tempid]] {:e tempid
                                                  :a :frontend/issue-id
                                                  :v (frontend-id-memo db eid)
                                                  :added true})
                              eid-map)]
    ;; XXX: need to do something about refs
    (concat
     (map (fn [datom]
            ;; replaces lookup-ref style e with tempid
            (update-in datom [:e] eid-map))
          txes)
     frontend-id-txes)))

(defn frontend-issue-transaction
  "Returns map of document transactions filtered for admin and filtered for read-only access"
  [transaction]
  (let [annotations (get-annotations transaction)
        frontend-id-memo (memoize (fn [db e] (:frontend/issue-id (d/entity db e))))]
    (when (and (:transaction/issue-tx? annotations)
               (:transaction/broadcast annotations))
      (when-let [public-datoms (some->> transaction
                                 :tx-data
                                 (filter (partial has-issue-frontend-id?
                                                  (:db-after transaction)
                                                  frontend-id-memo))
                                 (map (partial issue-datom-read-api
                                               (:db-after transaction)))
                                 (filter issue-whitelisted?)
                                 (add-issue-frontend-ids frontend-id-memo
                                                         (:db-after transaction))
                                 seq)]
        (merge {:tx-data public-datoms}
               annotations)))))

make reporting new issues to fe work

make reporting new issues to fe work


(ns bob (:use clojure.string))

(defn response-for [x]
	(if (blank? x)
		"Fine, be that way."
		(if (= (upper-case x) x)
			"Woah, chill out!"
			(if (= \? (.charAt x (- (.length x) 1)))
				"Sure."
				"Whatever."
			)
		)
	)

)

(ns bob (:use clojure.string))

(defn response-for [x]
	(cond
		(blank? x) "Fine, be that way."
		(= (upper-case x) x) "Woah, chill out!"
		(= \? (.charAt x (- (.length x) 1))) "Sure."
		true "Whatever."
	)
)

Refactor to use cond

Refactor to use cond


(ns emulator-chip8.opcode
  ;;  #?(:cljs (:require-macros [emulator-chip8.opcode :refer [defop to-opcode-func]]))
  )

;; #?(:clj
;;    (defmacro defop
;;      [name & body]
;;      (let [name (symbol (str "opcode-" name))
;;            args [{'r :registers 'm :memory :as 'cpu}
;;                  'addr-mode
;;                  ['n 'n-addr]]]
;;        `(defn ~name ~args ~@body))))

;; #?(:clj
;;    (defmacro to-opcode-func [name]
;;      (let [n  (symbol (str name))]
;;        `(~n)
;;        )))

(def opcode-table (atom #{}))

(defmacro defop
  [opcode args & body]
  (let [key (keyword (name opcode))
        pname (symbol (str "opcode-" (name opcode)))
        ]
    `(defn ~pname [~@args] ~@body)
    (swap! opcode-table conj key)
    ))

(defop :6XNN
  []
  ;;(println "ad")
  )

(defop :8XY3
  []
  ;;(println "ad")
  )

(deref opcode-table)
(reset! opcode-table #{})

(swap! opcode-table conj (keyword (name :aaa)))

(swap! opcode-table conj :as)

(defn make-opcode-match-list
  [opcode]
  (let [code (format "%04X" opcode)
        ZNNN (format "%SNNN" (subs code 0 1))
        ZXNN (format "%SXNN" (subs code 0 1))
        ZXYN (format "%SXYN" (subs code 0 1))
        ZXYZ (format "%SXY%S" (subs code 0 1) (subs code 3 4))
        ZXZZ (format "%SX%S"  (subs code 0 1) (subs code 2 4))]
    (list code ZNNN ZXNN ZXZZ ZXYN ZXYZ)))

(defn make-opcode-sets
  [opcode]
  ;; Create possible opcode set for handler-list
  (->> (make-opcode-match-list opcode)
       (map keyword)
       (set)))

(def handler-list
  {;; Execute machine language subroutine at address NNN
   :0NNN 'unimplement

   ;; Clear the screen
   :00E0 'clear-screen

   ;; Return from a subroutine
   :00EE 'return-from-subroutine

   ;; Jump to address NNN
   :1NNN 'jump-to-address

   ;; Execute subroutine starting at address NNN
   :2NNN 'call-subroutine

   ;; Skip the following instruction if the value of register VX equals NN
   :3XNN 'skip-when-VX-equal-NN

   ;; Skip the following instruction if the value of register VX is
   ;; not equal to NN
   :4XNN 'skip-when-VX-not-equal-NN

   ;; Skip the following instruction if the value of register VX is
   ;; equal to the value of register VY
   :5XY0 'skip-when-VX-equal-VY

   ;; Store number NN in register VX
   :6XNN 'store-NN-in-VX

   ;; Add the value NN to register VX
   :7XNN 'add-NN-to-VX

   ;; Store the value of register VY in register VX
   :8XY0 'store-VY-in-VX

   ;; Set VX to VX OR VY
   :8XY1 'set-VX-to-VX-or-VY

   ;; Set VX to VX AND VY
   :8XY2 'set-VX-to-VX-and-VY

   ;; Set VX to VX XOR VY
   :8XY3 'set-VX-to-VX-xor-VY

   ;; Add the value of register VY to register VX
   ;; Set VF to 1 if a carry occurs
   ;; Set VF to 0 if a carry does not occur
   :8XY4 'add-VY-to-VX

   ;; Subtract the value of register VY from register VX
   ;; Set VF to 0 if a borrow occurs
   ;; Set VF to 1 if a borrow does not occur
   :8XY5 'substract-VY-from-VX

   ;; Store the value of register VY shifted right one bit in register VX
   ;; Set register VF to the least significant bit prior to the
   ;; shift
   :8XY6 'unimplement

   ;; Set register VX to the value of VY minus VX
   ;; Set VF to 00 if a borrow occurs
   ;; Set VF to 01 if a borrow does not occur
   :8XY7 'unimplement

   ;; Store the value of register VY shifted left one bit in register VX
   ;; Set register VF to the most significant bit prior to the shift
   :8XYE 'unimplement

   ;; Skip the following instruction if the value of register VX is
   ;; not equal to the value of register VY
   :9XY0 'unimplement

   ;; Store memory address NNN in register I
   :ANNN 'store-NNN-in-I

   ;; Jump to address NNN + V0
   :BNNN 'unimplement

   ;; Set VX to a random number with a mask of NN
   :CXNN 'set-VX-random-mask-NN

   ;; Draw a sprite at position VX, VY with N bytes of sprite data
   ;; starting at the address stored in I
   ;; Set VF to 01 if any set pixels are changed to unset, and 00
   ;; otherwise
   :DXYN 'unimplement

   ;; Skip the following instruction if the key corresponding to
   ;; the hex value currently stored in register VX is pressed
   :EX9E 'unimplement

   ;; Skip the following instruction if the key corresponding to the
   ;; hex value currently stored in register VX is not pressed
   :EXA1 'unimplement

   ;; Store the current value of the delay timer in register VX
   :FX07 'store-delay-timer-to-VX

   ;; Wait for a keypress and store the result in register VX
   :FX0A 'unimplement

   ;; Set the delay timer to the value of register VX
   :FX15 'store-VX-to-delay-timer

   ;; Set the sound timer to the value of register VX
   :FX18 'store-VX-to-sound-timer

   ;; Add the value stored in register VX to register I
   :FX1E 'unimplement

   ;; Set I to the memory address of the sprite data corresponding
   ;; to the hexadecimal digit stored in register VX
   :FX29 'unimplement

   ;; Store the binary-coded decimal equivalent of the value stored
   ;; in register VX at addresses I, I + 1, and I + 2
   :FX33 'unimplement

   ;; Store the values of registers V0 to VX inclusive in memory
   ;; starting at address I
   ;; I is set to I + X + 1 after operation
   :FX55 'unimplement

   ;; Fill registers V0 to VX inclusive with the values stored in
   ;; memory starting at address I
   ;; I is set to I + X + 1 after operation
   :FX65 'unimplement
   })

(defn find-match-handler
  "Search for matching handler in handler list.
  If nothing find, return nil else return keyword."
  [handler opcode]
  (str "opcode-" (name (some (make-opcode-sets opcode) (keys handler))) )
  )

(defn make-handler-args
  "Parse the code to find how many VX, VY, NNN, NN, N
  and create argument lists."
  [opcode]
  (let [code (format "%04X" opcode)]
    {:NNN (subs code 1 4)
     :NN  (subs code 2 4)
     :N   (subs code 3 4)
     :VX  (subs code 1 2)
     :VY  (subs code 2 3)}))

(comment
  (make-opcode-sets 0xf155) ;; FX55
  (make-handler-args 0xf155) ;; FX55

  (find-match-handler handler-list 0xf155)

  (keys handler-list)
  )

(defn find-match-handler
  "Search for matching handler in handler list.
  If nothing find, return nil else return keyword."
  [handler opcode]
  (some (make-opcode-sets opcode) (keys handler)))

;; 0NNN
(defop 0NNN
  )

;; 00E0
(defn opcode-00E0
  "Clear the screen. This function will also set draw-flag to 1
  to make canvas function refresh."
  [])

;; 00EE
(defn opcode-00EE
  [])

;; 1NNN
(defn opcode-1NNN
  "Jump to address NNN."
  [])

;; 2NNN
(defn opcode-2NNN
  [])

;; 3XNN
(defn opcode-3XNN
  "Skip next instruction if the value of register VX equals NN"
  [])

;; 4XNN
(defn opcode-4XNN
  "Skip next instruction if the value of register VX is
  not equal to NN."
  [])

;; 5XY0
(defn opcode-5XY0
  "Skip next instruction if the value of register VX is
  equal to the value of register VY."
  [])

;; 6XNN
(defn opcode-6XNN
  "Store number NN in register VX."
  [])

;; 7XNN
(defn opcode-7XNN
  "Add the value NN to register VX."
  [])

;; 8XY0
(defn opcode-8XY0
  "Store the value of register VY in register VX."
  [])

;; 8XY1
(defn opcode-8XY1
  "Set VX to VX OR VY."
  [])

;; 8XY2
(defn opcode-8XY2
  "Set VX to VX AND VY."
  [])

;; 8XY3
(defn opcode-8XY3
  "Set VX to VX XOR VY."
  [])

;; 8XY4
(defn opcode-8XY4
  "Add the value of register VY to register VX.
  Set VF to 1 if a carry occurs
  Set VF to 0 if a carry does not occur"
  [])

;; 8XY5
(defn opcode-8XY5
  "Subtract the value of register VY from register VX.
  Set VF to 0 if a borrow occurs
  Set VF to 1 if a borrow does not occur"
  [])

;; 8XY6
(defn opcode-8XY6
  ""
  [])

;; 8XY7
(defn opcode-8XY7
  ""
  [])

;; 8XYE
(defn opcode-8XYE
  ""
  [])

;; 9XY0
(defn opcode-9XY0
  ""
  [])

;; ANNN
(defn opcode-ANNN
  "Store memory address NNN in register I."
  [])

;; BNNN
(defn opcode-BNNN
  ""
  [])

;; CXNN
(defn opcode-CXNN
  "Set VX to a random number with a mask of NN"
  [])

;; DXYN
(defn opcode-DXYN
  ""
  [])

;; EX9E
(defn opcode-EX9E
  ""
  [])

;; EXA1
(defn opcode-EXA1
  ""
  [])

;; FX07
(defn opcode-FX07
  "Store the current value of the delay timer in register VX."
  [])

;; FX0A
(defn opcode-FX0A
  ""
  [])

;; FX15
(defn opcode-FX15
  "Set the delay timer to the value of register VX."
  [])

;; FX18
(defn opcode-FX18
  "Set the sound timer to the value of register VX."
  [])

(ns emulator-chip8.opcode
  ;;  #?(:cljs (:require-macros [emulator-chip8.opcode :refer [defop to-opcode-func]]))
  )

;; #?(:clj
;;    (defmacro defop
;;      [name & body]
;;      (let [name (symbol (str "opcode-" name))
;;            args [{'r :registers 'm :memory :as 'cpu}
;;                  'addr-mode
;;                  ['n 'n-addr]]]
;;        `(defn ~name ~args ~@body))))

;; #?(:clj
;;    (defmacro to-opcode-func [name]
;;      (let [n  (symbol (str name))]
;;        `(~n)
;;        )))

(def opcode-table (atom #{}))

(defmacro defop
  [opcode args & body]
  (let [key (keyword (name opcode))
        pname (symbol (str "opcode-" (name opcode)))
        ]
    `(defn ~pname [~@args] ~@body)
    (swap! opcode-table conj key)
    ))

;; http://stackoverflow.com/questions/24897818/how-to-add-docstring-support-to-defn-like-clojure-macro

(defop :0NNN
  "Execute machine language subroutine at address NNN"
  [])

(defop :00E0
  "Clear the screen"
  [])

(defop :00EE
  "Return from a subroutine"
  [])

(defop :1NNN
  "Jump to address NNN"
  [])

(defop :2NNN
  "Execute subroutine starting at address NNN"
  [])

(defop :3XNN
  "Skip the following instruction if the value of register VX equals NN"
  [])

(defop :4XNN
  "Skip the following instruction if the value of register VX is not equal to
  NN"
  [])

(defop :5XY0
  "Skip the following instruction if the value of register VX is equal to the value of register VY"
  [])

;;;;;;;;;;;

(defop :6XNN
  []
  ;;(println "ad")
  )

(defop :8XY3
  []
  ;;(println "ad")
  )

(deref opcode-table)
(reset! opcode-table #{})

(swap! opcode-table conj (keyword (name :aaa)))

(swap! opcode-table conj :as)

(defn make-opcode-match-list
  [opcode]
  (let [code (format "%04X" opcode)
        ZNNN (format "%SNNN" (subs code 0 1))
        ZXNN (format "%SXNN" (subs code 0 1))
        ZXYN (format "%SXYN" (subs code 0 1))
        ZXYZ (format "%SXY%S" (subs code 0 1) (subs code 3 4))
        ZXZZ (format "%SX%S"  (subs code 0 1) (subs code 2 4))]
    (list code ZNNN ZXNN ZXZZ ZXYN ZXYZ)))

(defn make-opcode-sets
  [opcode]
  ;; Create possible opcode set for handler-list
  (->> (make-opcode-match-list opcode)
       (map keyword)
       (set)))

(def handler-list
  {;; Execute machine language subroutine at address NNN
   ;;   :0NNN 'unimplement

   ;; Clear the screen
   ;;   :00E0 'clear-screen

   ;; Return from a subroutine
   :00EE 'return-from-subroutine

   ;; Jump to address NNN
   :1NNN 'jump-to-address

   ;; Execute subroutine starting at address NNN
   :2NNN 'call-subroutine

   ;; Skip the following instruction if the value of register VX equals NN
   :3XNN 'skip-when-VX-equal-NN

   ;; Skip the following instruction if the value of register VX is
   ;; not equal to NN
   :4XNN 'skip-when-VX-not-equal-NN

   ;; Skip the following instruction if the value of register VX is
   ;; equal to the value of register VY
   :5XY0 'skip-when-VX-equal-VY

   ;; Store number NN in register VX
   :6XNN 'store-NN-in-VX

   ;; Add the value NN to register VX
   :7XNN 'add-NN-to-VX

   ;; Store the value of register VY in register VX
   :8XY0 'store-VY-in-VX

   ;; Set VX to VX OR VY
   :8XY1 'set-VX-to-VX-or-VY

   ;; Set VX to VX AND VY
   :8XY2 'set-VX-to-VX-and-VY

   ;; Set VX to VX XOR VY
   :8XY3 'set-VX-to-VX-xor-VY

   ;; Add the value of register VY to register VX
   ;; Set VF to 1 if a carry occurs
   ;; Set VF to 0 if a carry does not occur
   :8XY4 'add-VY-to-VX

   ;; Subtract the value of register VY from register VX
   ;; Set VF to 0 if a borrow occurs
   ;; Set VF to 1 if a borrow does not occur
   :8XY5 'substract-VY-from-VX

   ;; Store the value of register VY shifted right one bit in register VX
   ;; Set register VF to the least significant bit prior to the
   ;; shift
   :8XY6 'unimplement

   ;; Set register VX to the value of VY minus VX
   ;; Set VF to 00 if a borrow occurs
   ;; Set VF to 01 if a borrow does not occur
   :8XY7 'unimplement

   ;; Store the value of register VY shifted left one bit in register VX
   ;; Set register VF to the most significant bit prior to the shift
   :8XYE 'unimplement

   ;; Skip the following instruction if the value of register VX is
   ;; not equal to the value of register VY
   :9XY0 'unimplement

   ;; Store memory address NNN in register I
   :ANNN 'store-NNN-in-I

   ;; Jump to address NNN + V0
   :BNNN 'unimplement

   ;; Set VX to a random number with a mask of NN
   :CXNN 'set-VX-random-mask-NN

   ;; Draw a sprite at position VX, VY with N bytes of sprite data
   ;; starting at the address stored in I
   ;; Set VF to 01 if any set pixels are changed to unset, and 00
   ;; otherwise
   :DXYN 'unimplement

   ;; Skip the following instruction if the key corresponding to
   ;; the hex value currently stored in register VX is pressed
   :EX9E 'unimplement

   ;; Skip the following instruction if the key corresponding to the
   ;; hex value currently stored in register VX is not pressed
   :EXA1 'unimplement

   ;; Store the current value of the delay timer in register VX
   :FX07 'store-delay-timer-to-VX

   ;; Wait for a keypress and store the result in register VX
   :FX0A 'unimplement

   ;; Set the delay timer to the value of register VX
   :FX15 'store-VX-to-delay-timer

   ;; Set the sound timer to the value of register VX
   :FX18 'store-VX-to-sound-timer

   ;; Add the value stored in register VX to register I
   :FX1E 'unimplement

   ;; Set I to the memory address of the sprite data corresponding
   ;; to the hexadecimal digit stored in register VX
   :FX29 'unimplement

   ;; Store the binary-coded decimal equivalent of the value stored
   ;; in register VX at addresses I, I + 1, and I + 2
   :FX33 'unimplement

   ;; Store the values of registers V0 to VX inclusive in memory
   ;; starting at address I
   ;; I is set to I + X + 1 after operation
   :FX55 'unimplement

   ;; Fill registers V0 to VX inclusive with the values stored in
   ;; memory starting at address I
   ;; I is set to I + X + 1 after operation
   :FX65 'unimplement
   })

(defn find-match-handler
  "Search for matching handler in handler list.
  If nothing find, return nil else return keyword."
  [handler opcode]
  (str "opcode-" (name (some (make-opcode-sets opcode) (keys handler))) )
  )

(defn make-handler-args
  "Parse the code to find how many VX, VY, NNN, NN, N
  and create argument lists."
  [opcode]
  (let [code (format "%04X" opcode)]
    {:NNN (subs code 1 4)
     :NN  (subs code 2 4)
     :N   (subs code 3 4)
     :VX  (subs code 1 2)
     :VY  (subs code 2 3)}))

(comment
  (make-opcode-sets 0xf155) ;; FX55
  (make-handler-args 0xf155) ;; FX55

  (find-match-handler handler-list 0xf155)

  (keys handler-list)
  )

(defn find-match-handler
  "Search for matching handler in handler list.
  If nothing find, return nil else return keyword."
  [handler opcode]
  (some (make-opcode-sets opcode) (keys handler)))

;; 0NNN
(defop 0NNN
  )

;; 00E0
(defn opcode-00E0
  "Clear the screen. This function will also set draw-flag to 1
  to make canvas function refresh."
  [])

;; 00EE
(defn opcode-00EE
  [])

;; 1NNN
(defn opcode-1NNN
  "Jump to address NNN."
  [])

;; 2NNN
(defn opcode-2NNN
  [])

;; 3XNN
(defn opcode-3XNN
  "Skip next instruction if the value of register VX equals NN"
  [])

;; 4XNN
(defn opcode-4XNN
  "Skip next instruction if the value of register VX is
  not equal to NN."
  [])

;; 5XY0
(defn opcode-5XY0
  "Skip next instruction if the value of register VX is
  equal to the value of register VY."
  [])

;; 6XNN
(defn opcode-6XNN
  "Store number NN in register VX."
  [])

;; 7XNN
(defn opcode-7XNN
  "Add the value NN to register VX."
  [])

;; 8XY0
(defn opcode-8XY0
  "Store the value of register VY in register VX."
  [])

;; 8XY1
(defn opcode-8XY1
  "Set VX to VX OR VY."
  [])

;; 8XY2
(defn opcode-8XY2
  "Set VX to VX AND VY."
  [])

;; 8XY3
(defn opcode-8XY3
  "Set VX to VX XOR VY."
  [])

;; 8XY4
(defn opcode-8XY4
  "Add the value of register VY to register VX.
  Set VF to 1 if a carry occurs
  Set VF to 0 if a carry does not occur"
  [])

;; 8XY5
(defn opcode-8XY5
  "Subtract the value of register VY from register VX.
  Set VF to 0 if a borrow occurs
  Set VF to 1 if a borrow does not occur"
  [])

;; 8XY6
(defn opcode-8XY6
  ""
  [])

;; 8XY7
(defn opcode-8XY7
  ""
  [])

;; 8XYE
(defn opcode-8XYE
  ""
  [])

;; 9XY0
(defn opcode-9XY0
  ""
  [])

;; ANNN
(defn opcode-ANNN
  "Store memory address NNN in register I."
  [])

;; BNNN
(defn opcode-BNNN
  ""
  [])

;; CXNN
(defn opcode-CXNN
  "Set VX to a random number with a mask of NN"
  [])

;; DXYN
(defn opcode-DXYN
  ""
  [])

;; EX9E
(defn opcode-EX9E
  ""
  [])

;; EXA1
(defn opcode-EXA1
  ""
  [])

;; FX07
(defn opcode-FX07
  "Store the current value of the delay timer in register VX."
  [])

;; FX0A
(defn opcode-FX0A
  ""
  [])

;; FX15
(defn opcode-FX15
  "Set the delay timer to the value of register VX."
  [])

;; FX18
(defn opcode-FX18
  "Set the sound timer to the value of register VX."
  [])

add more defop

add more defop

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>


;; Copyright (c) Cognitect, Inc.
;; All rights reserved.

(ns transit.read
  (:refer-clojure :exclude [read])
  (:require [transit.write :as w]
            [clojure.edn :as edn])
  (:import [com.fasterxml.jackson.core
            JsonFactory JsonParser JsonToken JsonParseException]
           org.msgpack.MessagePack
           [org.msgpack.unpacker Unpacker MessagePackUnpacker]
           [org.msgpack.type Value MapValue ArrayValue RawValue ValueType]
           [org.apache.commons.codec.binary Base64]
           [java.io InputStream OutputStream EOFException]))

(set! *warn-on-reflection* true)

(defn read-int-str
  [s]
  (let [o (edn/read-string s)]
    (when (number? o) o)))

(def decode-fns (atom {":" #(keyword %)
                       "?" #(Boolean. ^String %)
                       "b" #(Base64/decodeBase64 ^bytes %)
                       "_" #(identity nil)
                       "i" #(try
                              (Long/parseLong %)
                              (catch NumberFormatException _ (read-int-str %)))
                       "d" #(Double. ^String %)
                       "f" #(java.math.BigDecimal. ^String %)
                       "t" #(if (string? %)
                              (java.util.Date. ^String %)
                              (java.util.Date. ^long %))
                       "u" #(if (string? %)
                              (java.util.UUID/fromString %)
                              (java.util.UUID. (first %) (second %)))
                       "r" #(java.net.URI. %)
                       "$" #(symbol %)
                       "set" #(reduce (fn [s v] (conj s v)) #{} %)
                       "list" #(reverse (into '() %))}))

(defn register-decode-fn
  [tag fn]
  (swap! decode-fns assoc tag fn))

(defn decode-fn
  [tag]
  ;;(prn "decode" tag rep)
  (@decode-fns tag))

(defprotocol ReadCache
  (cache-read [cache str as-map-key]))

(defn parse-str
  [s]
  ;;(prn "parse-str before" s)
  (let [res (if (and (string? s) (> (.length ^String s) 1))
              ;; any way to use w/ESC, et al?
              (case (.charAt ^String s 0)
                \~
                (case (.charAt ^String s 1)
                  \~ (subs s 1) ;; w/ESC
                  \^ (subs s 1) ;; w/SUB
                  \` (subs s 1) ;; w/RESERVED
                  \# s          ;; w/TAG
                  (if-let [decode-fn (decode-fn (subs s 1 2))]
                    (decode-fn (subs s 2))
                    s))
                s)
              s)]
    ;;(prn "parse-str after" res)
    res))

(defn parse-tagged-map
  [^java.util.Map m]
  (let [entries (.entrySet m)
        iter (.iterator entries)
        entry (when (.hasNext iter) (.next iter))
        key (when entry (.getKey ^java.util.Map$Entry entry))]
    (if (and entry (string? key) (> (.length ^String key) 1) (= w/TAG ^Character (.charAt ^String key 1)))
      (if-let [decode-fn (decode-fn (subs key 2))]
        (decode-fn (.getValue ^java.util.Map$Entry entry))
        m)
      m)))

(defn cache-code?
  [^String s]
  (= w/SUB ^Character (.charAt s 0)))

(defn code->idx
  [^String s]
  (- (byte ^Character (.charAt s 1)) w/BASE_CHAR_IDX))

(deftype ReadCacheImpl [^:unsynchronized-mutable idx cache]
  ReadCache
  (cache-read [_ str as-map-key]
    ;;(prn "cache read before" idx str)
    (let [res (if (and str (not (zero? (.length ^String str))))
                (if (w/cacheable? str as-map-key)
                  (do
                    (when (= idx (dec w/MAX_CACHE_ENTRIES))
                      (set! idx 0))
                    (aset ^objects cache idx (parse-str str))
                    (set! idx (inc idx))
                    str)
                  (if (cache-code? str)
                    (aget ^objects cache (code->idx str))
                    str))
                str)]
      ;;(prn "cache read after" idx res)
      res)))

(defn read-cache [] (ReadCacheImpl. 0 (make-array Object w/MAX_CACHE_ENTRIES)))

(defprotocol Parser
  (parse [p cache])
  (parse-val [p as-map-key cache])
  (parse-map [p as-map-key cache])
  (parse-array [p as-map-key cache]))

(extend-protocol Parser
  JsonParser
  (parse [^JsonParser jp cache]
    (when (.nextToken jp) (parse-val jp false cache)))

  (parse-val [^JsonParser jp as-map-key cache]
    ;;(prn "parse-val" (.getCurrentToken jp))
    (condp = (.getCurrentToken jp)
      JsonToken/START_OBJECT
      (parse-tagged-map (parse-map jp as-map-key cache))
      JsonToken/START_ARRAY
      (parse-array jp as-map-key cache)
      JsonToken/FIELD_NAME
      (parse-str (cache-read cache (.getText jp) as-map-key))
      JsonToken/VALUE_STRING
      (parse-str (cache-read cache (.getText jp) as-map-key))
      JsonToken/VALUE_NUMBER_INT
      (try
        (.getLongValue jp) ;; always read as long, coerce to string if too big
        (catch JsonParseException _ (read-int-str (.getText jp))))
      JsonToken/VALUE_NUMBER_FLOAT
      (.getDoubleValue jp) ;; always read as double
      JsonToken/VALUE_TRUE
      (.getBooleanValue jp)
      JsonToken/VALUE_FALSE
      (.getBooleanValue jp)
      JsonToken/VALUE_NULL
      nil))

  (parse-map [^JsonParser jp _ cache]
    (persistent!
     (let [res (transient {})]
       (while (not= (.nextToken jp) JsonToken/END_OBJECT)
         (let [k (parse-val jp true cache)
               _ (.nextToken jp)
               v (parse-val jp false cache)]
           (assoc! res k v)))
       res)))

  (parse-array [^JsonParser jp _ cache]
    (persistent!
     (let [res (transient [])]
       (while (not= (.nextToken jp) JsonToken/END_ARRAY)
         (conj! res (parse-val jp false cache)))
       res))))

(extend-protocol Parser
  MessagePackUnpacker
  (parse [^MessagePackUnpacker mup cache] (parse-val mup false cache))

  (parse-val [^MessagePackUnpacker mup as-map-key cache]
    (try
      (condp = (.getNextType mup)
        ValueType/MAP
        (parse-tagged-map (parse-map mup as-map-key cache))
        ValueType/ARRAY
        (parse-array mup as-map-key cache)
        ValueType/RAW
        (parse-str (cache-read cache
                               (-> mup .readValue .asRawValue .getString)
                               as-map-key))
        ValueType/INTEGER
        (-> mup .readValue .asIntegerValue .getLong) ;; always read as long
        ValueType/FLOAT
        (-> mup .readValue .asFloatValue .getDouble) ;; always read as double
        ValueType/BOOLEAN
        (-> mup .readValue .asBooleanValue .getBoolean)
        ValueType/NIL
        (.readNil mup))
      (catch EOFException e)))

  (parse-map [^MessagePackUnpacker mup _ cache]
    (persistent!
     (let [res (transient {})]
       (dotimes [_ (.readMapBegin mup)]
         (assoc! res (parse-val mup true cache) (parse-val mup false cache)))
       (.readMapEnd mup false)
       res)))

  (parse-array
    [^MessagePackUnpacker mup _ cache]
    (persistent!
     (let [res (transient [])]
       (dotimes [_ (.readArrayBegin mup)]
         (conj! res (parse-val mup false cache)))
       (.readArrayEnd mup false)
       res))))

(deftype Reader [r])

(defn js-reader [^InputStream stm]
  (Reader. (.createParser (JsonFactory.) stm)))

(defn mp-reader [^InputStream stm]
  (Reader. (.createUnpacker (MessagePack.) stm)))

(defn read [^Reader reader]
  (parse (.r reader) (read-cache)))

;; Copyright (c) Cognitect, Inc.
;; All rights reserved.

(ns transit.read
  (:refer-clojure :exclude [read])
  (:require [transit.write :as w]
            [clojure.edn :as edn])
  (:import [com.fasterxml.jackson.core
            JsonFactory JsonParser JsonToken JsonParseException]
           org.msgpack.MessagePack
           [org.msgpack.unpacker Unpacker MessagePackUnpacker]
           [org.msgpack.type Value MapValue ArrayValue RawValue ValueType]
           [org.apache.commons.codec.binary Base64]
           [java.io InputStream OutputStream EOFException]))

(set! *warn-on-reflection* true)

(defn read-int-str
  [s]
  (let [o (edn/read-string s)]
    (when (number? o) o)))

(def decode-fns (atom {":" #(keyword %)
                       "?" #(Boolean. ^String %)
                       "b" #(Base64/decodeBase64 ^bytes %)
                       "_" (fn [_] nil)
                       "i" #(try
                              (Long/parseLong %)
                              (catch NumberFormatException _ (read-int-str %)))
                       "d" #(Double. ^String %)
                       "f" #(java.math.BigDecimal. ^String %)
                       "t" #(if (string? %)
                              (java.util.Date. ^String %)
                              (java.util.Date. ^long %))
                       "u" #(if (string? %)
                              (java.util.UUID/fromString %)
                              (java.util.UUID. (first %) (second %)))
                       "r" #(java.net.URI. %)
                       "$" #(symbol %)
                       "set" #(reduce (fn [s v] (conj s v)) #{} %)
                       "list" #(reverse (into '() %))}))

(defn register-decode-fn
  [tag fn]
  (swap! decode-fns assoc tag fn))

(defn decode-fn
  [tag]
  ;;(prn "decode" tag rep)
  (@decode-fns tag))

(defprotocol ReadCache
  (cache-read [cache str as-map-key]))

(defn parse-str
  [s]
  ;;(prn "parse-str before" s)
  (let [res (if (and (string? s) (> (.length ^String s) 1))
              ;; any way to use w/ESC, et al?
              (case (.charAt ^String s 0)
                \~
                (case (.charAt ^String s 1)
                  \~ (subs s 1) ;; w/ESC
                  \^ (subs s 1) ;; w/SUB
                  \` (subs s 1) ;; w/RESERVED
                  \# s          ;; w/TAG
                  (if-let [decode-fn (decode-fn (subs s 1 2))]
                    (decode-fn (subs s 2))
                    s))
                s)
              s)]
    ;;(prn "parse-str after" res)
    res))

(defn parse-tagged-map
  [^java.util.Map m]
  (let [entries (.entrySet m)
        iter (.iterator entries)
        entry (when (.hasNext iter) (.next iter))
        key (when entry (.getKey ^java.util.Map$Entry entry))]
    (if (and entry (string? key) (> (.length ^String key) 1) (= w/TAG ^Character (.charAt ^String key 1)))
      (if-let [decode-fn (decode-fn (subs key 2))]
        (decode-fn (.getValue ^java.util.Map$Entry entry))
        m)
      m)))

(defn cache-code?
  [^String s]
  (= w/SUB ^Character (.charAt s 0)))

(defn code->idx
  [^String s]
  (- (byte ^Character (.charAt s 1)) w/BASE_CHAR_IDX))

(deftype ReadCacheImpl [^:unsynchronized-mutable idx cache]
  ReadCache
  (cache-read [_ str as-map-key]
    ;;(prn "cache read before" idx str)
    (let [res (if (and str (not (zero? (.length ^String str))))
                (if (w/cacheable? str as-map-key)
                  (do
                    (when (= idx (dec w/MAX_CACHE_ENTRIES))
                      (set! idx 0))
                    (aset ^objects cache idx (parse-str str))
                    (set! idx (inc idx))
                    str)
                  (if (cache-code? str)
                    (aget ^objects cache (code->idx str))
                    str))
                str)]
      ;;(prn "cache read after" idx res)
      res)))

(defn read-cache [] (ReadCacheImpl. 0 (make-array Object w/MAX_CACHE_ENTRIES)))

(defprotocol Parser
  (parse [p cache])
  (parse-val [p as-map-key cache])
  (parse-map [p as-map-key cache])
  (parse-array [p as-map-key cache]))

(extend-protocol Parser
  JsonParser
  (parse [^JsonParser jp cache]
    (when (.nextToken jp) (parse-val jp false cache)))

  (parse-val [^JsonParser jp as-map-key cache]
    ;;(prn "parse-val" (.getCurrentToken jp))
    (condp = (.getCurrentToken jp)
      JsonToken/START_OBJECT
      (parse-tagged-map (parse-map jp as-map-key cache))
      JsonToken/START_ARRAY
      (parse-array jp as-map-key cache)
      JsonToken/FIELD_NAME
      (parse-str (cache-read cache (.getText jp) as-map-key))
      JsonToken/VALUE_STRING
      (parse-str (cache-read cache (.getText jp) as-map-key))
      JsonToken/VALUE_NUMBER_INT
      (try
        (.getLongValue jp) ;; always read as long, coerce to string if too big
        (catch JsonParseException _ (read-int-str (.getText jp))))
      JsonToken/VALUE_NUMBER_FLOAT
      (.getDoubleValue jp) ;; always read as double
      JsonToken/VALUE_TRUE
      (.getBooleanValue jp)
      JsonToken/VALUE_FALSE
      (.getBooleanValue jp)
      JsonToken/VALUE_NULL
      nil))

  (parse-map [^JsonParser jp _ cache]
    (persistent!
     (let [res (transient {})]
       (while (not= (.nextToken jp) JsonToken/END_OBJECT)
         (let [k (parse-val jp true cache)
               _ (.nextToken jp)
               v (parse-val jp false cache)]
           (assoc! res k v)))
       res)))

  (parse-array [^JsonParser jp _ cache]
    (persistent!
     (let [res (transient [])]
       (while (not= (.nextToken jp) JsonToken/END_ARRAY)
         (conj! res (parse-val jp false cache)))
       res))))

(extend-protocol Parser
  MessagePackUnpacker
  (parse [^MessagePackUnpacker mup cache] (parse-val mup false cache))

  (parse-val [^MessagePackUnpacker mup as-map-key cache]
    (try
      (condp = (.getNextType mup)
        ValueType/MAP
        (parse-tagged-map (parse-map mup as-map-key cache))
        ValueType/ARRAY
        (parse-array mup as-map-key cache)
        ValueType/RAW
        (parse-str (cache-read cache
                               (-> mup .readValue .asRawValue .getString)
                               as-map-key))
        ValueType/INTEGER
        (-> mup .readValue .asIntegerValue .getLong) ;; always read as long
        ValueType/FLOAT
        (-> mup .readValue .asFloatValue .getDouble) ;; always read as double
        ValueType/BOOLEAN
        (-> mup .readValue .asBooleanValue .getBoolean)
        ValueType/NIL
        (.readNil mup))
      (catch EOFException e)))

  (parse-map [^MessagePackUnpacker mup _ cache]
    (persistent!
     (let [res (transient {})]
       (dotimes [_ (.readMapBegin mup)]
         (assoc! res (parse-val mup true cache) (parse-val mup false cache)))
       (.readMapEnd mup false)
       res)))

  (parse-array
    [^MessagePackUnpacker mup _ cache]
    (persistent!
     (let [res (transient [])]
       (dotimes [_ (.readArrayBegin mup)]
         (conj! res (parse-val mup false cache)))
       (.readArrayEnd mup false)
       res))))

(deftype Reader [r])

(defn js-reader [^InputStream stm]
  (Reader. (.createParser (JsonFactory.) stm)))

(defn mp-reader [^InputStream stm]
  (Reader. (.createUnpacker (MessagePack.) stm)))

(defn read [^Reader reader]
  (parse (.r reader) (read-cache)))

Fix bug with nil decoding

Fix bug with nil decoding


(ns audio-utils.util)

;;;; Pseudo atom based on a JS array

(defn aatom
  [x]
  (to-array [x]))

(defn areset!
  [x v]
  (aset x 0 v))

(defn aswap!
  [x f & args]
  (let [v (aget x 0)]
    (aset x 0 (apply f (into [v] args)))))

(defn aderef
  [x]
  (aget x 0))

;;;; Time/samples and dB/amplitude conversion

(defn db->amplitude
  "Convert a dB value such as -6.0 to an amplitude value between 0.0
   and 1.0, such as 0.5011872336272722."
  [x]
  (Math/pow 10 (/ x 20)))

(defn amplitude->db
  "Convert an amplitude value between -1.0 and 1.0, such as
   0.5011872336272722, to a dB value like -6.0."
  [x]
  (* 20 (Math/log10 x)))

(defn time->samples
  "Converts a time in milliseconds to the corresponding number of
   samples given a sample rate."
  [x sample-rate]
  (long (* (/ x 1000) sample-rate)))

(defn amplify-sample
  "Amplifies or attentuates a sample by a given amount of dB."
  [sample db]
  (* sample (db->amplitude db)))

(defn amplify
  "Amplifies all samples in the input collection by a given amount
   of dB."
  [coll db]
  (map #(amplify-sample % db) coll))

Add utility functions for amplifying/attenuating samples/signals


(ns shadow.build.data
  "generic helpers for the build data structure"
  (:require
    [clojure.set :as set]
    [clojure.java.io :as io]
    [shadow.debug :refer (?> ?-> ?->>)]
    [shadow.jvm-log :as log]
    [shadow.build.resource :as rc]
    [cljs.tagged-literals :as tags])
  (:import
    [com.google.javascript.jscomp BasicErrorManager ShadowCompiler]
    [org.apache.commons.codec.digest DigestUtils]
    [java.io FileInputStream File]
    [java.net URL]
    [java.nio.file Paths Path]))

;; FIXME: there are still lots of places that work directly with the map
;; that is ok for most things but makes it really annoying to change the structure of the data
;; this is basically just trying to create a formal API for the data
(defn build-state? [state]
  (true? (::build-state state)))

(def empty-data
  {::build-state true
   ;; map of {ns {require sym}}
   ;; keeping entries per ns since they might be relative
   ;; so the same alias might have different requires
   :str->sym {}

   ;; map of {sym resource-id}
   ;; CLJS or goog namespaces to source id
   :sym->id {}

   ;; lookup index of source name to source id
   ;; since closure only works with names not ids
   :name->id {}

   ;; a set of resource-ids used as entry points for the build
   :resolved-entries #{}

   ;; numeric require mapped to its namespace and back
   :require-id->sym {}
   :sym->require-id {}

   ;; map of {resource-id #{resource-id ...}}
   ;; keeps track of immediate deps for each given source
   ;; used for cache invalidation and collecting all deps
   :immediate-deps {}

   ;; map of {clojure.spec.alpha cljs.spec.alpha}
   ;; alias -> actual
   :ns-aliases '{cljs.loader shadow.loader}

   ;; map of {cljs.spec.alpha clojure.spec.alpha}
   ;; actual -> alias, only needed by compiler for the extra provide it needs to account for
   :ns-aliases-reverse '{shadow.loader cljs.loader}

   ;; a set to keep track of symbols that should be strings since they will never be compiled
   :magic-syms #{}

   ;; set of namespaces that are actually in use after :simple optimizations
   ;; some condition requires are removed, eg. react v16 bundle style
   ;; and those should not be included in the final output
   :live-js-deps #{}

   ;; set of dead js resource ids
   :dead-js-deps #{}

   ;; cljs.loader support which requires consts that are constructed by the compiler
   ;; AFTER compiling cljs.core
   :loader-constants {}

   :js-entries #{}

   :mode :dev})

(defn init [state]
  (merge state empty-data))

(defn error-manager []
  (proxy [BasicErrorManager] []
    (printSummary [])
    (println [level error]
      (log/debug ::closure-log {:level (str level)
                                :error (str error)}))))

(defn ^com.google.javascript.jscomp.Compiler make-closure-compiler
  []
  (doto (ShadowCompiler. (error-manager))
    (.disableThreads)))

(defn add-provide [state resource-id provide-sym]
  {:pre [(symbol? provide-sym)]}
  ;; sanity check, should never happen
  (let [conflict (get-in state [:sym->id provide-sym])]
    (when (and conflict (not= conflict resource-id))
      (throw (ex-info (format "symbol %s already provided by %s, conflict with %s" provide-sym conflict resource-id)
               {:provide provide-sym
                :conflict conflict
                :resource-id resource-id}))))

  (update state :sym->id assoc provide-sym resource-id))

(defn add-provides [{:keys [sources] :as state} {:keys [resource-id provides]}]
  {:pre [(rc/valid-resource-id? resource-id)
         (set? provides)
         ;; sanity check that source is added first
         (contains? sources resource-id)]}
  (reduce
    #(add-provide %1 resource-id %2)
    state
    provides))

(defn remove-provides [state {:keys [provides] :as rc}]
  {:pre [(rc/valid-resource? rc)
         (set? provides)]}

  (reduce
    #(update %1 :sym->id dissoc %2)
    state
    provides))

(defn add-string-lookup [{:keys [sources] :as state} require-from-ns require sym]
  {:pre [(symbol? require-from-ns)
         (string? require)
         (symbol? sym)]}

  #_(when-not (contains? sources require-from-ns)
      (throw (ex-info (format "can't add string lookup \"%s\"->\"%s\" for non-existent source %s" require sym require-from-ns)
               {:require-from-id require-from-ns
                :require require
                :sym sym})))

  (assoc-in state [:str->sym require-from-ns require] sym))

(defn get-string-alias [state require-from-ns require]
  {:pre [(symbol? require-from-ns)
         (string? require)]}
  (or (get-in state [:str->sym require-from-ns require])
      (throw (ex-info (format "could not find string alias for \"%s\" from %s" require require-from-ns)
               {:require-from-id require-from-ns
                :require require}))))

(defn get-deps-for-id
  "returns all deps as a set for a given id, these are unordered only a helper for caching"
  [state result rc-id]
  {:pre [(set? result)
         (rc/valid-resource-id? rc-id)]}
  (if (contains? result rc-id)
    result
    (let [deps (get-in state [:immediate-deps rc-id])]
      (when-not deps
        (throw (ex-info (format "no immediate deps for %s" rc-id) {})))
      (reduce #(get-deps-for-id state %1 %2) (conj result rc-id) deps))))

(defn deps->syms [{:keys [ns-aliases] :as state} {:keys [resource-id deps] :as rc}]
  (into [] (for [dep deps]
             (cond
               (symbol? dep)
               (get ns-aliases dep dep)

               (string? dep)
               (or (get-in state [:str->sym (:ns rc) dep])
                   (throw (ex-info (format "no ns alias for dep: %s from: %s" dep resource-id) {:resource-id resource-id :dep dep})))

               :else
               (throw (ex-info "invalid dep" {:dep dep}))
               ))))

(defn get-source-by-id [state id]
  {:pre [(rc/valid-resource-id? id)]}
  (or (get-in state [:sources id])
      (throw (ex-info (format "no source by id: %s" id) {:id id}))))

(defn get-build-sources [{:keys [build-sources] :as state}]
  (->> build-sources
       (map #(get-source-by-id state %))))

(defn get-source-by-name [state name]
  {:pre [(string? name)]}
  (let [id (or (get-in state [:name->id name])
               (throw (ex-info (format "no source by name: %s" name) {:name name})))]
    (get-source-by-id state id)))

(defn get-source-id-by-provide [state provide]
  {:pre [(symbol? provide)]}
  (or (get-in state [:sym->id provide])
      (when-some [alias (get-in state [:ns-aliases provide])]
        (get-in state [:sym->id alias]))
      (throw (ex-info (format "no source by provide: %s" provide) {:provide provide}))))

(defn get-source-by-provide [state provide]
  (let [id (get-source-id-by-provide state provide)]
    (get-source-by-id state id)))

(defn get-output! [state {:keys [resource-id] :as rc}]
  {:pre [(map? rc)
         (rc/valid-resource-id? resource-id)]}
  (or (get-in state [:output resource-id])
      (throw (ex-info (format "no output for id: %s" resource-id) {:resource-id resource-id}))))

(defn get-reader-features [state]
  (set/union
    (let [x (get-in state [:compiler-options :reader-features])]
      ;; FIXME: should probably validate this before starting a compile
      (cond
        (nil? x)
        #{}
        (keyword? x)
        #{x}
        (and (set? x) (every? keyword? x))
        x
        :else
        (throw (ex-info "invalid :reader-features" {:tag ::invalid-reader-features
                                                    :x x}))))
    #{:cljs}))

(defn add-source [state {:keys [resource-id resource-name] :as rc}]
  {:pre [(rc/valid-resource? rc)]}
  (-> state
      (update :sources assoc resource-id rc)
      (add-provides rc)
      (cond->
        resource-name
        (update :name->id assoc resource-name resource-id)
        )))

(defn remove-output-by-id [state resource-id]
  (let [{:keys [ns] :as rc} (get-in state [:sources resource-id])]
    (if-not rc
      state
      (-> state
          (update :output dissoc resource-id)
          ;; remove analyzer data so removed vars don't stick around
          ;; also fixes issues with ^:const otherwise ending up in compile errors
          (cond->
            ns
            (update-in [:compiler-env :cljs.analyzer/namespaces] dissoc ns))
          ))))

(defn remove-source-by-id [state resource-id]
  (let [{:keys [ns] :as rc} (get-in state [:sources resource-id])]
    (if-not rc
      state
      (-> state
          (remove-output-by-id resource-id)
          (update :immediate-deps dissoc resource-id)
          (remove-provides rc)
          (update :str->sym dissoc ns)
          (update :sources dissoc resource-id)
          ))))

(defn overwrite-source
  "adds a source to the build state, if the ns was provided previously the other is removed"
  [state {:keys [ns resource-id] :as rc}]
  {:pre [(rc/valid-resource? rc)]}
  (let [other-id (get-in state [:sym->id ns])]
    (-> state
        (cond->
          other-id
          (remove-source-by-id other-id))
        (add-source rc))))

(defn maybe-add-source
  "add given resource to the :sources and lookup indexes"
  [{:keys [sources] :as state}
   {:keys [resource-id] :as rc}]
  (if (contains? sources resource-id)
    ;; a source may already be present in case of string requires as they are not unique
    ;; "../foo" and "../../foo" may resolve to the same resource
    state
    (add-source state rc)
    ))

(defn output-file [state name & names]
  (let [output-dir (get-in state [:build-options :output-dir])]
    (when-not output-dir
      (throw (ex-info "no :output-dir" {})))

    (apply io/file output-dir name names)))

(defn cache-file [{:keys [cache-dir] :as state} name & names]
  (when-not cache-dir
    (throw (ex-info "no :cache-dir" {})))

  (apply io/file cache-dir name names))

(defn js-names-accessed-from-cljs
  ([{:keys [build-sources] :as state}]
   (js-names-accessed-from-cljs state build-sources))
  ([{:keys [js-entries] :as state} build-sources]
   (let [all-names
         (->> (for [src-id build-sources
                    :let [{:keys [resource-id type] :as src}
                          (get-source-by-id state src-id)]
                    :when (not= :shadow-js type)
                    :let [syms (deps->syms state src)]
                    sym syms]
                sym)
              (into #{}))]

     ;; filter out the names provided by npm deps
     (->> build-sources
          (map #(get-source-by-id state %))
          (filter #(= :shadow-js (:type %)))
          (filter #(set/superset? all-names (:provides %)))
          (map :ns)
          (into js-entries)))))

(defn get-source-code
  "this loads the source code for each source or uses the current if already loaded
   everything should only ever access :source from the compiler resources and never access the
   filesystem again (since it may have changed)

   the loading is delayed until here because of the :foreign which may have a minified file
   that should be used for release builds"
  [state {:keys [resource-id type source-fn source file url] :as rc}]
  (or source

      ;; dynamic resources that decide their contents based on build state
      ;; ie. js includes that choose to provide minified or dev versions
      (when source-fn
        (source-fn state))

      ;; FIXME: foreign lib support removed?
      ;; foreign is special case because it may have url-min as well as url
      #_(when (= :foreign type)
          (let [use-file-min
                (not= :none (get-in state [:compiler-options :optimizations] :none))]
            (if (and use-file-min url-min)
              (slurp url-min)
              (slurp url))))

      ;; otherwise read the file
      (when file
        (slurp file))

      ;; or url fallback when no file exists (files in jar)
      (when url
        (slurp url))

      (throw (ex-info (format "failed to get code for %s" resource-id) rc))))

(defn sha1-file [^File file]
  (with-open [in (FileInputStream. file)]
    (DigestUtils/sha1Hex in)))

(defn sha1-string [^String string]
  (DigestUtils/sha1Hex string))

(defn sha1-url [^URL url]
  (with-open [in (.openStream url)]
    (DigestUtils/sha1Hex in)))

(defn as-path ^Path [^String path]
  (Paths/get path (into-array String [])))

;; instead of unconditionally loading namespaces associated with data_readers.clj(c)
;; we delay loading them until actually used. this saves loading namespaces on the classpath
;; that may not actually be used anywhere otherwise.

;; I don't think putting a library on the classpath should trigger unconditionally loading it.
;; clojure only reads data_readers.clj(c) and uses unbound vars until actually loaded elsewhere

;; CLJS for some reason unconditionally just loads them. I think this is bad and don't want that.
;; Not loading them ever would lead to different behavior and resulting in
;; "why does this not work in shadow-cljs?" questions. As I want to stay as compatible as possible
;; I went with this route instead. It'll still just load the namespace but only
;; if the tag is actually used first.

;; there is also a security concern with just loading random namespaces on the classpath that may not actually be used
;; (ns some.lib)
;; (defn a-fake-reader [x] ...)
;; (hack-computer!)

;; but I guess that just comes with the territory. A library can still trigger that hack by just using
;; the data reader itself. at least in CLJ someone has to load it first. ¯\_(ツ)_/¯

;; doesn't need to memoize. once loaded it'll be bound, so it won't try again
(defn maybe-loading-data-readers []
  (reduce-kv
    (fn [readers tag reader-var]
      (if (or (not (var? reader-var)) (bound? reader-var))
        readers
        (assoc readers
          tag
          ;; swap reader-var with a fn that'll load the associated namespace first
          (fn [value]
            (let [reader-sym (.toSymbol reader-var)
                  ns (namespace reader-sym)]
              (try
                (when ns
                  ;; using :reload here in case loading the namespace fails
                  ;; if the var remains unbound after loading it must be due to an error
                  ;; without :reload that error would only show up once
                  ;; with :reload it should show up on rebuild as well
                  ;; otherwise the (ns ...) likely succeeded but the var remains unbound
                  ;; leading to a different error on first and subsequent builds
                  (require (symbol ns) :reload))
                (catch Exception e
                  (throw (ex-info (str "failed to read tag #" tag ", " ns " failed to load")
                           {:tag tag :value value}
                           e))))

              (try
                (reader-var value)
                (catch Exception e
                  (throw (ex-info (str "failed to read tag #" tag)
                           {:tag tag :value value}
                           e)))))))))
    tags/*cljs-data-readers*
    tags/*cljs-data-readers*))

(ns shadow.build.data
  "generic helpers for the build data structure"
  (:require
    [clojure.set :as set]
    [clojure.java.io :as io]
    [shadow.debug :refer (?> ?-> ?->>)]
    [shadow.jvm-log :as log]
    [shadow.build.resource :as rc]
    [cljs.tagged-literals :as tags]
    [cljs.analyzer :as ana])
  (:import
    [com.google.javascript.jscomp BasicErrorManager ShadowCompiler]
    [org.apache.commons.codec.digest DigestUtils]
    [java.io FileInputStream File]
    [java.net URL]
    [java.nio.file Paths Path]
    [clojure.java.api Clojure]))

;; FIXME: there are still lots of places that work directly with the map
;; that is ok for most things but makes it really annoying to change the structure of the data
;; this is basically just trying to create a formal API for the data
(defn build-state? [state]
  (true? (::build-state state)))

(def empty-data
  {::build-state true
   ;; map of {ns {require sym}}
   ;; keeping entries per ns since they might be relative
   ;; so the same alias might have different requires
   :str->sym {}

   ;; map of {sym resource-id}
   ;; CLJS or goog namespaces to source id
   :sym->id {}

   ;; lookup index of source name to source id
   ;; since closure only works with names not ids
   :name->id {}

   ;; a set of resource-ids used as entry points for the build
   :resolved-entries #{}

   ;; numeric require mapped to its namespace and back
   :require-id->sym {}
   :sym->require-id {}

   ;; map of {resource-id #{resource-id ...}}
   ;; keeps track of immediate deps for each given source
   ;; used for cache invalidation and collecting all deps
   :immediate-deps {}

   ;; map of {clojure.spec.alpha cljs.spec.alpha}
   ;; alias -> actual
   :ns-aliases '{cljs.loader shadow.loader}

   ;; map of {cljs.spec.alpha clojure.spec.alpha}
   ;; actual -> alias, only needed by compiler for the extra provide it needs to account for
   :ns-aliases-reverse '{shadow.loader cljs.loader}

   ;; a set to keep track of symbols that should be strings since they will never be compiled
   :magic-syms #{}

   ;; set of namespaces that are actually in use after :simple optimizations
   ;; some condition requires are removed, eg. react v16 bundle style
   ;; and those should not be included in the final output
   :live-js-deps #{}

   ;; set of dead js resource ids
   :dead-js-deps #{}

   ;; cljs.loader support which requires consts that are constructed by the compiler
   ;; AFTER compiling cljs.core
   :loader-constants {}

   :js-entries #{}

   :mode :dev})

(defn init [state]
  (merge state empty-data))

(defn error-manager []
  (proxy [BasicErrorManager] []
    (printSummary [])
    (println [level error]
      (log/debug ::closure-log {:level (str level)
                                :error (str error)}))))

(defn ^com.google.javascript.jscomp.Compiler make-closure-compiler
  []
  (doto (ShadowCompiler. (error-manager))
    (.disableThreads)))

(defn add-provide [state resource-id provide-sym]
  {:pre [(symbol? provide-sym)]}
  ;; sanity check, should never happen
  (let [conflict (get-in state [:sym->id provide-sym])]
    (when (and conflict (not= conflict resource-id))
      (throw (ex-info (format "symbol %s already provided by %s, conflict with %s" provide-sym conflict resource-id)
               {:provide provide-sym
                :conflict conflict
                :resource-id resource-id}))))

  (update state :sym->id assoc provide-sym resource-id))

(defn add-provides [{:keys [sources] :as state} {:keys [resource-id provides]}]
  {:pre [(rc/valid-resource-id? resource-id)
         (set? provides)
         ;; sanity check that source is added first
         (contains? sources resource-id)]}
  (reduce
    #(add-provide %1 resource-id %2)
    state
    provides))

(defn remove-provides [state {:keys [provides] :as rc}]
  {:pre [(rc/valid-resource? rc)
         (set? provides)]}

  (reduce
    #(update %1 :sym->id dissoc %2)
    state
    provides))

(defn add-string-lookup [{:keys [sources] :as state} require-from-ns require sym]
  {:pre [(symbol? require-from-ns)
         (string? require)
         (symbol? sym)]}

  #_(when-not (contains? sources require-from-ns)
      (throw (ex-info (format "can't add string lookup \"%s\"->\"%s\" for non-existent source %s" require sym require-from-ns)
               {:require-from-id require-from-ns
                :require require
                :sym sym})))

  (assoc-in state [:str->sym require-from-ns require] sym))

(defn get-string-alias [state require-from-ns require]
  {:pre [(symbol? require-from-ns)
         (string? require)]}
  (or (get-in state [:str->sym require-from-ns require])
      (throw (ex-info (format "could not find string alias for \"%s\" from %s" require require-from-ns)
               {:require-from-id require-from-ns
                :require require}))))

(defn get-deps-for-id
  "returns all deps as a set for a given id, these are unordered only a helper for caching"
  [state result rc-id]
  {:pre [(set? result)
         (rc/valid-resource-id? rc-id)]}
  (if (contains? result rc-id)
    result
    (let [deps (get-in state [:immediate-deps rc-id])]
      (when-not deps
        (throw (ex-info (format "no immediate deps for %s" rc-id) {})))
      (reduce #(get-deps-for-id state %1 %2) (conj result rc-id) deps))))

(defn deps->syms [{:keys [ns-aliases] :as state} {:keys [resource-id deps] :as rc}]
  (into [] (for [dep deps]
             (cond
               (symbol? dep)
               (get ns-aliases dep dep)

               (string? dep)
               (or (get-in state [:str->sym (:ns rc) dep])
                   (throw (ex-info (format "no ns alias for dep: %s from: %s" dep resource-id) {:resource-id resource-id :dep dep})))

               :else
               (throw (ex-info "invalid dep" {:dep dep}))
               ))))

(defn get-source-by-id [state id]
  {:pre [(rc/valid-resource-id? id)]}
  (or (get-in state [:sources id])
      (throw (ex-info (format "no source by id: %s" id) {:id id}))))

(defn get-build-sources [{:keys [build-sources] :as state}]
  (->> build-sources
       (map #(get-source-by-id state %))))

(defn get-source-by-name [state name]
  {:pre [(string? name)]}
  (let [id (or (get-in state [:name->id name])
               (throw (ex-info (format "no source by name: %s" name) {:name name})))]
    (get-source-by-id state id)))

(defn get-source-id-by-provide [state provide]
  {:pre [(symbol? provide)]}
  (or (get-in state [:sym->id provide])
      (when-some [alias (get-in state [:ns-aliases provide])]
        (get-in state [:sym->id alias]))
      (throw (ex-info (format "no source by provide: %s" provide) {:provide provide}))))

(defn get-source-by-provide [state provide]
  (let [id (get-source-id-by-provide state provide)]
    (get-source-by-id state id)))

(defn get-output! [state {:keys [resource-id] :as rc}]
  {:pre [(map? rc)
         (rc/valid-resource-id? resource-id)]}
  (or (get-in state [:output resource-id])
      (throw (ex-info (format "no output for id: %s" resource-id) {:resource-id resource-id}))))

(defn get-reader-features [state]
  (set/union
    (let [x (get-in state [:compiler-options :reader-features])]
      ;; FIXME: should probably validate this before starting a compile
      (cond
        (nil? x)
        #{}
        (keyword? x)
        #{x}
        (and (set? x) (every? keyword? x))
        x
        :else
        (throw (ex-info "invalid :reader-features" {:tag ::invalid-reader-features
                                                    :x x}))))
    #{:cljs}))

(defn add-source [state {:keys [resource-id resource-name] :as rc}]
  {:pre [(rc/valid-resource? rc)]}
  (-> state
      (update :sources assoc resource-id rc)
      (add-provides rc)
      (cond->
        resource-name
        (update :name->id assoc resource-name resource-id)
        )))

(defn remove-output-by-id [state resource-id]
  (let [{:keys [ns] :as rc} (get-in state [:sources resource-id])]
    (if-not rc
      state
      (-> state
          (update :output dissoc resource-id)
          ;; remove analyzer data so removed vars don't stick around
          ;; also fixes issues with ^:const otherwise ending up in compile errors
          (cond->
            ns
            (update-in [:compiler-env :cljs.analyzer/namespaces] dissoc ns))
          ))))

(defn remove-source-by-id [state resource-id]
  (let [{:keys [ns] :as rc} (get-in state [:sources resource-id])]
    (if-not rc
      state
      (-> state
          (remove-output-by-id resource-id)
          (update :immediate-deps dissoc resource-id)
          (remove-provides rc)
          (update :str->sym dissoc ns)
          (update :sources dissoc resource-id)
          ))))

(defn overwrite-source
  "adds a source to the build state, if the ns was provided previously the other is removed"
  [state {:keys [ns resource-id] :as rc}]
  {:pre [(rc/valid-resource? rc)]}
  (let [other-id (get-in state [:sym->id ns])]
    (-> state
        (cond->
          other-id
          (remove-source-by-id other-id))
        (add-source rc))))

(defn maybe-add-source
  "add given resource to the :sources and lookup indexes"
  [{:keys [sources] :as state}
   {:keys [resource-id] :as rc}]
  (if (contains? sources resource-id)
    ;; a source may already be present in case of string requires as they are not unique
    ;; "../foo" and "../../foo" may resolve to the same resource
    state
    (add-source state rc)
    ))

(defn output-file [state name & names]
  (let [output-dir (get-in state [:build-options :output-dir])]
    (when-not output-dir
      (throw (ex-info "no :output-dir" {})))

    (apply io/file output-dir name names)))

(defn cache-file [{:keys [cache-dir] :as state} name & names]
  (when-not cache-dir
    (throw (ex-info "no :cache-dir" {})))

  (apply io/file cache-dir name names))

(defn js-names-accessed-from-cljs
  ([{:keys [build-sources] :as state}]
   (js-names-accessed-from-cljs state build-sources))
  ([{:keys [js-entries] :as state} build-sources]
   (let [all-names
         (->> (for [src-id build-sources
                    :let [{:keys [resource-id type] :as src}
                          (get-source-by-id state src-id)]
                    :when (not= :shadow-js type)
                    :let [syms (deps->syms state src)]
                    sym syms]
                sym)
              (into #{}))]

     ;; filter out the names provided by npm deps
     (->> build-sources
          (map #(get-source-by-id state %))
          (filter #(= :shadow-js (:type %)))
          (filter #(set/superset? all-names (:provides %)))
          (map :ns)
          (into js-entries)))))

(defn get-source-code
  "this loads the source code for each source or uses the current if already loaded
   everything should only ever access :source from the compiler resources and never access the
   filesystem again (since it may have changed)

   the loading is delayed until here because of the :foreign which may have a minified file
   that should be used for release builds"
  [state {:keys [resource-id type source-fn source file url] :as rc}]
  (or source

      ;; dynamic resources that decide their contents based on build state
      ;; ie. js includes that choose to provide minified or dev versions
      (when source-fn
        (source-fn state))

      ;; FIXME: foreign lib support removed?
      ;; foreign is special case because it may have url-min as well as url
      #_(when (= :foreign type)
          (let [use-file-min
                (not= :none (get-in state [:compiler-options :optimizations] :none))]
            (if (and use-file-min url-min)
              (slurp url-min)
              (slurp url))))

      ;; otherwise read the file
      (when file
        (slurp file))

      ;; or url fallback when no file exists (files in jar)
      (when url
        (slurp url))

      (throw (ex-info (format "failed to get code for %s" resource-id) rc))))

(defn sha1-file [^File file]
  (with-open [in (FileInputStream. file)]
    (DigestUtils/sha1Hex in)))

(defn sha1-string [^String string]
  (DigestUtils/sha1Hex string))

(defn sha1-url [^URL url]
  (with-open [in (.openStream url)]
    (DigestUtils/sha1Hex in)))

(defn as-path ^Path [^String path]
  (Paths/get path (into-array String [])))

(def cljs-data-readers
  ;; overriding already loaded *data-readers* clj variants via CLJ
  ;; with cljs variant from data_readers.cljc if present
  (reduce-kv
    (fn [readers tag sym]
      ;; create unbound var like clojure *data-readers*
      ;; will load later via code below
      (assoc readers tag (Clojure/var sym)))
    tags/*cljs-data-readers*
    (ana/get-data-readers)))

;; instead of unconditionally loading namespaces associated with data_readers.clj(c)
;; we delay loading them until actually used. this saves loading namespaces on the classpath
;; that may not actually be used anywhere otherwise.

;; I don't think putting a library on the classpath should trigger unconditionally loading it.
;; clojure only reads data_readers.clj(c) and uses unbound vars until actually loaded elsewhere

;; CLJS for some reason unconditionally just loads them. I think this is bad and don't want that.
;; Not loading them ever would lead to different behavior and resulting in
;; "why does this not work in shadow-cljs?" questions. As I want to stay as compatible as possible
;; I went with this route instead. It'll still just load the namespace but only
;; if the tag is actually used first.

;; there is also a security concern with just loading random namespaces on the classpath that may not actually be used
;; (ns some.lib)
;; (defn a-fake-reader [x] ...)
;; (hack-computer!)

;; but I guess that just comes with the territory. A library can still trigger that hack by just using
;; the data reader itself. at least in CLJ someone has to load it first. ¯\_(ツ)_/¯

;; doesn't need to memoize. once loaded it'll be bound, so it won't try again
(defn maybe-loading-data-readers []
  (reduce-kv
    (fn [readers tag reader-var]
      (if (or (not (var? reader-var)) (bound? reader-var))
        readers
        (assoc readers
          tag
          ;; swap reader-var with a fn that'll load the associated namespace first
          (fn [value]
            (let [reader-sym (.toSymbol reader-var)
                  ns (namespace reader-sym)]
              (try
                (when ns
                  ;; using :reload here in case loading the namespace fails
                  ;; if the var remains unbound after loading it must be due to an error
                  ;; without :reload that error would only show up once
                  ;; with :reload it should show up on rebuild as well
                  ;; otherwise the (ns ...) likely succeeded but the var remains unbound
                  ;; leading to a different error on first and subsequent builds
                  (require (symbol ns) :reload))
                (catch Exception e
                  (throw (ex-info (str "failed to read tag #" tag ", " ns " failed to load")
                           {:tag tag :value value}
                           e))))

              (try
                (reader-var value)
                (catch Exception e
                  (throw (ex-info (str "failed to read tag #" tag)
                           {:tag tag :value value}
                           e)))))))))
    cljs-data-readers
    cljs-data-readers))

use :cljs variant from data_readers.cljc


(ns braid.page-inbox.core
  (:require
    [braid.lib.uuid :as uuid]
    [braid.base.api :as base]
    [braid.chat.api :as chat]
    #?@(:clj
         [[braid.page-inbox.commands :as commands]]
        :cljs
         [[braid.page-inbox.ui :as ui]
          [braid.page-inbox.styles :as styles]
          [braid.core.client.state.helpers :as helpers]])))

(defn init! []
  #?(:clj
     (do
       (base/register-commands!
         commands/commands))
     :cljs
     (do
       (base/register-initial-user-data-handler!
         (fn [db data]
           (assoc-in db [:user :open-thread-ids]
             (set (map :id (data :user-threads))))))

       (chat/register-group-page!
         {:key :inbox
          :on-load (fn [_]
                     )
          :view ui/inbox-page-view})

       (base/register-subs!
         {:open-thread-ids
          (fn [state _]
            (get-in state [:user :open-thread-ids]))

          :open-threads
          ;; TODO could be made more efficient by depending on other subs
          ;; or using reg-sub-raw and reactions
          (fn [state [_ group-id]]
            (let [open-thread-ids (get-in state [:user :open-thread-ids])
                  threads (state :threads)
                  open-threads (vals (select-keys threads open-thread-ids))]
              (->> open-threads
                   (filter (fn [thread]
                             (= (thread :group-id) group-id)))
                   ;; sort by last message sent by logged-in user, most recent first
                   (sort-by
                     (fn [thread]
                       (->> (thread :messages)
                            (map :created-at)
                            (apply max))))
                   reverse)))})

       (base/register-events!
         {:create-thread!
          (fn [{db :db} [_ thread-opts]]
            (let [thread-opts (merge
                                thread-opts
                                {:id (uuid/squuid)})]
              {:db (-> db
                       (helpers/create-thread thread-opts)
                       (helpers/add-to-open-threads (:id thread-opts)))
               :command [:braid.chat/create-thread!
                         {:thread-id (:id thread-opts)
                          :group-id (:group-id thread-opts)}]
               :dispatch [:focus-thread! (thread-opts :id)]}))

          :clear-inbox!
          (fn [{db :db} [_ _]]
            {:dispatch-n
             (into ()
                   (comp
                     (filter (fn [thread] (= (db :open-group-id) (thread :group-id))))
                     (map :id)
                     (map (fn [id] [:hide-thread! {:thread-id id :local-only? false}])))
                   (-> (db :threads)
                       (select-keys (get-in db [:user :open-thread-ids]))
                       vals))})

          :hide-thread!
          (fn [{db :db} [_ {:keys [thread-id local-only?]}]]
            {:db (update-in db [:user :open-thread-ids] disj thread-id)
             :command (when-not local-only?
                        [:braid.inbox/hide-thread!
                         {:thread-id thread-id}])})

          :reopen-thread!
          (fn [{db :db} [_ thread-id]]
            {:db (update-in db [:user :open-thread-ids] conj thread-id)
             :command [:braid.inbox/show-thread!
                       {:thread-id thread-id}]})})

       (base/register-styles!
         [:.app>.main styles/styles]))))

(ns braid.page-inbox.core
  (:require
    [braid.lib.uuid :as uuid]
    [braid.base.api :as base]
    [braid.chat.api :as chat]
    #?@(:clj
         [[braid.page-inbox.commands :as commands]]
        :cljs
         [[braid.page-inbox.ui :as ui]
          [braid.page-inbox.styles :as styles]
          [braid.core.client.state.helpers :as helpers]])))

(defn init! []
  #?(:clj
     (do
       (base/register-commands!
         commands/commands))
     :cljs
     (do
       (base/register-initial-user-data-handler!
         (fn [db data]
           (assoc-in db [:user :open-thread-ids]
             (set (map :id (data :user-threads))))))

       (chat/register-group-page!
         {:key :inbox
          :on-load (fn [_]
                     )
          :view ui/inbox-page-view})

       (base/register-subs!
         {:open-thread-ids
          (fn [state _]
            (get-in state [:user :open-thread-ids]))

          :open-threads
          ;; TODO could be made more efficient by depending on other subs
          ;; or using reg-sub-raw and reactions
          (fn [state [_ group-id]]
            (let [open-thread-ids (get-in state [:user :open-thread-ids])
                  threads (state :threads)
                  open-threads (vals (select-keys threads open-thread-ids))
                  now (js/Date.)]
              (->> open-threads
                   (filter (fn [thread]
                             (= (thread :group-id) group-id)))
                   (sort-by
                     (fn [thread]
                       (or (->> (thread :messages)
                                (map :created-at)
                                (apply max))
                           ;; treat threads with no messages as being just created
                           now)))
                   reverse)))})

       (base/register-events!
         {:create-thread!
          (fn [{db :db} [_ thread-opts]]
            (let [thread-opts (merge
                                thread-opts
                                {:id (uuid/squuid)})]
              {:db (-> db
                       (helpers/create-thread thread-opts)
                       (helpers/add-to-open-threads (:id thread-opts)))
               :command [:braid.chat/create-thread!
                         {:thread-id (:id thread-opts)
                          :group-id (:group-id thread-opts)}]
               :dispatch [:focus-thread! (thread-opts :id)]}))

          :clear-inbox!
          (fn [{db :db} [_ _]]
            {:dispatch-n
             (into ()
                   (comp
                     (filter (fn [thread] (= (db :open-group-id) (thread :group-id))))
                     (map :id)
                     (map (fn [id] [:hide-thread! {:thread-id id :local-only? false}])))
                   (-> (db :threads)
                       (select-keys (get-in db [:user :open-thread-ids]))
                       vals))})

          :hide-thread!
          (fn [{db :db} [_ {:keys [thread-id local-only?]}]]
            {:db (update-in db [:user :open-thread-ids] disj thread-id)
             :command (when-not local-only?
                        [:braid.inbox/hide-thread!
                         {:thread-id thread-id}])})

          :reopen-thread!
          (fn [{db :db} [_ thread-id]]
            {:db (update-in db [:user :open-thread-ids] conj thread-id)
             :command [:braid.inbox/show-thread!
                       {:thread-id thread-id}]})})

       (base/register-styles!
         [:.app>.main styles/styles]))))

[page-inbox] Fix re-sort button always showing when empty threads