(ns alder.node-type
  (:require [alder.audio.midiapi :as midiapi]))

(defrecord NodeType
    [inputs outputs extra-data
     built-in
     default-title default-size
     constructor
     export-data])

(def audio-destination-node-type
  (NodeType. {:signal {:type :node
                       :index 0
                       :title "Signal"}}
             {}
             nil
             true
             "Listener"
             [100 40]
             (fn [ctx] (aget ctx "destination"))
             {:ignore-export true}))

(def oscillator-node-type
  (NodeType. {:frequency {:type :param
                          :name "frequency"
                          :default 220
                          :title "Frequency"
                          :data-type :number
                          :range [0 22050]}
              :waveform {:type :constant
                         :name "type"
                         :default "square"
                         :title "Waveform"
                         :data-type :string
                         :choices ["sine" "square" "sawtooth" "triangle"]}}
             {:signal {:type :node
                       :index 0
                       :title "Signal"
                       :data-type :signal}}
             nil
             false
             "Osc"
             [70 40]
             (fn [ctx] (.call (aget ctx "createOscillator") ctx))
             {:constructor "context.createOscillator()"}))

(def gain-node-type
  (NodeType. {:gain {:type :param
                     :name "gain"
                     :default 1
                     :title "Gain"
                     :data-type :number}
              :signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal"
                           :data-type :signal}}
             nil
             false
             "Gain"
             [70 40]
             (fn [ctx] (.call (aget ctx "createGain") ctx))
             {:constructor "context.createGain()"}))

(def adsr-node-type
  (NodeType. {:gate {:type :gate
                     :name "gate"
                     :title "Gate"}
              :attack {:type :constant
                       :name "attack"
                       :default 0.1
                       :title "Attack"
                       :data-type :number}
              :decay {:type :constant
                      :name "decay"
                      :default 0.1
                      :title "Decay"
                      :data-type :number}
              :sustain {:type :constant
                        :name "sustain"
                        :default 0.8
                        :title "Sustain"
                        :data-type :number}
              :release {:type :constant
                        :name "release"
                        :default 0.1
                        :title "Release"
                        :data-type :number}}
             {:envelope {:type :node
                         :index 0
                         :title "Envelope"
                         :data-type :param}}
             nil
             false
             "ADSR"
             [70 90]
             #(js/ADSRNode. %)
             {:constructor "new ADSRNode(context)"
              :dependencies {"ADSRNode" ["audio/adsr_node"
                                         (str (.-origin js/location)
                                              "/js/audio/adsr_node.js")]}}))

(def fft-analyser-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {}
             {:inspector-fields [:fft]}
             false
             "FFT"
             [70 40]
             (fn [ctx] (.call (aget ctx "createAnalyser") ctx))
             {:ignore-export true}))

(def scope-analyser-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {}
             {:inspector-fields [:waveform]}
             false
             "Scope"
             [80 40]
             (fn [ctx] (.call (aget ctx "createAnalyser") ctx))
             {:ignore-export true}))

(def output-node-type
  (NodeType. {:signal-in {:type :null-node
                          :index 0
                          :title "Signal in"}}
             {}
             nil
             false
             "Output"
             [80 40]
             (fn [ctx] #js {})
             {:type :output}))

(def input-node-type
  (NodeType. {}
             {:signal-out {:type :null-node
                           :index 0
                           :title "Signal out"}}
             nil
             false
             "Input"
             [80 40]
             (fn [ctx] #js {})
             {:type :input}))

(def biquad-filter-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}
              :frequency {:type :param
                          :name "frequency"
                          :title "Frequency"
                          :default 350
                          :data-type :number
                          :range [0 22050]}
              :detune {:type :param
                       :name "detune"
                       :title "Detune"
                       :default 0
                       :data-type :number
                       :range [-100 100]}
              :Q {:type :param
                  :name "Q"
                  :title "Quality"
                  :default 1
                  :data-type :number
                  :range [0.0001 1000]}
              :gain {:type :param
                     :name "gain"
                     :title "Gain"
                     :default 0
                     :data-type :number
                     :range [-40 40]}
              :type {:type :constant
                     :name "type"
                     :title "Type"
                     :default "lowpass"
                     :data-type :string
                     :choices ["lowpass" "highpass" "bandpass"
                               "lowshelf" "highshelf" "peaking"
                               "notch"
                               "allpass"]}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "LO Filter"
             [90 100]
             (fn [ctx] (.call (aget ctx "createBiquadFilter") ctx))
             {:constructor "context.createBiquadFilter()"}))

(def const-source-node-type
  (NodeType. {:value {:type :accessor
                      :name "value"
                      :default 1
                      :title "Value"
                      :data-type :number}}
             {:signal {:type :node
                       :index 0
                       :title "Signal out"
                       :data-type :signal}}
             nil
             false
             "Const"
             [80 40]
             (fn [ctx] (js/ConstSourceNode. ctx))
             {:constructor "new ConstSourceNode(context)"}))

(def stereo-panner-node-type
  (NodeType. {:pan {:type :param
                    :name "pan"
                    :default 0
                    :title "Pan"
                    :data-type :number
                    :range [-1 1]}
              :signal-in {:type :node
                          :index 0
                          :title "Signal in"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Pan"
             [70 40]
             (fn [ctx] (.call (aget ctx "createStereoPanner") ctx))
             {:constructor "context.createStereoPanner()"}))

(def stereo-splitter-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}}
             {:left-out {:type :node
                         :index 0
                         :title "Left channel out"
                         :data-type :signal}
              :right-out {:type :node
                          :index 1
                          :title "Right channel out"
                          :data-type :signal}}
             nil
             false
             "Split"
             [70 40]
             (fn [ctx] (.call (aget ctx "createChannelSplitter") ctx 2))
             {:constructor "context.createChannelSplitter(2)"}))

(def stereo-merger-node-type
  (NodeType. {:left-in {:type :node
                        :index 0
                        :title "Left channel in"}
              :right-in {:type :node
                         :index 1
                         :title "Right channel in"}}
             {:signal-out {:type :node
                          :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Merge"
             [80 40]
             (fn [ctx] (.call (aget ctx "createChannelMerger") ctx 2))
             {:constructor "context.createChannelMerger(2)"}))

(def delay-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}
              :delay-time {:type :param
                           :name "delayTime"
                           :data-type :number
                           :range [0 5]
                           :title "Delay time"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Delay"
             [80 40]
             (fn [ctx] (.call (aget ctx "createDelay") ctx 5))
             {:constructor "context.createDelay(5)"}))

(def midi-note-node-type
  (NodeType. {:device {:type :accessor
                       :name "device"
                       :default nil
                       :title "Device"
                       :data-type :midi-device
                       :serializable false}
              :note-mode {:type :constant
                          :name "noteMode"
                          :default "retrig"
                          :data-type :string
                          :title "Mode"
                          :choices ["retrig" "legato"]}
              :portamento {:type :constant
                           :name "portamento"
                           :default 0
                           :data-type :number
                           :range [0 5]
                           :title "Portamento"}
              :priority {:type :constant
                         :name "priority"
                         :default "last-on"
                         :data-type :string
                         :title "Priority"
                         :choices ["last-on" "highest" "lowest"]}}
             {:gate {:type :node
                     :index 0
                     :title "Gate"
                     :data-type :gate}
              :frequency {:type :node
                          :index 1
                          :title "Frequency"
                          :data-type :param}}
             nil
             false
             "MIDI Note"
             [100 80]
             #(js/MIDINoteNode. %)
             {:constructor "new MIDINoteNode(context)"
              :dependencies {"MIDINoteNode" ["audio/midi_note_node"
                                             (str (.-origin js/location)
                                                  "/js/audio/midi_note_node.js")]}}))

(def midi-cc-node-type
  (NodeType. {:device {:type :accessor
                       :name "device"
                       :default nil
                       :title "Device"
                       :data-type :midi-device
                       :serializable false}
              :channel {:type :constant
                        :name "channel"
                        :default 0
                        :data-type :number
                        :range [0 127]
                        :title "Channel"}}
             {:value {:type :node
                      :index 0
                      :title "Value"
                      :data-type :param}}
             {:inspector-fields [:midi-cc-learn]}
             false
             "MIDI CC"
             [100 40]
             #(js/MIDICCNode. %)
             {:constructor "new MIDICCNode(context)"
              :dependencies {"MIDICCNode" ["audio/midi_cc_node"
                                           (str (.-origin js/location)
                                                "/js/audio/midi_cc_node.js")]}}))

(def has-midi-support (midiapi/has-midi-access))

(def all-node-types
  (let [basic-nodes {:audio-destination audio-destination-node-type
                     :output output-node-type
                     :input input-node-type
                     :oscillator oscillator-node-type
                     :gain gain-node-type
                     :biquad-filter biquad-filter-node-type
                     :adsr adsr-node-type
                     :const-source const-source-node-type
                     :fft fft-analyser-node-type
                     :scope scope-analyser-node-type
                     :stereo-panner stereo-panner-node-type
                     :stereo-splitter stereo-splitter-node-type
                     :stereo-merger stereo-merger-node-type
                     :delay delay-node-type}
        midi-nodes (if has-midi-support
                     {:midi-note midi-note-node-type
                      :midi-cc midi-cc-node-type}
                     {})]
    (merge basic-nodes midi-nodes)))

(def all-node-groups
  (let [generators [[:oscillator oscillator-node-type]
                    [:const-source const-source-node-type]]
        filters [[:biquad-filter biquad-filter-node-type]
                 [:gain gain-node-type]
                 [:stereo-panner stereo-panner-node-type]
                 [:stereo-splitter stereo-splitter-node-type]
                 [:stereo-merger stereo-merger-node-type]
                 [:delay delay-node-type]]
        envelopes [[:adsr adsr-node-type]]
        midi-nodes [[:midi-note midi-note-node-type]
                    [:midi-cc midi-cc-node-type]]
        analysers [[:scope scope-analyser-node-type]
                   [:fft fft-analyser-node-type]]
        interfaces [[:input input-node-type]
                    [:output output-node-type]
                    [:audio-destination audio-destination-node-type]]]
    (concat [{:title "Generators" :node-types generators}
             {:title "Filters" :node-types filters}
             {:title "Envelopes" :node-types envelopes}]
            (if has-midi-support
              [{:title "MIDI" :node-types midi-nodes}]
              [])
            [{:title "Analysers" :node-types analysers}]
            [{:title "Interfaces" :node-types interfaces}])))

(defn get-node-type [node-type-id]
  (all-node-types node-type-id))

(ns alder.node-type
  (:require [alder.audio.midiapi :as midiapi]))

(defrecord NodeType
    [inputs outputs extra-data
     built-in
     default-title default-size
     constructor
     export-data])

(def audio-destination-node-type
  (NodeType. {:signal {:type :node
                       :index 0
                       :title "Signal"}}
             {}
             nil
             true
             "Listener"
             [100 40]
             (fn [ctx] (aget ctx "destination"))
             {:ignore-export true}))

(def oscillator-node-type
  (NodeType. {:frequency {:type :param
                          :name "frequency"
                          :default 220
                          :title "Frequency"
                          :data-type :number
                          :range [0 22050]}
              :waveform {:type :constant
                         :name "type"
                         :default "square"
                         :title "Waveform"
                         :data-type :string
                         :choices ["sine" "square" "sawtooth" "triangle"]}}
             {:signal {:type :node
                       :index 0
                       :title "Signal"
                       :data-type :signal}}
             nil
             false
             "Osc"
             [70 40]
             (fn [ctx] (.call (aget ctx "createOscillator") ctx))
             {:constructor "context.createOscillator()"}))

(def gain-node-type
  (NodeType. {:gain {:type :param
                     :name "gain"
                     :default 1
                     :title "Gain"
                     :data-type :number}
              :signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal"
                           :data-type :signal}}
             nil
             false
             "Gain"
             [70 40]
             (fn [ctx] (.call (aget ctx "createGain") ctx))
             {:constructor "context.createGain()"}))

