; Iyye - AI agent
; Copyright (C) 2016-2017  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.words
  (:require
    [clojure.tools.logging :as log]
    [iyye.bios.ioframes :as ioframes]
    [iyye.bios.persistence :as persistence]
    ;[iyye.subcon.knowledge.relation :as relation]
    ))

(def action-words (ref []))
(def noun-words (ref []))
;(def types-words (ref []))
;(def relations-words (ref []))
(def instances-words (ref []))
(def adjective-words (ref []))

(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
(defrecord Iyye_Atom [Name Uname])
(defrecord Iyye_Relation [atom Predicate Types Function Data])
(defrecord Iyye_Type [atom Relations])
(defrecord Iyye_Instance [atom type])

(defn create-iyye-atom [name words-list]
  (let [Time (persistence/current-time-to-string)
        uname (str name (count words-list))
        atom (->Iyye_Atom name uname)]
    atom))

(defn create-iyye-type [Name]
  (let [type-atom (create-iyye-atom Name noun-words)
        type (->Iyye_Type type-atom [])]
    type))

(defn create-iyye-relation [Name AccordingTo Reason When Types Function]
  (let [action-atom (create-iyye-atom Name @noun-words)
        relation (->Iyye_Relation action-atom Reason Types Function [])]
    relation))

(defn create-iyye-instance [values])

(defn load-iyye-atom-from-db [uname])

(defn load-iyye-types-from-db [name]
  )

(defn load-iyye-relations-from-db [name]
  )

(defn get-iyye-types [name]
  (let [builtin-types #(for [word @noun-words :when (= (:Name word) name)] word)
        loaded-types (load-iyye-types-from-db name)]
      (if (empty? builtin-types)
        (if (empty? loaded-types)
          :UNKNOWN
          loaded-types)
        (if (empty? loaded-types)
          builtin-types
          (apply conj builtin-types loaded-types)))))

(defn set-iyye-type! [type]
  )

(defn get-iyye-relations [name]
  (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)
        loaded-relations (load-iyye-relations-from-db name)]
    (if (empty? builtin-relations)
      (if (empty? loaded-relations)
        :UNKNOWN
        loaded-relations)
      (if (empty? loaded-relations)
        builtin-relations
        (apply conj builtin-relations loaded-relations)))))

