(ns babel.english.writer
  (:refer-clojure :exclude [get-in]))

(require '[babel.english.grammar :refer [small small-plus-vp-pronoun]])
(require '[babel.english.lexicon :refer [lexicon]])
(require '[babel.english.morphology :refer [fo]])

(require '[babel.reader :refer [read-all read-one]])
(require '[babel.writer :as writer
           :refer [delete-from-expressions
                   fill-language-by-spec
                   process write-lexicon]])
(require '[clojure.tools.logging :as log])
(require '[dag-unify.core :refer (fail? get-in strip-refs unify)])

(defn expression [spec]
  (writer/expression small-plus-vp-pronoun spec))

(defn translate [source-language-short-name]
  "generate English translations of all available expressions in source language."
  (let [source-expressions (read-all :top source-language-short-name)]
    (.size (pmap (fn [source-expression]
                   (do (log/debug (str source-language-short-name ": " (:surface source-expression)))
                       (log/debug (str source-language-short-name ": " (get-in (:structure source-expression) [:synsem :sem])))
                       (let [spec {:synsem {:sem (strip-refs (get-in (:structure source-expression) [:synsem :sem]))}}]
                         (let [existing-english-expression (read-one spec "en")]
                           (if existing-english-expression
                             ;; found existing expression: return that.
                             (do
                               (log/info (str (:surface source-expression) " -> " (:surface existing-english-expression)))
                               existing-english-expression)
                             ;; else, no existing expression: generate a new one.
                             (do
                               (log/debug (str "generating from spec: " spec))
                               (log/info (str "generating using source expression: "
                                              (:surface source-expression)))
                               (try
                                 (let [result
                                       (process [{:fill-one-language
                                                  {:count 1
                                                   :spec spec
                                                   :model small-plus-vp-pronoun
                                                   }}]
                                                source-language-short-name)]
                                   ;; TODO: 'result' is currently returning nil: should return something more indicative
                                   ;; of what the (process) command did.
                                   (log/debug (str "process result:" result)))
                                (catch Exception e
                                  (cond
                                    true
                                    (log/error (str "Could not translate source expression: "
                                                    "'" (get source-expression :surface) "'"
                                                    " from language: '" source-language-short-name
                                                    "' with predicate: '"
                                                    (strip-refs (get-in source-expression [:structure :synsem :sem :pred]))
                                                    "' into English; subj: '"
                                                    "'" (get-in source-expression [:structure :synsem :sem :subj :pred])
                                                    "'"))
                                    false
                                    (throw e))))))))))
                 source-expressions))))

(defn all [ & [count]]
  (let [count (if count (Integer. count) 10)
        ;; subset of the lexicon: only verbs which are infinitives and that can be roots:
        ;; (i.e. those that have a specific (non- :top) value for [:synsem :sem :pred])
        root-verbs
        (zipmap
         (keys @lexicon)
         (map (fn [lexeme-set]
                (filter (fn [lexeme]
                          (and
                           (or true (= (get-in lexeme [:synsem :sem :pred]) :talk)) ;; for development, restrict :pred to a single value.
                           (= (get-in lexeme [:synsem :cat]) :verb)
                           (= (get-in lexeme [:synsem :infl]) :top)
                           (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
                        lexeme-set))
              (vals @lexicon)))]

    (write-lexicon "en" @lexicon)
    (log/info (str "done writing lexicon."))
    (log/info (str "generating with this many verbs: " (.size (reduce concat (vals root-verbs)))))
    (.size (pmap (fn [verb]
                   (let [root-form (get-in verb [:english :english])]
                     (log/debug (str "generating from root-form:" root-form))
                     (.size (map (fn [tense]
                                   (let [spec (unify {:root {:english {:english root-form}}}
                                                     tense)]
                                     (.size
                                      (map (fn [gender]
                                             (let [spec (unify spec
                                                               {:comp {:synsem {:agr gender}}})]
                                               (log/trace (str "generating from gender: " gender))
                                               (.size
                                                (map (fn [person]
                                                       (let [spec (unify spec
                                                                         {:comp {:synsem {:agr {:person person}}}})]
                                                         (log/trace (str "generating from person: " person))
                                                         (.size
                                                          (map (fn [number]
                                                                 (let [spec (unify spec
                                                                                {:comp {:synsem {:agr {:number number}}}})]
                                                                   (log/debug (str "generating from spec: " spec))
                                                                   (try
                                                                     (process [{:fill-one-language
                                                                                {:count 1
                                                                                :spec spec
                                                                                :model small
                                                                                }}]
                                                                              "it")
                                                                     (catch Exception e
                                                                       (cond

                                                                        ;; TODO: make this conditional on
                                                                        ;; there being a legitimate reason for the exception -
                                                                        ;; e.g. the verb is "works (nonhuman)" (which takes a non-human
                                                                        ;; subject), but we're trying to generate with
                                                                        ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
                                                                        ;; are human.
                                                                        true

                                                                        (log/warn (str "ignoring exception: " e))
                                                                        false
                                                                        (throw e))))
                                                                   ))
                                                               [:sing :plur]))))
                                                     [:1st :2nd :3rd]))))
                                           (cond (= tense
                                                    {:synsem {:sem {:aspect :perfect
                                                                    :tense :past}}})
                                                 [{:gender :masc}
                                                  {:gender :fem}]
                                                 true
                                                 [:top])))))
                                 (list {:synsem {:sem {:tense :conditional}}}
                                       {:synsem {:sem {:tense :future}}}
                                       {:synsem {:sem {:tense :present}}}
                                       {:synsem {:sem {:aspect :progressive
                                                       :tense :past}}}
                                      {:synsem {:sem {:aspect :perfect
                                                      :tense :past}}})))))
                 (reduce concat
                         (map (fn [key]
                                (get root-verbs key))
                              (sort (keys root-verbs))))))))

(ns babel.english.writer
  (:refer-clojure :exclude [get-in]))

(require '[babel.english.grammar :refer [small small-plus-vp-pronoun]])
(require '[babel.english.lexicon :refer [lexicon]])
(require '[babel.english.morphology :refer [fo]])

(require '[babel.reader :refer [read-all read-one]])
(require '[babel.writer :as writer
           :refer [delete-from-expressions
                   fill-language-by-spec
                   process write-lexicon]])
(require '[clojure.tools.logging :as log])
(require '[dag-unify.core :refer (fail? get-in strip-refs unify)])

(defn expression [spec]
  (writer/expression small-plus-vp-pronoun spec))

(defn translate [source-language-short-name]
  "generate English translations of all available expressions in source language."
  (let [source-expressions (read-all :top source-language-short-name)]
    (.size (pmap (fn [source-expression]
                   (do (log/debug (str source-language-short-name ": " (:surface source-expression)))
                       (log/debug (str source-language-short-name ": " (get-in (:structure source-expression) [:synsem :sem])))
                       (let [spec {:synsem {:sem (strip-refs (get-in (:structure source-expression) [:synsem :sem]))}}]
                         (let [existing-english-expression (read-one spec "en")]
                           (if existing-english-expression
                             ;; found existing expression: return that.
                             (do
                               (log/info (str (:surface source-expression) " -> " (:surface existing-english-expression)))
                               existing-english-expression)
                             ;; else, no existing expression: generate a new one.
                             (do
                               (log/debug (str "generating from spec: " spec))
                               (log/info (str "generating using source expression: "
                                              (:surface source-expression)))
                               (try
                                 (let [result
                                       (process [{:fill-one-language
                                                  {:count 1
                                                   :spec spec
                                                   :model small-plus-vp-pronoun
                                                   }}]
                                                source-language-short-name)]
                                   ;; TODO: 'result' is currently returning nil: should return something more indicative
                                   ;; of what the (process) command did.
                                   (log/debug (str "process result:" result)))
                                (catch Exception e
                                  (cond
                                    true
                                    (log/error (str "Could not translate source expression: "
                                                    "'" (get source-expression :surface) "'"
                                                    " from language: '" source-language-short-name
                                                    "' with predicate: '"
                                                    (strip-refs (get-in source-expression [:structure :synsem :sem :pred]))
                                                    "' into English; subj:'"
                                                    "'" (get-in source-expression [:structure :synsem :sem :subj :pred])
                                                    "'"))
                                    false
                                    (throw e))))))))))
                 source-expressions))))

(defn all [ & [count]]
  (let [count (if count (Integer. count) 10)
        ;; subset of the lexicon: only verbs which are infinitives and that can be roots:
        ;; (i.e. those that have a specific (non- :top) value for [:synsem :sem :pred])
        root-verbs
        (zipmap
         (keys @lexicon)
         (map (fn [lexeme-set]
                (filter (fn [lexeme]
                          (and
                           (or true (= (get-in lexeme [:synsem :sem :pred]) :talk)) ;; for development, restrict :pred to a single value.
                           (= (get-in lexeme [:synsem :cat]) :verb)
                           (= (get-in lexeme [:synsem :infl]) :top)
                           (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
                        lexeme-set))
              (vals @lexicon)))]

    (write-lexicon "en" @lexicon)
    (log/info (str "done writing lexicon."))
    (log/info (str "generating with this many verbs: " (.size (reduce concat (vals root-verbs)))))
    (.size (pmap (fn [verb]
                   (let [root-form (get-in verb [:english :english])]
                     (log/debug (str "generating from root-form:" root-form))
                     (.size (map (fn [tense]
                                   (let [spec (unify {:root {:english {:english root-form}}}
                                                     tense)]
                                     (.size
                                      (map (fn [gender]
                                             (let [spec (unify spec
                                                               {:comp {:synsem {:agr gender}}})]
                                               (log/trace (str "generating from gender: " gender))
                                               (.size
                                                (map (fn [person]
                                                       (let [spec (unify spec
                                                                         {:comp {:synsem {:agr {:person person}}}})]
                                                         (log/trace (str "generating from person: " person))
                                                         (.size
                                                          (map (fn [number]
                                                                 (let [spec (unify spec
                                                                                {:comp {:synsem {:agr {:number number}}}})]
                                                                   (log/debug (str "generating from spec: " spec))
                                                                   (try
                                                                     (process [{:fill-one-language
                                                                                {:count 1
                                                                                :spec spec
                                                                                :model small
                                                                                }}]
                                                                              "it")
                                                                     (catch Exception e
                                                                       (cond

                                                                        ;; TODO: make this conditional on
                                                                        ;; there being a legitimate reason for the exception -
                                                                        ;; e.g. the verb is "works (nonhuman)" (which takes a non-human
                                                                        ;; subject), but we're trying to generate with
                                                                        ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
                                                                        ;; are human.
                                                                        true

                                                                        (log/warn (str "ignoring exception: " e))
                                                                        false
                                                                        (throw e))))
                                                                   ))
                                                               [:sing :plur]))))
                                                     [:1st :2nd :3rd]))))
                                           (cond (= tense
                                                    {:synsem {:sem {:aspect :perfect
                                                                    :tense :past}}})
                                                 [{:gender :masc}
                                                  {:gender :fem}]
                                                 true
                                                 [:top])))))
                                 (list {:synsem {:sem {:tense :conditional}}}
                                       {:synsem {:sem {:tense :future}}}
                                       {:synsem {:sem {:tense :present}}}
                                       {:synsem {:sem {:aspect :progressive
                                                       :tense :past}}}
                                      {:synsem {:sem {:aspect :perfect
                                                      :tense :past}}})))))
                 (reduce concat
                         (map (fn [key]
                                (get root-verbs key))
                              (sort (keys root-verbs))))))))

fix quote in log output

fix quote in log output


;; Copyright (c) 2013-2015 Andrey Antukh <niwi@niwi.be>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.core.crypto
  "Modes implementation"
  (:require [buddy.core.bytes :as bytes]
            [buddy.core.codecs :as codecs])
  (:import org.bouncycastle.crypto.engines.TwofishEngine
           org.bouncycastle.crypto.engines.BlowfishEngine
           org.bouncycastle.crypto.engines.AESEngine
           org.bouncycastle.crypto.engines.ChaChaEngine
           org.bouncycastle.crypto.modes.CBCBlockCipher
           org.bouncycastle.crypto.modes.SICBlockCipher
           org.bouncycastle.crypto.modes.OFBBlockCipher
           org.bouncycastle.crypto.params.ParametersWithIV
           org.bouncycastle.crypto.params.KeyParameter
           clojure.lang.IFn
           clojure.lang.Keyword))

(def ^{:doc "Supported block cipher modes."
       :dynamic true}
  *supported-modes* {:ecb #(identity %)
                     :cbc #(CBCBlockCipher. %)
                     :ctr #(SICBlockCipher. %)
                     :sic #(SICBlockCipher. %)
                     :ofb #(OFBBlockCipher. %1 (* 8 (.getBlockSize %1)))})

(def ^{:doc "Supported block ciphers."
       :dynamic true}
  *supported-block-ciphers* {:twofish #(TwofishEngine.)
                             :blowfish #(BlowfishEngine.)
                             :aes #(AESEngine.)})

(def ^{:doc "Supported block ciphers."
       :dynamic true}
  *supported-stream-ciphers* {:chacha #(ChaChaEngine.)})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cipher protocol declaration.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol BlockCipher
  "Common interface to block ciphers."
  (get-block-size [_] "Get block size in bytes."))

(defprotocol StreamCipher
  "Common interface to stream ciphers.")

(defprotocol Cipher
  "Common interface to both, stream and block ciphers."
  (initialize! [_ params] "Initialize cipher")
  (process-block! [_ input] "Encrypt/Decrypt a block of bytes."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation details.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^{:private true
       :doc "Check if op is a valid op keyword."
       :static true}
  valid-op? (comp boolean #{:encrypt :decrypt}))

(defn- initialize-cipher!
  [engine {:keys [iv key op]}]
  {:pre [(bytes/bytes? key)
         (valid-op? op)]}
  (let [params (if (nil? iv)
                 (KeyParameter. key)
                 (ParametersWithIV. (KeyParameter. key) iv))
        encrypt (condp = op
                  :encrypt true
                  :decrypt false)]
    (.init engine encrypt params)
    engine))

(defn- block-cipher-process!
  [engine input]
  (let [buffer (byte-array (.getBlockSize engine))]
    (.processBlock engine input 0 buffer 0)
    buffer))

(defn- stream-cipher-process!
  [engine input]
  (let [len    (count input)
        buffer (byte-array len)]
    (.processBytes engine input 0 len buffer 0)
    buffer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Low level api.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- algorithm-supported?
  [^Keyword type ^Keyword cipher]
  (condp = type
    :block (contains? *supported-block-ciphers* cipher)
    :stream (contains? *supported-stream-ciphers* cipher)))

(defn- mode-supported?
  [^Keyword mode]
  (contains? *supported-modes* mode))

(defn block-cipher
  "Block cipher engine constructor."
  [^Keyword alg ^Keyword mode]
  {:pre [(algorithm-supported? :block alg)
         (mode-supported? mode)]}
  (let [modefactory (get *supported-modes* mode)
        enginefactory (get *supported-block-ciphers* alg)
        engine (modefactory (enginefactory))]
    (reify
      BlockCipher
      (get-block-size [_]
        (.getBlockSize engine))

      Cipher
      (initialize! [_ params]
        (initialize-cipher! engine params))
      (process-block! [_ input]
        (block-cipher-process! engine input)))))

(defn stream-cipher
  "Stream cipher engine constructor."
  [^Keyword alg]
  {:pre [(algorithm-supported? :stream alg)]}
  (let [enginefactory (get *supported-stream-ciphers* alg)
        engine (enginefactory)]
    (reify
      StreamCipher ;; Mark only
      Cipher
      (initialize! [_ params]
        (initialize-cipher! engine params))
      (process-block! [_ input]
        (stream-cipher-process! engine input)))))

(defn process-bytes!
  "Backward compatibility alias for `process-block!`
  function. This function will be removed in the
  next stable version."
  [engine input]
  (process-block! engine input))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; High level api.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; (defn get-buffer-for-input
;;   [^bytes input ^long blocksize]
;;   (let [length (count input)
;;         csize (double (/ input blocksize))]
;;     (cond
;;       (<= csize blocksize)
;;       (byte-array blocksize)

;;       (> csize blocksize)
;;       (let [m (mod csize blocksize)]
;;         (if (== m 0)
;;           (byte-array (long csize))
;;           (byte-array (+ (long csize) blocksize)))))))

(defn split-by-blocksize
  "Split a byte array in blocksize blocks.

  Given a arbitrary size bytearray and block size in bytes,
  returns a lazy sequence of bytearray blocks of blocksize
  size. If last block does not have enought data for fill
  all block, it is padded using zerobyte padding."
  [^bytes input ^long blocksize]
  (let [inputsize (count input)
        seqgen (fn seqgen [& {:keys [cursormin cursormax remain]}]
                 (cond
                   (<= remain blocksize)
                   (let [buffer (byte-array blocksize)]
                     (System/arraycopy input cursormin buffer 0 remain)
                     (list buffer))

                   (> remain blocksize)
                   (let [buffer (byte-array blocksize)]
                     (System/arraycopy input cursormin buffer 0 blocksize)
                     (cons buffer (lazy-seq (seqgen :cursormin cursormax
                                                    :cursormax (+ cursormax blocksize)
                                                    :remain (- inputsize cursormax)))))
                   :else nil))]
    (lazy-seq (seqgen :cursormin 0
                      :cursormax blocksize
                      :remain inputsize))))

(defn encrypt
  "Encrypt message, and return a result as byte array."
  [input & {:keys [alg mode iv nonce key] :or {alg :aes mode :ctr}}]
  {:pre [(or (bytes/bytes? iv)
             (bytes/bytes? nonce))
         (bytes/bytes? key)]}
  (let [^bytes iv (or iv nonce)
        ^bytes input (codecs/->byte-array input)]
    (cond
      (algorithm-supported? :block alg)
      (let [cipher (block-cipher alg mode)
            blocksize (get-block-size cipher)]
        (initialize! cipher {:op :encrypt :iv iv :key key})
        (apply bytes/concat (reduce (fn [acc block]
                                      (conj acc (process-block! cipher block)))
                                    [] (split-by-blocksize input blocksize))))

      (algorithm-supported? :stream alg)
      (let [cipher (stream-cipher alg)]
        (initialize! cipher {:op :encrypt :iv iv :key key})
        (process-block! cipher input)))))

;; Copyright (c) 2013-2015 Andrey Antukh <niwi@niwi.be>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.core.crypto
  "Modes implementation"
  (:require [buddy.core.bytes :as bytes]
            [buddy.core.codecs :as codecs])
  (:import org.bouncycastle.crypto.engines.TwofishEngine
           org.bouncycastle.crypto.engines.BlowfishEngine
           org.bouncycastle.crypto.engines.AESEngine
           org.bouncycastle.crypto.engines.ChaChaEngine
           org.bouncycastle.crypto.modes.CBCBlockCipher
           org.bouncycastle.crypto.modes.SICBlockCipher
           org.bouncycastle.crypto.modes.OFBBlockCipher
           org.bouncycastle.crypto.params.ParametersWithIV
           org.bouncycastle.crypto.params.KeyParameter
           clojure.lang.IFn
           clojure.lang.Keyword))

(def ^{:doc "Supported block cipher modes."
       :dynamic true}
  *supported-modes* {:ecb #(identity %)
                     :cbc #(CBCBlockCipher. %)
                     :ctr #(SICBlockCipher. %)
                     :sic #(SICBlockCipher. %)
                     :ofb #(OFBBlockCipher. %1 (* 8 (.getBlockSize %1)))})

(def ^{:doc "Supported block ciphers."
       :dynamic true}
  *supported-block-ciphers* {:twofish #(TwofishEngine.)
                             :blowfish #(BlowfishEngine.)
                             :aes #(AESEngine.)})

(def ^{:doc "Supported block ciphers."
       :dynamic true}
  *supported-stream-ciphers* {:chacha #(ChaChaEngine.)})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cipher protocol declaration.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol BlockCipher
  "Common interface to block ciphers."
  (get-block-size [_] "Get block size in bytes."))

(defprotocol StreamCipher
  "Common interface to stream ciphers.")

(defprotocol Cipher
  "Common interface to both, stream and block ciphers."
  (initialize! [_ params] "Initialize cipher")
  (process-block! [_ input] "Encrypt/Decrypt a block of bytes."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation details.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^{:private true
       :doc "Check if op is a valid op keyword."
       :static true}
  valid-op? (comp boolean #{:encrypt :decrypt}))

(defn- initialize-cipher!
  [engine {:keys [iv key op]}]
  {:pre [(bytes/bytes? key)
         (valid-op? op)]}
  (let [params (if (nil? iv)
                 (KeyParameter. key)
                 (ParametersWithIV. (KeyParameter. key) iv))
        encrypt (condp = op
                  :encrypt true
                  :decrypt false)]
    (.init engine encrypt params)
    engine))

(defn- block-cipher-process!
  [engine input]
  (let [buffer (byte-array (.getBlockSize engine))]
    (.processBlock engine input 0 buffer 0)
    buffer))

(defn- stream-cipher-process!
  [engine input]
  (let [len    (count input)
        buffer (byte-array len)]
    (.processBytes engine input 0 len buffer 0)
    buffer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Low level api.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- algorithm-supported?
  [^Keyword type ^Keyword cipher]
  (condp = type
    :block (contains? *supported-block-ciphers* cipher)
    :stream (contains? *supported-stream-ciphers* cipher)))

(defn- mode-supported?
  [^Keyword mode]
  (contains? *supported-modes* mode))

(defn block-cipher
  "Block cipher engine constructor."
  [^Keyword alg ^Keyword mode]
  {:pre [(algorithm-supported? :block alg)
         (mode-supported? mode)]}
  (let [modefactory (get *supported-modes* mode)
        enginefactory (get *supported-block-ciphers* alg)
        engine (modefactory (enginefactory))]
    (reify
      BlockCipher
      (get-block-size [_]
        (.getBlockSize engine))

      Cipher
      (initialize! [_ params]
        (initialize-cipher! engine params))
      (process-block! [_ input]
        (block-cipher-process! engine input)))))

(defn stream-cipher
  "Stream cipher engine constructor."
  [^Keyword alg]
  {:pre [(algorithm-supported? :stream alg)]}
  (let [enginefactory (get *supported-stream-ciphers* alg)
        engine (enginefactory)]
    (reify
      StreamCipher ;; Mark only
      Cipher
      (initialize! [_ params]
        (initialize-cipher! engine params))
      (process-block! [_ input]
        (stream-cipher-process! engine input)))))

(defn process-bytes!
  "Backward compatibility alias for `process-block!`
  function. This function will be removed in the
  next stable version."
  [engine input]
  (process-block! engine input))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; High level api.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn split-by-blocksize
  "Split a byte array in blocksize blocks.

  Given a arbitrary size bytearray and block size in bytes,
  returns a lazy sequence of bytearray blocks of blocksize
  size. If last block does not have enought data for fill
  all block, it is padded using zerobyte padding."
  [^bytes input ^long blocksize]
  (let [inputsize (count input)
        seqgen (fn seqgen [& {:keys [cursormin cursormax remain]}]
                 (cond
                   (<= remain blocksize)
                   (let [buffer (byte-array blocksize)]
                     (System/arraycopy input cursormin buffer 0 remain)
                     (list buffer))

                   (> remain blocksize)
                   (let [buffer (byte-array blocksize)]
                     (System/arraycopy input cursormin buffer 0 blocksize)
                     (cons buffer (lazy-seq (seqgen :cursormin cursormax
                                                    :cursormax (+ cursormax blocksize)
                                                    :remain (- inputsize cursormax)))))
                   :else nil))]
    (lazy-seq (seqgen :cursormin 0
                      :cursormax blocksize
                      :remain inputsize))))

(defn encrypt
  "Encrypt message, and return a result as byte array."
  [input & {:keys [alg mode iv nonce key] :or {alg :aes mode :ctr}}]
  {:pre [(or (bytes/bytes? iv)
             (bytes/bytes? nonce))
         (bytes/bytes? key)]}
  (let [^bytes iv (or iv nonce)
        ^bytes input (codecs/->byte-array input)]
    (cond
      (algorithm-supported? :block alg)
      (let [cipher (block-cipher alg mode)
            blocksize (get-block-size cipher)]
        (initialize! cipher {:op :encrypt :iv iv :key key})
        (apply bytes/concat (reduce (fn [acc block]
                                      (conj acc (process-block! cipher block)))
                                    [] (split-by-blocksize input blocksize))))

      (algorithm-supported? :stream alg)
      (let [cipher (stream-cipher alg)]
        (initialize! cipher {:op :encrypt :iv iv :key key})
        (process-block! cipher input)))))

Remove commented code.

Remove commented code.


(ns cfpb.qu.resources
  "RESTful resources for datasets and slices. Uses
Liberator (http://clojure-liberator.github.com/) to handle exposing
the resources.

In Liberator, returning a map from a function adds that map to the
context passed to subsequent functions. We use that heavily in exists?
functions to return the resource that will be presented later."
  (:require
   [clojure.string :as str]
   [taoensso.timbre :as log]
   [liberator.core :refer [defresource request-method-in]]
   [monger.core :as mongo]
   [noir.response :refer [status]]
   [protoflex.parse :refer [parse]]
   [cfpb.qu.data :as data]
   [cfpb.qu.views :as views]
   [cfpb.qu.query :as query :refer [params->Query]]
   [cfpb.qu.query.parser :refer [where-expr]]
   [cfpb.qu.hal :as hal]))

(defn not-found [msg]
  (status
   404
   (views/layout-html
    (views/not-found-html msg))))

(defresource
  ^{:doc "Resource for the collection of datasets."}
  index
  :available-media-types ["text/html" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :handle-ok (fn [{:keys [representation]}]
               (let [datasets (data/get-datasets)
                     resource (hal/new-resource "/data")
                     embedded (map (fn [dataset]
                                     (hal/add-properties
                                      (hal/new-resource (str "/data/" (:name dataset)))
                                      (:info dataset))) datasets)
                     resource (reduce #(hal/add-resource %1 "dataset" %2) resource embedded)]
                 (views/index (:media-type representation) resource))))

(defresource
  ^{:doc "Resource for an individual dataset."}
  dataset
  :available-media-types ["text/html" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :exists? (fn [{:keys [request]}]
             (let [dataset (get-in request [:params :dataset])
                   metadata (data/get-metadata dataset)]
               (if metadata
                 {:dataset dataset
                  :metadata metadata})))
  :handle-not-found (fn [{:keys [request representation]}]
                      (let [dataset (get-in request [:params :dataset])
                            message (str "No such dataset: " dataset)]
                        (case (:media-type representation)
                          "text/html" (not-found message)
                          message)))
  :handle-ok (fn [{:keys [dataset metadata representation]}]
               (let [resource (-> (hal/new-resource (str "/data/" dataset))
                                  (hal/add-link :rel "up" :href "/data")
                                  (hal/add-property :id dataset)
                                  (hal/add-properties (:info metadata))
                                  (hal/add-property :concepts (:concepts metadata)))
                     embedded (map (fn [[slice info]]
                                     (-> (hal/new-resource (str "/data/" dataset "/" (name slice)))
                                         (hal/add-property :id (name slice))
                                         (hal/add-properties info))) (:slices metadata))
                     resource (reduce #(hal/add-resource %1 "slice" %2) resource embedded)]
                 (views/dataset (:media-type representation) resource)
                 #_(apply str
                        (views/layout-html
                         (views/dataset-html dataset metadata))))))

(defresource
  ^{:doc "Resource for an individual slice."}
  slice
  :available-media-types ["text/html" "text/csv" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :exists? (fn [{:keys [request]}]
             (let [dataset (get-in request [:params :dataset])
                   metadata (data/get-metadata dataset)
                   slice (get-in request [:params :slice])]
               (if-let [slicedef (get-in metadata [:slices (keyword slice)])]
                 {:dataset dataset
                  :metadata metadata
                  :slice (keyword slice)})))
  :handle-not-found (fn [{:keys [request representation]}]
                      (let [dataset (get-in request [:params :dataset])
                            slice (get-in request [:params :slice])
                            message (str "No such slice: " dataset "/" slice)]
                        (case (:media-type representation)
                          "text/html" (not-found message)
                          message)))
  :handle-ok (fn [{:keys [dataset metadata slice request representation]}]
               (let [params (:params request)
                     headers (:headers request)
                     slicedef (get-in metadata [:slices slice])
                     query (params->Query params slicedef)
                     query (mongo/with-db (mongo/get-db dataset)
                             (query/execute (:table slicedef) query))
                     resource (-> (hal/new-resource (str "/data/" dataset "/" (name slice)))
                                  (hal/add-link :rel "up" :href (str "/data/" dataset))
                                  (hal/add-properties {:dataset dataset :slice (name slice)})
                                  (hal/add-properties (-> query
                                                          (dissoc :slicedef :mongo :dimensions)
                                                          (assoc :results (:result query))
                                                          (dissoc :result))))
                     view-map {:dataset dataset
                               :slicedef slicedef
                               :params params
                               :headers headers
                               :resource resource}]
                 (views/slice (:media-type representation)
                              query
                              view-map))))

(ns cfpb.qu.resources
  "RESTful resources for datasets and slices. Uses
Liberator (http://clojure-liberator.github.com/) to handle exposing
the resources.

In Liberator, returning a map from a function adds that map to the
context passed to subsequent functions. We use that heavily in exists?
functions to return the resource that will be presented later."
  (:require
   [clojure.string :as str]
   [taoensso.timbre :as log]
   [liberator.core :refer [defresource request-method-in]]
   [monger.core :as mongo]
   [noir.response :refer [status]]
   [protoflex.parse :refer [parse]]
   [cfpb.qu.data :as data]
   [cfpb.qu.views :as views]
   [cfpb.qu.query :as query :refer [params->Query]]
   [cfpb.qu.query.parser :refer [where-expr]]
   [cfpb.qu.hal :as hal]))

(defn not-found [msg]
  (status
   404
   (views/layout-html
    (views/not-found-html msg))))

(defresource
  ^{:doc "Resource for the collection of datasets."}
  index
  :available-media-types ["text/html" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :handle-ok (fn [{:keys [representation]}]
               (let [datasets (data/get-datasets)
                     resource (hal/new-resource "/data")
                     embedded (map (fn [dataset]
                                     (hal/add-properties
                                      (hal/new-resource (str "/data/" (:name dataset)))
                                      (:info dataset))) datasets)
                     resource (reduce #(hal/add-resource %1 "dataset" %2) resource embedded)]
                 (views/index (:media-type representation) resource))))

(defresource
  ^{:doc "Resource for an individual dataset."}
  dataset
  :available-media-types ["text/html" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :exists? (fn [{:keys [request]}]
             (let [dataset (get-in request [:params :dataset])
                   metadata (data/get-metadata dataset)]
               (if metadata
                 {:dataset dataset
                  :metadata metadata})))
  :handle-not-found (fn [{:keys [request representation]}]
                      (let [dataset (get-in request [:params :dataset])
                            message (str "No such dataset: " dataset)]
                        (case (:media-type representation)
                          "text/html" (not-found message)
                          message)))
  :handle-ok (fn [{:keys [dataset metadata representation]}]
               (let [resource (-> (hal/new-resource (str "/data/" dataset))
                                  (hal/add-link :rel "up" :href "/data")
                                  (hal/add-property :id dataset)
                                  (hal/add-properties (:info metadata))
                                  (hal/add-property :concepts (:concepts metadata)))
                     embedded (map (fn [[slice info]]
                                     (-> (hal/new-resource (str "/data/" dataset "/" (name slice)))
                                         (hal/add-property :id (name slice))
                                         (hal/add-properties info))) (:slices metadata))
                     resource (reduce #(hal/add-resource %1 "slice" %2) resource embedded)]
                 (views/dataset (:media-type representation) resource)
                 #_(apply str
                        (views/layout-html
                         (views/dataset-html dataset metadata))))))

(defresource
  ^{:doc "Resource for an individual slice."}
  slice
  :available-media-types ["text/html" "text/csv" "application/json" "application/xml"]
  :method-allowed? (request-method-in :get)
  :exists? (fn [{:keys [request]}]
             (let [dataset (get-in request [:params :dataset])
                   metadata (data/get-metadata dataset)
                   slice (get-in request [:params :slice])]
               (if-let [slicedef (get-in metadata [:slices (keyword slice)])]
                 {:dataset dataset
                  :metadata metadata
                  :slice (keyword slice)})))
  :handle-not-found (fn [{:keys [request representation]}]
                      (let [dataset (get-in request [:params :dataset])
                            slice (get-in request [:params :slice])
                            message (str "No such slice: " dataset "/" slice)]
                        (case (:media-type representation)
                          "text/html" (not-found message)
                          message)))
  :handle-ok (fn [{:keys [dataset metadata slice request representation]}]
               (let [params (:params request)
                     headers (:headers request)
                     slicedef (get-in metadata [:slices slice])
                     query (params->Query params slicedef)
                     query (mongo/with-db (mongo/get-db dataset)
                             (query/execute (:table slicedef) query))
                     href (str "/data/" dataset "/" (name slice))
                     resource (-> (hal/new-resource href)
                                  (hal/add-link :rel "up" :href (str "/data/" dataset))
                                  (hal/add-link :rel "query"
                                                :href (str href ".{?format}?$where={?where}&$orderBy={?orderBy}&$select={?select}")
                                                :templated true)
                                  (hal/add-properties {:dataset dataset :slice (name slice)})
                                  (hal/add-properties (-> query
                                                          (dissoc :slicedef :mongo :dimensions)
                                                          (assoc :results (:result query))
                                                          (dissoc :result))))
                     view-map {:dataset dataset
                               :slicedef slicedef
                               :params params
                               :headers headers
                               :resource resource}]
                 (views/slice (:media-type representation)
                              query
                              view-map))))

Add query templated URL to slice

Add query templated URL to slice


(ns clj-json.core
  (:import (clj_json JsonExt)
           (org.codehaus.jackson JsonFactory JsonParser JsonParser$Feature)
<<<<<<< HEAD
           (java.io StringWriter StringReader BufferedReader)))
=======
           (java.io StringWriter StringReader BufferedReader))
  (:use (clojure.contrib [def :only (defvar-)])
        (clojure [walk :only (postwalk)]
                 [string :only (join)])))
>>>>>>> implement user extendable coercions

(def ^{:tag JsonFactory, :private true} factory
  (doto (JsonFactory.)
    (.configure JsonParser$Feature/ALLOW_UNQUOTED_CONTROL_CHARS true)))

(def *coercions* {clojure.lang.IPersistentSet vec
                  clojure.lang.Keyword (fn [x] (join "/" (remove nil? ((juxt namespace name) x))))})

(defn- coerce [obj]
  (postwalk (fn [x]
              (if-let [coercion (seq (filter #(instance? (key %) x) *coercions*))]
                ((-> coercion first val) x)
                x)) obj))

(defn generate-string
  "Returns a JSON-encoding String for the given Clojure object."
  {:tag String}
  [obj]
  (let [sw        (StringWriter.)
        generator (.createJsonGenerator factory sw)]
    (JsonExt/generate generator (coerce obj))
    (.flush generator)
    (.toString sw)))

(defn parse-string
  "Returns the Clojure object corresponding to the given JSON-encoded string."
  [string & [keywords]]
  (JsonExt/parse
    (.createJsonParser factory (StringReader. string))
    true (or keywords false) nil))

(defn- parsed-seq* [^JsonParser parser keywords]
  (let [eof (Object.)]
    (lazy-seq
      (let [elem (JsonExt/parse parser true keywords eof)]
        (if-not (identical? elem eof)
          (cons elem (parsed-seq* parser keywords)))))))

(defn parsed-seq
  "Returns a lazy seq of Clojure objects corresponding to the JSON read from
  the given reader. The seq continues until the end of the reader is reached."
  [#^BufferedReader reader & [keywords]]
  (parsed-seq* (.createJsonParser factory reader) (or keywords false)))

(ns clj-json.core
  (:import (clj_json JsonExt)
           (org.codehaus.jackson JsonFactory JsonParser JsonParser$Feature)
           (java.io StringWriter StringReader BufferedReader))
  (:use (clojure [walk :only (postwalk)]
                 [string :only (join)])))

(def ^{:private true :tag JsonFactory} factory
  (doto (JsonFactory.)
    (.configure JsonParser$Feature/ALLOW_UNQUOTED_CONTROL_CHARS true)))

(def *coercions* {clojure.lang.IPersistentSet vec
                  clojure.lang.Keyword (fn [x] (join "/" (remove nil? ((juxt namespace name) x))))})

(defn- coerce [obj]
  (postwalk (fn [x]
              (if-let [coercion (seq (filter #(instance? (key %) x) *coercions*))]
                ((-> coercion first val) x)
                x)) obj))

(defn generate-string
  "Returns a JSON-encoding String for the given Clojure object."
  {:tag String}
  [obj]
  (let [sw        (StringWriter.)
        generator (.createJsonGenerator factory sw)]
    (JsonExt/generate generator (coerce obj))
    (.flush generator)
    (.toString sw)))

(defn parse-string
  "Returns the Clojure object corresponding to the given JSON-encoded string."
  [string & [keywords]]
  (JsonExt/parse
    (.createJsonParser factory (StringReader. string))
    true (or keywords false) nil))

(defn- parsed-seq* [^JsonParser parser keywords]
  (let [eof (Object.)]
    (lazy-seq
      (let [elem (JsonExt/parse parser true keywords eof)]
        (if-not (identical? elem eof)
          (cons elem (parsed-seq* parser keywords)))))))

(defn parsed-seq
  "Returns a lazy seq of Clojure objects corresponding to the JSON read from
  the given reader. The seq continues until the end of the reader is reached."
  [#^BufferedReader reader & [keywords]]
  (parsed-seq* (.createJsonParser factory reader) (or keywords false)))

remove contrib dependency

remove contrib dependency


(ns seria.buffer
  (:require [seria.util :refer [cljc-ceil]])
  #?(:clj (:import [seria SeriaByteBuffer])))

(defprotocol HybridBuffer
  (read-byte! [this])
  (read-ubyte! [this])
  (read-short! [this])
  (read-ushort! [this])
  (read-int! [this])
  (read-uint! [this])
  (read-long! [this])
  (read-float! [this])
  (read-double! [this])
  (read-char! [this])
  (read-boolean! [this])

  (write-byte! [this value])
  (write-ubyte! [this value])
  (write-short! [this value])
  (write-ushort! [this value])
  (write-int! [this value])
  (write-uint! [this value])
  (write-long! [this value])
  (write-float! [this value])
  (write-double! [this value])
  (write-char! [this value])
  (write-boolean! [this value])

  (get-bit-position [this])
  (get-bit-position! [this amount])
  (set-bit-position! [this position])

  (get-byte-position [this])
  (get-byte-position! [this amount])
  (set-byte-position! [this position])

  (get-max-byte-length [this])
  (set-max-byte-length! [this value])

  (to-raw! [this]))

(defn long->ints [^long value]
  [(unchecked-int (bit-shift-right value 32))
   (unchecked-int value)])

(defn ints->long [int-1 int-2]
  (bit-or (unchecked-long (bit-shift-left int-1 32))
          (bit-and int-2 0xFFFFFFFF)))

(do #?(:clj  (extend-type SeriaByteBuffer
               HybridBuffer
               (read-byte!    [this] (.getByte this))
               (read-ubyte!   [this] (short (bit-and (.getByte this) 0xFF)))
               (read-short!   [this] (.getShort this))
               (read-ushort!  [this] (int (bit-and (.getShort this) 0xFFFF)))
               (read-int!     [this] (.getInt this))
               (read-uint!    [this] (long (bit-and (.getInt this) 0xFFFFFFFF)))
               (read-long!    [this] (ints->long (.getInt this) (.getInt this)))
               (read-float!   [this] (.getFloat this))
               (read-double!  [this] (.getDouble this))
               (read-char!    [this] (.getChar this))
               (read-boolean! [this] (.getBoolean this))

               (write-byte!    [this value] (.putByte this (byte value)))
               (write-ubyte!   [this value] (.putByte this (unchecked-byte (bit-and value 0xFF))))
               (write-short!   [this value] (.putShort this (short value)))
               (write-ushort!  [this value] (.putShort this (unchecked-short (bit-and value 0xFFFF))))
               (write-int!     [this value] (.putInt this (int value)))
               (write-uint!    [this value] (.putInt this (unchecked-int (bit-and value 0xFFFFFFFF))))
               (write-long!    [this value] (let [[int-1 int-2] (long->ints value)]
                                              (.putInt this int-1)
                                              (.putInt this int-2)))
               (write-float!   [this value] (.putFloat this (float value)))
               (write-double!  [this value] (.putDouble this (double value)))
               (write-char!    [this value] (.putChar this (char value)))
               (write-boolean! [this value] (.putBoolean this (boolean value)))

               (get-bit-position     [this] (.getBitPosition this))
               (get-byte-position    [this] (.getBytePosition this))
               (get-max-byte-length  [this] (.getMaxByteLength this))

               (set-bit-position!    [this value] (.setBitPosition this value))
               (set-byte-position!   [this value] (.setBytePosition this value))
               (set-max-byte-length! [this value] (.setMaxByteLength this value))

               (get-bit-position!    [this amount] (let [position (.getBitPosition this)]
                                                     (.setBitPosition this (+ position amount))
                                                     position))
               (get-byte-position!   [this amount] (let [position (.getBytePosition this)]
                                                     (.setBytePosition this (+ position amount))
                                                     position))
               (to-raw! [this] (.toRaw this)))

       :cljs (extend-type js/DataView
               HybridBuffer
               (read-byte!    [this] (.getInt8 this (get-byte-position! this this 1)))
               (read-ubyte!   [this] (.getUint8 this (get-byte-position! this 1)))
               (read-short!   [this] (.getInt16 this (get-byte-position! this 2)))
               (read-ushort!  [this] (.getUint16 this (get-byte-position! this 2)))
               (read-int!     [this] (.getInt32 this (get-byte-position! this 4)))
               (read-uint!    [this] (.getUint32 this (get this 4)))
               (read-long!    [this] (ints->long (.getInt32 this (get-byte-position! this 4))
                                                 (.getInt32 this (get-byte-position! this 4))))
               (read-float!   [this] (.getFloat32 this (get-byte-position! this 4)))
               (read-double!  [this] (.getFloat64 this (get-byte-position! this 8)))
               (read-char!    [this] (.getUint16 this (get-byte-position! this 2)))
               (read-boolean! [this] (-> this
                                         (.getInt8 (quot (get-bit-position! this 1) 8))
                                         (bit-test (rem 8))))

               (write-byte!    [this value] (.setInt8 this (get-byte-position! this 1) (byte value)))
               (write-ubyte!   [this value] (.setUint8 this (get-byte-position! this 1) (unchecked-byte value)))
               (write-short!   [this value] (.setInt16 this (get-byte-position! this 2) (short value)))
               (write-ushort!  [this value] (.setUint16 this (get-byte-position! this 2) (unchecked-short value)))
               (write-int!     [this value] (.setInt32 this (get-byte-position! this 4) (int value)))
               (write-uint!    [this value] (.setUint32 this (get-byte-position! this 4) (unchecked-int value)))
               (write-long!    [this value] (let [[int-1 int-2] (long->ints value)]
                                              (.setInt32 this (get-byte-position! this 4) int-1)
                                              (.setInt32 this (get-byte-position! this 4) int-2)))
               (write-float!   [this value] (.setFloat32 this (float value)))
               (write-double!  [this value] (.setFloat64 this (double value)))
               (write-char!    [this value] (.setUint16 this (char value)))
               (write-boolean! [this value] (let [bit-position  (get-bit-position! this 1)]
                                              (.setInt8 this
                                                        (quot bit-position 8)
                                                        (-> this
                                                            (.getInt8 (quot bit-position 8))
                                                            ((if value bit-set bit-clear) (rem bit-position 8))
                                                            (unchecked-byte)))))

               (get-byte-position   [this] (.-bytePosition this))
               (get-max-byte-length [this] (.-maxByteLength this))

               (set-bit-position!    [this value] (set! (.-bitPosition this) value))
               (set-byte-position!   [this value] (set! (.-bytePosition this) value))
               (set-max-byte-length! [this value] (set! (.-maxByteLength this) value))

               (get-bit-position!  [this amount] (let [position (.-bitPosition this)]
                                                   (set! (.-bitPosition this) (+ position amount))
                                                   position))
               (get-byte-position! [this amount] (let [position (.-bytePosition this)]
                                                   (set! (.-bytePosition this) (+ position amount))
                                                   position))

               (to-raw [this] (let [total-bit-length  (int (- (cljc-ceil (/ (get-bit-position this) 8))
                                                              (get-max-byte-length this)))
                                    total-byte-length (get-byte-position this)
                                    array-buffer      (.-buffer this)]
                                (-> (js/Int8Array (+ total-bit-length total-byte-length))
                                    (.set (js/Int8Array. (.slice array-buffer 0 total-byte-length))
                                          0)
                                    (.set (js/Int8Array. (.slice array-buffer max-byte-length
                                                                 (+ max-byte-length total-bit-length)))
                                          total-byte-length)
                                    (.-buffer)))))))

(def ^:const header-byte-length 4)
(def ^:const header-bit-length 1)

(defn make-buffer [max-bit-length max-byte-length]
  (let [length          (+ max-bit-length max-byte-length)
        buffer #?(:clj  (SeriaByteBuffer/allocate length)
                  :cljs (js/DataView. (js/ArrayBuffer. length)))]
    (set-max-byte-length! buffer max-byte-length)))

(defn prepare-buffer! [buffer]
  (-> buffer
      (set-byte-position! header-byte-length)
      (set-bit-position! (+ header-bit-length (* 8 (get-max-byte-length buffer))))))

(defn raw->buffer [raw]
  (let [buffer #?(:clj  (SeriaByteBuffer/wrap ^bytes raw)
                  :cljs (js/DataView. raw))
        schema-id       (read-ushort! buffer)
        byte-length     (read-ushort! buffer)
        diffed?         (-> buffer
                            (set-bit-position! (* 8 (+ header-byte-length byte-length)))
                            (read-boolean!))]
    {:schema-id schema-id
     :diffed?   diffed?
     :buffer    buffer}))

(defn buffer->raw [buffer schema-id diffed?]
  (let [byte-position (get-byte-position buffer)
        byte-length   (- byte-position header-byte-length)
        bit-position  (get-bit-position buffer)]
    (-> buffer
        (set-byte-position! 0)
        (write-ushort! schema-id)
        (write-ushort! byte-length)
        (set-byte-position! byte-position)

        (set-bit-position! (* 8 (+ header-byte-length (get-max-byte-length buffer))))
        (write-boolean! diffed?)
        (set-bit-position! bit-position)

        (to-raw!))))

(ns seria.buffer
  (:require [seria.util :refer [cljc-ceil]])
  #?(:clj (:import [seria SeriaByteBuffer])))

(defprotocol HybridBuffer
  (read-byte! [this])
  (read-ubyte! [this])
  (read-short! [this])
  (read-ushort! [this])
  (read-int! [this])
  (read-uint! [this])
  (read-long! [this])
  (read-float! [this])
  (read-double! [this])
  (read-char! [this])
  (read-boolean! [this])

  (write-byte! [this value])
  (write-ubyte! [this value])
  (write-short! [this value])
  (write-ushort! [this value])
  (write-int! [this value])
  (write-uint! [this value])
  (write-long! [this value])
  (write-float! [this value])
  (write-double! [this value])
  (write-char! [this value])
  (write-boolean! [this value])

  (get-bit-position [this])
  (get-bit-position! [this amount])
  (set-bit-position! [this position])

  (get-byte-position [this])
  (get-byte-position! [this amount])
  (set-byte-position! [this position])

  (get-max-byte-length [this])
  (set-max-byte-length! [this value])

  (to-raw! [this]))

(defn long->ints [^long value]
  [(unchecked-int (bit-shift-right value 32))
   (unchecked-int value)])

(defn ints->long [int-1 int-2]
  (bit-or (unchecked-long (bit-shift-left int-1 32))
          (bit-and int-2 0xFFFFFFFF)))

(do #?(:clj  (extend-type SeriaByteBuffer
               HybridBuffer
               (read-byte!    [this] (.getByte this))
               (read-ubyte!   [this] (short (bit-and (.getByte this) 0xFF)))
               (read-short!   [this] (.getShort this))
               (read-ushort!  [this] (int (bit-and (.getShort this) 0xFFFF)))
               (read-int!     [this] (.getInt this))
               (read-uint!    [this] (long (bit-and (.getInt this) 0xFFFFFFFF)))
               (read-long!    [this] (ints->long (.getInt this) (.getInt this)))
               (read-float!   [this] (.getFloat this))
               (read-double!  [this] (.getDouble this))
               (read-char!    [this] (.getChar this))
               (read-boolean! [this] (.getBoolean this))

               (write-byte!    [this value] (.putByte this (byte value)))
               (write-ubyte!   [this value] (.putByte this (unchecked-byte (bit-and value 0xFF))))
               (write-short!   [this value] (.putShort this (short value)))
               (write-ushort!  [this value] (.putShort this (unchecked-short (bit-and value 0xFFFF))))
               (write-int!     [this value] (.putInt this (int value)))
               (write-uint!    [this value] (.putInt this (unchecked-int (bit-and value 0xFFFFFFFF))))
               (write-long!    [this value] (let [[int-1 int-2] (long->ints value)]
                                              (.putInt this int-1)
                                              (.putInt this int-2)))
               (write-float!   [this value] (.putFloat this (float value)))
               (write-double!  [this value] (.putDouble this (double value)))
               (write-char!    [this value] (.putChar this (char value)))
               (write-boolean! [this value] (.putBoolean this (boolean value)))

               (get-bit-position     [this] (.getBitPosition this))
               (get-byte-position    [this] (.getBytePosition this))
               (get-max-byte-length  [this] (.getMaxByteLength this))

               (set-bit-position!    [this value] (.setBitPosition this value))
               (set-byte-position!   [this value] (.setBytePosition this value))
               (set-max-byte-length! [this value] (.setMaxByteLength this value))

               (get-bit-position!    [this amount] (let [position (.getBitPosition this)]
                                                     (.setBitPosition this (+ position amount))
                                                     position))
               (get-byte-position!   [this amount] (let [position (.getBytePosition this)]
                                                     (.setBytePosition this (+ position amount))
                                                     position))
               (to-raw! [this] (.toRaw this)))

       :cljs (extend-type js/DataView
               HybridBuffer
               (read-byte!    [this] (.getInt8 this (get-byte-position! this this 1)))
               (read-ubyte!   [this] (.getUint8 this (get-byte-position! this 1)))
               (read-short!   [this] (.getInt16 this (get-byte-position! this 2)))
               (read-ushort!  [this] (.getUint16 this (get-byte-position! this 2)))
               (read-int!     [this] (.getInt32 this (get-byte-position! this 4)))
               (read-uint!    [this] (.getUint32 this (get this 4)))
               (read-long!    [this] (ints->long (.getInt32 this (get-byte-position! this 4))
                                                 (.getInt32 this (get-byte-position! this 4))))
               (read-float!   [this] (.getFloat32 this (get-byte-position! this 4)))
               (read-double!  [this] (.getFloat64 this (get-byte-position! this 8)))
               (read-char!    [this] (.getUint16 this (get-byte-position! this 2)))
               (read-boolean! [this] (-> this
                                         (.getInt8 (quot (get-bit-position! this 1) 8))
                                         (bit-test (rem 8))))

               (write-byte!    [this value] (.setInt8 this (get-byte-position! this 1) (byte value)))
               (write-ubyte!   [this value] (.setUint8 this (get-byte-position! this 1) (unchecked-byte value)))
               (write-short!   [this value] (.setInt16 this (get-byte-position! this 2) (short value)))
               (write-ushort!  [this value] (.setUint16 this (get-byte-position! this 2) (unchecked-short value)))
               (write-int!     [this value] (.setInt32 this (get-byte-position! this 4) (int value)))
               (write-uint!    [this value] (.setUint32 this (get-byte-position! this 4) (unchecked-int value)))
               (write-long!    [this value] (let [[int-1 int-2] (long->ints value)]
                                              (.setInt32 this (get-byte-position! this 4) int-1)
                                              (.setInt32 this (get-byte-position! this 4) int-2)))
               (write-float!   [this value] (.setFloat32 this (float value)))
               (write-double!  [this value] (.setFloat64 this (double value)))
               (write-char!    [this value] (.setUint16 this (char value)))
               (write-boolean! [this value] (let [bit-position  (get-bit-position! this 1)]
                                              (.setInt8 this
                                                        (quot bit-position 8)
                                                        (-> this
                                                            (.getInt8 (quot bit-position 8))
                                                            ((if value bit-set bit-clear) (rem bit-position 8))
                                                            (unchecked-byte)))))

               (get-byte-position   [this] (.-bytePosition this))
               (get-max-byte-length [this] (.-maxByteLength this))

               (set-bit-position!    [this value] (do (set! (.-bitPosition this) value) this))
               (set-byte-position!   [this value] (do (set! (.-bytePosition this) value) this))
               (set-max-byte-length! [this value] (do (set! (.-maxByteLength this) value) this))

               (get-bit-position!  [this amount] (let [position (.-bitPosition this)]
                                                   (set! (.-bitPosition this) (+ position amount))
                                                   position))
               (get-byte-position! [this amount] (let [position (.-bytePosition this)]
                                                   (set! (.-bytePosition this) (+ position amount))
                                                   position))

               (to-raw [this] (let [total-bit-length  (int (- (cljc-ceil (/ (get-bit-position this) 8))
                                                              (get-max-byte-length this)))
                                    total-byte-length (get-byte-position this)
                                    array-buffer      (.-buffer this)]
                                (-> (js/Int8Array (+ total-bit-length total-byte-length))
                                    (.set (js/Int8Array. (.slice array-buffer 0 total-byte-length))
                                          0)
                                    (.set (js/Int8Array. (.slice array-buffer max-byte-length
                                                                 (+ max-byte-length total-bit-length)))
                                          total-byte-length)
                                    (.-buffer)))))))

(def ^:const header-byte-length 4)
(def ^:const header-bit-length 1)

(defn make-buffer [max-bit-length max-byte-length]
  (let [length          (+ max-bit-length max-byte-length)
        buffer #?(:clj  (SeriaByteBuffer/allocate length)
                  :cljs (js/DataView. (js/ArrayBuffer. length)))]
    (set-max-byte-length! buffer max-byte-length)))

(defn prepare-buffer! [buffer]
  (-> buffer
      (set-byte-position! header-byte-length)
      (set-bit-position! (+ header-bit-length (* 8 (get-max-byte-length buffer))))))

(defn raw->buffer [raw]
  (let [buffer #?(:clj  (SeriaByteBuffer/wrap ^bytes raw)
                  :cljs (js/DataView. raw))
        schema-id       (read-ushort! buffer)
        byte-length     (read-ushort! buffer)
        diffed?         (-> buffer
                            (set-bit-position! (* 8 (+ header-byte-length byte-length)))
                            (read-boolean!))]
    {:schema-id schema-id
     :diffed?   diffed?
     :buffer    buffer}))

(defn buffer->raw [buffer schema-id diffed?]
  (let [byte-position (get-byte-position buffer)
        byte-length   (- byte-position header-byte-length)
        bit-position  (get-bit-position buffer)]
    (-> buffer
        (set-byte-position! 0)
        (write-ushort! schema-id)
        (write-ushort! byte-length)
        (set-byte-position! byte-position)

        (set-bit-position! (* 8 (+ header-byte-length (get-max-byte-length buffer))))
        (write-boolean! diffed?)
        (set-bit-position! bit-position)

        (to-raw!))))

Fix set-* methods for cljs in protocol HybridBuffer


(ns genartlib.curves
  (:use [genartlib.algebra :only [interpolate]]))

(defn- single-chaikin-step [points tightness]
  (loop [points points
         new-points [(first points)]]
    (if (<= (count points) 1)
      (vec (concat new-points [(last points)]))
      (let [[start-x start-y] (first points)
            [end-x end-y] (second points)
            q-x (interpolate start-x end-x (+ 0.0 tightness))
            q-y (interpolate start-y end-y (+ 0.0 tightness))
            r-x (interpolate start-x end-x (- 1.0 tightness))
            r-y (interpolate start-y end-y (- 1.0 tightness))]
        (recur (rest points) (concat new-points [[q-x q-y] [r-x r-y]]))))))

(defn chaikin-curve

  "Forms a Chaikin curve from a seq of points, returning a new
   seq of points.

   The tightness parameter controls how sharp the corners will be,
   and should be a value between 0.0 and 0.5.  A value of 0.0 retains
   full sharpness, and 0.5 creates maximum smoothness.

   The depth parameter controls how many recursive steps will occur.
   The more steps, the smoother the curve is (assuming tightness is
   greater than zero). Suggested values are between 1 and 8, with a
   good default being 4.

   When points form a closed polygon, it's recommended that the start
   point be repeated at the end of points to avoid a gap."

  ([points] (chaikin-curve [points 4 0.25]))
  ([points depth] (chaikin-curve [points depth 0.25]))

  ([points depth tightness]
    (loop [depth depth
           points points]
      (if (zero? depth)
        points
        (recur (dec depth) (single-chaikin-step points tightness))))))

Convert to UNIX style line endings

Convert to UNIX style line endings


(ns tictag.beeminder
  (:require [org.httpkit.client :as http]
            [cheshire.core :as cheshire]
            [taoensso.timbre :as timbre]
            [clojure.string :as str]
            [clojure.data :refer [diff]]
            [tictag.db :as db]))

(defmulti match? (fn [a _] (class a)))

(defmethod match? java.util.regex.Pattern
  [a b]
  (some #(re-find a %) b))

(defmethod match? java.lang.String
  [a b]
  (b a))

(defmethod match? clojure.lang.Keyword
  [a b]
  (b (name a)))

(defmethod match? clojure.lang.PersistentList
  [a b]
  (match? (vec a) b))

(defmethod match? clojure.lang.PersistentVector
  [[pred & args] b]
  (case (name pred)
    "and" (every? #(match? % b) args)
    "or"  (some #(match? % b) args)))

(defn goal-url [user goal]
  (format "https://www.beeminder.com/api/v1/users/%s/goals/%s.json" user goal))

(defn datapoints-url [user goal]
  (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints.json" user goal))

(defn datapoints [auth-token user goal]
  (:datapoints
   (cheshire/parse-string
    (:body
     @(http/request {:url         (goal-url user goal)
                     :method      :get
                     :query-params {:auth_token auth-token
                                    :datapoints true}}))
    true)))

(defn update-datapoint! [auth-token user goal datapoint]
  (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints/%s.json"
                              user goal (:id datapoint))
                 :method :put
                 :query-params {:auth_token auth-token
                                :value (:value datapoint)}}))

(defn create-datapoint! [auth-token user goal datapoint]
  (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints.json"
                              user goal)
                 :method :post
                 :query-params {:auth_token auth-token
                                :value (:value datapoint)
                                :daystamp (:daystamp datapoint)}}))

(defn save-datapoint! [auth-token user goal datapoint]
  (if (:id datapoint)
    (update-datapoint! auth-token user goal datapoint)
    (create-datapoint! auth-token user goal datapoint)))

(defn delete-datapoint! [auth-token user goal datapoint]
  (when (:id datapoint)
    (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints/%s.json"
                                user goal (:id datapoint))
                   :method :delete
                   :query-params {:auth_token auth-token}})))

(defn days-matching-tag [tags rows]
  (timbre/tracef "Matching tags %s, rows %s" tags rows)
  (->> rows
       (filter #(match? tags (:tags %)))
       (map :local-day)
       (frequencies)))

(defn sync! [db user]
  (timbre/debugf "Beginning beeminder sync: %s" (:enabled? (:beeminder user)))
  (when (:enabled? (:beeminder user))
    (when-let [goals (seq (db/get-goals db (:beeminder user)))]
      (timbre/tracef "goals are %s, getting rows" goals)
      (let [rows (db/get-pings-by-user (:db db) user)]
        (timbre/tracef "Rows: %s" rows)
        (doseq [{:keys [goal/name goal/tags]} goals]
          (timbre/debugf "Syncing goal: %s with tags %s" name tags)
          (let [{:keys [username token]} (:beeminder user)
                days                     (days-matching-tag tags rows)
                existing-datapoints      (datapoints
                                          (get-in
                                           user
                                           [:beeminder :token])
                                          username
                                          name)
                existing-map             (group-by :daystamp existing-datapoints)
                to-save                  (filter :value
                                                 (for [[daystamp value] days
                                                       :let             [hours (* (/ (:gap (:tagtime db)) 60 60) value)
                                                                         {id :id old-value :value}
                                                                         (first
                                                                          (existing-map daystamp))]]
                                                   {:id       id
                                                    :daystamp daystamp
                                                    :value    (when (or (not old-value)
                                                                        (not= (float old-value) (float hours)))
                                                                (float hours))}))
                to-delete                (concat
                                          (remove (fn [{:keys [daystamp]}]
                                                    (days daystamp))
                                                  existing-datapoints)
                                          (flatten
                                           (remove nil?
                                                   (map rest (vals existing-map)))))
                save-futures             (doall (map #(save-datapoint! token username name %) to-save))
                delete-futures           (doall (map #(delete-datapoint! token username name %) to-delete))]
            (doseq [resp (concat save-futures delete-futures)]
              (timbre/debugf "result %s %s: %s"
                             (-> @resp :opts :url)
                             (-> @resp :opts :method)
                             (:status @resp)))))))))

(defn user-for [token]
  (let [resp (-> (http/request {:url         "https://www.beeminder.com/api/v1/users/me.json"
                                :method      :get
                                :query-params {:auth_token token}})
                 (deref))]
    (if (= (:status resp) 200)
      (cheshire/parse-string (:body resp) true)
      nil)))

(ns tictag.beeminder
  (:require [org.httpkit.client :as http]
            [cheshire.core :as cheshire]
            [taoensso.timbre :as timbre]
            [clojure.string :as str]
            [clojure.data :refer [diff]]
            [tictag.db :as db]))

(defmulti match? (fn [a _] (class a)))

(defmethod match? java.util.regex.Pattern
  [a b]
  (some #(re-find a %) b))

(defmethod match? java.lang.String
  [a b]
  (b a))

(defmethod match? clojure.lang.Keyword
  [a b]
  (b (name a)))

(defmethod match? clojure.lang.PersistentList
  [a b]
  (match? (vec a) b))

(defmethod match? clojure.lang.PersistentVector
  [[pred & args] b]
  (case (name pred)
    "and" (every? #(match? % b) args)
    "or"  (some #(match? % b) args)))

(defn goal-url [user goal]
  (format "https://www.beeminder.com/api/v1/users/%s/goals/%s.json" user goal))

(defn datapoints-url [user goal]
  (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints.json" user goal))

(defn datapoints [auth-token user goal]
  (:datapoints
   (cheshire/parse-string
    (:body
     @(http/request {:url         (goal-url user goal)
                     :method      :get
                     :query-params {:auth_token auth-token
                                    :datapoints true}}))
    true)))

(defn update-datapoint! [auth-token user goal datapoint]
  (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints/%s.json"
                              user goal (:id datapoint))
                 :method :put
                 :query-params {:auth_token auth-token
                                :value (:value datapoint)}}))

(defn create-datapoint! [auth-token user goal datapoint]
  (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints.json"
                              user goal)
                 :method :post
                 :query-params {:auth_token auth-token
                                :value (:value datapoint)
                                :daystamp (:daystamp datapoint)}}))

(defn save-datapoint! [auth-token user goal datapoint]
  (if (:id datapoint)
    (update-datapoint! auth-token user goal datapoint)
    (create-datapoint! auth-token user goal datapoint)))

(defn delete-datapoint! [auth-token user goal datapoint]
  (when (:id datapoint)
    (http/request {:url (format "https://www.beeminder.com/api/v1/users/%s/goals/%s/datapoints/%s.json"
                                user goal (:id datapoint))
                   :method :delete
                   :query-params {:auth_token auth-token}})))

(defn days-matching-tag [tags rows]
  (->> rows
       (filter #(match? tags (:tags %)))
       (map :local-day)
       (frequencies)))

(defn sync! [db user]
  (timbre/debugf "Beginning beeminder sync: %s" (:enabled? (:beeminder user)))
  (when (:enabled? (:beeminder user))
    (when-let [goals (seq (db/get-goals db (:beeminder user)))]
      (timbre/tracef "goals are %s, getting rows" goals)
      (let [rows (db/get-pings-by-user (:db db) user)]
        (doseq [{:keys [goal/name goal/tags]} goals]
          (timbre/debugf "Syncing goal: %s with tags %s" name tags)
          (let [{:keys [username token]} (:beeminder user)
                days                     (days-matching-tag tags rows)
                existing-datapoints      (datapoints
                                          (get-in
                                           user
                                           [:beeminder :token])
                                          username
                                          name)
                existing-map             (group-by :daystamp existing-datapoints)
                to-save                  (filter :value
                                                 (for [[daystamp value] days
                                                       :let             [hours (* (/ (:gap (:tagtime db)) 60 60) value)
                                                                         {id :id old-value :value}
                                                                         (first
                                                                          (existing-map daystamp))]]
                                                   {:id       id
                                                    :daystamp daystamp
                                                    :value    (when (or (not old-value)
                                                                        (not= (float old-value) (float hours)))
                                                                (float hours))}))
                to-delete                (concat
                                          (remove (fn [{:keys [daystamp]}]
                                                    (days daystamp))
                                                  existing-datapoints)
                                          (flatten
                                           (remove nil?
                                                   (map rest (vals existing-map)))))
                save-futures             (doall (map #(save-datapoint! token username name %) to-save))
                delete-futures           (doall (map #(delete-datapoint! token username name %) to-delete))]
            (doseq [resp (concat save-futures delete-futures)]
              (timbre/debugf "result %s %s: %s"
                             (-> @resp :opts :url)
                             (-> @resp :opts :method)
                             (:status @resp)))))))))

(defn user-for [token]
  (let [resp (-> (http/request {:url         "https://www.beeminder.com/api/v1/users/me.json"
                                :method      :get
                                :query-params {:auth_token token}})
                 (deref))]
    (if (= (:status resp) 200)
      (cheshire/parse-string (:body resp) true)
      nil)))

remove crazy logs in beeminder

remove crazy logs in beeminder


(ns triboard.ai.ai
  (:require
    [cljs.spec :as s :include-macros true]
    [triboard.ai.scores :as scores]
    [triboard.logic.board :as board]
    [triboard.logic.constants :as cst]
    [triboard.logic.game :as game]
    [triboard.logic.move :as move]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- make-ai
  [board player]
  {:player player
   :other-players (remove #{player} cst/players)
   :cell-weights (scores/get-weights-by-cell board)
   })

(defn- score-move
  "Compute the strength of a move, based on the converted cells"
  [{:keys [player cell-weights]} [point conversions]]
  (reduce
    #(scores/update-score-diff cell-weights %1 %2)
    scores/null-score-diff
    (conj conversions (move/empty-cell-conversion player point))
    ))

(defn- worst-possible-score-from
  [{:keys [player other-players] :as ai} game-state]
  (transduce
    (comp
      (mapcat #(get (:moves game-state) %))
      (map #(score-move ai %))
      (map #(get % player)))
    min
    other-players))

(defn- move-best-outcome
  [ai game [coord converted :as move]]
  (let [new-game (game/play-move game coord)
        move-diff (get (score-move ai move) (:player ai))
        next-diff (worst-possible-score-from ai (game/current-state new-game))]
    (+ move-diff next-diff)))

(defn- max-by
  [key-fn coll]
  (apply max-key (memoize key-fn) coll))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(s/fdef best-move
  :args (s/tuple ::game ::cst/player)
  :ret ::board/coord)

(defn best-move
  "[SIMPLISTIC] Return the best move for a player based on:
   * The immediate gain
   * The worse immediate lost afterwards"
  [game player]
  (let [game-state (game/current-state game)
        ai (make-ai (:board game-state) player)]
    (first
      (max-by #(move-best-outcome ai game %)
        (get-in game-state [:moves player]))
      )))

(ns triboard.ai.ai
  (:require
    [cljs.spec :as s :include-macros true]
    [triboard.ai.scores :as scores]
    [triboard.logic.board :as board]
    [triboard.logic.constants :as cst]
    [triboard.logic.game :as game]
    [triboard.logic.move :as move]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- make-ai
  [board player]
  {:player player
   :other-players (remove #{player} cst/players)
   :cell-weights (scores/get-weights-by-cell board)
   })

(defn- score-move
  "Compute the strength of a move, based on the converted cells"
  [{:keys [player cell-weights]} [point conversions]]
  (reduce
    #(scores/update-score-diff cell-weights %1 %2)
    scores/null-score-diff
    (conj conversions (move/empty-cell-conversion player point))
    ))

(defn- worst-possible-score-from
  [{:keys [player other-players] :as ai} moves]
  (transduce
    (comp
      (mapcat #(get moves %))
      (map #(score-move ai %))
      (map #(get % player)))
    min
    other-players))

(defn- move-best-outcome
  [ai game [coord converted :as move]]
  (let [new-game (game/play-move game coord)
        move-diff (get (score-move ai move) (:player ai))
        new-moves (:moves (game/current-state new-game))
        next-diff (worst-possible-score-from ai new-moves)]
    (+ move-diff next-diff)))

(defn- max-by
  [key-fn coll]
  (apply max-key (memoize key-fn) coll))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(s/fdef best-move
  :args (s/tuple ::game ::cst/player)
  :ret ::board/coord)

(defn best-move
  "[SIMPLISTIC] Return the best move for a player based on:
   * The immediate gain
   * The worse immediate lost afterwards"
  [game player]
  (let [game-state (game/current-state game)
        ai (make-ai (:board game-state) player)]
    (first
      (max-by #(move-best-outcome ai game %)
        (get-in game-state [:moves player]))
      )))

simplify ai

simplify ai


(ns cljam.pileup
  (:require (cljam [cigar :as cgr]
                   [bam :as bam])))

(def ^:private window-width 500) ;; TODO: estiamte from actual data
(def ^:private step 100) ;; TODO: estiamte from actual data
(def ^:private center 50) ;; TODO: estiamte from actual data

(defn- count-for-pos
  "Returns a histogram value of the specified position."
  [alns ^String rname ^Long pos]
  (loop [alns2 alns
         val 0]
    (let [[aln & rst] alns2]
      (if (nil? aln)
        val
        (if (and (= rname (:rname aln))
                 (>= pos (:pos aln))
                 (<= pos (+ (:pos aln) (cgr/count-ref (:cigar aln)))))
          (recur rst (inc val))
          (recur rst val))))))

(defn rpositions
  ([^Long start ^Long end]
     (rpositions start end start))
  ([^Long start ^Long end ^Long n]
     (if (>= end n)
       (cons n
             (lazy-seq (rpositions start end (inc n))))
       nil)))

(defn- read-alignments
  [rdr ^String rname ^Long rlength ^Long pos]
  (let [^Long left (let [^Long val (- pos window-width)]
                     (if (< val 0)
                       0
                       val))
        ^Long right (let [^Long val (+ pos window-width)]
                      (if (< rlength val)
                        rlength
                        val))]
    (bam/read-alignments rdr rname left right)))

(defn- search-ref
  [refs rname]
  (first
   (filter (fn [r] (= (:name r) rname))
           refs)))

(defn- pileup*
  ([rdr rname rlength start end]
     (flatten
      (let [parts (partition-all step (rpositions start end))]
        (map (fn [positions]
               (let [^Long pos (if (= (count positions) step)
                                 (nth positions center)
                                 (nth positions (quot (count positions) 2)))
                     alns (read-alignments rdr rname rlength pos)]
                 (map #(count-for-pos alns rname %) positions)))
             parts)))))

(defn pileup
  ([rdr]
     ;; TODO
     )
  ([rdr ^String rname]
     (pileup rdr rname -1 -1))
  ([rdr ^String rname ^Long start* ^Long end*]
     (let [r (search-ref (.refs rdr) rname)]
       (if (nil? r)
         nil
         (pileup* rdr
                  rname (:len r)
                  (if (neg? start*) 0 start*)
                  (if (neg? end*) (:len r) end*))))))

(ns cljam.pileup
  (:require (cljam [cigar :as cgr]
                   [bam :as bam])))

(def ^:private window-width 1250) ;; TODO: estiamte from actual data
(def ^:private step 2000) ;; TODO: estiamte from actual data
(def ^:private center (int (/ step 2))) ;; TODO: estiamte from actual data

(defn- count-for-alignment
  [^clojure.lang.PersistentHashMap aln
   ^String rname
   ^clojure.lang.LazySeq positions]
  (if (= rname (:rname aln))
    (let [left (:pos aln)
          right (+ (:pos aln) (cgr/count-ref (:cigar aln)))]
      (map (fn [p] (if (and (>= p left)
                            (<= p right)) 1 0)) positions))
    (take (count positions) (repeat 0))))

(defn- count-for-positions
  "Returns a histogram value of the specified position."
  [^clojure.lang.LazySeq alns
   ^String rname positions]
  (if (pos? (count alns))
    (apply map + (map #(count-for-alignment % rname positions) alns))
    (take (count positions) (repeat 0))))

(defn rpositions
  ([^Long start ^Long end]
     (rpositions start end start))
  ([^Long start ^Long end ^Long n]
     (if (>= end n)
       (cons n
             (lazy-seq (rpositions start end (inc n))))
       nil)))

(defn- read-alignments
  [rdr ^String rname ^Long rlength ^Long pos]
  (let [^Long left (let [^Long val (- pos window-width)]
                     (if (< val 0)
                       0
                       val))
        ^Long right (let [^Long val (+ pos window-width)]
                      (if (< rlength val)
                        rlength
                        val))]
    (bam/read-alignments rdr rname left right)))

(defn- search-ref
  [refs rname]
  (first
   (filter (fn [r] (= (:name r) rname))
           refs)))

(defn- pileup*
  ([rdr ^String rname ^Long rlength ^Long start ^Long end]
     (flatten
      (let [parts (partition-all step (rpositions start end))]
        (map (fn [positions]
               (let [^Long pos (if (= (count positions) step)
                                 (nth positions center)
                                 (nth positions (quot (count positions) 2)))
                     ^clojure.lang.LazySeq alns (read-alignments rdr rname rlength pos)]
                 (count-for-positions alns rname positions)))
             parts)))))

(defn pileup
  ([rdr]
     ;; TODO
     )
  ([rdr ^String rname]
     (pileup rdr rname -1 -1))
  ([rdr ^String rname ^Long start* ^Long end*]
     (let [r (search-ref (.refs rdr) rname)]
       (if (nil? r)
         nil
         (pileup* rdr
                  rname (:len r)
                  (if (neg? start*) 0 start*)
                  (if (neg? end*) (:len r) end*))))))

improve pileup performance

improve pileup performance