(def adsr-node-type
  (NodeType. {:gate {:type :gate
                     :name "gate"
                     :title "Gate"}
              :attack {:type :constant
                       :name "attack"
                       :default 0.1
                       :title "Attack"
                       :data-type :number}
              :decay {:type :constant
                      :name "decay"
                      :default 0.1
                      :title "Decay"
                      :data-type :number}
              :sustain {:type :constant
                        :name "sustain"
                        :default 0.8
                        :title "Sustain"
                        :data-type :number}
              :release {:type :constant
                        :name "release"
                        :default 0.1
                        :title "Release"
                        :data-type :number}}
             {:envelope {:type :node
                         :index 0
                         :title "Envelope"
                         :data-type :param}}
             nil
             false
             "ADSR"
             [70 90]
             #(js/ADSRNode. %)
             {:constructor "new ADSRNode(context)"
              :dependencies {"ADSRNode" ["audio/adsr_node"
                                         (str (.-origin js/location)
                                              "/js/audio/adsr_node.js")]}}))

(def fft-analyser-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {}
             {:inspector-fields [:fft]}
             false
             "FFT"
             [70 40]
             (fn [ctx] (.call (aget ctx "createAnalyser") ctx))
             {:ignore-export true}))

(def scope-analyser-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal"}}
             {}
             {:inspector-fields [:waveform]}
             false
             "Scope"
             [80 40]
             (fn [ctx] (.call (aget ctx "createAnalyser") ctx))
             {:ignore-export true}))

(def output-node-type
  (NodeType. {:signal-in {:type :null-node
                          :index 0
                          :title "Signal in"}}
             {}
             nil
             false
             "Output"
             [80 40]
             (fn [ctx] #js {})
             {:type :output}))

(def input-node-type
  (NodeType. {}
             {:signal-out {:type :null-node
                           :index 0
                           :title "Signal out"}}
             nil
             false
             "Input"
             [80 40]
             (fn [ctx] #js {})
             {:type :input}))

(def biquad-filter-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}
              :frequency {:type :param
                          :name "frequency"
                          :title "Frequency"
                          :default 350
                          :data-type :number
                          :range [0 22050]}
              :detune {:type :param
                       :name "detune"
                       :title "Detune"
                       :default 0
                       :data-type :number
                       :range [-100 100]}
              :Q {:type :param
                  :name "Q"
                  :title "Quality"
                  :default 1
                  :data-type :number
                  :range [0.0001 1000]}
              :gain {:type :param
                     :name "gain"
                     :title "Gain"
                     :default 0
                     :data-type :number
                     :range [-40 40]}
              :type {:type :constant
                     :name "type"
                     :title "Type"
                     :default "lowpass"
                     :data-type :string
                     :choices ["lowpass" "highpass" "bandpass"
                               "lowshelf" "highshelf" "peaking"
                               "notch"
                               "allpass"]}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "LO Filter"
             [90 100]
             (fn [ctx] (.call (aget ctx "createBiquadFilter") ctx))
             {:constructor "context.createBiquadFilter()"}))

(def const-source-node-type
  (NodeType. {:value {:type :accessor
                      :name "value"
                      :default 1
                      :title "Value"
                      :data-type :number}}
             {:signal {:type :node
                       :index 0
                       :title "Signal out"
                       :data-type :signal}}
             nil
             false
             "Const"
             [80 40]
             (fn [ctx] (js/ConstSourceNode. ctx))
             {:constructor "new ConstSourceNode(context)"}))

(def stereo-panner-node-type
  (NodeType. {:pan {:type :param
                    :name "pan"
                    :default 0
                    :title "Pan"
                    :data-type :number
                    :range [-1 1]}
              :signal-in {:type :node
                          :index 0
                          :title "Signal in"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Pan"
             [70 40]
             (fn [ctx] (.call (aget ctx "createStereoPanner") ctx))
             {:constructor "context.createStereoPanner()"}))

(def stereo-splitter-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}}
             {:left-out {:type :node
                         :index 0
                         :title "Left channel out"
                         :data-type :signal}
              :right-out {:type :node
                          :index 1
                          :title "Right channel out"
                          :data-type :signal}}
             nil
             false
             "Split"
             [70 40]
             (fn [ctx] (.call (aget ctx "createChannelSplitter") ctx 2))
             {:constructor "context.createChannelSplitter(2)"}))