(defn check-params [action params]
  (let [act-params (:Types action)]
  (compare act-params (map #(:Name (:atom %)) params))))

;(dosync (alter types-words conj type))
;(persistence/write-noun-to-db (into {} type))

(defn apply-relation [relation params]
  (when (check-params relation params)
    ((:Function relation) params)))

(defn action [cmd params IO]
  (let [actions-list (get-iyye-relations cmd)
        params-list (map get-iyye-types params)]
    (case (count actions-list)
      0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
      1 (let [action (first actions-list)]
          (when (not (apply-relation action params-list))
            (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))

      (let [matching-actions (for [action @actions-list :when (check-params action params-list)] action)]
        (if (empty? matching-actions)
          (ioframes/process-output IO (str "failed to parse: no many matched parameters to " cmd ": " actions-list))
          ((:Function (first matching-actions)) params-list))))))                     ; FIXME Yumzya first

; Iyye - AI agent
; Copyright (C) 2016-2017  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.words
  (:require
    [clojure.tools.logging :as log]
    [iyye.bios.ioframes :as ioframes]
    [iyye.bios.persistence :as persistence]
    ;[iyye.subcon.knowledge.relation :as relation]
    ))

(def action-words (ref {}))
(def noun-words (ref {}))
;(def types-words (ref []))
;(def relations-words (ref []))
;(def instances-words (ref []))
;(def adjective-words (ref []))

(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
(defrecord Iyye_Atom [Name Uname Builtin])
(defrecord Iyye_Relation [atom Predicate Types Function PredicateFunction Data])
(defrecord Iyye_Type [atom Relations])
(defrecord Iyye_Instance [atom type])

(defn create-iyye-atom [name words-list & builtin]
  (let [uname (str name (count words-list))
        b (if (nil? builtin) false (first builtin))
        atom (->Iyye_Atom name uname b)]
    atom))

(defn create-iyye-type [Name & builtin]
  (let [type-atom (create-iyye-atom Name noun-words builtin)
        type (->Iyye_Type type-atom [])]
    type))

(defn create-iyye-relation [Name Predicate Types Function PredicateFunction & builtin]
  (let [action-atom (create-iyye-atom Name @noun-words builtin)
        relation (->Iyye_Relation action-atom Predicate Types Function PredicateFunction [])]
    relation))

(defn create-iyye-instance [values])

(defn load-iyye-atom-from-db [uname])

(defn load-iyye-atoms-from-db [name & [dbname]])

(defn load-iyye-types-from-db [name]
  (load-iyye-atoms-from-db name "types"))

(defn save-iyye-type-to-db [type]
  )

(defn load-iyye-relations-from-db [name]
  (load-iyye-atoms-from-db name "relations"))

(defn get-iyye-atoms [name builtins dbname]
  (let [builtin-types #(for [word @builtins :when (= (:Name word) name)] word)
        loaded-types (load-iyye-atoms-from-db name dbname)]
    (if (empty? builtin-types)
      (if (empty? loaded-types)
        :UNKNOWN
        loaded-types)
      (if (empty? loaded-types)
        builtin-types
        (apply conj builtin-types loaded-types)))))

(defn get-iyye-types [name]
  (get-iyye-atoms name noun-words "types"))

(defn set-iyye-type! [type]
  (let [uname (:Uname (:atom type))
        builtin (:Builtin (:atom type))]
(do (dosync (alter noun-words assoc @noun-words uname type))
    (when builtin
      (save-iyye-type-to-db type)))
    ))

; (defn get-iyye-relations [name]
  ; (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)
  ;       loaded-relations (load-iyye-relations-from-db name)]
  ; (if (empty? builtin-relations)
  ; (if (empty? loaded-relations)
  ;       :UNKNOWN
  ;      loaded-relations)
  ; (if (empty? loaded-relations)
  ;        builtin-relations
  ;        (apply conj builtin-relations loaded-relations)))))

(defn get-iyye-relations [name]
  (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)]
    (if (empty? builtin-relations)
      :UNKNOWN
      builtin-relations)))

(defn check-params [action params]
  (let [act-params (:Types action)]
    (compare act-params (map #(:Name (:atom %)) params))))

  ;(dosync (alter types-words conj type))
  ;(persistence/write-noun-to-db (into {} type))

(defn apply-relation [relation params]
  (when (check-params relation params)
    ((:Function relation) params)))

(defn apply-query [relation params]
  (when (check-params relation params)
    ((:PredicateFunction relation) params)))

(defn- run-action [cmd params IO func]
  (let [actions-list (get-iyye-relations cmd)
        params-list (map get-iyye-types params)]
    (case (count actions-list)
      0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
      1 (let [action (first actions-list)]
          (when (not (func action params-list))
            (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))
      (let [matching-actions (for [action @actions-list :when (check-params action params-list)] action)]
        (if (empty? matching-actions)
          (ioframes/process-output IO (str "failed to parse: no many matched parameters to " cmd ": " actions-list))
          (func (first matching-actions) params-list)))))) ; FIXME Yumzya first

(defn action [cmd params IO]
  (if (= \? (last cmd))
    (run-action (subs cmd 0 (dec (count cmd))) params IO apply-query)
    (run-action cmd params IO apply-relation)))

Update words.clj

Update words.clj


; Iyye - AI agent
; Copyright (C) 2016-2018  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.words
  (:require
    [clojure.tools.logging :as log]
    [iyye.bios.ioframes :as ioframes]
    [iyye.bios.persistence :as persistence]
    ;[iyye.subcon.knowledge.relation :as relation]
    ))

(def dbg-IO (ref nil))

(def action-words (ref {}))
(def noun-words (ref {}))
;(def types-words (ref []))
;(def relations-words (ref []))
;(def instances-words (ref []))
;(def adjective-words (ref []))

(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
(defrecord Iyye_Atom [Name Uname Builtin])
(defrecord Iyye_Relation [atom Predicate Types Function PredicateFunction Data])
(defrecord Iyye_Type [atom Relations])
(defrecord Iyye_Instance [atom type])

(def atoms-number (ref 0))
(defn inc-atoms! []
  (dosync (ref-set atoms-number (inc @atoms-number)))
  @atoms-number)

(defn create-iyye-atom [name & builtin]
  (let [uname (str name (inc-atoms!))
        b (if (nil? builtin) false (first builtin))
        atom (->Iyye_Atom name uname b)]
    atom))

(defn create-iyye-type [Name & builtin]
  (let [type-atom (create-iyye-atom Name builtin)
        type (->Iyye_Type type-atom [])]
    type))

(defn create-iyye-type-from-db [t]
  "de-serialize t"
  (let [mykey #(keyword (str %1 %2))
        create-types #(clojure.string/split (t (mykey "Relation-Types-List" %1)) #"_")
        create-data #(hash-map (keyword (t (mykey "Relation-Data-List1" %1))) ; Only 2 now
                       (t (mykey "Relation-Data-List2" %1)))
        relations-list
        (loop [rel-vec []
               num 0]
          (if-not (t (mykey "Relation-name" num))
            rel-vec
            (let [rel-uname (t (mykey "Relation-uname" num))]
              (recur (conj rel-vec
                         (->Iyye_Relation
                           (->Iyye_Atom (t (mykey "Relation-name" num))
                                        rel-uname
                                        false)
                           (->Iyye_ModalPredicate
                             (t (mykey "Relation-AccordingTo" num))
                             (t (mykey "Relation-When" num))
                             (t (mykey "Relation-Time" num))
                             (t (mykey "Relation-Prob" num)))
                           (create-types num)
                           (:Function (@action-words (t (mykey "Relation-uname" num))))
                           (:PredicateFunction (@action-words (t (mykey "Relation-uname" num))))
                           (create-data num)))
                   (inc num)))))]
    (->Iyye_Type (->Iyye_Atom (:Name t) (:Uname t) false) relations-list)))

(defn create-iyye-relation [Name Predicate Types Function PredicateFunction & builtin]
  (let [action-atom (create-iyye-atom Name builtin)
        relation (->Iyye_Relation action-atom Predicate Types Function PredicateFunction [])]
    relation))

(def time-start (persistence/local-time-to-string))
(defn get-supertypes [atype]
  "gets types: self, type, immidiate parents"               ; FIXME Yumzia:0 get all parents
  (if-not (:UNKNOWN atype)
    (let [rels (:Relations atype)]
      (conj (for [supertype rels :when (:super (:Data supertype))]
              {:Name (:super (:Data supertype)) :Predicate (:Predicate supertype)})
              {:Name "type" :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}
              {:Name (:Name (:atom atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))
    {:UNKNOWN (:UNKNOWN atype)}))

(defn create-iyye-instance [values])

(defn load-iyye-atom-from-db [uname])

(defn load-iyye-atoms-from-db [name & [dbname]]
  )

(defn- print-io-str [IO prstr]
  "helper dbg func"
  (future (Thread/sleep 1000) (ioframes/process-output IO (pr-str prstr))))

(defn load-iyye-relations-from-db [name]
  (load-iyye-atoms-from-db name "relations"))

(defn load-iyye-types-from-db [name]
  (let [types (persistence/read-knowledge-from-db "types" {})]
    ))

(defn save-iyye-type-to-db [type]
  (let [types-list-str (fn [types]
          (reduce #(str %1 "_" %2) types))
        rel-key (fn [name ind]
          (keyword (str name ind)))
        get-rel
        (fn [ind rel]
          {(rel-key "Relation-name" ind) (:Name (:atom rel))
             (rel-key "Relation-uname" ind) (:Uname (:atom rel))
            (rel-key "Relation-AccordingTo" ind) (:AccordingTo (:Predicate rel))
            (rel-key "Relation-When" ind) (:When (:Predicate rel))
            (rel-key "Relation-Time" ind) (:Time (:Predicate rel))
             (rel-key "Relation-Prob" ind) (:Prob (:Predicate rel))
             (rel-key "Relation-Types-List" ind) (types-list-str (:Types rel))
           (rel-key "Relation-Data-List1" ind) (types-list-str (map name (keys (:Data rel))))
               (rel-key "Relation-Data-List2" ind) (types-list-str (vals (:Data rel)))
           })]
    (let [write-type (reduce conj {:Uname (:Uname (:atom type))
                                   :Name  (:Name (:atom type))}
                             (map-indexed get-rel (:Relations type)))
          ]
      ; (when @dbg-IO (print-io-str @dbg-IO (pr-str "add list: " type ":::"
      ;                                          (map-indexed get-rel (:Relations type)))))
      (persistence/write-knowledge-to-db "types" write-type))))

(defn save-iyye-builtin-type-to-db [type]

  )
;(persistence/write-noun-to-db (into {} type))

(defn get-iyye-atoms [name builtins]
  "returns a list of found atoms with supplied name"
  (let [builtin-types
        (for [word (vals @builtins) :when (= (:Name (:atom word)) name)] word)]
    (if (empty? builtin-types) (list {:UNKNOWN name}) builtin-types)))

(defn get-iyye-types [name]
  (get-iyye-atoms name noun-words))

(defn get-iyye-relations [name]
  (get-iyye-atoms name action-words))

(defn set-iyye-type! [type]
  (let [uname (:Uname (:atom type))
        builtin (:Builtin (:atom type))]
      (do
        (dosync (alter noun-words #(assoc % uname type)))
        (if-not builtin
          (save-iyye-type-to-db type)
          (save-iyye-builtin-type-to-db type)))))

(defn check-params [action params]
  (let [act-params (:Types action)]
    (when (= (count params) (count act-params))
      (let [params-types (map #(get-supertypes %) params)
        ;   vec-params (vec (map #(:Name (:atom %)) params))
            pairs (map vector act-params params-types)
            ok (every? true? (for [cur pairs]
                               (if (= :UNKNOWN (first cur))
                                 (if (:UNKNOWN (second cur)) true false)
                                 (some true?
                                       (map #(= (first cur) %) (map :Name (second cur)))))))]
    ok))))  ; FIXME Yumzya context aware compare

(defn apply-relation [relation params]
  (when (check-params relation params)
    ((:Function relation) params)))

(defn apply-query [relation params]
  (when (check-params relation params)
    ((:PredicateFunction relation) params)))

(defn- run-action [cmd params IO func]
  (let [actions-list (get-iyye-relations cmd)
        params-list (apply concat (map get-iyye-types params))]
    (case (count actions-list)
      0 (print-io-str IO (str "failed to parse: no matching action to " cmd))
      1 (let [action (first actions-list)
              result (func action params-list)]
          (if result
            (print-io-str IO result)))
      (let [matching-actions
            (for [action actions-list :when (check-params action params-list)] action)]
        (if (empty? matching-actions)
          (print-io-str IO (pr-str "Cant find " cmd " " params))
          (let [result (func (first matching-actions) params-list)]
            (if result
              (print-io-str IO result)
              (print-io-str IO "False"))))))))

(defn action [cmd params IO]
  (when (not @dbg-IO) (dosync (ref-set dbg-IO IO)))
  (if (= \? (last cmd))
    (run-action (subs cmd 0 (dec (count cmd))) params IO apply-query)
    (run-action cmd params IO apply-relation)))

; Iyye - AI agent
; Copyright (C) 2016-2018  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.words
  (:require
    [clojure.tools.logging :as log]
    [iyye.bios.ioframes :as ioframes]
    [iyye.bios.persistence :as persistence]))
    ;[iyye.subcon.knowledge.relation :as relation]

(def dbg-IO (ref nil))

(def builtin-words (ref {}))

(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob ])
(defrecord Iyye_Name [Name Uname Type Word2vec Tags])
(defrecord Iyye_Type [name Relations toString])
(defrecord Iyye_Verb [name Types Result Function Complexity])
;(defrecord Iyye_Query [verb PredicateFunction])
(defrecord Iyye_Relation [name Types Predicate Function PredicateFunction Data])
(defrecord Iyye_Instance [name type])
(defrecord Iyye_Error [bug toString])

(defn pred-toString [pred] (pr-str ))

(def names-number (ref 0))
(defn inc-names! []
  (dosync (ref-set names-number (inc @names-number)))
  @names-number)

(defn get-types [verb] (if (:Types verb)
                         (:Types verb)
                         (if (:verb verb)
                           ())))

(defn create-iyye-name [name type & builtin]
  (let [uname (str name (inc-names!))
        b (if (nil? builtin) false (first builtin))
        atom (->Iyye_Name name uname type nil {})]
    atom))

(defn create-iyye-type [Name & builtin]
  (let [type-atom (create-iyye-name Name "type" builtin)
        type (->Iyye_Type type-atom (list) pr-str)]
    type))

(defn create-iyye-type-from-db [t]
  "de-serialize t"
  (let [mykey #(keyword (str %1 %2))
        create-types #(clojure.string/split (t (mykey "Relation-Types-List" %1)) #"_")
        create-data #(hash-map (keyword (t (mykey "Relation-Data-List1" %1))) ; Only 2 now
                               (t (mykey "Relation-Data-List2" %1)))
        relations-list
        (loop [rel-vec []
               num 0]
          (if-not (t (mykey "Relation-name" num))
            rel-vec
            (let [rel-uname (t (mykey "Relation-uname" num))]
              (recur (conj rel-vec
                           (->Iyye_Relation
                             (->Iyye_Name (t (mykey "Relation-name" num))
                                          rel-uname
                                          "relation"
                                          nil {})
                             []
                             (->Iyye_ModalPredicate
                               (t (mykey "Relation-AccordingTo" num))
                               (t (mykey "Relation-When" num))
                               (t (mykey "Relation-Time" num))
                               (t (mykey "Relation-Prob" num)))
                             nil
                             ;  (create-types num)
                             ; (:Function (@verb-words (t (mykey "Relation-uname" num))))
                             (:PredicateFunction (@builtin-words (t (mykey "Relation-uname" num))))
                             (create-data num)))
                     (inc num)))))]
    (->Iyye_Type (->Iyye_Name (:Name t) (:Uname t) "type" nil {}) relations-list str)))

(defn create-iyye-verb [Name Types Result Function & builtin]
  (let [action-atom (create-iyye-type Name "verb" builtin)
        relation (->Iyye_Verb action-atom Types Result Function [])]
    relation))

(defn create-iyye-relation [Name Predicate Types Function PredicateFunction & builtin]
  (let [action-atom (create-iyye-name Name "relation" builtin)
        relation (->Iyye_Relation action-atom Types Predicate Function PredicateFunction [])]
    relation))

(def time-start (persistence/local-time-to-string))

(defn get-supertypes [atype]
  "gets types: self, type, immediate parents"               ; FIXME Yumzia:0 get all parents
  (if-not (:UNKNOWN atype)
    (if-not (and (= "type" (:Name (:name atype))) (not= "relation" (:Type (:name atype))))
      (let [rels (:Relations atype)]
       (conj (for [supertype rels :when (:super (:Data supertype))]
                {:Name (:super (:Data supertype)) :Predicate (:Predicate supertype)})
             {:Name (:Type (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}
             {:Name (:Name (:name atype)) :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))
      (list {:Name "type" :Predicate (->Iyye_ModalPredicate :IYE :AXIOM time-start :ALWAYS)}))
    {:UNKNOWN (:UNKNOWN atype)}))

(defn create-iyye-instance [values])

(defn load-iyye-atom-from-db [uname])

(defn load-iyye-atoms-from-db [name & [dbname]]
  )

(defn- print-io-str [IO prstr]
  "helper dbg func"
  (future (Thread/sleep 1000) (ioframes/process-output IO (pr-str prstr))))

(defn load-iyye-relations-from-db [name]
  (load-iyye-atoms-from-db name "relations"))

(defn load-iyye-types-from-db [name]
  (let [types (persistence/read-knowledge-from-db "types" {})]
    ))

(defn save-iyye-type-to-db [type]
  (let [types-list-str (fn [types]
                         (reduce #(str %1 "_" %2) types))
        rel-key (fn [name ind]
                  (keyword (str name ind)))
        get-rel
        (fn [ind rel]
          {(rel-key "Relation-name" ind)        (:Name (:name rel))
           (rel-key "Relation-uname" ind)       (:Uname (:name rel))
           (rel-key "Relation-AccordingTo" ind) (:AccordingTo (:Predicate rel))
           (rel-key "Relation-When" ind)        (:When (:Predicate rel))
           (rel-key "Relation-Time" ind)        (:Time (:Predicate rel))
           (rel-key "Relation-Prob" ind)        (:Prob (:Predicate rel))
           (rel-key "Relation-Types-List" ind)  (types-list-str (:Types rel))
           (rel-key "Relation-Data-List1" ind)  (types-list-str (map name (keys (:Data rel))))
           (rel-key "Relation-Data-List2" ind)  (types-list-str (vals (:Data rel)))
           })]
    (let [write-type (reduce conj {:Uname (:Uname (:name type))
                                   :Name  (:Name (:name type))}
                             (map-indexed get-rel (:Relations type)))
          ]
      ; (when @dbg-IO (print-io-str @dbg-IO (pr-str "add list: " type ":::"
      ;                                          (map-indexed get-rel (:Relations type)))))
      (persistence/write-knowledge-to-db "types" write-type))))

(defn save-iyye-builtin-type-to-db [type]

  )
;(persistence/write-noun-to-db (into {} type))

(defn get-iyye-atoms [name mypred]
  "returns a list of found atoms with supplied name"
  (let [builtin-types
        (for [word (vals @builtin-words) :when (= (mypred word) name)] word)]
    (if (empty? builtin-types) (list {:UNKNOWN name}) builtin-types)))

(defn get-iyye-types [name]
  (get-iyye-atoms name #(:Name (:name %))))

(defn get-iyye-verbs [name]
  (get-iyye-atoms name #(:Name (:name (:name %)))))

(defn get-iyye-words [name]
  (let [types (get-iyye-types name)
        verbs (get-iyye-verbs name)]
    (if (:UNKNOWN (first types))
      (if (:UNKNOWN (first verbs))
        types
        verbs)
      (if (:UNKNOWN (first verbs))
        types
        (apply conj verbs types)))))

(defn set-iyye-type! [type]
  (let [uname (:Uname (:name type))
        builtin (:Builtin (:name type))]
    (do
      (dosync (alter builtin-words #(assoc % uname type)))
      (if-not builtin
        (save-iyye-type-to-db type)
        (save-iyye-builtin-type-to-db type)))))

(defn check-params [action params]
  "true if params matches action, false other ways"
  (let [act-params (:Types action)
        check-params-count
        (fn [p1 p2]
          (if (= "*" (last p2))
            (>= (count p1) (count p2))
            (= (count p1) (count p2))))]
    (when (check-params-count params act-params)
      (let [params-types (map #(get-supertypes %) (flatten params))
            act-params2 (take (count params-types) act-params)
            ;   vec-params (vec (map #(:Name (:name %)) params))
            pairs (map vector act-params2 params-types)
            check-pair (fn [t check]
                         (case t
                             :UNKNOWN (= :UNKNOWN check)
                             "*" true
                             (some true?
                                   (map #(= t %) (map :Name check)))))]
        (every? true? (for [cur pairs] (check-pair (first cur) (flatten (second cur)))))))))    ; FIXME Yumzya context aware compare/tags

; (defn apply-relation [relation params]
; (when (check-params relation params)
;  ((:Function relation) params)) )

(defn run-action [cmd params IO]
  (let [actions-list (get-iyye-verbs cmd)
        params-list (if (map? (first params))               ; map? is a check for non-string but resolved type
                      params (map get-iyye-words params))]
    (case (count actions-list)
      0 (->Iyye_Error (str "failed to parse: no matching action to " cmd) pr-str)
      1 (let [action (first actions-list)]
          (if (check-params action params-list)
            ((:Function action) params-list)
            (->Iyye_Error (pr-str "Params invalid for " cmd " : " params) pr-str)))
      (let [matching-actions
            (for [action actions-list :when (check-params action params-list)] action)]
        (case (count matching-actions)
          0 (->Iyye_Error (pr-str "Cant find " cmd " " params) pr-str)
          1 ((:Function (first matching-actions)) params-list)
          (->Iyye_Error (pr-str "Too many actions " cmd " " params) pr-str))))))

(defn action [cmd params IO]
  "Params are either text or objects from previous evaluations"
  (when (not @dbg-IO) (dosync (ref-set dbg-IO IO)))         ; set debug
  ; (print-io-str @dbg-IO (str "cmd: " cmd "::" (pr-str params)) )
  (run-action cmd params IO))

Update words.clj

Update words.clj


(ns user
  (:require
   [figwheel-sidecar.repl-api :as f]))

;; user is a namespace that the Clojure runtime looks for and
;; loads if its available

;; You can place helper functions in here. This is great for starting
;; and stopping your webserver and other development services

;; The definitions in here will be available if you run "lein repl" or launch a
;; Clojure repl some other way

;; You have to ensure that the libraries you :require are listed in your dependencies

;; Once you start down this path
;; you will probably want to look at
;; tools.namespace https://github.com/clojure/tools.namespace
;; and Component https://github.com/stuartsierra/component

(defn fig-start
  "This starts the figwheel server and watch based auto-compiler."
  []
  ;; this call will only work are long as your :cljsbuild and
  ;; :figwheel configurations are at the top level of your project.clj
  ;; and are not spread across different lein profiles

  ;; otherwise you can pass a configuration into start-figwheel! manually
  (f/start-figwheel!))

(defn fig-stop
  "Stop the figwheel server and watch based auto-compiler."
  []
  (f/stop-figwheel!))

;; if you are in an nREPL environment you will need to make sure you
;; have setup piggieback for this to work
(defn cljs-repl
  "Launch a ClojureScript REPL that is connected to your build and host environment."
  []
  (f/cljs-repl))

(ns user
  (:require
   [figwheel-sidecar.repl-api :as f]))

;; user is a namespace that the Clojure runtime looks for and
;; loads if its available

;; You can place helper functions in here. This is great for starting
;; and stopping your webserver and other development services

;; The definitions in here will be available if you run "lein repl" or launch a
;; Clojure repl some other way

;; You have to ensure that the libraries you :require are listed in your dependencies

;; Once you start down this path
;; you will probably want to look at
;; tools.namespace https://github.com/clojure/tools.namespace
;; and Component https://github.com/stuartsierra/component

(defn fig-start
  "This starts the figwheel server and watch based auto-compiler."
  []
  ;; this call will only work as long as your :cljsbuild and
  ;; :figwheel configurations are at the top level of your project.clj
  ;; and are not spread across different lein profiles

  ;; otherwise you can pass a configuration into start-figwheel! manually
  (f/start-figwheel!))

(defn fig-stop
  "Stop the figwheel server and watch based auto-compiler."
  []
  (f/stop-figwheel!))

;; if you are in an nREPL environment you will need to make sure you
;; have setup piggieback for this to work
(defn cljs-repl
  "Launch a ClojureScript REPL that is connected to your build and host environment."
  []
  (f/cljs-repl))

Fix typo in comment in user.clj

Fix typo in comment in user.clj


(do
  (clojure.core/use '[clojure.core])
  (require '[clojure.string :as str])
  (require '[clojure.pprint :as pp])
  (require '[clojure.math.numeric-tower :as math])
)

(let [ res (->> "%s"
                str/split-lines
                (map (fn [x] (str "  \"" (str/replace x "=" "\": \"") \")))
                (str/join ",\n")) ]
  (str "{\n" res "\n}"))

(do
  ;; Imports and aliases
  (clojure.core/use '[clojure.core])
  (require '[clojure.string :as str])
  (require '[clojure.pprint :as pp])
  (require '[clojure.math.numeric-tower :as math])

  ;; Convenience functions
  (defn codeblock [s & { type :type }] (str "```" type "\n" s "\n```"))
)

Add global codeblock function for convenience


(ns overtone-workspace.grumbles
  (:use [overtone.live]))

;; Inspired by an example in an early chapter of the SuperCollider book

(definst grumble [speed 6 freq-mul 1]
  (let [snd (mix (map #(* (lf-tri (* % freq-mul 100))
                          (max 0 (+ (lf-noise1:kr speed)
                                    (line:kr 1 -1 120 :action FREE))))
                      [1 (/ 2 3) (/ 3 2) 2]))]
    (pan2 snd (sin-osc:kr 1))))

(grumble :freq-mul 0.5)
(grumble :freq-mul 0.75)
(grumble :freq-mul 1)
(grumble :freq-mul 1.5)
(grumble :freq-mul 2)

(ctl grumble :speed 3000)

(volume (/  32  127))

(ns overtone-workspace.grumbles
  (:use [overtone.live]))

;; Inspired by an example in an early chapter of the SuperCollider book

(definst grumble [speed 6 freq-mul 1]
  (let [snd (mix (map #(* (lf-tri (* % freq-mul 100))
                          (max 0 (+ (lf-noise1:kr speed)
                                    (line:kr 1 -1 120 :action FREE))))
                      [1 (/ 2 3) (/ 3 2) 2]))]
    (pan2 snd (sin-osc:kr 1))))

;; (grumble :freq-mul 0.5)
;; (grumble :freq-mul 0.75)
;; (grumble :freq-mul 1)
;; (grumble :freq-mul 1.5)
;; (grumble :freq-mul 2)
;; (ctl grumble :speed 3000)

(volume (/  32  127))

(def metro (metronome 10))

(defn player [beat notes]
  (let [notes (if (empty? notes)
                [4 8 2 1.5]
                notes)]
    (at (metro beat)
        (grumble :freq-mul 0.25))
    (at (metro beat)
        (if (zero? (mod beat 5))
          (grumble :freq-mul 1)))
    (at (metro (+ 0.5 beat))
        (if (zero? (mod beat 6))
          (grumble :freq-mul (choose notes))))
    (apply-by (metro (inc beat)) #'player (inc beat) (next notes) [])
    ))

;;(player (metro) [])
;;(stop)

Add player from overtone.examples.getting-started.basic


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "DSL for processing data"}
  dsbdp.data-processing-dsl
  (:require [dsbdp.byte-array-conversion :refer :all]))

(def ^:dynamic *incremental-indicator-suffix* "#inc")

(defn create-proc-sub-fn
  [data-processing-definition input]
  (into
    '()
    (reverse
      (reduce
        (fn [v data-proc-def-element]
          (cond
            (symbol? data-proc-def-element)
              (let [s data-proc-def-element]
                (cond
                  (or (= s 'nth) (= s 'get))
                    (conj v (ns-resolve 'clojure.core s) 'input)
                  (ns-resolve 'clojure.core s)
                    (conj v (ns-resolve 'clojure.core s))
                  (ns-resolve 'dsbdp.byte-array-conversion s)
                    (conj v (ns-resolve 'dsbdp.byte-array-conversion s) 'input)
                  :default
                    (do
                      (println "Could not resolve symbol:" s)
                      v)))
            (list? data-proc-def-element)
              (conj v (into '() (reverse (create-proc-sub-fn data-proc-def-element input))))
            :default (conj v data-proc-def-element)))
        [] data-processing-definition))))

(defn- create-proc-fn-body-java-map-out
  "Create a data processing function body for emitting data into a Java map."
  [input rules output]
  (reduce
    (fn [v rule]
      (conj v `(.put
                ~(name (first rule))
                ~(create-proc-sub-fn (second rule) input))))
    (if (nil? output)
      '[doto (java.util.HashMap.)]
      '[doto ^java.util.Map output])
    rules))

(defn- create-proc-fn-body-clj-map-out
  "Create a data processing function body for emitting data into a Clojure map."
  [input rules output]
  (reduce
    (fn [v rule]
      (conj v `(assoc
                ~(name (first rule))
                ~(create-proc-sub-fn (second rule) input))))
    (if (nil? output)
      '[-> {}]
      '[-> output])
    rules))

(defn- create-proc-fn-body-csv-str-out
  "Create a data processing function body for emitting data into a CSV string."
  [input rules output]
  (reduce
    (fn [v rule]
      (let [data-proc-sub-fn (create-proc-sub-fn (second rule) input)
            tmp-v (if (some #{:qm} rule)
                    (conj v `(.append "\"") `(.append ~data-proc-sub-fn) `(.append "\""))
                    (conj v `(.append ~data-proc-sub-fn)))]
        (if (not= rule (last rules))
          (conj tmp-v `(.append ","))
          tmp-v)))
    (if (nil? output)
      '[doto (java.lang.StringBuilder.)]
      '[doto ^java.lang.StringBuilder output])
    rules))

(defn- create-proc-fn-body-json-str-out
  "Create a data processing function body for emitting data into a JSON string."
  [input rules output]
  (reduce
    (fn [v rule]
      (let [data-proc-sub-fn (create-proc-sub-fn (second rule) input)
            tmp-k (conj v `(.append "\"") `(.append ~(name (first rule))) `(.append "\":"))
            tmp-v (if (some #{:qm} rule)
                    (conj tmp-k `(.append "\"") `(.append ~data-proc-sub-fn) `(.append "\""))
                    (conj tmp-k `(.append ~data-proc-sub-fn)))]
        (if (not= rule (last rules))
          (conj tmp-v `(.append ","))
          (conj tmp-v `(.append "}")))))
    (if (nil? output)
      '[doto (java.lang.StringBuilder.) (.append "{")]
      '[doto ^java.lang.StringBuilder output (.deleteCharAt (- (.length ^java.lang.StringBuilder output) 1)) (.append ",")])
    rules))

(defn create-proc-fn
  "Create a data processing function based on the given dsl-expression."
  [dsl-expression]
;  (println "Got DSL expression:" dsl-expression)
  (let [input-sym 'input
        output-type (name (:output-type dsl-expression))
        rules (:rules dsl-expression)
        output-sym (if (.endsWith output-type *incremental-indicator-suffix*)
                     'output)
        fn-body-vec (condp (fn [^String v ^String s] (.startsWith s v)) output-type
                      "java-map" (create-proc-fn-body-java-map-out input-sym rules output-sym)
                      "clj-map" (create-proc-fn-body-clj-map-out input-sym rules output-sym)
                      "csv-str" (create-proc-fn-body-csv-str-out input-sym rules output-sym)
                      "json-str" (create-proc-fn-body-json-str-out input-sym rules output-sym)
                      (do
                        (println "Unknown output type:" output-type)
                        (println "Defaulting to :java-map as output type.")
                        (create-proc-fn-body-java-map-out input-sym nil rules)))
;        _ (println "Created data processing function vector from DSL:" fn-body-vec)
        fn-body (reverse (into '() fn-body-vec))
;        _ (println "Created data processing function body:" fn-body)
        data-processing-fn (if (not (nil? output-sym))
                             (eval `(fn [~input-sym ~output-sym] ~fn-body))
                             (eval `(fn [~input-sym] ~fn-body)))]
    data-processing-fn))

(defn create-proc-fns-vec
  [fn-mapping dsl-expression]
  )

;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "DSL for processing data"}
  dsbdp.data-processing-dsl
  (:require [dsbdp.byte-array-conversion :refer :all]))

(def ^:dynamic *incremental-indicator-suffix* "#inc")

(defn create-proc-sub-fn
  [data-processing-definition input]
  (into
    '()
    (reverse
      (reduce
        (fn [v data-proc-def-element]
          (cond
            (symbol? data-proc-def-element)
              (let [s data-proc-def-element]
                (cond
                  (or (= s 'nth) (= s 'get))
                    (conj v (ns-resolve 'clojure.core s) 'input)
                  (ns-resolve 'clojure.core s)
                    (conj v (ns-resolve 'clojure.core s))
                  (ns-resolve 'dsbdp.byte-array-conversion s)
                    (conj v (ns-resolve 'dsbdp.byte-array-conversion s) 'input)
                  :default
                    (do
                      (println "Could not resolve symbol:" s)
                      v)))
            (list? data-proc-def-element)
              (conj v (into '() (reverse (create-proc-sub-fn data-proc-def-element input))))
            :default (conj v data-proc-def-element)))
        [] data-processing-definition))))

(defn- create-proc-fn-body-java-map-out
  "Create a data processing function body for emitting data into a Java map."
  [input rules output]
  (reduce
    (fn [v rule]
      (conj v `(.put
                ~(name (first rule))
                ~(create-proc-sub-fn (second rule) input))))
    (if (nil? output)
      '[doto (java.util.HashMap.)]
      '[doto ^java.util.Map output])
    rules))

(defn- create-proc-fn-body-clj-map-out
  "Create a data processing function body for emitting data into a Clojure map."
  [input rules output]
  (reduce
    (fn [v rule]
      (conj v `(assoc
                ~(name (first rule))
                ~(create-proc-sub-fn (second rule) input))))
    (if (nil? output)
      '[-> {}]
      '[-> output])
    rules))

(defn- create-proc-fn-body-csv-str-out
  "Create a data processing function body for emitting data into a CSV string."
  [input rules output]
  (reduce
    (fn [v rule]
      (let [data-proc-sub-fn (create-proc-sub-fn (second rule) input)
            tmp-v (if (some #{:qm} rule)
                    (conj v `(.append "\"") `(.append ~data-proc-sub-fn) `(.append "\""))
                    (conj v `(.append ~data-proc-sub-fn)))]
        (if (not= rule (last rules))
          (conj tmp-v `(.append ","))
          tmp-v)))
    (if (nil? output)
      '[doto (java.lang.StringBuilder.)]
      '[doto ^java.lang.StringBuilder output])
    rules))

(defn- create-proc-fn-body-json-str-out
  "Create a data processing function body for emitting data into a JSON string."
  [input rules output]
  (reduce
    (fn [v rule]
      (let [data-proc-sub-fn (create-proc-sub-fn (second rule) input)
            tmp-k (conj v `(.append "\"") `(.append ~(name (first rule))) `(.append "\":"))
            tmp-v (if (some #{:qm} rule)
                    (conj tmp-k `(.append "\"") `(.append ~data-proc-sub-fn) `(.append "\""))
                    (conj tmp-k `(.append ~data-proc-sub-fn)))]
        (if (not= rule (last rules))
          (conj tmp-v `(.append ","))
          (conj tmp-v `(.append "}")))))
    (if (nil? output)
      '[doto (java.lang.StringBuilder.) (.append "{")]
      '[doto ^java.lang.StringBuilder output (.deleteCharAt (- (.length ^java.lang.StringBuilder output) 1)) (.append ",")])
    rules))

(defn create-proc-fn
  "Create a data processing function based on the given dsl-expression."
  [dsl-expression]
;  (println "Got DSL expression:" dsl-expression)
  (let [input-sym 'input
        output-type (name (:output-type dsl-expression))
        rules (:rules dsl-expression)
        output-sym (if (.endsWith output-type *incremental-indicator-suffix*)
                     'output)
        fn-body-vec (condp (fn [^String v ^String s] (.startsWith s v)) output-type
                      "java-map" (create-proc-fn-body-java-map-out input-sym rules output-sym)
                      "clj-map" (create-proc-fn-body-clj-map-out input-sym rules output-sym)
                      "csv-str" (create-proc-fn-body-csv-str-out input-sym rules output-sym)
                      "json-str" (create-proc-fn-body-json-str-out input-sym rules output-sym)
                      (do
                        (println "Unknown output type:" output-type)
                        (println "Defaulting to :java-map as output type.")
                        (create-proc-fn-body-java-map-out input-sym nil rules)))
;        _ (println "Created data processing function vector from DSL:" fn-body-vec)
        fn-body (reverse (into '() fn-body-vec))
;        _ (println "Created data processing function body:" fn-body)
        data-processing-fn (if (not (nil? output-sym))
                             (eval `(fn [~input-sym ~output-sym] ~fn-body))
                             (eval `(fn [~input-sym] ~fn-body)))]
    data-processing-fn))

(defn create-partial-proc-fn
  [dsl-expression start-idx end-idx]
  (if (= 0 start-idx)
    (create-proc-fn
      {:output-type (:output-type dsl-expression)
       :rules (subvec (:rules dsl-expression) start-idx end-idx)})))

(defn create-proc-fns-vec
  [fn-mapping dsl-expression]
;  (loop [v [(fn [in _] ((create-partial-proc-fn dsl-expression 0 (first fn-mapping))))]
;         current-idx (first fn-mapping)
;         remaining-mapping (rest fn-mapping)]
;    (if (empty? remaining-mapping)
;      (conj v )
;      (recur
;        (conj v )
;        )))
  )

Add implementation for create-partial-proc-fn with start-idx=0.


(require '[figwheel-sidecar.repl :as r]
         '[figwheel-sidecar.repl-api :as ra])

(ra/start-figwheel!
  {:figwheel-options {:css-dirs ["resources/public/css"]
                      :server-port 3449
                      :server-ip   "0.0.0.0"}
   :build-ids ["main", "view"]
   :all-builds
   [{:id "main"
     :figwheel {:on-jsload "uxbox.main.ui/init"}
     :source-paths ["src" "vendor"]
     :compiler
     {:main 'uxbox.main
      :parallel-build false
      :optimizations :none
      :closure-defines {"uxbox.common.constants.url"
                        "https://test.uxbox.io/api"}
      :warnings {:ns-var-clash false}
      :language-in  :ecmascript6
      :language-out :ecmascript5
      :output-to "resources/public/js/main.js"
      :output-dir "resources/public/js/main"
      :asset-path "js/main"
      :verbose true}}

    {:id "view"
     :figwheel {:on-jsload "uxbox.view.ui/init"}
     :source-paths ["src" "vendor"]
     :compiler
     {:main 'uxbox.view
      :parallel-build false
      :optimizations :none
      :closure-defines {"uxbox.common.constants.url"
                        "https://test.uxbox.io/api"}
      :warnings {:ns-var-clash false}
      :language-in  :ecmascript6
      :language-out :ecmascript5
      :output-to "resources/public/view/js/view.js"
      :output-dir "resources/public/view/js/view"
      :asset-path "js/view"
      :verbose true}}
    ]})

(ra/cljs-repl "main")

(require '[figwheel-sidecar.repl :as r]
         '[figwheel-sidecar.repl-api :as ra])

(ra/start-figwheel!
  {:figwheel-options {:css-dirs ["resources/public/css"
                                 "resources/public/view/css"]
                      :server-port 3449
                      :server-ip   "0.0.0.0"}
   :build-ids ["main", "view"]
   :all-builds
   [{:id "main"
     :figwheel {:on-jsload "uxbox.main.ui/init"}
     :source-paths ["src" "vendor"]
     :compiler
     {:main 'uxbox.main
      :parallel-build false
      :optimizations :none
      :closure-defines {"uxbox.common.constants.url"
                        "https://test.uxbox.io/api"}
      :warnings {:ns-var-clash false}
      :language-in  :ecmascript6
      :language-out :ecmascript5
      :output-to "resources/public/js/main.js"
      :output-dir "resources/public/js/main"
      :asset-path "js/main"
      :verbose true}}

    {:id "view"
     :figwheel {:on-jsload "uxbox.view.ui/init"}
     :source-paths ["src" "vendor"]
     :compiler
     {:main 'uxbox.view
      :parallel-build false
      :optimizations :none
      :closure-defines {"uxbox.common.constants.url"
                        "https://test.uxbox.io/api"}
      :warnings {:ns-var-clash false}
      :language-in  :ecmascript6
      :language-out :ecmascript5
      :output-to "resources/public/view/js/view.js"
      :output-dir "resources/public/view/js/view"
      :asset-path "js/view"
      :verbose true}}
    ]})

(ra/cljs-repl "main")

Add missing entry to css-dirs of figwheel config.


{:user {:signing {:gpg-key "8ED1CE42"}

        :dependencies [[alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pprint
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

{:user {:signing {:gpg-key "8ED1CE42"}

        :dependencies [[alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy alembic.still/load-project
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pprint
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

Add shorthand for alembic.still/load-project


(ns braid.search.ui.search-page-styles
  (:require
    [garden.units :refer [rem em px]]
    [braid.core.client.ui.styles.mixins :as mixins]
    [braid.core.client.ui.styles.vars :as vars]))

(def avatar-size (rem 4))

(def card-style
  [:>.card
   {:margin-bottom "50%"
    :max-width (rem 25)}

   [:>.header
    {:overflow "auto"}

    [:>.pill.off
     :>.pill.on
     {:color [["white" "!important"]]}]

    [:>.status
     {:display "inline-block"
      :margin-left (em 0.5)}
     (mixins/mini-text)]

    [:>.badges
     {:display "inline-block"
      :margin [[0 (em 0.5)]]}

     [:>.admin::before
      {:display "inline-block"
       :-webkit-font-smoothing "antialiased"}
      (mixins/fontawesome \uf0e3)]]

    [:>img.avatar
     {:margin-top (px 2)
      :border-radius (px 3)
      :width avatar-size
      :height avatar-size
      :background "white"
      :float "left"}]]

   [:>.local-time

    [:&::after
     (mixins/fontawesome \uf017)
     {:margin-left (em 0.25)}]]])

(def >search-page
  [:>.page.search

   [:>.threads
    card-style]

   [:>.content
    card-style]])

(ns braid.search.ui.search-page-styles)

(def >search-page
  [:>.page.search])

Remove unnecessary search page styles

Remove unnecessary search page styles


(ns love-letter-cljs.handlers
    (:require [re-frame.core :refer [dispatch register-handler]]
              [love-letter-cljs.db :as db]
              [love-letter-cljs.game :as l]))

(defn remove-first [face coll]
  (let [[pre post] (split-with #(not= face (:face %)) coll)]
    (vec (concat pre (rest post)))))

(register-handler
 :initialize-db
 (fn  [_ _]
   db/default-db))

(defn reset-state [db]
  (assoc-in db [:state]
            {:display-card nil
             :phase :draw
             :active-card nil
             :guard-guess nil
             :card-target nil
             :log []}))

(register-handler
 :new-game
 (fn [db _]
   (-> db
       (reset-state)
       (assoc-in [:game] (l/create-and-deal)))))

(register-handler
 :reset-state
 (fn [db _]
    (reset-state db)))

(register-handler
 :set-display-card
 (fn [db [_ face]]
   (assoc-in db [:state :display-card] face)))

(defn handle-countess [db player-id]
  (let [path  [:game :players player-id :hand]
        hand  (get-in db path)
        hand' (remove-first :countess hand)]
    (assoc-in db path hand')))

(defn set-phase [db phase]
  (assoc-in db [:state :phase] phase))

(register-handler
 :set-phase
 (fn [db [_ phase]]
   (set-phase db phase)))

(register-handler
 :set-active-card
 (fn [db [_ face]]
   (as-> db d
     (assoc-in d [:state :active-card] face)
     (condp = face
       :princess (set-phase d :resolution)
       :handmaid (set-phase d :resolution)
       (set-phase d :target)))))

(register-handler
 :set-target
 (fn [db [_ target-id]]
   (let [active-card (:active-card (:state db))]
     (as-> db d
       (assoc-in d [:state :card-target] target-id)
       (condp = active-card
         :guard (set-phase d :guard)
         (set-phase d :resolution))))))

(register-handler
 :set-guard-guess
 (fn [db [_ face]]
   (-> db
       (assoc-in [:state :guard-guess] face)
       (set-phase :resolution))))

;; For cycling turns
(defn next-in-list [current item-list]
  (as-> item-list i
    (drop-while #(not= current %) i)
    (or (first (next i)) (first item-list))))

(defn player-list [game]
  (->> game
       :players
       vals
       (filter :alive?)
       (mapv :id)))

(defn handle-next-player [db]
  (let [current-player (:current-player (:game db))
        players        (player-list (:game db))
        next-player    (next-in-list current-player players)]
    (-> db
        (assoc-in [:game :current-player] next-player)
        (assoc-in [:game :players next-player :protected?] false)
        (set-phase :draw))))

(register-handler
 :next-player
 re-frame.core/debug
 (fn [db _]
   (handle-next-player db)))

(register-handler
 :draw-card
 (fn [db [_ player-id]]
   (as-> db d
     (assoc-in d [:game] (l/draw-card (:game db) player-id))
     (if (l/countess-check d player-id)
       (-> d
           (handle-countess player-id)
           (handle-next-player))
       d))))

(defn play-card [db face current-player]
  (let [path [:game :players current-player :hand]]
    (assoc-in db path (remove-first face (get-in db path)))))

(defn update-game [db game]
  (assoc db :game game))

(defn resolve-effect [db]
  (let [{:keys [card-target active-card guard-guess]} (:state db)
        game (:game db)
        current-player (:current-player game)]
    (condp = active-card
      :prince   (update-game db (l/prince-ability game card-target))
      :guard    (update-game db (l/guard-ability  game guard-guess card-target))
      :baron    (update-game db (l/baron-ability  game current-player card-target))
      :king     (update-game db (l/king-ability   game current-player card-target))
      :handmaid (update-game db (l/handmaid-ability game current-player))
      :countess db
      :priest   db
      :princess (update-game db (l/kill-player game current-player))
      db)))

(register-handler
 :resolve-effect
 re-frame.core/debug
 (fn [db _]
   (let [active-card    (get-in db [:state :active-card])
         current-player (get-in db [:game  :current-player])]
     (-> db
         (play-card active-card current-player)
         (resolve-effect)
         (handle-next-player)))))

(ns love-letter-cljs.handlers
    (:require [re-frame.core :refer [dispatch register-handler]]
              [love-letter-cljs.db :as db]
              [love-letter-cljs.game :as l]))

(defn remove-first [face coll]
  (let [[pre post] (split-with #(not= face (:face %)) coll)]
    (vec (concat pre (rest post)))))

(register-handler
 :initialize-db
 (fn  [_ _]
   db/default-db))

(defn reset-state [db]
  (assoc-in db [:state]
            {:display-card nil
             :phase :draw
             :active-card nil
             :guard-guess nil
             :card-target nil
             :log []}))

(register-handler
 :new-game
 (fn [db _]
   (-> db
       (reset-state)
       (assoc-in [:game] (l/create-and-deal)))))

(register-handler
 :reset-state
 (fn [db _]
    (reset-state db)))

(register-handler
 :set-display-card
 (fn [db [_ face]]
   (assoc-in db [:state :display-card] face)))

(defn handle-countess [db player-id]
  (let [path  [:game :players player-id :hand]
        hand  (get-in db path)
        hand' (remove-first :countess hand)]
    (assoc-in db path hand')))

(defn set-phase [db phase]
  (assoc-in db [:state :phase] phase))

(register-handler
 :set-phase
 (fn [db [_ phase]]
   (set-phase db phase)))

(register-handler
 :set-active-card
 (fn [db [_ face]]
   (as-> db d
     (assoc-in d [:state :active-card] face)
     (condp = face
       :princess (set-phase d :resolution)
       :handmaid (set-phase d :resolution)
       :countess (set-phase d :resolution)
       (set-phase d :target)))))

(register-handler
 :set-target
 (fn [db [_ target-id]]
   (let [active-card (:active-card (:state db))]
     (as-> db d
       (assoc-in d [:state :card-target] target-id)
       (condp = active-card
         :guard (set-phase d :guard)
         (set-phase d :resolution))))))

(register-handler
 :set-guard-guess
 (fn [db [_ face]]
   (-> db
       (assoc-in [:state :guard-guess] face)
       (set-phase :resolution))))

;; For cycling turns
(defn next-in-list [current item-list]
  (as-> item-list i
    (drop-while #(not= current %) i)
    (or (first (next i)) (first item-list))))

(defn player-list [game]
  (->> game
       :players
       vals
       (filter :alive?)
       (mapv :id)))

(defn handle-next-player [db]
  (let [current-player (:current-player (:game db))
        players        (player-list (:game db))
        next-player    (next-in-list current-player players)]
    (-> db
        (assoc-in [:game :current-player] next-player)
        (assoc-in [:game :players next-player :protected?] false)
        (set-phase :draw))))

(register-handler
 :next-player
 re-frame.core/debug
 (fn [db _]
   (handle-next-player db)))

(register-handler
 :draw-card
 (fn [db [_ player-id]]
   (as-> db d
     (assoc-in d [:game] (l/draw-card (:game db) player-id))
     (if (l/countess-check d player-id)
       (-> d
           (handle-countess player-id)
           (handle-next-player))
       d))))

(defn play-card [db face current-player]
  (let [path [:game :players current-player :hand]]
    (assoc-in db path (remove-first face (get-in db path)))))

(defn update-game [db game]
  (assoc db :game game))

(defn resolve-effect [db]
  (let [{:keys [card-target active-card guard-guess]} (:state db)
        game (:game db)
        current-player (:current-player game)]
    (condp = active-card
      :prince   (update-game db (l/prince-ability game card-target))
      :guard    (update-game db (l/guard-ability  game guard-guess card-target))
      :baron    (update-game db (l/baron-ability  game current-player card-target))
      :king     (update-game db (l/king-ability   game current-player card-target))
      :handmaid (update-game db (l/handmaid-ability game current-player))
      :countess db
      :priest   db
      :princess (update-game db (l/kill-player game current-player))
      db)))

(register-handler
 :resolve-effect
 re-frame.core/debug
 (fn [db _]
   (let [active-card    (get-in db [:state :active-card])
         current-player (get-in db [:game  :current-player])]
     (-> db
         (play-card active-card current-player)
         (resolve-effect)
         (handle-next-player)))))

Add transition when playing countess

Add transition when playing countess


(ns com.wsscode.pathom.specs.query
  (:require [clojure.spec.alpha :as s]
            [clojure.test.check]
            [clojure.test.check.generators :as gen #?@(:cljs [:include-macros true])]
            [clojure.test.check.properties]))

(def ^:dynamic *query-gen-max-depth* 4)

(s/def ::property (s/with-gen keyword? #(s/gen #{:user/id :user/name :product/title :name :other})))
(s/def ::special-property #{'*})
(s/def ::ident-value (s/with-gen any? #(s/gen #{123 "123" [:a "b"]})))
(s/def ::ident (s/with-gen
                 (s/and vector? (s/cat :ident ::property :value ::ident-value))
                 #(gen/let [s (s/gen (s/cat :ident ::property :value ::ident-value))]
                    (vec s))))
(s/def ::join-key (s/or :prop ::property :ident ::ident :param-exp ::join-key-param-expr))
(s/def ::join (s/map-of ::join-key ::join-query :count 1 :conform-keys true))
(s/def ::union (s/map-of ::property ::query :min-count 1 :conform-keys true))
(s/def ::recursion (s/or :depth (s/with-gen nat-int? #(s/gen (s/int-in 1 5)))
                         :unbounded #{'...}))

(s/def ::join-query
  (s/with-gen
    (s/or :query ::query
          :union ::union
          :recursion ::recursion)
    #(gen/frequency [[10 (s/gen ::query)]
                     [2 (s/gen ::union)]
                     [1 (s/gen ::recursion)]])))

(s/def ::params
  (s/with-gen map?
    (fn [] (gen/map (s/gen #{:param/random :param/foo :param/bar}) gen/string-alphanumeric))))

(s/def ::param-expr-key
  (s/with-gen
    (s/or :prop ::property
          :join ::join
          :ident ::ident)
    #(gen/frequency [[20 (s/gen ::property)]
                     [8 (s/gen ::join)]
                     [4 (s/gen ::ident)]])))

(s/def ::param-expr
  (s/with-gen
    (s/and list? (s/cat :expr ::param-expr-key :params ::params))
    #(gen/let [q (s/gen ::param-expr-key)
               p (s/gen ::params)]
       (list q p))))

(s/def ::join-key-param-expr
  (s/with-gen
    (s/and list? (s/cat :expr ::join-key :params ::params))
    #(gen/let [q (s/gen ::join-key)
               p (s/gen ::params)]
       (list q p))))

(s/def ::query-expr
  (s/or :prop ::property
        :join ::join
        :ident ::ident
        :param-exp ::param-expr
        :special ::special-property))

(s/def ::query
  (s/coll-of ::query-expr :kind vector?
    :gen #(let [g (s/gen (s/coll-of ::query-expr :kind vector? :max-count 5))]
            (gen/->Generator
              (fn [rdn size]
                (if (> *query-gen-max-depth* 0)
                  (binding [*query-gen-max-depth* (dec *query-gen-max-depth*)]
                    (gen/call-gen g rdn size))
                  (gen/call-gen (gen/return []) rdn size)))))))

; those symbol set examples have to writen outside of the with-gen, otherwise CLJS doesn't compiles
(def sample-mutations '#{do-something create/this-thing operation.on/space})

(s/def ::mutation-key (s/with-gen symbol? #(s/gen sample-mutations)))

(s/def ::mutation-expr
  (s/with-gen
    (s/and list? (s/cat :mutate-key ::mutation-key :params (s/? ::params)))
    #(gen/let [key (s/gen ::mutation-key)
               val (s/gen ::params)]
       (list key val))))

(s/def ::mutation-join
  (s/map-of ::mutation-expr ::query :count 1 :conform-keys true))

(s/def ::mutation
  (s/or :mutation ::mutation-expr
        :mutation-join ::mutation-join))

(s/def ::mutation-tx
  (s/with-gen
    (s/and vector? (s/cat :mutations (s/+ ::mutation) :reads (s/* ::property)))
    #(gen/fmap vec (s/gen (s/cat :mutations (s/+ ::mutation) :reads (s/* ::property))))))

(s/def ::transaction
  (s/with-gen
    (s/or :query ::query
          :mutation ::mutation-tx)
    #(gen/frequency [[5 (s/gen ::query)] [1 (s/gen ::mutation-tx)]])))

(comment
  (gen/sample (s/gen ::join-key) 30)
  (s/conform ::transaction [:a {'(:b {:foo "bar"}) [:c]}])
  (s/conform ::transaction [:a '(:b {:foo "bar"})]))

(ns com.wsscode.pathom.specs.query
  (:require [clojure.spec.alpha :as s]
            [clojure.test.check]
            [clojure.test.check.generators :as gen #?@(:cljs [:include-macros true])]
            [clojure.test.check.properties]))

(def ^:dynamic *query-gen-max-depth* 4)

(s/def ::property (s/with-gen keyword? #(s/gen #{:user/id :user/name :product/title :name :other})))
(s/def ::special-property #{'*})
(s/def ::ident-value (s/with-gen any? #(gen/frequency [[10 (gen/return 123)]
                                                       [10 (gen/return "123")]
                                                       [2 (gen/return [:a "b"])]
                                                       [1 (gen/return '_)]])))
(s/def ::ident (s/with-gen
                 (s/and vector? (s/cat :ident ::property :value ::ident-value))
                 #(gen/let [s (s/gen (s/cat :ident ::property :value ::ident-value))]
                    (vec s))))
(s/def ::join-key (s/or :prop ::property :ident ::ident :param-exp ::join-key-param-expr))
(s/def ::join (s/map-of ::join-key ::join-query :count 1 :conform-keys true))
(s/def ::union (s/map-of ::property ::query :min-count 1 :conform-keys true))
(s/def ::recursion (s/or :depth (s/with-gen nat-int? #(s/gen (s/int-in 1 5)))
                         :unbounded #{'...}))

(s/def ::join-query
  (s/with-gen
    (s/or :query ::query
          :union ::union
          :recursion ::recursion)
    #(gen/frequency [[10 (s/gen ::query)]
                     [2 (s/gen ::union)]
                     [1 (s/gen ::recursion)]])))

(s/def ::params
  (s/with-gen map?
    (fn [] (gen/map (s/gen #{:param/random :param/foo :param/bar}) gen/string-alphanumeric))))

(s/def ::param-expr-key
  (s/with-gen
    (s/or :prop ::property
          :join ::join
          :ident ::ident)
    #(gen/frequency [[20 (s/gen ::property)]
                     [8 (s/gen ::join)]
                     [4 (s/gen ::ident)]])))

(s/def ::param-expr
  (s/with-gen
    (s/and list? (s/cat :expr ::param-expr-key :params ::params))
    #(gen/let [q (s/gen ::param-expr-key)
               p (s/gen ::params)]
       (list q p))))

(s/def ::join-key-param-expr
  (s/with-gen
    (s/and list? (s/cat :expr ::join-key :params ::params))
    #(gen/let [q (s/gen ::join-key)
               p (s/gen ::params)]
       (list q p))))

(s/def ::query-expr
  (s/or :prop ::property
        :join ::join
        :ident ::ident
        :param-exp ::param-expr
        :special ::special-property))

(s/def ::query
  (s/coll-of ::query-expr :kind vector?
    :gen #(let [g (s/gen (s/coll-of ::query-expr :kind vector? :max-count 5))]
            (gen/->Generator
              (fn [rdn size]
                (if (> *query-gen-max-depth* 0)
                  (binding [*query-gen-max-depth* (dec *query-gen-max-depth*)]
                    (gen/call-gen g rdn size))
                  (gen/call-gen (gen/return []) rdn size)))))))

; those symbol set examples have to writen outside of the with-gen, otherwise CLJS doesn't compiles
(def sample-mutations '#{do-something create/this-thing operation.on/space})

(s/def ::mutation-key (s/with-gen symbol? #(s/gen sample-mutations)))

(s/def ::mutation-expr
  (s/with-gen
    (s/and list? (s/cat :mutate-key ::mutation-key :params (s/? ::params)))
    #(gen/let [key (s/gen ::mutation-key)
               val (s/gen ::params)]
       (list key val))))

(s/def ::mutation-join
  (s/map-of ::mutation-expr ::query :count 1 :conform-keys true))

(s/def ::mutation
  (s/or :mutation ::mutation-expr
        :mutation-join ::mutation-join))

(s/def ::mutation-tx
  (s/with-gen
    (s/and vector? (s/cat :mutations (s/+ ::mutation) :reads (s/* ::property)))
    #(gen/fmap vec (s/gen (s/cat :mutations (s/+ ::mutation) :reads (s/* ::property))))))

(s/def ::transaction
  (s/with-gen
    (s/or :query ::query
          :mutation ::mutation-tx)
    #(gen/frequency [[5 (s/gen ::query)] [1 (s/gen ::mutation-tx)]])))

Improve ident-value generator

Improve ident-value generator


(ns clj-simple-chart.ncs.discovery-year
  (:require [clojure.test :as test]
            [clj-http.client :as client]
            [clojure.string :as string]
            [clj-simple-chart.csv.csvmap :as csvmap]))

(def url "http://factpages.npd.no/ReportServer?/FactPages/TableView/discovery&rs:Command=Render&rc:Toolbar=false&rc:Parameters=f&rs:Format=CSV&Top100=false&IpAddress=81.191.126.253&CultureCode=en")
; factpages => discovery => table view => overview

(defonce raw-data (-> url
                      (client/get)
                      (:body)
                      (csvmap/csv-map)))

(def data (:data raw-data))

(test/is (= [:dscName
             :cmpLongName
             :dscCurrentActivityStatus
             :dscHcType
             :wlbName
             :nmaName
             :fldName
             :dscDateFromInclInField
             :dscDiscoveryYear
             :dscResInclInDiscoveryName
             :dscOwnerKind
             :dscOwnerName
             :dscNpdidDiscovery
             :fldNpdidField
             :wlbNpdidWellbore
             :dscFactPageUrl
             :dscFactMapUrl
             :dscDateUpdated
             :dscDateUpdatedMax
             :DatesyncNPD]
            (:columns raw-data)))

(def numeric-columns [:dscDiscoveryYear])

(def field-names (->> (map :fldName data)
                      (distinct)
                      (remove empty?)
                      (sort)
                      (vec)))

(defn de-duplicate [coll]
  {:pre [(coll? coll)]}
  (->> coll
       (sort-by :dscDiscoveryYear)
       (first)))

(def data-parsed (->> data
                      (csvmap/read-string-columns numeric-columns)
                      (csvmap/number-or-throw-columns numeric-columns)
                      (group-by :fldName)
                      (vals)
                      (mapv de-duplicate)
                      (flatten)))

(defn discovery-year [fldName]
  {:pre [(some #{fldName} field-names)]}
  (->> data-parsed
       (filter #(= (:fldName %) fldName))
       (first)
       (:dscDiscoveryYear)))

(test/is (= 1969 (discovery-year "EKOFISK")))
(test/is (= 1978 (discovery-year "GULLFAKS")))
(test/is (= 1979 (discovery-year "TROLL")))
(test/is (= 1979 (discovery-year "SNORRE")))
(test/is (= 1981 (discovery-year "VESLEFRIKK")))
(test/is (= 1984 (discovery-year "SNØHVIT")))
(test/is (= 1988 (discovery-year "EMBLA")))

(test/is (= 2000 (discovery-year "GOLIAT")))
(test/is (= 2010 (discovery-year "JOHAN SVERDRUP")))

(ns clj-simple-chart.ncs.discovery-year
  (:require [clojure.test :as test]
            [clj-http.client :as client]
            [clojure.string :as string]
            [clj-simple-chart.csv.csvmap :as csvmap]))

(def url "http://factpages.npd.no/ReportServer?/FactPages/TableView/discovery&rs:Command=Render&rc:Toolbar=false&rc:Parameters=f&rs:Format=CSV&Top100=false&IpAddress=81.191.126.253&CultureCode=en")
; factpages => discovery => table view => overview

(defonce raw-data (-> url
                      (client/get)
                      (:body)
                      (csvmap/csv-map)))

(def data (:data raw-data))

(test/is (= [:dscName
             :cmpLongName
             :dscCurrentActivityStatus
             :dscHcType
             :wlbName
             :nmaName
             :fldName
             :dscDateFromInclInField
             :dscDiscoveryYear
             :dscResInclInDiscoveryName
             :dscOwnerKind
             :dscOwnerName
             :dscNpdidDiscovery
             :fldNpdidField
             :wlbNpdidWellbore
             :dscFactPageUrl
             :dscFactMapUrl
             :dscDateUpdated
             :dscDateUpdatedMax
             :DatesyncNPD]
            (:columns raw-data)))

(def numeric-columns [:dscDiscoveryYear])

(def field-names (->> (map :fldName data)
                      (distinct)
                      (remove empty?)
                      (sort)
                      (vec)))

(defn de-duplicate [coll]
  {:pre [(coll? coll)]}
  (->> coll
       (sort-by :dscDiscoveryYear)
       (first)))

(def data-parsed (->> data
                      (csvmap/read-string-columns numeric-columns)
                      (csvmap/number-or-throw-columns numeric-columns)
                      (remove #(= "Included in other discovery" (:dscCurrentActivityStatus %)))
                      (group-by :fldName)
                      (vals)
                      (mapv de-duplicate)
                      (flatten)))

(defn discovery-year [fldName]
  {:pre [(some #{fldName} field-names)]}
  (->> data-parsed
       (filter #(= (:fldName %) fldName))
       (first)
       (:dscDiscoveryYear)))

; TODO: Consider adding more tests.
(test/is (= 1969 (discovery-year "EKOFISK")))
(test/is (= 1978 (discovery-year "GULLFAKS")))
(test/is (= 1979 (discovery-year "TROLL")))
(test/is (= 1979 (discovery-year "SNORRE")))
(test/is (= 1981 (discovery-year "VESLEFRIKK")))
(test/is (= 1984 (discovery-year "SNØHVIT")))
(test/is (= 1988 (discovery-year "EMBLA")))

(test/is (= 2000 (discovery-year "GOLIAT")))
(test/is (= 2010 (discovery-year "JOHAN SVERDRUP")))

Correct mismatch for Snøhvit

Correct mismatch for Snøhvit


(ns buddy.crypto.hashers.bcrypt
  (:require [buddy.crypto.hashers.protocols :refer [IHasher]]
            [buddy.crypto.hashers.sha256 :refer [make-sha256]]
            [buddy.crypto.core :refer :all]
            [clojure.string :refer [split]])
  (:import (buddy.impl BCrypt)
           (javax.crypto.spec PBEKeySpec)
           (javax.crypto SecretKeyFactory)))

(defn make-bcrypt
  [password log-rouds]
  (let [salt    (BCrypt/gensalt log-rouds)
        passwd  (-> (make-sha256 password)
                    (BCrypt/hashpw salt))]
    (bytes->hex (str->bytes passwd))))

(defn make-password
  "Encrypts a raw string password using
  pbkdf2_sha1 algorithm and return formatted
  string."
  [pw]
  (format "bcrypt+sha256$%s" (make-bcrypt pw 11)))

(defn check-password
  "Check if a unencrypted password matches
  with another encrypted password."
  [attempt encrypted]
  (let [[t p] (split encrypted #"\$")]
    (if (not= t "bcrypt+sha256")
      (throw (IllegalArgumentException. "invalid type of hasher"))
      (BCrypt/hashpw attempt (bytes->str (hex->bytes p))))))

(defrecord Bcrypt []
  IHasher
  (verify [_ attempt encrypted]
    (check-password attempt encrypted))
  (make-hash [_ password salt]
    (make-password password))
  (make-hash [_ password]
    (make-password password)))

(ns buddy.crypto.hashers.bcrypt
  (:require [buddy.crypto.hashers.protocols :refer [IHasher]]
            [buddy.crypto.hashers.sha256 :refer [make-sha256]]
            [buddy.crypto.core :refer :all]
            [clojure.string :refer [split]])
  (:import (buddy.impl BCrypt)))

(defn make-bcrypt
  [password log-rouds]
  (let [salt    (BCrypt/gensalt log-rouds)
        passwd  (-> (make-sha256 password)
                    (BCrypt/hashpw salt))]
    (bytes->hex (str->bytes passwd))))

(defn make-password
  "Encrypts a raw string password using
  pbkdf2_sha1 algorithm and return formatted
  string."
  [pw]
  (format "bcrypt+sha256$%s" (make-bcrypt pw 11)))

(defn check-password
  "Check if a unencrypted password matches
  with another encrypted password."
  [attempt encrypted]
  (let [[t p] (split encrypted #"\$")]
    (if (not= t "bcrypt+sha256")
      (throw (IllegalArgumentException. "invalid type of hasher"))
      (BCrypt/hashpw attempt (bytes->str (hex->bytes p))))))

(defrecord Bcrypt []
  IHasher
  (verify [_ attempt encrypted]
    (check-password attempt encrypted))
  (make-hash [_ password salt]
    (make-password password))
  (make-hash [_ password]
    (make-password password)))

Remove not used imports from bcrypt hasher namespace.


(ns examples.extemp-piano
  (:use [overtone.live]
        [overtone.inst synth sampled-piano]))

;; This example has been translated from the Extempore code demonstrated in
;; http://vimeo.com/21956071 (found around the 10 minute mark)

;; Original Extempore code:
;; (load-sampler sampler "/home/andrew/Documents/samples/piano")
;; (define scale (pc:scale 0 'aeolian))
;; (define loop
;;   (lambda (beat dur root)
;;      (for-each (lambda (p offset)
;;                   (play (+ offset) sampler p 100 (* 2.0 dur)))
;;                (pc:make-chord 40 (cosr 75 10 1/32) 5
;;                               (pc:chord root (if (member root '(10 8))
;;                                                '^7
;;                                                '-7)))
;;                '(1/3 1 3/2 1 2 3))
;;      (callback (*metro* (+ beat (* 0.5 dur))) 'loop (+ dur beat)
;;                dur
;;                (if (member root '(0 8))
;;                  (random '(2 7 10))
;;                  (random '(0 8))))))

(def chord-prog
  [#{[2 :minor7] [7 :minor7] [10 :major7]}
   #{[0 :minor7] [8 :major7]}])

(def beat-offsets [0 0.1 0.2 1/3  0.7 0.9])

(def metro (metronome 20))
;;(metro :bpm 30)

(def root 40)
(def max-range 35)
(def range-variation 10)
(def range-period 8)

;;this assumes you have the mda-piano or the piano samples available. Feel free
;;to eplace piano with a different synth which accepts a MIDI note as its first
;;arg such as tb303.
;; (def instrument tb303)

(defn beat-loop
  [metro beat chord-idx]
  (let [[tonic chord-name] (choose (seq (nth chord-prog chord-idx)))
        nxt-chord-idx      (mod (inc chord-idx) (count chord-prog))]
    (dorun
     (map (fn [note offset]
            (at (metro (+ beat offset)) (sampled-piano note 0.3)))
          (rand-chord (+ root tonic) chord-name (count beat-offsets) (cosr beat range-variation  max-range range-period))
          beat-offsets))
    (apply-at (metro (inc beat)) #'beat-loop [metro (inc beat) nxt-chord-idx])))

;;start the music:
(beat-loop metro (metro) 0)

;;try changing the beat-offsets on the fly
;;(def beat-offsets [0 0.2 1/3  0.5 0.8])
;;(def beat-offsets [0 0.2 0.4  0.6 0.8])
;;(def beat-offsets [0 0.1 0.11 0.13 0.15 0.17 0.2 0.4 0.5 0.55 0.6 0.8])

;;to stop call (stop)
;;(stop)

(ns examples.extemp-piano
  (:use [overtone.live]
        [overtone.inst synth sampled-piano]))

;; This example has been translated from the Extempore code demonstrated in
;; http://vimeo.com/21956071 (found around the 10 minute mark)

;; Original Extempore code:
;; (load-sampler sampler "/home/andrew/Documents/samples/piano")
;; (define scale (pc:scale 0 'aeolian))
;; (define loop
;;   (lambda (beat dur root)
;;      (for-each (lambda (p offset)
;;                   (play (+ offset) sampler p 100 (* 2.0 dur)))
;;                (pc:make-chord 40 (cosr 75 10 1/32) 5
;;                               (pc:chord root (if (member root '(10 8))
;;                                                '^7
;;                                                '-7)))
;;                '(1/3 1 3/2 1 2 3))
;;      (callback (*metro* (+ beat (* 0.5 dur))) 'loop (+ dur beat)
;;                dur
;;                (if (member root '(0 8))
;;                  (random '(2 7 10))
;;                  (random '(0 8))))))

(def chord-prog
  [#{[2 :minor7] [7 :minor7] [10 :major7]}
   #{[0 :minor7] [8 :major7]}])

(def beat-offsets [0 0.1 0.2 1/3  0.7 0.9])

(def metro (metronome 20))

(def root 40)
(def max-range 35)
(def range-variation 10)
(def range-period 8)

(defn beat-loop
  [metro beat chord-idx]
  (let [[tonic chord-name] (choose (seq (nth chord-prog chord-idx)))
        nxt-chord-idx      (mod (inc chord-idx) (count chord-prog))
        note-range         (cosr beat range-variation  max-range range-period)
        notes-to-play      (rand-chord (+ root tonic)
                                       chord-name
                                       (count beat-offsets)
                                       note-range)]
    (dorun
     (map (fn [note offset]
            (at (metro (+ beat offset)) (sampled-piano note 0.3)))
          notes-to-play
          beat-offsets))
    (apply-at (metro (inc beat)) #'beat-loop [metro (inc beat) nxt-chord-idx])))

;;start the music:
(beat-loop metro (metro) 0)

;;try changing the beat-offsets on the fly
;;(def beat-offsets [0 0.2 1/3  0.5 0.8])
;;(def beat-offsets [0 0.2 0.4  0.6 0.8])
;;(def beat-offsets [0 0.1 0.11 0.13 0.15 0.17 0.2 0.4 0.5 0.55 0.6 0.8])

;;to stop call (stop)
;;(stop)

clean up extemp piano example

clean up extemp piano example


(ns refactor-nrepl.ns.helpers
  (:require [clojure.string :as str]
            [clojure.tools.namespace.parse :refer [read-ns-decl]])
  (:import [java.io FileReader PushbackReader StringReader]))

(defn- libspec?
  [thing]
  (or (vector? thing)
      (symbol? thing)))

(defn prefix-form?
  "True if the vector is of the form [prefix libspec1 libspec2...]"
  [v]
  (and (vector? v)
       (symbol? (first v))
       (not-any? keyword? v)
       (> (count v) 1)
       (every? libspec? (rest v))))

(defn index-of-component [ns-form type]
  (first (keep-indexed #(when (and (sequential? %2) (= (first %2) type)) %1)
                       ns-form)))

(defn get-ns-component
  "Extracts a sub-component from the ns declaration.

type is either :require, :use or :import"
  [ns type]
  (some->> (index-of-component ns type) (nth ns)))

(defn prefix
  "java.util.Date -> java.util"
  [fully-qualified-name]
  (let [parts (-> fully-qualified-name str (.split "\\.") butlast)]
    (when (seq parts)
      (str/join "." parts))))

(defn suffix
  "java.util.Date -> Date
  clojure.core/str -> str"
  [fully-qualified-name]
  (if (re-find #"/" (str fully-qualified-name))
    (-> fully-qualified-name str (.split "/") last)
    (-> fully-qualified-name str (.split "\\.") last)))

(defn read-ns-form
  [path]
  (if-let [ns-form
           (read-ns-decl (PushbackReader. (FileReader. path)))]
    ns-form
    (throw (IllegalArgumentException. "Malformed ns form!"))))

(defn file-content-sans-ns [file-content]
  (let [rdr (PushbackReader. (StringReader. file-content))]
    (read rdr)
    (str/triml (slurp rdr))))

(ns refactor-nrepl.ns.helpers
  (:require [clojure.string :as str]
            [clojure.tools.namespace.parse :refer [read-ns-decl]])
  (:import [java.io FileReader PushbackReader StringReader]))

(defn- libspec?
  [thing]
  (or (vector? thing)
      (symbol? thing)))

(defn prefix-form?
  "True if the vector is of the form [prefix libspec1 libspec2...]"
  [v]
  (and (vector? v)
       (symbol? (first v))
       (not-any? keyword? v)
       (> (count v) 1)
       (every? libspec? (rest v))))

(defn index-of-component [ns-form type]
  (first (keep-indexed #(when (and (sequential? %2) (= (first %2) type)) %1)
                       ns-form)))

(defn get-ns-component
  "Extracts a sub-component from the ns declaration.

type is either :require, :use or :import"
  [ns type]
  (some->> (index-of-component ns type) (nth ns)))

(defn prefix
  "java.util.Date -> java.util

  clojure.walk/walk -> clojure.walk"
  [fully-qualified-name]
  (if(re-find #"/" (str fully-qualified-name))
    (-> fully-qualified-name str (.split "/") first)
    (let [parts (-> fully-qualified-name str (.split "\\.") butlast)]
      (when (seq parts)
        (str/join "." parts)))))

(defn suffix
  "java.util.Date -> Date
  clojure.core/str -> str"
  [fully-qualified-name]
  (if (re-find #"/" (str fully-qualified-name))
    (-> fully-qualified-name str (.split "/") last)
    (-> fully-qualified-name str (.split "\\.") last)))

(defn read-ns-form
  [path]
  (if-let [ns-form
           (read-ns-decl (PushbackReader. (FileReader. path)))]
    ns-form
    (throw (IllegalArgumentException. "Malformed ns form!"))))

(defn file-content-sans-ns [file-content]
  (let [rdr (PushbackReader. (StringReader. file-content))]
    (read rdr)
    (str/triml (slurp rdr))))

make helpers/prefix work on clj symbols

make helpers/prefix work on clj symbols


(ns forecast.parse
  (:require [clojure.string :as string]
            [clojure.java.io]
            [clojure.tools.logging :as log]
            [clojure.core.async :refer [go]]

            [forecast.helpers :as h]
            [forecast.metrics :as metrics]
            [forecast.repository.ip-locator :as ip]
            [forecast.repository.location-forecast :as location]
            [forecast.repository.storage.memory :as memory]
            ))

(defn use-memory-storage
  []
  (ip/use-memory-storage)
  (location/use-memory-storage))

(defn use-aerospike-storage
  []
  (ip/use-aerospike-storage)
  (location/use-aerospike-storage))

(defn parse-logfile
  [filename f]
  (with-open [rdr (clojure.java.io/reader (str "data/" filename))]
    (doseq [line (line-seq rdr)]
      (h/bump :num-logs)
      (f line))))

(defn log-parser
  [line]
  (->
   line
   (string/split #"\t")
   (nth 23)          ;; ip address
   ip/store-ip
   ))

(defn process-new-ips
  []
  (doseq [ip (ip/new-ips)]
    (ip/find-location ip)))

(defn process-new-locations
  []
  (doseq [loc (location/new-locations)]
    (location/find-forecast loc)))
;; (doseq [loc (location/new-locations)] (println loc))

(defn infinite-loop [f]
  (f)
  (future (infinite-loop f))
  nil)

(defn daemon
  []
  (.start
   (Thread.
    (infinite-loop
     #(do
        (Thread/sleep 1000)
        (process-new-ips)
        ))))
  (.start
   (Thread.
    (infinite-loop
     #(do
        (Thread/sleep 1000)
        (process-new-locations)
        ))))
  )

(defn get-histogram
  [num-bins]
  (let [temps (location/done-temperatures)]
    (if (empty? temps)
      []
      ;; (h/histogram (map :temp temps) num-bins))))
      (h/histogram temps num-bins))))

(defn print-histogram
  [num-bins]
  (let [bins (get-histogram num-bins)]
    (if bins
      (do
        (println "\nbucketMin\tbucketMax\tcount")
        (doseq [bin bins]
          (println (clojure.string/join "\t" [(h/round-digits 1 (first bin)) (h/round-digits 1 (second bin)) (int (nth bin 2))]))))
      (println "no temperatures found"))
    )
  )

;; (defn run
;;   [filename num-bins]
;;   (println "\n\n-------------")
;;   (metrics/reset-metrics)
;;   ;; (memory/clear)
;;   (parse-logfile filename log-parser)
;;   (process-new-ips)
;;   (process-new-locations)
;;   ;; (metrics/print-metrics)
;;   ;; (println "ip metrics:" (:metrics @ip/ip-repo))
;;   ;; (println "location metrics: " (:metrics @location/location-repo))
;;   (print-histogram)
;;   )

(defn use-live []
  (ip/use-ipinfo-service)
  (location/use-openweather-service))

(defn parse-args
  [params]
  (metrics/reset-metrics)
  (let [args (set params)]
    ;; setup
    (when (contains? args "--aero")
      (println "using aerospike")
      (use-aerospike-storage))
    (when (contains? args "--live")
      (println "using live services")
      (use-live))

    ;; process file
    (when-not (and (first params) (= \- (-> params first first)))
      (println "load file")
      (parse-logfile (first params) log-parser))

    ;; post processing
    (when (contains? args "--process")
      (println "processing ...")
      (process-new-ips)
      (process-new-locations)
      )
    (when (contains? args "--daemon")
      (println "setting up a daemon")
      (daemon))
    (when (contains? args "--hist")
      (let [num-bins (if (= \- (-> params second first))
                       5
                       (read-string (second params)))]
        (print-histogram num-bins)))
    ))

;; (parse-logfile "logfile" log-parser)
;; (parse-logfile "logfile-big" log-parser)

;; (process-new-locations)
;; (process-all-locations)
;; (ip/new-ips)
;; (location/new-locations)
;; (location/done-temperatures)
;; (:close! @ip/ip-repo)

;; (process-new-locations)
;; (location/done-temperatures)
;; (get-histogram 5)

;; (use-memory-storage)
;; (use-aerospike-storage)
;; (run "logfile" 5)

(ns forecast.parse
  (:require [clojure.string :as string]
            [clojure.java.io]
            [clojure.tools.logging :as log]
            [clojure.core.async :refer [go]]

            [forecast.helpers :as h]
            [forecast.metrics :as metrics]
            [forecast.repository.ip-locator :as ip]
            [forecast.repository.location-forecast :as location]
            [forecast.repository.storage.memory :as memory]
            ))

(defn use-memory-storage
  []
  (ip/use-memory-storage)
  (location/use-memory-storage))

(defn use-aerospike-storage
  []
  (ip/use-aerospike-storage)
  (location/use-aerospike-storage))

(defn parse-logfile
  [filename f]
  (with-open [rdr (clojure.java.io/reader (str "data/" filename))]
    (doseq [line (line-seq rdr)]
      (h/bump :num-logs)
      (f line))))

(defn log-parser
  [line]
  (->
   line
   (string/split #"\t")
   (nth 23)          ;; ip address
   ip/store-ip
   ))

(defn process-new-ips
  []
  (doseq [ip (ip/new-ips)]
    (ip/find-location ip)))

(defn process-new-locations
  []
  (doseq [loc (location/new-locations)]
    (location/find-forecast loc)))
;; (doseq [loc (location/new-locations)] (println loc))

(defn infinite-loop [f]
  (f)
  (future (infinite-loop f))
  nil)

(defn daemon
  []
  (.start
   (Thread.
    (infinite-loop
     #(do
        (Thread/sleep 1000)
        (process-new-ips)
        ))))
  (.start
   (Thread.
    (infinite-loop
     #(do
        (Thread/sleep 1000)
        (process-new-locations)
        )))))

(defn get-histogram
  [num-bins]
  (let [temps (location/done-temperatures)]
    (if (empty? temps)
      []
      ;; (h/histogram (map :temp temps) num-bins))))
      (h/histogram temps num-bins))))

(defn print-histogram
  [num-bins]
  (let [bins (get-histogram num-bins)]
    (if bins
      (do
        (println "\nbucketMin\tbucketMax\tcount")
        (doseq [bin bins]
          (println (clojure.string/join "\t" [(h/round-digits 1 (first bin)) (h/round-digits 1 (second bin)) (int (nth bin 2))]))))
      (println "no temperatures found"))
    )
  )

;; (defn run
;;   [filename num-bins]
;;   (println "\n\n-------------")
;;   (metrics/reset-metrics)
;;   ;; (memory/clear)
;;   (parse-logfile filename log-parser)
;;   (process-new-ips)
;;   (process-new-locations)
;;   ;; (metrics/print-metrics)
;;   ;; (println "ip metrics:" (:metrics @ip/ip-repo))
;;   ;; (println "location metrics: " (:metrics @location/location-repo))
;;   (print-histogram)
;;   )

(defn use-live []
  (ip/use-ipinfo-service)
  (location/use-openweather-service))

(defn parse-args
  [params]
  (metrics/reset-metrics)
  (let [args (set params)
        process? (contains? args "--process")
        num-bins-location (if process? second first)]
    ;; setup
    (when (contains? args "--aero")
      (println "using aerospike")
      (use-aerospike-storage))
    (when (contains? args "--live")
      (println "using live services")
      (use-live))

    ;; load logfile
    (when-not (and process? (first params) (= \- (-> params first first)))
      (println "load file")
      (parse-logfile (first params) log-parser))

    ;; post processing
    (when process?
      (println "processing ...")
      (process-new-ips)
      (process-new-locations)
      )
    (when (contains? args "--daemon")
      (println "setting up a daemon")
      (daemon))
    (when (contains? args "--hist")
      (let [num-bins (if (= \- (-> params num-bins-location first))
                       5
                       (read-string (second params)))]
        (print-histogram num-bins)))
    ))

;; (parse-logfile "logfile" log-parser)
;; (parse-logfile "logfile-big" log-parser)

;; (process-new-locations)
;; (process-all-locations)
;; (ip/new-ips)
;; (location/new-locations)
;; (location/done-temperatures)
;; (:close! @ip/ip-repo)

;; (process-new-locations)
;; (location/done-temperatures)
;; (get-histogram 5)

;; (use-memory-storage)
;; (use-aerospike-storage)
;; (run "logfile" 5)

Fix issue with num-bins on aerospike histogram.


(require '[cljs.build.api :as b])

(def options
  {:main 'beicon.tests.test_core
   :output-to "out/tests.js"
   :output-dir "out/tests"
   :target :nodejs
   :optimizations :advanced
   :pretty-print true
   :verbose true})

(let [start (System/nanoTime)]
  (println "Building ...")
  (b/build (b/inputs "test" "src") options)
  (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))

(require '[cljs.build.api :as b])

(def options
  {:main 'beicon.tests.test_core
   :output-to "out/tests.js"
   :output-dir "out/tests"
   :target :nodejs
   :optimizations :advanced
   :language-in :es5
   :pretty-print true
   :verbose true})

(let [start (System/nanoTime)]
  (println "Building ...")
  (b/build (b/inputs "test" "src") options)
  (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))

Set proper :language-in on build.clj script.