(def stereo-merger-node-type
  (NodeType. {:left-in {:type :node
                        :index 0
                        :title "Left channel in"}
              :right-in {:type :node
                         :index 1
                         :title "Right channel in"}}
             {:signal-out {:type :node
                          :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Merge"
             [80 40]
             (fn [ctx] (.call (aget ctx "createChannelMerger") ctx 2))
             {:constructor "context.createChannelMerger(2)"}))

(def delay-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}
              :delay-time {:type :param
                           :name "delayTime"
                           :data-type :number
                           :range [0 5]
                           :title "Delay time"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Delay"
             [80 40]
             (fn [ctx] (.call (aget ctx "createDelay") ctx 5))
             {:constructor "context.createDelay(5)"}))

(def compressor-node-type
  (NodeType. {:signal-in {:type :node
                          :index 0
                          :title "Signal in"}
              :threshold {:type :param
                          :name "threshold"
                          :data-type :number
                          :default -24
                          :title "Threshold"
                          :range [-100 0]}
              :knee {:type :param
                     :name "knee"
                     :data-type :number
                     :default 30
                     :range [0 40]
                     :title "Knee"}
              :ratio {:type :param
                      :name "ratio"
                      :data-type :number
                      :default 12
                      :range [1 20]
                      :title "Ratio"}
              :attack {:type :param
                       :name "attack"
                       :data-type :number
                       :default 0.003
                       :range [0 1]
                       :title "Attack"}
              :release {:type :param
                        :name "release"
                        :data-type :number
                        :default 0.25
                        :range [0 1]
                        :title "Release"}}
             {:signal-out {:type :node
                           :index 0
                           :title "Signal out"
                           :data-type :signal}}
             nil
             false
             "Compressor"
             [120 100]
             (fn [ctx] (.call (aget ctx "createDynamicsCompressor") ctx))
             {:constructor "context.createDynamicsCompressor()"}))

(def midi-note-node-type
  (NodeType. {:device {:type :accessor
                       :name "device"
                       :default nil
                       :title "Device"
                       :data-type :midi-device
                       :serializable false}
              :note-mode {:type :constant
                          :name "noteMode"
                          :default "retrig"
                          :data-type :string
                          :title "Mode"
                          :choices ["retrig" "legato"]}
              :portamento {:type :constant
                           :name "portamento"
                           :default 0
                           :data-type :number
                           :range [0 5]
                           :title "Portamento"}
              :priority {:type :constant
                         :name "priority"
                         :default "last-on"
                         :data-type :string
                         :title "Priority"
                         :choices ["last-on" "highest" "lowest"]}}
             {:gate {:type :node
                     :index 0
                     :title "Gate"
                     :data-type :gate}
              :frequency {:type :node
                          :index 1
                          :title "Frequency"
                          :data-type :param}}
             nil
             false
             "MIDI Note"
             [100 80]
             #(js/MIDINoteNode. %)
             {:constructor "new MIDINoteNode(context)"
              :dependencies {"MIDINoteNode" ["audio/midi_note_node"
                                             (str (.-origin js/location)
                                                  "/js/audio/midi_note_node.js")]}}))

(def midi-cc-node-type
  (NodeType. {:device {:type :accessor
                       :name "device"
                       :default nil
                       :title "Device"
                       :data-type :midi-device
                       :serializable false}
              :channel {:type :constant
                        :name "channel"
                        :default 0
                        :data-type :number
                        :range [0 127]
                        :title "Channel"}}
             {:value {:type :node
                      :index 0
                      :title "Value"
                      :data-type :param}}
             {:inspector-fields [:midi-cc-learn]}
             false
             "MIDI CC"
             [100 40]
             #(js/MIDICCNode. %)
             {:constructor "new MIDICCNode(context)"
              :dependencies {"MIDICCNode" ["audio/midi_cc_node"
                                           (str (.-origin js/location)
                                                "/js/audio/midi_cc_node.js")]}}))

(def has-midi-support (midiapi/has-midi-access))

(def all-node-types
  (let [basic-nodes {:audio-destination audio-destination-node-type
                     :output output-node-type
                     :input input-node-type
                     :oscillator oscillator-node-type
                     :gain gain-node-type
                     :biquad-filter biquad-filter-node-type
                     :adsr adsr-node-type
                     :const-source const-source-node-type
                     :fft fft-analyser-node-type
                     :scope scope-analyser-node-type
                     :stereo-panner stereo-panner-node-type
                     :stereo-splitter stereo-splitter-node-type
                     :stereo-merger stereo-merger-node-type
                     :delay delay-node-type
                     :compressor compressor-node-type}
        midi-nodes (if has-midi-support
                     {:midi-note midi-note-node-type
                      :midi-cc midi-cc-node-type}
                     {})]
    (merge basic-nodes midi-nodes)))

(def all-node-groups
  (let [generators [[:oscillator oscillator-node-type]
                    [:const-source const-source-node-type]]
        filters [[:biquad-filter biquad-filter-node-type]
                 [:gain gain-node-type]
                 [:stereo-panner stereo-panner-node-type]
                 [:stereo-splitter stereo-splitter-node-type]
                 [:stereo-merger stereo-merger-node-type]
                 [:delay delay-node-type]
                 [:compressor compressor-node-type]]
        envelopes [[:adsr adsr-node-type]]
        midi-nodes [[:midi-note midi-note-node-type]
                    [:midi-cc midi-cc-node-type]]
        analysers [[:scope scope-analyser-node-type]
                   [:fft fft-analyser-node-type]]
        interfaces [[:input input-node-type]
                    [:output output-node-type]
                    [:audio-destination audio-destination-node-type]]]
    (concat [{:title "Generators" :node-types generators}
             {:title "Filters" :node-types filters}
             {:title "Envelopes" :node-types envelopes}]
            (if has-midi-support
              [{:title "MIDI" :node-types midi-nodes}]
              [])
            [{:title "Analysers" :node-types analysers}]
            [{:title "Interfaces" :node-types interfaces}])))

(defn get-node-type [node-type-id]
  (all-node-types node-type-id))

Add compressor node

Add compressor node


(ns circle.backend.build.email
  (:require [circle.backend.build :as build])
  (:require [circle.backend.email :as email])
  (:use [clojure.core.incubator :only (-?>)])
  (:use [clojure.tools.logging :only (infof)])
  (:use [arohner.utils :only (inspect)]))

(defn email-subject [build]
  (if (build/successful? build)
    (format "Build %s Success" (build/build-name build))
    (format "Build %s FAIL" (build/build-name build))))

(defn success-email-body [build]
  (format "Build %s successful" (build/build-name build)))

(defn fail-email-body [build]
  (str "Build of " (-> @build :vcs-revision) " failed " (str/join "\n" (map #(str (:out %) (:err %)) (-> @build :action-results)))))

(defn email-body [build]
  (if (build/successful? build)
    (success-email-body build)
    (fail-email-body build)))

(defn send-build-email [build to]
  (email/send :to to
              :subject (email-subject build)
              :body (email-body build)))

(defn except-to-string [e]
  (str (.getMessage e) "\n"
       (-> e
           (.getStackTrace)
           (seq)
           (->>
            (map #(.toString %))
            (str/join "\n")))))

(defn send-build-error-email [build e]
  (email/send :to "arohner@gmail.com"
              :subject "Circle exception"
              :body (str @build "\n" (except-to-string e))))

(defn translate-recipient [build to]
  (condp = to
    :owner (-?> @build :repository :owner :email (vector))
    :committer (->> (-> @build :commits)
                    (map (fn [c]
                           (-> c :author :email))))
    [to]))

(defn get-build-email-recipients [build]
  (->> (-> @build :notify-email)
       (mapcat #(translate-recipient build %))
       (set)))

(defn notify-build-results [build]
  (let [recipients (get-build-email-recipients build)]
    (if (seq recipients)
      (doseq [e recipients]
        (send-build-email build e))
      (infof "build %s has no notify, not sending email" @build))))

(ns circle.backend.build.email
  (:require [clojure.string :as str])
  (:use [clojure.tools.logging :only (infof)])
  (:use [clojure.core.incubator :only (-?>)])
  (:require [circle.backend.build :as build])
  (:require [circle.backend.email :as email]))

(defn email-subject [build]
  (if (build/successful? build)
    (format "Build %s Success" (build/build-name build))
    (format "Build %s FAIL" (build/build-name build))))

(defn success-email-body [build]
  (format "Build %s successful" (build/build-name build)))

(defn fail-email-body [build]
  (str "Build of " (-> @build :vcs-revision) " failed " (str/join "\n" (map #(str (:out %) (:err %)) (-> @build :action-results)))))

(defn email-body [build]
  (if (build/successful? build)
    (success-email-body build)
    (fail-email-body build)))

(defn send-build-email [build to]
  (email/send :to to
              :subject (email-subject build)
              :body (email-body build)))

(defn except-to-string [e]
  (str (.getMessage e) "\n"
       (-> e
           (.getStackTrace)
           (seq)
           (->>
            (map #(.toString %))
            (str/join "\n")))))

(defn send-build-error-email [build e]
  (email/send :to "arohner@gmail.com"
              :subject "Circle exception"
              :body (str @build "\n" (except-to-string e))))

(defn translate-recipient [build to]
  (condp = to
    :owner (-?> @build :repository :owner :email (vector))
    :committer (->> (-> @build :commits)
                    (map (fn [c]
                           (-> c :author :email))))
    [to]))

(defn get-build-email-recipients [build]
  (->> (-> @build :notify-email)
       (mapcat #(translate-recipient build %))
       (set)))

(defn notify-build-results [build]
  (let [recipients (get-build-email-recipients build)]
    (if (seq recipients)
      (doseq [e recipients]
        (send-build-email build e))
      (infof "build %s has no notify, not sending email" @build))))

Fix a missing require

Fix a missing require


(ns clojuredocs.site.intro
  (:require [compojure.core :refer (defroutes GET)]
            [somnium.congomongo :as mon]
            [fogus.unk :refer (memo-ttl)]
            [clojuredocs.search :as search]
            [clojuredocs.site.common :as common]))

(defn $index [top-contribs]
  [:div
   [:div.row
    [:div.col-md-12
     [:section
      [:h1 "ClojureDocs is a community-powered documentation and examples repository for the " [:a {:href "http://clojure.org"} "Clojure programming language"] "."]]
     [:section
      [:form.search {:method :get :action "/search" :autocomplete "off"}
       [:input.form-control {:type "text"
                             :name "query"
                             :placeholder "Looking for?"
                             :autofocus "autofocus"
                             :autocomplete "off"}]]
      [:table.ac-results]]]]
   [:div.row
    [:div.col-md-6
     [:section
      [:h3 "Getting started with ClojureDocs"]
      [:p "Finding the right tool for the job can be tough, so we've outlined a few ways to go about your search below."]
      [:ul
       [:li [:i.icon-search] "Use the search box above to find what you're looking for."]
       [:li [:i.icon-map-marker] "Take a look at the Clojure Core quickref, which displays Clojure vars grouped by category."]
       [:li [:i.icon-book] "Browse an alphabetical list of vars defined in Clojure Core or Contrib."]]]]
    [:div.col-md-6
     [:section
      [:h3 "Top Contributors"]
      [:div.top-contribs
       (map common/$avatar top-contribs)]]]]
   [:div.row
    [:div.col-md-12
     [:h3 "Clojure is concise, powerful, and performant."]]
    [:div.col-md-6
     [:p
      "New to Clojure and not sure where to start? If you'd like to get a good background on Clojure's design origins (and be entertained at the same time), start "
      [:a {:href "http://www.infoq.com/presentations/Are-We-There-Yet-Rich-Hickey"} "here"]
      "."]
     [:p "If you're ready to jump in, then "
      [:a {:href ""} "here you go"]
      "."]]
    [:div.col-md-6
     [:div.example-code
      [:pre
       {:class "brush: clj"}
       (slurp "src/examples/clj/first.clj")]]]]
   [:div.row
    [:div.col-md-12
     [:h3 "On Clojure"]]
    [:div.col-md-6
     [:p "There's no denying that Clojure is just so "
      " *different* "
      " from what most of us are used to. "
      [:em "What is up with all those parentheses?!"]]
     [:p ]
     [:p "So it's no surprise that it"
      " takes a bit to get your head around. Stick with it, and you won't be disappointed."]]
    [:div.col-md-6
     [:p "But don't take our word for it, here's what XKCD has to say:"]
     [:p [:img {:src "http://imgs.xkcd.com/comics/lisp_cycles.png"}]]
     [:p "Seems like more than a few, these days. Happy coding!"]]
    [:div.col-md-12.used-by
     [:h3 "Clojure in Production"]
     [:ul
      (for [{:keys [src url]}
            [{:src "https://g.twimg.com/Twitter_logo_blue.png"
              :url "https://twitter.com"}
             {:src "http://www.akamai.com/images/img/bg/akamai-logo.png"
              :url "http://www.akamai.com/"}
             {:src "http://www.climate.com/preso/assets/imgs/shared/logos/tcc_logo_marcom.png"
              :url "http://www.climate.com/"}
             {:src "http://upload.wikimedia.org/wikipedia/commons/thumb/6/69/Netflix_logo.svg/200px-Netflix_logo.svg.png"
              :url "https://www.netflix.com"}
             {:src "http://www.factual.com/assets/factual_logo_small-9d5ae614ae5422b251648ca62d6b4e51.png"
              :url "http://www.factual.com"}
             {:src "https://www.simple.com/img/logo-a2236763875.png"
              :url "https://simple.com"}
             {:src "http://upload.wikimedia.org/wikipedia/commons/c/cc/Groupon_logo.png"
              :url "http://www.groupon.com/"}
             {:src "https://d1lpkba4w1baqt.cloudfront.net/heroku-logo-light-234x60.png"
              :url "https://www.heroku.com"}
             {:src "http://img.brightcove.com/logo-corporate-new.png"
              :url "http://www.brightcove.com"}
             {:src "http://f.cl.ly/items/3D0u2W0H322U1V2Z2u0P/80x50_orange.png"
              :url "https://soundcloud.com"}]]
        [:li [:a {:href url} [:img {:src src}]]])]]]
   [:div.row
    [:div.col-md-6
     [:section
      [:h3 "Contribute to ClojureDocs"]
      [:p "We need your help to make ClojureDocs a great community resource. Here are a couple of ways you can contribute."]
      [:ul
       [:li
        [:h4 [:i.icon-comment-alt] "Give Feedback"]
        [:p "Please " [:a {:href "https://github.com/zk/clojuredocs/issues"} "open a ticket"] " if you have an idea of how we can improve ClojureDocs."]]
       [:li
        [:h4 [:i.icon-indent-right] "Add an Example"]
        [:p "Sharing your knowledge with fellow Clojurists is easy:"]
        [:p "First, take a look at the examples style guide, and then add an example for your favorite var (or pick one from the list)."]
        [:p "In addition to examples, you also have the ability to add 'see also' references between vars."]]]]]]])

(defn top-contribs []
  (let [scores (atom {})]
    (doseq [{:keys [history]} (mon/fetch :examples)]
      (let [history (reverse history)
            first-user (-> history first :user)]
        (swap! scores update-in [first-user] #(+ 4 (or % 0)))
        (doseq [user (->> history rest (map :user))]
          (swap! scores update-in [user] #(inc (or % 0))))))
    (->> @scores
         (sort-by second)
         reverse
         (take (* 9 5))
         (map #(assoc (first %) :score (second %))))))

(def top-contribs (memo-ttl top-contribs (* 1000 60 60 6)))

(defroutes routes
  (GET "/" []
    (fn [{:keys [user]}]
      (-> {:content ($index (top-contribs))
           :body-class "intro-page"
           :hide-search true
           :user user}
          common/$main)))

  (GET "/search" []
    (fn [{:keys [params]}]
      {:headers {"Content-Type" "application/edn"}
       :body (pr-str (search/query (:query params)))})))

;; Scratch for front page example code
(comment

;; Function definition

(defn get-subject [scene]
  (get scene :subject))

;; Functions are first-class in Clojure

(map get-subject theater)
;;=> ("Frankie", "Lucy")

;; And can be anonymous

(map (fn [scene] (get scene :object)) theater)
;;=> ("relax" "Clojure")

;; And short-handed (hah!)

(map #(get % :action) theater)
;;=> ("says" "❤s")

;; Though idiomatically, it's:

(map :action theater)
;;=> ("says" "❤s")

;; baby shoes, never used.

;; Let's define a variable

(def story ["used" "never" "shoes" "baby" "sale" "for"])

;; Clojure has literals for keywords,
;; lists, maps, and much more.

(println story) ;;=> [:used :never :shoes :baby :sale :for]

;; Not much of a story, yet. We need to
;; reorder, and insert some punctuation

(->> story
     (reverse)                          ; reverse the list
     (partition 2)                      ; break it up into chunks of 2
     (map #(interpose " " %))
     (interpose ", ")                   ; insert spaces
     flatten
     (apply str))
)

(ns clojuredocs.site.intro
  (:require [compojure.core :refer (defroutes GET)]
            [somnium.congomongo :as mon]
            [fogus.unk :refer (memo-ttl)]
            [clojuredocs.search :as search]
            [clojuredocs.site.common :as common]))

(defn $index [top-contribs]
  [:div
   [:div.row
    [:div.col-md-12
     [:section
      [:h1 "ClojureDocs is a community-powered documentation and examples repository for the " [:a {:href "http://clojure.org"} "Clojure programming language"] "."]]
     [:section
      [:form.search {:method :get :action "/search" :autocomplete "off"}
       [:input.form-control {:type "text"
                             :name "query"
                             :placeholder "Looking for?"
                             :autofocus "autofocus"
                             :autocomplete "off"}]]
      [:table.ac-results]]]]
   [:div.row
    [:div.col-md-6
     [:section
      [:h3 "Getting started with ClojureDocs"]
      [:p "Finding the right tool for the job can be tough, so we've outlined a few ways to go about your search below."]
      [:ul
       [:li [:i.icon-search] "Use the search box above to find what you're looking for."]
       [:li [:i.icon-map-marker] "Take a look at the Clojure Core quickref, which displays Clojure vars grouped by category."]
       [:li [:i.icon-book] "Browse an alphabetical list of vars defined in Clojure Core or Contrib."]]]]
    [:div.col-md-6
     [:section
      [:h3 "Top Contributors"]
      [:div.top-contribs
       (map common/$avatar top-contribs)]]]]
   [:div.row
    [:div.col-md-12
     [:h3 "Clojure is concise, powerful, and performant."]]
    [:div.col-md-6
     [:p
      "New to Clojure and not sure where to start? If you'd like to get a good background on Clojure's design origins (and be entertained at the same time), start "
      [:a {:href "http://www.infoq.com/presentations/Are-We-There-Yet-Rich-Hickey"} "here"]
      "."]
     [:p "If you're ready to jump in, then "
      [:a {:href ""} "here you go"]
      "."]]
    [:div.col-md-6
     [:div.example-code
      [:pre
       {:class "brush: clj"}
       (slurp "src/examples/clj/first.clj")]]]]
   [:div.row
    [:div.col-md-12
     [:h3 "On Clojure"]]
    [:div.col-md-6
     [:p "There's no denying that Clojure is just so "
      " *different* "
      " from what most of us are used to. "
      [:em "What is up with all those parentheses?!"]]
     [:p ]
     [:p "So it's no surprise that it"
      " takes a bit to get your head around. Stick with it, and you won't be disappointed."]]
    [:div.col-md-6
     [:p "But don't take our word for it, here's what XKCD has to say:"]
     [:p [:img {:src "https://imgs.xkcd.com/comics/lisp_cycles.png"}]]
     [:p "Seems like more than a few, these days. Happy coding!"]]
    [:div.col-md-12.used-by
     [:h3 "Clojure in Production"]
     [:ul
      (for [{:keys [src url]}
            [{:src "https://g.twimg.com/Twitter_logo_blue.png"
              :url "https://twitter.com"}
             {:src "https://upload.wikimedia.org/wikipedia/en/8/8b/Akamai_logo.svg"
              :url "http://www.akamai.com/"}
             {:src "https://upload.wikimedia.org/wikipedia/en/2/22/The_Climate_Corporation_Logo2.jpg"
              :url "http://www.climate.com/"}
             {:src "https://upload.wikimedia.org/wikipedia/commons/thumb/6/69/Netflix_logo.svg/200px-Netflix_logo.svg.png"
              :url "https://www.netflix.com"}
             {:src "https://www.factual.com/assets/factual_logo_small-9d5ae614ae5422b251648ca62d6b4e51.png"
              :url "http://www.factual.com"}
             {:src "https://www.simple.com/img/logo-a2236763875.png"
              :url "https://simple.com"}
             {:src "https://upload.wikimedia.org/wikipedia/commons/c/cc/Groupon_logo.png"
              :url "http://www.groupon.com/"}
             {:src "https://d1lpkba4w1baqt.cloudfront.net/heroku-logo-light-234x60.png"
              :url "https://www.heroku.com"}
             {:src "https://img.brightcove.com/logo-corporate-new.png"
              :url "http://www.brightcove.com"}
             {:src "https://upload.wikimedia.org/wikipedia/en/9/92/SoundCloud_logo.svg"
              :url "https://soundcloud.com"}]]
        [:li [:a {:href url} [:img {:src src}]]])]]]
   [:div.row
    [:div.col-md-6
     [:section
      [:h3 "Contribute to ClojureDocs"]
      [:p "We need your help to make ClojureDocs a great community resource. Here are a couple of ways you can contribute."]
      [:ul
       [:li
        [:h4 [:i.icon-comment-alt] "Give Feedback"]
        [:p "Please " [:a {:href "https://github.com/zk/clojuredocs/issues"} "open a ticket"] " if you have an idea of how we can improve ClojureDocs."]]
       [:li
        [:h4 [:i.icon-indent-right] "Add an Example"]
        [:p "Sharing your knowledge with fellow Clojurists is easy:"]
        [:p "First, take a look at the examples style guide, and then add an example for your favorite var (or pick one from the list)."]
        [:p "In addition to examples, you also have the ability to add 'see also' references between vars."]]]]]]])

(defn top-contribs []
  (let [scores (atom {})]
    (doseq [{:keys [history]} (mon/fetch :examples)]
      (let [history (reverse history)
            first-user (-> history first :user)]
        (swap! scores update-in [first-user] #(+ 4 (or % 0)))
        (doseq [user (->> history rest (map :user))]
          (swap! scores update-in [user] #(inc (or % 0))))))
    (->> @scores
         (sort-by second)
         reverse
         (take (* 9 5))
         (map #(assoc (first %) :score (second %))))))

(def top-contribs (memo-ttl top-contribs (* 1000 60 60 6)))

(defroutes routes
  (GET "/" []
    (fn [{:keys [user]}]
      (-> {:content ($index (top-contribs))
           :body-class "intro-page"
           :hide-search true
           :user user}
          common/$main)))

  (GET "/search" []
    (fn [{:keys [params]}]
      {:headers {"Content-Type" "application/edn"}
       :body (pr-str (search/query (:query params)))})))

;; Scratch for front page example code
(comment

;; Function definition

(defn get-subject [scene]
  (get scene :subject))

;; Functions are first-class in Clojure

(map get-subject theater)
;;=> ("Frankie", "Lucy")

;; And can be anonymous

(map (fn [scene] (get scene :object)) theater)
;;=> ("relax" "Clojure")

;; And short-handed (hah!)

(map #(get % :action) theater)
;;=> ("says" "❤s")

;; Though idiomatically, it's:

(map :action theater)
;;=> ("says" "❤s")

;; baby shoes, never used.

;; Let's define a variable

(def story ["used" "never" "shoes" "baby" "sale" "for"])

;; Clojure has literals for keywords,
;; lists, maps, and much more.

(println story) ;;=> [:used :never :shoes :baby :sale :for]

;; Not much of a story, yet. We need to
;; reorder, and insert some punctuation

(->> story
     (reverse)                          ; reverse the list
     (partition 2)                      ; break it up into chunks of 2
     (map #(interpose " " %))
     (interpose ", ")                   ; insert spaces
     flatten
     (apply str))
)

Switch images to https

Switch images to https


;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.be>
;; Copyright (c) 2014-2015 Alejandro Gómez
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.exception
  "The Exception monad.

  Also known as Try monad, popularized by Scala.

  It represents a computation that may either result
  in an exception or return a successfully computed
  value. Is very similar to Either monad, but is
  semantically different.

  It consists in two types: Success and Failure. The
  Success type is a simple wrapper like Right of Either
  monad. But the Failure type is slightly different
  from Left, because it is forced to wrap an instance
  of Throwable (or Error in cljs).

  The most common use case of this monad is for wrap
  third party libraries that uses standard Exception
  based error handling. In normal circumstances you
  should use Either instead.

  The types defined for Exception monad (Success and
  Failure) also implementes the clojure IDeref interface
  which facilitates libraries developing using monadic
  composition without forcing a user of that library
  to use or understand monads.

  That is because when you will dereference the
  failure instance, it will reraise the containing
  exception."
  #+clj
  (:require [cats.protocols :as proto]
            [cats.core :refer [with-monad]])

  #+cljs
  (:require [cats.protocols :as proto])

  #+cljs
  (:require-macros [cats.monad.exception :refer [try-on]]
                   [cats.core :refer [with-monad]]))

(defn throw-exception
  [message]
  #+clj (throw (IllegalArgumentException. message))
  #+cljs (throw (js/Error. message)))

(defn exception?
  "Check if provided parameter is an instance
  of exception or not."
  [e]
  (instance? #+clj Exception #+cljs js/Error e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types and implementations.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declare exception-monad)

(deftype Success [v]
  proto/Context
  (get-context [_] exception-monad)

  proto/Extract
  (extract [_] v)

  #+clj
  clojure.lang.IDeref
  #+clj
  (deref [_] v)

  #+cljs
  IDeref
  #+cljs
  (-deref [_] v)

  #+clj
  Object
  #+clj
  (equals [self other]
    (if (instance? Success other)
      (= v (.-v other))
      false))

  #+clj
  (toString [self]
    (with-out-str (print [v])))

  #+cljs
  cljs.core/IEquiv
  #+cljs
  (-equiv [self other]
    (if (instance? Success other)
      (= v (.-v other))
      false)))

(deftype Failure [e]
  proto/Context
  (get-context [_] exception-monad)

  proto/Extract
  (extract [_] e)

  #+clj
  clojure.lang.IDeref
  #+clj
  (deref [_] (throw e))

  #+cljs
  IDeref
  #+cljs
  (-deref [_] (throw e))

  Object
  #+clj
  (equals [self other]
    (if (instance? Failure other)
      (= e (.-e other))
      false))

  (toString [_]
    (with-out-str
      (print [e])))

  #+cljs
  cljs.core/IEquiv
  #+cljs
  (-equiv [self other]
    (if (instance? Failure other)
      (= e (.-e other))
      false)))

(alter-meta! #'->Success assoc :private true)
(alter-meta! #'->Failure assoc :private true)

(defn success
  "A Success type constructor.

  It wraps any arbitrary value into
  success type."
  [v]
  (Success. v))

(defn failure
  "A failure type constructor.

  If a provided parameter is an exceptio, it wraps
  it in a `Failure` instance and return it. But if
  a provided parameter is arbitrary data, it tries
  create an exception from it using clojure `ex-info`
  function.

  Take care that `ex-info` function in clojurescript
  differs a little bit from clojure."
  ([e] (failure e ""))
  ([e message]
   (if (exception? e)
     (Failure. e)
     (Failure. (ex-info message e)))))

(defn success?
  "Check if a provided parameter is a success instance"
  [v]
  (instance? Success v))

(defn failure?
  "Check if a provided parameter is a failure instance."
  [v]
  (instance? Failure v))

(defn try?
  "Check if a provided parameter is instance
  of Try monad."
  [v]
  (let [m (proto/get-context v)]
    (= m exception-monad)))

(defn exec-try-on
  [func]
  (try
    (let [result (func)]
      (if (exception? result)
        (failure result)
        (success result)))
    #+clj
    (catch Throwable e (failure e))
    #+cljs
    (catch js/Error e (failure e))))

(defn exec-try-or-else
  [func defaultvalue]
  (let [result (exec-try-on func)]
    (if (failure? result)
      (success defaultvalue)
      result)))

(defn exec-try-or-recover
  [func recoverfn]
  (let [result (exec-try-on func)]
    (with-monad exception-monad
      (if (failure? result)
        (recoverfn (.-e result))
        result))))

#+clj
(defmacro try-on
  "Wraps a computation and return success of failure."
  [expr]
  `(let [func# (fn [] ~expr)]
     (exec-try-on func#)))

#+clj
(defmacro try-or-else
  [expr defaultvalue]
  `(let [func# (fn [] ~expr)]
     (exec-try-or-else func# ~defaultvalue)))

#+clj
(defmacro try-or-recover
  [expr func]
  `(let [func# (fn [] ~expr)]
     (exec-try-or-recover func# ~func)))

(defn wrap
  "Wrap a function in a try monad.

  Is a high order function that accept a function
  as parameter and returns an other that returns
  success or failure depending of result of the
  first function."
  [func]
  (let [metadata (meta func)]
    (-> (fn [& args] (try-on (apply func args)))
        (with-meta metadata))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Monad definition
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^{:doc "The exception monad type definition."}
  exception-monad
  (reify
    proto/Functor
    (fmap [_ f s]
      (if (success? s)
        (try-on (f (proto/extract s)))
        s))

    proto/Applicative
    (pure [_ v]
      (success v))

    (fapply [m af av]
      (if (success? af)
        (proto/fmap m (proto/get-value af) av)
        af))

    proto/Monad
    (mreturn [_ v]
      (success v))

    (mbind [_ s f]
      (if (success? s)
        (f (proto/extract s))
        s))))

;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.be>
;; Copyright (c) 2014-2015 Alejandro Gómez
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.exception
  "The Exception monad.

  Also known as Try monad, popularized by Scala.

  It represents a computation that may either result
  in an exception or return a successfully computed
  value. Is very similar to Either monad, but is
  semantically different.

  It consists in two types: Success and Failure. The
  Success type is a simple wrapper like Right of Either
  monad. But the Failure type is slightly different
  from Left, because it is forced to wrap an instance
  of Throwable (or Error in cljs).

  The most common use case of this monad is for wrap
  third party libraries that uses standard Exception
  based error handling. In normal circumstances you
  should use Either instead.

  The types defined for Exception monad (Success and
  Failure) also implementes the clojure IDeref interface
  which facilitates libraries developing using monadic
  composition without forcing a user of that library
  to use or understand monads.

  That is because when you will dereference the
  failure instance, it will reraise the containing
  exception."
  #+clj
  (:require [cats.protocols :as proto]
            [cats.core :refer [with-monad]])

  #+cljs
  (:require [cats.protocols :as proto])

  #+cljs
  (:require-macros [cats.monad.exception :refer [try-on]]
                   [cats.core :refer [with-monad]]))

(defn throw-exception
  [message]
  #+clj (throw (IllegalArgumentException. message))
  #+cljs (throw (js/Error. message)))

(defn throwable?
  "Return true if `v` is an instance of
  the Throwable or js/Error type."
  [e]
  (instance? #+clj Exception #+cljs js/Error e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types and implementations.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declare exception-monad)

(deftype Success [v]
  proto/Context
  (get-context [_] exception-monad)

  proto/Extract
  (extract [_] v)

  #+clj
  clojure.lang.IDeref
  #+clj
  (deref [_] v)

  #+cljs
  IDeref
  #+cljs
  (-deref [_] v)

  #+clj
  Object
  #+clj
  (equals [self other]
    (if (instance? Success other)
      (= v (.-v other))
      false))

  #+clj
  (toString [self]
    (with-out-str (print [v])))

  #+cljs
  cljs.core/IEquiv
  #+cljs
  (-equiv [self other]
    (if (instance? Success other)
      (= v (.-v other))
      false)))

(deftype Failure [e]
  proto/Context
  (get-context [_] exception-monad)

  proto/Extract
  (extract [_] e)

  #+clj
  clojure.lang.IDeref
  #+clj
  (deref [_] (throw e))

  #+cljs
  IDeref
  #+cljs
  (-deref [_] (throw e))

  Object
  #+clj
  (equals [self other]
    (if (instance? Failure other)
      (= e (.-e other))
      false))

  (toString [_]
    (with-out-str
      (print [e])))

  #+cljs
  cljs.core/IEquiv
  #+cljs
  (-equiv [self other]
    (if (instance? Failure other)
      (= e (.-e other))
      false)))

(alter-meta! #'->Success assoc :private true)
(alter-meta! #'->Failure assoc :private true)

(defn success
  "A Success type constructor.

  It wraps any arbitrary value into
  success type."
  [v]
  (Success. v))

(defn failure
  "A failure type constructor.

  If a provided parameter is an exceptio, it wraps
  it in a `Failure` instance and return it. But if
  a provided parameter is arbitrary data, it tries
  create an exception from it using clojure `ex-info`
  function.

  Take care that `ex-info` function in clojurescript
  differs a little bit from clojure."
  ([e] (failure e ""))
  ([e message]
   (if (throwable? e)
     (Failure. e)
     (Failure. (ex-info message e)))))

(defn success?
  "Check if a provided parameter is a success instance"
  [v]
  (instance? Success v))

(defn failure?
  "Check if a provided parameter is a failure instance."
  [v]
  (instance? Failure v))

(defn try?
  "Check if a provided parameter is instance
  of Try monad."
  [v]
  (let [m (proto/get-context v)]
    (= m exception-monad)))

(defn exec-try-on
  [func]
  (try
    (let [result (func)]
      (if (exception? result)
        (failure result)
        (success result)))
    #+clj
    (catch Throwable e (failure e))
    #+cljs
    (catch js/Error e (failure e))))

(defn exec-try-or-else
  [func defaultvalue]
  (let [result (exec-try-on func)]
    (if (failure? result)
      (success defaultvalue)
      result)))

(defn exec-try-or-recover
  [func recoverfn]
  (let [result (exec-try-on func)]
    (with-monad exception-monad
      (if (failure? result)
        (recoverfn (.-e result))
        result))))

#+clj
(defmacro try-on
  "Wraps a computation and return success of failure."
  [expr]
  `(let [func# (fn [] ~expr)]
     (exec-try-on func#)))

#+clj
(defmacro try-or-else
  [expr defaultvalue]
  `(let [func# (fn [] ~expr)]
     (exec-try-or-else func# ~defaultvalue)))

#+clj
(defmacro try-or-recover
  [expr func]
  `(let [func# (fn [] ~expr)]
     (exec-try-or-recover func# ~func)))

(defn wrap
  "Wrap a function in a try monad.

  Is a high order function that accept a function
  as parameter and returns an other that returns
  success or failure depending of result of the
  first function."
  [func]
  (let [metadata (meta func)]
    (-> (fn [& args] (try-on (apply func args)))
        (with-meta metadata))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Monad definition
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^{:doc "The exception monad type definition."}
  exception-monad
  (reify
    proto/Functor
    (fmap [_ f s]
      (if (success? s)
        (try-on (f (proto/extract s)))
        s))

    proto/Applicative
    (pure [_ v]
      (success v))

    (fapply [m af av]
      (if (success? af)
        (proto/fmap m (proto/get-value af) av)
        af))

    proto/Monad
    (mreturn [_ v]
      (success v))

    (mbind [_ s f]
      (if (success? s)
        (f (proto/extract s))
        s))))

Rename exception? precate to throwable?.


(ns leipzig-live.core
    (:require [reagent.core :as reagent :refer [atom]]
              [cljs.js :as cljs]))

;; -------------------------
;; Sound

(defonce context (js/window.AudioContext.))
(defn beep! [freq start dur]
  (let [start (+ start (.-currentTime context))
        stop (+ start dur)]
    (doto (.createOscillator context)
      (.connect (.-destination context))
      (-> .-frequency .-value (set! freq))
      (-> .-type (set! "square"))
      (.start start)
      (.stop stop))))

;; -------------------------
;; Evaluation

(defonce compiler-state (cljs/empty-state))
(defn evaluate
  [expr-str]
  (cljs/eval-str
    compiler-state
    (str "(identity " expr-str ")")
    nil
    {:eval cljs/js-eval}
    #(:value %)))

;; -------------------------
;; Behaviour

(defprotocol Action
  (process [this state]))

(defrecord Play [])
(defrecord Refresh [text])

(extend-protocol Action
  Refresh
  (process [{expr-str :text} state]
    (let [new-state (assoc-in state [:text] expr-str)]
      (if-let [value (evaluate expr-str)]
        (assoc-in new-state [:music] value)
        new-state)))

  Play
  (process [_ {pitches :music :as state}]
    (doseq [[seconds hertz] (map vector (range) pitches)]
      (beep! hertz seconds 1))
    state))

(defn apply-action! [state-atom action]
  (swap! state-atom (partial process action)))

;; -------------------------
;; Views

(defn home-page [handle! state]
  [:div [:h1 "Welcome to Leipzig Live!"]
   [:div [:input {:type "text"
                  :value (:text state)
                  :on-change #(-> % .-target .-value ->Refresh handle!)}]
   [:button {:on-click (fn [_] (handle! (->Play)))} "Play!"]]
   [:div
    (-> state :music print)]])

;; -------------------------
;; Initialize app

(defn mount-root []
  (let [state-atom (atom {:music [100 120]
                     :text "'(100 120)"})]
    (reagent/render
      [home-page (partial apply-action! state-atom) @state-atom]
      js/document.body)))

(defn init! []
  (mount-root))

(ns leipzig-live.core
    (:require [reagent.core :as reagent :refer [atom]]
              [cljs.js :as cljs]))

;; -------------------------
;; Sound

(defonce context (js/window.AudioContext.))
(defn beep! [freq start dur]
  (let [start (+ start (.-currentTime context))
        stop (+ start dur)]
    (doto (.createOscillator context)
      (.connect (.-destination context))
      (-> .-frequency .-value (set! freq))
      (-> .-type (set! "square"))
      (.start start)
      (.stop stop))))

;; -------------------------
;; Evaluation

(defonce compiler-state (cljs/empty-state))
(defn evaluate
  [expr-str]
  (cljs/eval-str
    compiler-state
    (str "(identity " expr-str ")")
    nil
    {:eval cljs/js-eval}
    #(:value %)))

;; -------------------------
;; Behaviour

(defprotocol Action
  (process [this state]))

(defrecord Play [])
(defrecord Refresh [text])

(extend-protocol Action
  Refresh
  (process [{expr-str :text} state]
    (let [new-state (assoc-in state [:text] expr-str)]
      (if-let [value (evaluate expr-str)]
        (assoc-in new-state [:music] value)
        new-state)))

  Play
  (process [_ {pitches :music :as state}]
    (doseq [[seconds hertz] (map vector (range) pitches)]
      (beep! hertz seconds 1))
    state))

(defn apply-action! [state-atom action]
  (swap! state-atom (partial process action)))

;; -------------------------
;; Views

(defn home-page [handle! state]
  [:div [:h1 "Welcome to Leipzig Live!"]
   [:div [:input {:type "text"
                  :value (:text state)
                  :on-change #(-> % .-target .-value ->Refresh handle!)}]
   [:button {:on-click (fn [_] (handle! (->Play)))} "Play!"]]
   [:div
    (-> state :music print)]])

;; -------------------------
;; Wiring

(defn mount-root []
  (let [state-atom (atom {:music [100 120]
                          :text "'(100 120)"})]
    (reagent/render
      [home-page (partial apply-action! state-atom) @state-atom]
      js/document.body)))

(defn init! []
  (mount-root))

Comment only.

Comment only.


(ns catacumba.utils
  (:import java.nio.file.Paths))

(def ^{:doc "Transducer for lowercase headers keys."}
  lowercase-keys-t (map (fn [[^String key value]]
                          [(.toLowerCase key) value])))

(def ^{:doc "Transducer for keywordice."}
  keywordice-keys-t (map (fn [[^String key value]]
                           [(keyword key) value])))

(defn str->path
  [^String path]
  (Paths/get path (into-array String [])))

(defn assoc-conj!
  [map key val]
  (assoc! map key
    (if-let [cur (get map key)]
      (if (vector? cur)
        (conj cur val)
        [cur val])
      val)))

(defn- get-arities
  [f]
  {:pre [(instance? clojure.lang.AFunction f)]}
  (->> (class f)
       (.getDeclaredMethods)
       (filter #(= "invoke" (.getName %)))
       (map #(-> % .getParameterTypes alength))
       (set)))

Add get-arities util function.

Add get-arities util function.


;; Copyright (c) Daniel Borchmann. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.

(ns conexp.contrib.draw.scenes
  (:use conexp.base)
  (:use [clojure.contrib.swing-utils :only (do-swing)])
  (:import [java.awt Color Canvas]
	   [java.awt.event ComponentListener]
	   [java.io File]
	   [java.awt.image BufferedImage]
	   [javax.imageio ImageIO]
           [javax.swing JScrollBar]
	   [no.geosoft.cc.graphics GWindow GScene GStyle GWorldExtent]))

(ns-doc "Namespace for scene abstraction.")

;;; scenes

(defvar- *default-scene-style* (doto (GStyle.)
				 (.setBackgroundColor Color/WHITE)
				 (.setAntialiased true))
  "Default GScene style.")

(defn make-window
  "Creates default window."
  []
  (GWindow. Color/WHITE))

;; setting custom data

(defn- initialize-scene
  "Initializies given scene."
  [^GScene scn]
  (.setUserData scn (ref {}))
  scn)

(defn add-data-to-scene
  "Adds given data under keyword to scene."
  [^GScene scn, key, data]
  (dosync
   (alter (.getUserData scn) assoc key data)))

(defn update-data-for-scene
  "Updates data item associated with keys in scene."
  [^GScene scn, keys, data]
  (dosync
   (alter (.getUserData scn) assoc-in keys data)))

(defn remove-data-from-scene
  "Removes all data associated with key from scene."
  [^GScene scn, key]
  (dosync
   (alter (.getUserData scn) disj key)))

(defn get-data-from-scene
  "Returns data associated with key from scene."
  [^GScene scn, key]
  (-> scn .getUserData deref (get key)))

(declare add-scene-hook)

(defn make-scene
  "Makes scene on given window."
  [window]
  (let [^GScene scn (GScene. window)]
    (doto scn
      (initialize-scene)
      (add-data-to-scene :hooks {})
      (add-scene-hook :image-changed)
      (.shouldZoomOnResize true)
      (.shouldWorldExtentFitViewport false)
      (.setStyle *default-scene-style*))
    scn))

(defn redraw-scene
  "Redraws current viewport of scene."
  [^GScene scn]
  (.zoom scn 1.0))

(defn scene-height
  "Returns the height of the given scene."
  [^GScene scn]
  (.getHeight (.getWorldExtent scn)))

(defn scene-width
  "Returns the width of the given scene."
  [^GScene scn]
  (.getWidth (.getWorldExtent scn)))

;; hooks

(defn- get-scene-hooks
  "Returns the hooks with their corresponding callbacks for scene."
  [scn]
  (get-data-from-scene scn :hooks))

(defn- set-scene-hooks
  "Sets hash-map of hooks to callbacks as scene hooks."
  [scn, hooks]
  (add-data-to-scene scn :hooks hooks))

(defn add-scene-hook
  "Adds hook for scene."
  [scn, hook]
  (when (not (contains? (get-scene-hooks scn) hook))
    (update-data-for-scene scn [:hooks hook] [])))

(defn set-scene-callback
  "Sets given functions as callbacks for hook on scene."
  [scn hook functions]
  (when (not (contains? (get-scene-hooks scn) hook))
    (add-scene-hook scn hook))
  (set-scene-hooks scn (assoc (get-scene-hooks scn) hook functions)))

(defn add-scene-callback
  "Adds given function as additional callback for hook."
  [scn hook function]
  (set-scene-callback scn hook
                      (conj (get (get-scene-hooks scn) hook)
                            function)))

(defn remove-scene-callback
  "Removes a given function from a given hook."
  [scn hook function]
  (set-scene-callback scn hook
                      (remove #{function}
                              (get (get-scene-hooks scn) hook))))

(defn call-scene-hook
  "Calls all callbacks of hook with given arguments. Every hook is
  called in a thread-safe manner."
  [scn hook & args]
  (when (not (contains? (get-scene-hooks scn) hook))
    (illegal-argument "Hook " hook " cannot be called for scene."))
  (doseq [callback (get (get-scene-hooks scn) hook)]
    (do-swing (apply callback args))))

;; methods on scenes

(defn start-interaction
  "Starts a given interaction for scene. interaction must be a
  function from a scene to a GInteraction object."
  [^GScene scn interaction]
  (.. scn getWindow (startInteraction (interaction scn))))

(defn get-zoom-factors
  "Returns zoom factors for height and width of given scene."
  [^GScene scn]
  (let [^GWorldExtent current-world-extent (.getWorldExtent scn),
	^GWorldExtent initial-world-extent (.getInitialWorldExtent scn)]
    [(/ (.getHeight current-world-extent) (.getHeight initial-world-extent)),
     (/ (.getWidth current-world-extent) (.getWidth initial-world-extent))]))

(defn get-canvas-from-scene
  "Returns canvas associated with a scene."
  [^GScene scn]
  (let [^Canvas canvas (.. scn getWindow getCanvas)]
    (.addComponentListener canvas (proxy [ComponentListener] []
				    (componentResized [comp-evt]
				      (call-scene-hook scn :image-changed))))
    canvas))

(defn save-image
  "Saves image on scene scn in given file with given format."
  [^GScene scn, ^File file, format]
  (let [^Canvas cnv (.. scn getWindow getCanvas)]
    (let [^BufferedImage image (BufferedImage. (.getWidth cnv)
						(.getHeight cnv)
						BufferedImage/TYPE_INT_RGB)]
      (.print cnv (.createGraphics image))
      (when-not (ImageIO/write image format file)
	(illegal-argument "Format " format " not supported for saving images.")))))

(defn show-labels
  "Turns visibility of labels on scene on and off."
  [^GScene scn, toggle]
  (.setVisibility scn (if toggle
			GScene/ANNOTATION_VISIBLE
			GScene/ANNOTATION_INVISIBLE)))

(defn add-scrollbars
  "Adds given scrollbars for scene."
  [^GScene scene, ^JScrollBar horizontal-scrollbar, ^JScrollBar vertical-scrollbar]
  (.installScrollHandler scene horizontal-scrollbar vertical-scrollbar))

;;; coordinate transformers

(defn device-to-world
  "Transforms a device coordinate pair [x y] to a world coordinate pair for the given scene."
  [^GScene scn x y]
  (let [trf (.getTransformer scn)
	ptn (.deviceToWorld trf x y)]
    [(aget ptn 0) (aget ptn 1)]))

(defn world-to-device
  "Transforms a world coordinate pair [x y] of the given scene to a device coordinate pair."
  [^GScene scn x y]
  (let [trf (.getTransformer scn)
	ptn (.worldToDevice trf x y)]
    [(aget ptn 0) (aget ptn 1)]))

(defn origin
  "Returns the origin of scn."
  [scn]
  (world-to-device scn 0 0))

;;;

nil

;; Copyright (c) Daniel Borchmann. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.

(ns conexp.contrib.draw.scenes
  (:use conexp.base)
  (:import [java.awt Color Canvas]
	   [java.awt.event ComponentListener]
	   [java.io File]
	   [java.awt.image BufferedImage]
	   [javax.imageio ImageIO]
           [javax.swing JScrollBar]
	   [no.geosoft.cc.graphics GWindow GScene GStyle GWorldExtent]))

(ns-doc "Namespace for scene abstraction.")

;;; scenes

(defvar- *default-scene-style* (doto (GStyle.)
				 (.setBackgroundColor Color/WHITE)
				 (.setAntialiased true))
  "Default GScene style.")

(defn make-window
  "Creates default window."
  []
  (GWindow. Color/WHITE))

;; setting custom data

(defn- initialize-scene
  "Initializies given scene."
  [^GScene scn]
  (.setUserData scn (ref {}))
  scn)

(defn add-data-to-scene
  "Adds given data under keyword to scene."
  [^GScene scn, key, data]
  (dosync
   (alter (.getUserData scn) assoc key data)))

(defn update-data-for-scene
  "Updates data item associated with keys in scene."
  [^GScene scn, keys, data]
  (dosync
   (alter (.getUserData scn) assoc-in keys data)))

(defn remove-data-from-scene
  "Removes all data associated with key from scene."
  [^GScene scn, key]
  (dosync
   (alter (.getUserData scn) disj key)))

(defn get-data-from-scene
  "Returns data associated with key from scene."
  [^GScene scn, key]
  (-> scn .getUserData deref (get key)))

(declare add-scene-hook)

(defn make-scene
  "Makes scene on given window."
  [window]
  (let [^GScene scn (GScene. window)]
    (doto scn
      (initialize-scene)
      (add-data-to-scene :hooks {})
      (add-scene-hook :image-changed)
      (.shouldZoomOnResize true)
      (.shouldWorldExtentFitViewport false)
      (.setStyle *default-scene-style*))
    scn))

(defn redraw-scene
  "Redraws current viewport of scene."
  [^GScene scn]
  (.zoom scn 1.0))

(defn scene-height
  "Returns the height of the given scene."
  [^GScene scn]
  (.getHeight (.getWorldExtent scn)))

(defn scene-width
  "Returns the width of the given scene."
  [^GScene scn]
  (.getWidth (.getWorldExtent scn)))

;; hooks

(defn- get-scene-hooks
  "Returns the hooks with their corresponding callbacks for scene."
  [scn]
  (get-data-from-scene scn :hooks))

(defn- set-scene-hooks
  "Sets hash-map of hooks to callbacks as scene hooks."
  [scn, hooks]
  (add-data-to-scene scn :hooks hooks))

(defn add-scene-hook
  "Adds hook for scene."
  [scn, hook]
  (when (not (contains? (get-scene-hooks scn) hook))
    (update-data-for-scene scn [:hooks hook] [])))

(defn set-scene-callback
  "Sets given functions as callbacks for hook on scene."
  [scn hook functions]
  (when (not (contains? (get-scene-hooks scn) hook))
    (add-scene-hook scn hook))
  (set-scene-hooks scn (assoc (get-scene-hooks scn) hook functions)))

(defn add-scene-callback
  "Adds given function as additional callback for hook."
  [scn hook function]
  (set-scene-callback scn hook
                      (conj (get (get-scene-hooks scn) hook)
                            function)))

(defn remove-scene-callback
  "Removes a given function from a given hook."
  [scn hook function]
  (set-scene-callback scn hook
                      (remove #{function}
                              (get (get-scene-hooks scn) hook))))

(defn call-scene-hook
  "Calls all callbacks of hook with given arguments. Every hook is
  called in a thread-safe manner."
  [scn hook & args]
  (when (not (contains? (get-scene-hooks scn) hook))
    (illegal-argument "Hook " hook " cannot be called for scene."))
  (doseq [callback (get (get-scene-hooks scn) hook)]
    (apply callback args)))

;; methods on scenes

(defn start-interaction
  "Starts a given interaction for scene. interaction must be a
  function from a scene to a GInteraction object."
  [^GScene scn interaction]
  (.. scn getWindow (startInteraction (interaction scn))))

(defn get-zoom-factors
  "Returns zoom factors for height and width of given scene."
  [^GScene scn]
  (let [^GWorldExtent current-world-extent (.getWorldExtent scn),
	^GWorldExtent initial-world-extent (.getInitialWorldExtent scn)]
    [(/ (.getHeight current-world-extent) (.getHeight initial-world-extent)),
     (/ (.getWidth current-world-extent) (.getWidth initial-world-extent))]))

(defn get-canvas-from-scene
  "Returns canvas associated with a scene."
  [^GScene scn]
  (let [^Canvas canvas (.. scn getWindow getCanvas)]
    (.addComponentListener canvas (proxy [ComponentListener] []
				    (componentResized [comp-evt]
				      (call-scene-hook scn :image-changed))))
    canvas))

(defn save-image
  "Saves image on scene scn in given file with given format."
  [^GScene scn, ^File file, format]
  (let [^Canvas cnv (.. scn getWindow getCanvas)]
    (let [^BufferedImage image (BufferedImage. (.getWidth cnv)
						(.getHeight cnv)
						BufferedImage/TYPE_INT_RGB)]
      (.print cnv (.createGraphics image))
      (when-not (ImageIO/write image format file)
	(illegal-argument "Format " format " not supported for saving images.")))))

(defn show-labels
  "Turns visibility of labels on scene on and off."
  [^GScene scn, toggle]
  (.setVisibility scn (if toggle
			GScene/ANNOTATION_VISIBLE
			GScene/ANNOTATION_INVISIBLE)))

(defn add-scrollbars
  "Adds given scrollbars for scene."
  [^GScene scene, ^JScrollBar horizontal-scrollbar, ^JScrollBar vertical-scrollbar]
  (.installScrollHandler scene horizontal-scrollbar vertical-scrollbar))

;;; coordinate transformers

(defn device-to-world
  "Transforms a device coordinate pair [x y] to a world coordinate pair for the given scene."
  [^GScene scn x y]
  (let [trf (.getTransformer scn)
	ptn (.deviceToWorld trf x y)]
    [(aget ptn 0) (aget ptn 1)]))

(defn world-to-device
  "Transforms a world coordinate pair [x y] of the given scene to a device coordinate pair."
  [^GScene scn x y]
  (let [trf (.getTransformer scn)
	ptn (.worldToDevice trf x y)]
    [(aget ptn 0) (aget ptn 1)]))

(defn origin
  "Returns the origin of scn."
  [scn]
  (world-to-device scn 0 0))

;;;

nil

Call hooks without do-swing

Call hooks without do-swing

they might not need it.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>


; 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 relations-words (ref []))
(def types-words (ref []))
(def instances-words (ref []))
(def adjective-words (ref []))
(def action-words (ref []))

(defrecord Iyye_Predicate [AccordingTo When Time Prob])

(defrecord Iyye_Atom [Name Uname predicate])

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

(defrecord Iyye_Type [atom SubtypeOf Subtypes Predicates])

(defn create-iyye-type [Name AccordingTo When SubtypeOf Subtypes]
  (let [type-atom (create-iyye-atom Name AccordingTo When types-words)
        type (->Iyye_Type type-atom SubtypeOf Subtypes [])]
    type))

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

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

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

(defrecord Iyye_Relation [atom Reason Types Function])

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

(defrecord Iyye_Instance [atom type])

(defn create-iyye-instance [values])

;(dosync (alter relations-words conj relation))
;(persistence/write-action-to-db (conj (into {} (:atom 8action)) (dissoc (into {} action) :atom)))
;
; (defn write-to-db [atom]
;  (persistence/write-knowledge-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom))))

;(defn ^{:source "(+ 1 a)"} aaa [a] (+ 1 a))
;(defmacro getsrc [func] `(:source (meta (var ~func))))

(defn iyye_is_type_function [p1 p2]
  (let [p2-type (load-iyye-type-from-db p2)
        newtype (if p2-type p2-type (create-iyye-type p2 :IYE :ALWAYS p1 []))])

  )

(defn iyye_consists_function [p1 p2]
  (let [])
  )

(defn iyye_instance_function [p1 name]
  (let [])
  )

(def iyye_is_type (ref 0))
(def iyye_consists_type (ref 0))
(def iyye_create_instance (ref 0))

(defn action [cmd params IO]
  (let [actions
        (for [action @action-words :when (= (:Name action) cmd)]
          action)]
    (case (count actions)
      0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
      1 (let [action (first actions)]
          (if (compare params (:Types action))
            ((:Function action) params)
            (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))
      (ioframes/process-output IO (str "failed to parse: too many matched action to " cmd ": " actions)))))

(defn- init-builtins-kb []
  (let [t_is (create-iyye-relation "is" :IYE :AXIOM :ALWAYS [] iyye_is_type_function)
        consistsof (create-iyye-relation "consists" :IYE :AXIOM :ALWAYS [] iyye_consists_function)
        instof (create-iyye-relation "instance of" :IYE :AXIOM :ALWAYS [] iyye_instance_function)]
    (dosync (ref-set iyye_is_type t_is))
    (dosync (ref-set iyye_consists_type consistsof))
    (dosync (ref-set iyye_create_instance instof))
    ; (dosync (alter noun-words conj iyye_concept))
    ;(dorun (map #(do ( persistence/write-fact-to-db (into {} %))) @action-words))
    ))

(defn- init-db-kb []
  (let []
    (dosync (alter relations-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "relations" {:When :ALWAYS})))
    (dosync (alter types-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "types" {:When :ALWAYS})))
    ))

(defn load-init-kb []
  (init-builtins-kb)
  (init-db-kb)

  )

(defn init-kb []
  (init-builtins-kb)
  )

; (apply str (rest (str (:When {:When :ALWAYS}))))

; 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 types-words (ref []))
(def relations-words (ref []))
(def instances-words (ref []))
(def adjective-words (ref []))
(def action-words (ref []))

(defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
(defrecord Iyye_Atom [Name Uname])
(defrecord Iyye_Relation [atom Predicate Inputs Function])
(defrecord Iyye_Type [atom SubtypeOf Subtypes])
(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 types-words)
        type (->Iyye_Type type-atom [] [])]
    type))

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

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

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

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

(defn create-iyye-instance [values])

(defn action [cmd params IO]
  (let [actions
        (for [action @action-words :when (= (:Name action) cmd)]
          action)]
    (case (count actions)
      0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
      1 (let [action (first actions)]
          (if (compare params (:Types action))
            ((:Function action) params)
            (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))
      (ioframes/process-output IO (str "failed to parse: too many matched action to " cmd ": " actions)))))

Update words.clj

Update words.clj


(ns {{name}}.core
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [goog.dom :as gdom]
            [{{name}}.devbar :as db]
            [{{name}}.state-viewer :as sv]
            [{{name}}.example-components :as ex]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.async :refer [<! >! put! chan]]))

(def app-name "{{name}}")

;control atoms for dev bar and state viewer
(defonce dev-mode (atom true))
(defonce state-viewer (atom false))

(def om-link
  (html [:a {:href "https://github.com/omcljs/om"} "Om"]))

(def intro-text
  (html
    [:p "This is an example application using "
     om-link
     ". You can modify this example by editing "
     [:code (str "src/" app-name "/core.cljs")]
     "."]))

(def init-state
  {:example-data (mapv (fn [n] {:value n}) (range 1 5))})

(defonce state (atom (init-state)))

(def devbar-opts
  {:buttons [[#(reset! state (init-state)) "reset state"]
             [#(db/toggle-dev dev-mode state) "toggle devmode"]
             [#(sv/toggle-state-view state-viewer state) "toggle state viewer"]]})

(reset! db/devbar-opts devbar-opts)

;force conditional code to be called on each reload
;TODO: replace this with a function that figwheel can call on refresh
(db/cond-render-dev-bar dev-mode state)
(sv/cond-render-state-view state-viewer state)

;start an Om render loop using the example master component
(om/root ex/master-component state {:target (gdom/getElement "app")
                                    :shared {:app-header (str "Welcome to " app-name)
                                             :intro-text intro-text}})

(ns {{name}}.main
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [goog.dom :as gdom]
            [{{name}}.devbar :as db]
            [{{name}}.state-viewer :as sv]
            [{{name}}.example-components :as ex]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.async :refer [<! >! put! chan]]))

(def app-name "{{name}}")

;control atoms for dev bar and state viewer
(defonce dev-mode (atom true))
(defonce state-viewer (atom false))

(def om-link
  (html [:a {:href "https://github.com/omcljs/om"} "Om"]))

(def intro-text
  (html
    [:p "This is an example application using "
     om-link
     ". You can modify this example by editing "
     [:code (str "src/" app-name "/core.cljs")]
     "."]))

(def init-state
  {:example-data (mapv (fn [n] {:value n}) (range 1 5))})

(defonce state (atom (init-state)))

(def devbar-opts
  {:buttons [[#(reset! state (init-state)) "reset state"]
             [#(db/toggle-dev dev-mode state) "toggle devmode"]
             [#(sv/toggle-state-view state-viewer state) "toggle state viewer"]]})

(reset! db/devbar-opts devbar-opts)

;force conditional code to be called on each reload
;TODO: replace this with a function that figwheel can call on refresh
(db/cond-render-dev-bar dev-mode state)
(sv/cond-render-state-view state-viewer state)

;start an Om render loop using the example master component
(om/root ex/master-component state {:target (gdom/getElement "app")
                                    :shared {:app-header (str "Welcome to " app-name)
                                             :intro-text intro-text}})

fix incorrect ns form in main namespace

fix incorrect ns form in main namespace