(ns cavm.cgdata
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as s])
  (:require [clojure.java.io :as io])
  (:require [clojure-csv.core :as csv])
  (:require [me.raynes.fs :as fs])
  (:gen-class))

;
; Utility functions
;

(defn- chunked-pmap [f coll]
  (->> coll
       (partition-all 250)
       (pmap (fn [chunk] (doall (map f chunk))))
       (apply concat)))

(defn- normalized-path
  "Like fs/normalized-path, but doesn't add *cwd*."
  [path]
  (fs/with-cwd "/"
    (apply io/file (drop 1 (fs/split (fs/normalized-path path))))))

(defn- tabbed [line]
  (s/split line #"\t"))

;
; cgData metadata
;

(defn- all-json [path]
  (let [files (file-seq (io/file path))
        fnames (map str files)]
    (map #(vector (s/replace % #"\.json$" "") (json/read-str (slurp %)))
         (filter #(.endsWith ^String % ".json") fnames))))

(defn- json-add [acc [file {n "name" t "type" :as metadata}]]
  (if-let [group (and (= t "probeMap") (metadata "group"))]
    (assoc-in acc [t (str group "::" (metadata ":assembly"))] file)
    (assoc-in acc [t n] file)))

(defn- json-table [json-list]
  (reduce json-add {} json-list))

(defn- dirname [file]
   (s/replace file #"[^/]*$" ""))

(defn- basename [file]
  (s/replace file #".*/([^/]*)$" "$1"))

(defn- make-absolute [^String path]
  (if (.startsWith path "/")
    path
    (str "/" path)))

(defn- normalize-path [cut file path]
  (if (= (dirname file) (dirname path))
    (basename path)
    (make-absolute (subs path cut))))

; either pass through [k v] or map it to a file if
; it matches an object in the table.
(defn resolve-reference [normalize table file [k v]]
  (if-let [match (and (.startsWith ^String k ":")
                      (or
                        (get-in table [(subs k 1) v])
                        (get-in table [(subs k 1) (str v "::hg18")])))]
    [k (normalize file match)]
    [k v]))

; rewrite table to use files instead of object names
(defn- resolve-references [normalize table file metadata]
  (into {}
        (map #(resolve-reference normalize table file %) metadata)))

(defn- write-json [file json]
  (with-open [writer (io/writer file)]
    (binding [*out* writer]
      (json/pprint json :escape-slash false))))

(defn- fix-json [root]
  (let [files (all-json root)
        table (json-table files)
        normalize (partial normalize-path (count root))]
    (doseq [[file data] files]
      (write-json (str file ".json")
                  (resolve-references normalize table file data)))))

; apply f to values of map
(defn- fmap [f m]
  (into {} (for [[k v] m] [k (f v)])))

;
; cgData clinicalFeature
;

(defmulti ^:private feature-line
  (fn [acc line] () (second line)))

(defmethod ^:private feature-line :default
  [acc [feature attr value]]
  (assoc-in acc [feature attr] value))

(defn- add-state [curr value]
  (conj (vec curr) value))

(defmethod ^:private feature-line "state"
  [acc [feature attr value]]
  (update-in acc [feature attr] add-state value))

(defn- parse-order [order]
  (first (csv/parse-csv order)))

(defmethod ^:private feature-line "stateOrder"
  [acc [feature attr value]]
  (assoc-in acc [feature attr] (parse-order value)))

(defn- feature-map [lines]
  "Read tab-split clincalFeature rows into a map"
  (reduce feature-line {} lines))

(defn- calc-order
  "Take feature order from 'stateOrder', or file order of 'state' rows."
  [feature]
  (if-let [state (or (feature "stateOrder") (feature "state"))]
    (-> feature
        (assoc :order (into {} (map #(vector %1 %2) state (range))))
        (assoc :state state))
    feature))

(defn feature-file [file]
  (when (and file (.exists (io/as-file file)))
    (->> file
         (slurp)
         (#(s/split % #"\n"))     ; split lines
         (map #(s/split % #"\t")) ; split tabs
         (feature-map)
         (fmap calc-order))))

;
; cgData genomicMatrix
;

(defn- parseFloatNA [str]
  (if (or (= str "NA") (= str "nan") (= str ""))
    Double/NaN
    (Float/parseFloat str)))

; If we have no feature description, we try "float". If that
; fails, we try "category" by passing in a hint. We do not
; allow the hint to override a feature description, since that
; would mask curation errors. multimethod may not be the best
; mechanism for this policy.

(defmulti ^:private data-line
  "(id val val val val) -> seq of parsed values)

  Return a seq of floats from a split probe line, with probe name,
  feature definition, and data type as metadata."
  (fn [features cols & [hint]]
    (or (get (get features (first cols)) "valueType")
        hint)))

(defmethod ^:private data-line :default
  [features cols & [hint]]
  (try ; the body must be eager so we stay in the try/except scope
    (let [feature (get features (first cols))]
      (with-meta
        (mapv parseFloatNA (rest cols)) ; eager
        {:probe (String. ^String (first cols)) ; copy, because split is evil.
         :feature feature
         :valueType "float"}))
    (catch NumberFormatException e
      (data-line features cols "category"))))

; update map with value for NA
(defn- nil-val [order]
  (assoc order "" Double/NaN))

(defn- ad-hoc-order
  "Provide default order from data order in file"
  [feature cols]
  (if (:order feature)
    feature
    (let [state (distinct cols) ; XXX drop ""? This adds "" as a state.
          order (into {} (map vector state (range)))] ; XXX handle all values null?
      (assoc feature :state state :order order))))

(defn- throw-on-nil [x msg & args]
  (when-not x
    (throw (IllegalArgumentException.
             (apply format msg args))))
  x)

(defmethod ^:private data-line "category"
  [features cols & [hint]]
  (let [name (first cols)
        feature (get features name)  ; use 'get' to handle nil
        feature (ad-hoc-order feature (rest cols))
        order (nil-val (:order feature))
        msg "Invalid state %s for feature %s"
        vals (map #(throw-on-nil (order %) msg % name)
                  (rest cols))]
    (with-meta
      vals
      {:probe (String. ^String name) ; copy the string. string/split is evil.
       :feature feature
       :valueType "category"})))

(defmulti matrix-data
  "Return seq of scores, probes X samples, with samples as metadata"
  (fn [metadata features lines] (metadata "type")))

(defmethod matrix-data :default
  [metadata features lines]
  (with-meta (chunked-pmap #(data-line features (tabbed %)) (rest lines))
             {:samples (rest (tabbed (first lines)))}))

(defn- transpose [lines]
  (apply mapv vector lines))

(defmethod matrix-data "clinicalMatrix"
  [metadata features lines]
  (let [lines (transpose lines)]
    (with-meta (chunked-pmap #(data-line features (tabbed %)) (rest lines))
               {:samples (rest (first lines))})))

(defn- cgdata-meta [file]
  (let [mfile (io/as-file (str file ".json"))]
    (if (.exists mfile)
      (json/read-str (slurp mfile))
      {"name" file})))

(defn- path-from-root
  "Return file path relative to root"
  [root file]
  (let [root (fs/normalized-path root)
        file (fs/normalized-path file)]
    (when-not (fs/child-of? root file)
      (throw (IllegalArgumentException. (str file " not in root path: " root))))
    (apply io/file (drop (count (fs/split root)) (fs/split file)))))

(defn- path-from-ref
  "Construct a file path relative to the root of the referring file. 'referer'
  must be relative to root."
  [referrer file]
  (let [sref (fs/split referrer)
        sfile (fs/split file)]
    (if (= (first sfile) fs/unix-root)
      (apply io/file (drop 1 sfile))
      (fs/with-cwd fs/unix-root
        (normalized-path (apply io/file (concat (drop-last 1 sref) sfile)))))))

(defn- references [referrer md]
  "Return map of any references in md to their paths relative to the root. 'referer'
  must be relative to root."
  (let [refs (->> md
                  (keys)
                  (filter #(.startsWith % ":")))]
    (into {} (map vector refs (map #(str (path-from-ref referrer (md %))) refs)))))

(defn matrix-file
  "Return a map describing a cgData matrix file. This will read
  any assoicated json or clinicalFeature file."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)
        cf (refs ":clinicalFeature")
        feature (when cf (feature-file (fs/file root cf)))]
    {:rfile rfile
     :meta meta-data
     :refs refs
     :features feature}))

;
; cgData probemaps
;

(defn- split-no-empty [in pat] ; XXX Does this need to handle quotes?
  (filter #(not (= "" %)) (s/split in pat)))

(defn- probemap-row [row]
  (let [[name genes chrom start end strand] (s/split row #"\t")]
    {:name name
     :genes (split-no-empty genes #",")
     :chrom chrom
     :chromStart (. Integer parseInt start)
     :chromEnd (. Integer parseInt end)
     :strand strand}))

(defn probemap-data
  "Return seq of probes entries as maps"
  [rows]
  (map probemap-row rows))

(defn probemap-file
  "Return a map describing a cgData probemap file. This will read
  any assoicated json."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)]
    {:rfile rfile
     :meta meta-data
     :refs refs}))

(ns cavm.cgdata
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as s])
  (:require [clojure.java.io :as io])
  (:require [clojure-csv.core :as csv])
  (:require [me.raynes.fs :as fs])
  (:gen-class))

;
; Utility functions
;

(defn- chunked-pmap [f coll]
  (->> coll
       (partition-all 250)
       (pmap (fn [chunk] (doall (map f chunk))))
       (apply concat)))

(defn- normalized-path
  "Like fs/normalized-path, but doesn't add *cwd*."
  [path]
  (fs/with-cwd "/"
    (apply io/file (drop 1 (fs/split (fs/normalized-path path))))))

(defn- tabbed [line]
  (s/split line #"\t"))

;
; cgData metadata
;

(defn- all-json [path]
  (let [files (file-seq (io/file path))
        fnames (map str files)]
    (map #(vector (s/replace % #"\.json$" "") (json/read-str (slurp %)))
         (filter #(.endsWith ^String % ".json") fnames))))

(defn- json-add [acc [file {n "name" t "type" :as metadata}]]
  (if-let [group (and (= t "probeMap") (metadata "group"))]
    (assoc-in acc [t (str group "::" (metadata ":assembly"))] file)
    (assoc-in acc [t n] file)))

(defn- json-table [json-list]
  (reduce json-add {} json-list))

(defn- dirname [file]
   (s/replace file #"[^/]*$" ""))

(defn- basename [file]
  (s/replace file #".*/([^/]*)$" "$1"))

(defn- make-absolute [^String path]
  (if (.startsWith path "/")
    path
    (str "/" path)))

(defn- normalize-path [cut file path]
  (if (= (dirname file) (dirname path))
    (basename path)
    (make-absolute (subs path cut))))

; either pass through [k v] or map it to a file if
; it matches an object in the table.
(defn resolve-reference [normalize table file [k v]]
  (if-let [match (and (.startsWith ^String k ":")
                      (or
                        (get-in table [(subs k 1) v])
                        (get-in table [(subs k 1) (str v "::hg18")])))]
    [k (normalize file match)]
    [k v]))

; rewrite table to use files instead of object names
(defn- resolve-references [normalize table file metadata]
  (into {}
        (map #(resolve-reference normalize table file %) metadata)))

(defn- write-json [file json]
  (with-open [writer (io/writer file)]
    (binding [*out* writer]
      (json/pprint json :escape-slash false))))

(defn- fix-json [root]
  (let [files (all-json root)
        table (json-table files)
        normalize (partial normalize-path (count root))]
    (doseq [[file data] files]
      (write-json (str file ".json")
                  (resolve-references normalize table file data)))))

; apply f to values of map
(defn- fmap [f m]
  (into {} (for [[k v] m] [k (f v)])))

;
; cgData clinicalFeature
;

(defmulti ^:private feature-line
  (fn [acc line] () (second line)))

(defmethod ^:private feature-line :default
  [acc [feature attr value]]
  (assoc-in acc [feature attr] value))

(defn- add-state [curr value]
  (conj (vec curr) value))

(defmethod ^:private feature-line "state"
  [acc [feature attr value]]
  (update-in acc [feature attr] add-state value))

(defn- parse-order [order]
  (first (csv/parse-csv order)))

(defmethod ^:private feature-line "stateOrder"
  [acc [feature attr value]]
  (assoc-in acc [feature attr] (parse-order value)))

(defn- feature-map [lines]
  "Read tab-split clincalFeature rows into a map"
  (reduce feature-line {} lines))

(defn- calc-order
  "Take feature order from 'stateOrder', or file order of 'state' rows."
  [feature]
  (if-let [state (or (feature "stateOrder") (feature "state"))]
    (-> feature
        (assoc :order (into {} (map #(vector %1 %2) state (range))))
        (assoc :state state))
    feature))

(defn feature-file [file]
  (when (and file (.exists (io/as-file file)))
    (->> file
         (slurp)
         (#(s/split % #"\n"))     ; split lines
         (map #(s/split % #"\t")) ; split tabs
         (feature-map)
         (fmap calc-order))))

;
; cgData genomicMatrix
;

(defn- parseFloatNA [str]
  (if (or (= str "NA") (= str "nan") (= str ""))
    Double/NaN
    (Float/parseFloat str)))

; If we have no feature description, we try "float". If that
; fails, we try "category" by passing in a hint. We do not
; allow the hint to override a feature description, since that
; would mask curation errors. multimethod may not be the best
; mechanism for this policy.

(defmulti ^:private data-line
  "(id val val val val) -> seq of parsed values)

  Return a seq of floats from a split probe line, with probe name,
  feature definition, and data type as metadata."
  (fn [features cols & [hint]]
    (or (get (get features (first cols)) "valueType")
        hint)))

(defmethod ^:private data-line :default
  [features cols & [hint]]
  (try ; the body must be eager so we stay in the try/except scope
    (let [feature (get features (first cols))]
      (with-meta
        (mapv parseFloatNA (rest cols)) ; eager
        {:probe (String. ^String (first cols)) ; copy, because split is evil.
         :feature feature
         :valueType "float"}))
    (catch NumberFormatException e
      (data-line features cols "category"))))

; update map with value for NA
(defn- nil-val [order]
  (assoc order "" Double/NaN))

(defn- ad-hoc-order
  "Provide default order from data order in file"
  [feature cols]
  (if (:order feature)
    feature
    (let [state (distinct cols) ; XXX drop ""? This adds "" as a state.
          order (into {} (map vector state (range)))] ; XXX handle all values null?
      (assoc feature :state state :order order))))

(defn- throw-on-nil [x msg & args]
  (when-not x
    (throw (IllegalArgumentException.
             (apply format msg args))))
  x)

(defmethod ^:private data-line "category"
  [features cols & [hint]]
  (let [name (first cols)
        feature (get features name)  ; use 'get' to handle nil
        feature (ad-hoc-order feature (rest cols))
        order (nil-val (:order feature))
        msg "Invalid state %s for feature %s"
        vals (map #(throw-on-nil (order %) msg % name)
                  (rest cols))]
    (with-meta
      vals
      {:probe (String. ^String name) ; copy the string. string/split is evil.
       :feature feature
       :valueType "category"})))

(defmulti matrix-data
  "Return seq of scores, probes X samples, with samples as metadata"
  (fn [metadata features lines] (metadata "type")))

(defmethod matrix-data :default
  [metadata features lines]
  (with-meta (chunked-pmap #(data-line features (tabbed %)) (rest lines))
             {:samples (rest (tabbed (first lines)))}))

(defn- transpose [lines]
  (apply mapv vector lines))

(defmethod matrix-data "clinicalMatrix"
  [metadata features lines]
  (let [lines (transpose (map tabbed lines))]
    (with-meta (chunked-pmap #(data-line features %) (rest lines))
               {:samples (rest (first lines))})))

(defn- cgdata-meta [file]
  (let [mfile (io/as-file (str file ".json"))]
    (if (.exists mfile)
      (json/read-str (slurp mfile))
      {"name" file})))

(defn- path-from-root
  "Return file path relative to root"
  [root file]
  (let [root (fs/normalized-path root)
        file (fs/normalized-path file)]
    (when-not (fs/child-of? root file)
      (throw (IllegalArgumentException. (str file " not in root path: " root))))
    (apply io/file (drop (count (fs/split root)) (fs/split file)))))

(defn- path-from-ref
  "Construct a file path relative to the root of the referring file. 'referer'
  must be relative to root."
  [referrer file]
  (let [sref (fs/split referrer)
        sfile (fs/split file)]
    (if (= (first sfile) fs/unix-root)
      (apply io/file (drop 1 sfile))
      (fs/with-cwd fs/unix-root
        (normalized-path (apply io/file (concat (drop-last 1 sref) sfile)))))))

(defn- references [referrer md]
  "Return map of any references in md to their paths relative to the root. 'referer'
  must be relative to root."
  (let [refs (->> md
                  (keys)
                  (filter #(.startsWith % ":")))]
    (into {} (map vector refs (map #(str (path-from-ref referrer (md %))) refs)))))

(defn matrix-file
  "Return a map describing a cgData matrix file. This will read
  any assoicated json or clinicalFeature file."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)
        cf (refs ":clinicalFeature")
        feature (when cf (feature-file (fs/file root cf)))]
    {:rfile rfile
     :meta meta-data
     :refs refs
     :features feature}))

;
; cgData probemaps
;

(defn- split-no-empty [in pat] ; XXX Does this need to handle quotes?
  (filter #(not (= "" %)) (s/split in pat)))

(defn- probemap-row [row]
  (let [[name genes chrom start end strand] (s/split row #"\t")]
    {:name name
     :genes (split-no-empty genes #",")
     :chrom chrom
     :chromStart (. Integer parseInt start)
     :chromEnd (. Integer parseInt end)
     :strand strand}))

(defn probemap-data
  "Return seq of probes entries as maps"
  [rows]
  (map probemap-row rows))

(defn probemap-file
  "Return a map describing a cgData probemap file. This will read
  any assoicated json."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)]
    {:rfile rfile
     :meta meta-data
     :refs refs}))

Fix clinialMatrix loading.

Fix clinialMatrix loading.


(ns degasolv.pkgsys.apt
  "Namespace containing functions related to the APT package system."
  (:require [clojure.string :as string]
            [clojure.java.io :as io]
            [degasolv.util :refer :all]
            [degasolv.resolver :as r :refer :all]
            [tupelo.core :as t])
  (:import (java.util.zip GZIPInputStream)))

; TODO: Add provides
;
; In case I change the zip input streamer later
(defn ->zip-input-stream
  [is]
  (GZIPInputStream. is))

(defn deb-to-degasolv-requirements
  [s]
  (if (empty? s)
    nil
    (t/it-> s
          (string/replace it #":(any|i386|amd64)" "")
          (string/replace it #"[ ()]" "")
          (string/replace it #"<<" "<")
          (string/replace it #">>" ">")
          (string/replace it #"([^><=,]+)=([^><=|,]+)"
                          "$1==$2")
          (string/split it #",")
          (mapv
            #(string-to-requirement %)
            it))))

(defn start-pkg-segment?
  [lines]
  (t/truthy?
    (re-matches
      #"^Package:.*$"
      (first lines))))

(defn lines-to-map
  [lines]
  (t/it-> lines
        (map
          (fn [line]
            (let [[_ k v] (re-matches #"^([^:]+): +(.*)$" line)]
              [(keyword
                (string/lower-case k))
              v]))
          it)
        (transient (into {} it))))

(defn convert-pkg-requirements
  [pkg]
  (let [deps (:depends pkg)]
    (if deps
      (assoc!
        pkg
        :depends
        (deb-to-degasolv-requirements
          deps))
      pkg)))

(defn add-pkg-location
  [pkg url]
  (assoc! pkg
         :location
         (t/it-> url
               (str it "/" (:filename pkg))
               (string/replace
                 it
                 #"/+"
                 "/")
               (string/replace
                 it
                 #"^([a-zA-Z]+:)/"
                 "$1//"))))

(defn deb-to-degasolv-provides
  [s]
  (t/it-> s
        (string/replace it #"\p{Blank}" "")
        (string/split it #",")
        (into [] it)))

(defn expand-provides
  [pkg]
  (let [new-package
        (->PackageInfo
          (string/replace
            (:package pkg)
            #"[:]any$"
            "")
          (:version pkg)
          (:location pkg)
          (:depends pkg))]
  (if (:provides pkg)
    (t/it->
      (deb-to-degasolv-provides (:provides pkg))
        (map
        #(->PackageInfo
           %
           "0"
           (:location pkg)
           (:depends pkg))
        it)
      (conj
        it
        new-package))
    [new-package])))

(defn apt-repo
  [url info]
  (t/it->
    info
    (string/split it #"\n\n")
    (map
      (fn each-package
        [pkg]
        (as->
          pkg each
          (string/split-lines each)
          (filter
            #(re-matches #"^(Provides|Version|Package|Depends|Filename):.*" %)
            each)
          (lines-to-map each)
          (convert-pkg-requirements each)
          (add-pkg-location each url)
          (expand-provides each)))
      it)
    (apply concat it)
    (fn query [id]
      (filter
        #(= id (:id %))
        it))
    (memoize it)))
;;    (reduce
;;      (fn conjv
;;        [c v]
;;        (update-in c
;;                   [(:id v)]
;;                   #(conj (vec %1) %2)
;;                   v))
;;      {}
;;      it)
;;  (map-query it)))

(defn slurp-apt-repo
  [repospec]
  (let [[pkgtype url dist & pools]
        (string/split repospec #" +")]
     (mapv
      (fn each-loc
           [loc]
           (t/it->
            loc
            (string/join "/" it)
            (with-open
              [in
               (->zip-input-stream
                (io/input-stream it))]
              (slurp in))
            (apt-repo url it)))
           (if (.contains dist "/")
             [[url
               dist
               "Packages.gz"]]
             (mapv
              (fn each-pool
                [pool]
                [url
                 "dists"
                 dist
                 pool
                 pkgtype
                 "Packages.gz"])
              pools)))))

(ns degasolv.pkgsys.apt
  "Namespace containing functions related to the APT package system."
  (:require [clojure.string :as string]
            [clojure.java.io :as io]
            [degasolv.util :refer :all]
            [degasolv.resolver :as r :refer :all]
            [tupelo.core :as t]
            [serovers.core :as vers])
  (:import (java.util.zip GZIPInputStream)))

; TODO: Add provides
;
; In case I change the zip input streamer later
(defn ->zip-input-stream
  [is]
  (GZIPInputStream. is))

(defn deb-to-degasolv-requirements
  [s]
  (if (empty? s)
    nil
    (t/it-> s
          (string/replace it #":(any|i386|amd64)" "")
          (string/replace it #"[ ()]" "")
          (string/replace it #"<<" "<")
          (string/replace it #">>" ">")
          (string/replace it #"([^><=,]+)=([^><=|,]+)"
                          "$1==$2")
          (string/split it #",")
          (mapv
            #(string-to-requirement %)
            it))))

(defn start-pkg-segment?
  [lines]
  (t/truthy?
    (re-matches
      #"^Package:.*$"
      (first lines))))

(defn lines-to-map
  [lines]
  (t/it-> lines
        (map
          (fn [line]
            (let [[_ k v] (re-matches #"^([^:]+): +(.*)$" line)]
              [(keyword
                (string/lower-case k))
              v]))
          it)
        (transient (into {} it))))

(defn convert-pkg-requirements
  [pkg]
  (let [deps (:depends pkg)]
    (if deps
      (assoc!
        pkg
        :depends
        (deb-to-degasolv-requirements
          deps))
      pkg)))

(defn add-pkg-location
  [pkg url]
  (assoc! pkg
         :location
         (t/it-> url
               (str it "/" (:filename pkg))
               (string/replace
                 it
                 #"/+"
                 "/")
               (string/replace
                 it
                 #"^([a-zA-Z]+:)/"
                 "$1//"))))

(defn deb-to-degasolv-provides
  [s]
  (t/it-> s
        (string/replace it #"\p{Blank}" "")
        (string/split it #",")
        (into [] it)))

(defn expand-provides
  [pkg]
  (let [new-package
        (->PackageInfo
          (string/replace
            (:package pkg)
            #"[:]any$"
            "")
          (:version pkg)
          (:location pkg)
          (:depends pkg))]
  (if (:provides pkg)
    (t/it->
      (deb-to-degasolv-provides (:provides pkg))
        (map
        #(->PackageInfo
           %
           "0"
           (:location pkg)
           (:depends pkg))
        it)
      (conj
        it
        new-package))
    [new-package])))

(defn apt-repo
  [url info]
  (t/it->
    info
    (string/split it #"\n\n")
    (map
      (fn each-package
        [pkg]
        (as->
          pkg each
          (string/split-lines each)
          (filter
            #(re-matches #"^(Provides|Version|Package|Depends|Filename):.*" %)
            each)
          (lines-to-map each)
          (convert-pkg-requirements each)
          (add-pkg-location each url)
          (expand-provides each)))
      it)
    (apply concat it)
    (fn query [id]
      (sort-by
        :version
        #(- (vers/debian-vercmp %1 %2))
        (filter
        #(= id (:id %))
        it)))
    (memoize it)))
;;    (reduce
;;      (fn conjv
;;        [c v]
;;        (update-in c
;;                   [(:id v)]
;;                   #(conj (vec %1) %2)
;;                   v))
;;      {}
;;      it)
;;  (map-query it)))

(defn slurp-apt-repo
  [repospec]
  (let [[pkgtype url dist & pools]
        (string/split repospec #" +")]
     (mapv
      (fn each-loc
           [loc]
           (t/it->
            loc
            (string/join "/" it)
            (with-open
              [in
               (->zip-input-stream
                (io/input-stream it))]
              (slurp in))
            (apt-repo url it)))
           (if (.contains dist "/")
             [[url
               dist
               "Packages.gz"]]
             (mapv
              (fn each-pool
                [pool]
                [url
                 "dists"
                 dist
                 pool
                 pkgtype
                 "Packages.gz"])
              pools)))))

Make sure the packages get returned sorted by version


(ns dynasty-league.core)

(defn -main
  "I don't do a whole lot ... yet."
  [& args]
  (println "Hello, World!"))

(def all-players {:a 1 :b 2 :c 3})

(defn remove-players
  "Removes players from the original list of players." [players]
  (apply dissoc all-players players))

(defn calculate-best-player
  "Chooses the most optimal player to be drafted from the remaining player.
  Use the remove-players as the argument for this function."
  [players])

(ns dynasty-league.core)

(defn -main
  "I don't do a whole lot ... yet."
  [& args]
  (println "Hello, World!"))

;; Generated from the extraction of excel files. Vector keys help to avoid
;; cases of players with the same name (on different teams).
(def all-players {["Player Name1" "Team Name1"] {:stat1 "a"
                                                 :stat2 "b"
                                                 :stat3 "c"}
                  ["Player Name3" "Team Name2"] {:stat1 "a"
                                                 :stat2 "b"
                                                 :stat3 "c"}
                  ["Player Name3" "Team Name3"] {:stat1 "a"
                                                 :stat2 "b"
                                                 :stat3 "c"}})

;; List of players taken, ordered by how they were selected in draft.
(def moves-made
  [["Player Name3" "Team Name3"]
   ["Player Name1" "Team Name1"]])

(defn apply-moves-made
  "Uses moves-made to create a current pool of players." []
  (for [move moves-made]
    (dissoc all-players move)))

;; Remove later.
(defn select-random-player
  "Selects random player."
  (rand-nth (keys apply-moves-made)))

(defn calculate-best-player
  "Chooses the most optimal player to be drafted from the remaining player.
  Use the remove-players as the argument for this function." []
  )

Change to player removals

Change to player removals

This implements the 'moves made' strategy


(ns cake
  (:require [clojure.stacktrace :as stacktrace]
            [clj-stacktrace.repl :as clj-stacktrace])
  (:import [java.io File FileInputStream]
           [java.util Properties]))

(def *current-task* nil)
(def *project*      nil)
(def *config*       nil)
(def *script*       nil)
(def *opts*         nil)
(def *pwd*          nil)
(def *env*          nil)
(def *shell-env*    nil)
(def *vars*         nil)
(def *root* (System/getProperty "cake.project"))

(def *ins*  nil)
(def *outs* nil)

(defn verbose? []
  (boolean (or (:v *opts*) (:verbose *opts*))))

(defn debug? []
  (boolean (or (:d *opts*) (:debug *opts*))))

(defn read-config [file]
  (if (.exists file)
    (with-open [f (FileInputStream. file)]
      (into {} (doto (Properties.) (.load f))))
    {}))

(def *config* (merge (read-config (File. (System/getProperty "user.home") ".cake/config"))
                     (read-config (File. ".cake/config"))))

(defn print-stacktrace [e]
  (if-let [pst-color (*config* "clj-stacktrace")]
    (do (printf "%s: " (.getName (class e)))
        (clj-stacktrace/pst-on *out* (= "color" pst-color) e))
    (do (stacktrace/print-cause-trace e)
        (flush))))

(ns cake
  (:require [clojure.stacktrace :as stacktrace]
            [clj-stacktrace.repl :as clj-stacktrace])
  (:import [java.io File FileInputStream]
           [java.util Properties]))

(def *current-task* nil)
(def *project*      nil)
(def *script*       nil)
(def *opts*         nil)
(def *pwd*          nil)
(def *env*          nil)
(def *shell-env*    nil)
(def *vars*         nil)
(def *root* (System/getProperty "cake.project"))

(def *ins*  nil)
(def *outs* nil)

(defn verbose? []
  (boolean (or (:v *opts*) (:verbose *opts*))))

(defn debug? []
  (boolean (or (:d *opts*) (:debug *opts*))))

(defn read-config [file]
  (if (.exists file)
    (with-open [f (FileInputStream. file)]
      (into {} (doto (Properties.) (.load f))))
    {}))

(def *config* (merge (read-config (File. (System/getProperty "user.home") ".cake/config"))
                     (read-config (File. ".cake/config"))))

(defn print-stacktrace [e]
  (if-let [pst-color (*config* "clj-stacktrace")]
    (do (printf "%s: " (.getName (class e)))
        (clj-stacktrace/pst-on *out* (= "color" pst-color) e))
    (do (stacktrace/print-cause-trace e)
        (flush))))

remove left over *config*

remove left over *config*


(ns i18n-word-guess.run
  (:require [i18n-word-guess [game :as impl]
                             [db :as db]]
            [clojure.java.io :as io]))

;;-----------------------------------------------------------------------------
;; Dictionary

(defn- load-words [file-name]
  (with-open [rdr (io/reader file-name)]
    (into [] (line-seq rdr))))

(def questionable-nouns (filter #(<= 5 (count %) 10)
                   (load-words (io/resource "nouns.txt"))))

(def all-nouns (load-words (io/resource "nouns-full.txt")))

;(count questionable-nouns)
;(count all-nouns)

;;-----------------------------------------------------------------------------
;; Game routine

(defn- game-message [{:keys [status guess]}]
  (case status
    :start "Начинайте"
    :ok "Продолжайте"
    :win "Вы победили"
    :repeat (str "Вариант \"" guess "\" уже был")
    :no-match (str "Вариант \"" guess "\" не подходит")
;    :over "Игра уже закончена"
    :not-in-dict  (str "Слова \"" guess "\" нет в словаре")
    ""))

(defn- format-step [{:keys [word mask] :as step}]
  (merge (select-keys step [:game_id
                            :guess
                            :mask
                            :status
                            :creation_date])
         {:code (impl/encode mask word)
          :message (game-message step)}))

(defn- get-game-cur [id]
  (->> (db/get-game-cur id)
       format-step))

(defn get-game-history [id]
  (->> (db/get-game-history id)
       (map format-step)))

(defn new-game! [& [{:keys [session] :as ctx}]]
  (let [word               (rand-nth questionable-nouns)
        [game-rec]         (db/insert-game! {:word word})
        game-id            (:id game-rec)
        [initial-step-rec] (db/insert-step! {:game_id game-id
                                             :session session
                                             :mask    (impl/initial-mask word)
                                             :status  :start})]
    (get-game-cur game-id)))

(defn guess-game! [game-id new-guess
                   & [{:keys [session] :as ctx}]]
  (let [lower-guess (clojure.string/lower-case new-guess)
        prev-guesses (map :guess (db/get-game-history game-id))
        {:keys [word mask status]} (db/get-game-cur game-id)]
    (when-not (= (keyword status) :win)
      (db/insert-step!
       (merge {:game_id   game-id
               :session   session
               :guess     new-guess}
              (cond
               (some #{lower-guess} prev-guesses)  {:status :repeat
                                                    :mask   mask}
               (not-any? #{lower-guess} all-nouns) {:status :not-in-dict
                                                    :mask   mask}
               :else (impl/next-step word mask new-guess)))))
    (get-game-cur game-id)))

;(get-game-cur 26)
;(new-game! {:session "65453"})
;(guess-game! 29 "сифен")
;(get-game-history 29)

(defn get-hints [code]
  (impl/code-hints all-nouns code))

;; (distinct (map impl/word->phon questionable-nouns))

(ns i18n-word-guess.run
  (:require [i18n-word-guess [game :as impl]
                             [db :as db]]
            [clojure.java.io :as io]))

;;-----------------------------------------------------------------------------
;; Dictionary

(defn- load-words [file-name]
  (with-open [rdr (io/reader file-name)]
    (into [] (line-seq rdr))))

(def questionable-nouns (filter #(<= 5 (count %) 10)
                   (load-words (io/resource "nouns.txt"))))

(def all-nouns (load-words (io/resource "nouns-full.txt")))

;(count questionable-nouns)
;(count all-nouns)

;;-----------------------------------------------------------------------------
;; Game routine

(defn- game-message [{:keys [status guess]}]
  (case status
    :start "Начинайте"
    :ok "Продолжайте"
    :win "Вы победили"
    :repeat (str "Вариант \"" guess "\" уже был")
    :no-match (str "Вариант \"" guess "\" не подходит")
;    :over "Игра уже закончена"
    :not-in-dict  (str "Слова \"" guess "\" нет в словаре")
    ""))

(defn- format-step [{:keys [word mask] :as step}]
  (merge (select-keys step [:game_id
                            :guess
                            :mask
                            :status
                            :creation_date])
         {:code (impl/encode mask word)
          :message (game-message step)}))

(defn- get-game-cur [id]
  (->> (db/get-game-cur id)
       format-step))

(defn get-game-history [id]
  (->> (db/get-game-history id)
       (map format-step)))

(defn new-game! [& [{:keys [session] :as ctx}]]
  (let [word               (rand-nth questionable-nouns)
        [game-rec]         (db/insert-game! {:word word})
        game-id            (:id game-rec)
        [initial-step-rec] (db/insert-step! {:game_id game-id
                                             :session session
                                             :mask    (impl/initial-mask word)
                                             :status  :start})]
    (get-game-cur game-id)))

(defn guess-game! [game-id new-guess
                   & [{:keys [session] :as ctx}]]
  (let [lower-guess (clojure.string/lower-case new-guess)
        prev-guesses (map :guess (db/get-game-history game-id))
        {:keys [word mask status]} (db/get-game-cur game-id)]
    (when-not (= (keyword status) :win)
      (db/insert-step!
       (merge {:game_id   game-id
               :session   session
               :guess     new-guess}
              (cond
               (some #{lower-guess} prev-guesses)  {:status :repeat
                                                    :mask   mask}
               (not-any? #{lower-guess} all-nouns) {:status :not-in-dict
                                                    :mask   mask}
               :else (impl/next-step word mask lower-guess)))))
    (get-game-cur game-id)))

;(get-game-cur 26)
;(new-game! {:session "65453"})
;(guess-game! 29 "сифен")
;(get-game-history 29)

(defn get-hints [code]
  (impl/code-hints all-nouns code))

;; (distinct (map impl/word->phon questionable-nouns))

Fix case sensitivity bug

Fix case sensitivity bug


(ns catalog.layout.text
  "Render catalog items as plain text"
  (:require [catalog.layout.common :as layout :refer [empty-or-blank? wrap]]
            [clj-time
             [core :as time.core]
             [format :as time.format]]
            [clojure
             [set :as set]
             [string :as string]
             [walk :as walk]]
            [endophile.core :as endophile]))

(def ^:private dos-newline "\r\n")
(def ^:private double-newline (str dos-newline dos-newline))

(defmulti to-text (fn [{:keys [tag attrs content]}] tag))

(defmethod to-text :a [{content :content {href :href} :attrs}]
  (if (not-empty content) content href))
(defmethod to-text :h1 [{content :content}] (str content double-newline))
(defmethod to-text :h2 [{content :content}] (str  content double-newline))
(defmethod to-text :h3 [{content :content}] (str  content double-newline))
(defmethod to-text :ul [{content :content}] [:list {:type "ul"} content])
(defmethod to-text :li [{content :content}] [:li content])
(defmethod to-text :br [_] dos-newline)
(defmethod to-text :default [{content :content}] content) ; just assume :p

(defn- node? [node]
  (and (map? node) (or (set/subset? #{:tag :content} (set (keys node))) (= (:tag node) :br))))

(defn- visitor [node]
  (if (node? node)
    (to-text node)
    node))

(defn md-to-text [markdown]
  (->>
   markdown
   endophile/mp
   endophile/to-clj
   (walk/postwalk #(visitor %))
   string/join))

(def ^:private line-length 72)

(defn wrap-line [text]
  ;; see http://rosettacode.org/wiki/Word_wrap#Clojure
  (string/join dos-newline (re-seq (re-pattern (str ".{1," line-length "}(?:\\s|\\z)")) text)))

(defn- entry-heading-str
  [{:keys [creator title subtitles name-of-part source-publisher source-date]}]
  (wrap-line
   (str
    (wrap creator "" ": " false)
    (->> [(wrap title) (for [s subtitles] (wrap s)) (wrap name-of-part)]
         flatten
         (remove empty-or-blank?)
         (string/join " "))
    (when (or source-publisher source-date) " - ")
    (wrap source-publisher "" (if source-date ", " "") false) (wrap (layout/year source-date)))))

(defmulti entry-str (fn [{fmt :format}] fmt))

(defn- ausleihe
  [library-signature]
  (when library-signature
    (wrap-line
     (str "Ausleihe: " (layout/braille-signatures library-signature)))))

(defn- ausleihe-simple
  [library-signature]
  (when library-signature
    (wrap library-signature "Ausleihe: ")))

(defn- verkauf
  [{:keys [product-number price price-on-request?]}]
  (when (or product-number price-on-request?)
    (wrap-line
     (str "Verkauf: "
          (wrap price "" ". " false)
          (layout/braille-signatures product-number)))))

(defn- description-str
  [description]
  (wrap-line (wrap description)))

(defn- producer-str
  ([producer-brief]
   (wrap producer-brief))
  ([producer-brief rucksackbuch-number]
   (wrap producer-brief "" ", " false) (wrap rucksackbuch-number "Rucksackbuch Nr. ")))

(defn- genre-str
  [genre-text]
  (wrap genre-text "Genre: "))

(defn- join [& more]
  (->> more
   (remove empty-or-blank?)
   (string/join dos-newline)))

(defmethod entry-str :braille
  [{:keys [creator title subtitles name-of-part source-publisher
           source-date genre-text description producer-brief
           rucksackbuch? rucksackbuch-number
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (if rucksackbuch?
     (producer-str producer-brief rucksackbuch-number)
     (producer-str producer-brief))
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :musiknoten
  [{:keys [creator title subtitles name-of-part source-publisher
           source-date genre-text description producer-brief
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (description-str description)
   (producer-str producer-brief)
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :taktilesbuch
  [{:keys [creator title subtitles name-of-part source-publisher
           source-date genre-text description producer-brief
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (description-str description)
   (producer-str producer-brief)
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :hörbuch
  [{:keys [genre-text description duration narrators producer-brief
           produced-commercially? library-signature
           product-number price price-on-request?] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (str (wrap duration "" " Min., " false) (layout/render-narrators narrators))
   (if produced-commercially?
     (wrap producer-brief "" ", Hörbuch aus dem Handel")
     (producer-str producer-brief))
   (ausleihe-simple library-signature)
   (when (or product-number price-on-request?)
     (str "Verkauf: " (when product-number (str product-number ", ")) price))))

(defmethod entry-str :grossdruck
  [{:keys [genre-text description library-signature volumes
           product-number price price-on-request?] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (when library-signature
     (str "Ausleihe: " library-signature (wrap volumes ", " " Bd. " false)))
   (when (or product-number price-on-request?)
     (str "Verkauf: " price))))

(defmethod entry-str :e-book
  [{:keys [genre-text description library-signature] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (ausleihe-simple library-signature)))

(defmethod entry-str :hörfilm
  [{:keys [personel-text movie_country genre-text
           description producer library-signature] :as item}]
  (join
   (entry-heading-str item)
   (wrap personel-text)
   (wrap movie_country)
   (genre-str genre-text)
   (description-str description)
   (producer-str producer)
   (ausleihe-simple library-signature)))

(defmethod entry-str :ludo
  [{:keys [source-publisher genre-text description
           game-description accompanying-material library-signature] :as item}]
  (join
   (entry-heading-str item)
   (wrap source-publisher)
   (genre-str genre-text)
   (description-str description)
   (wrap game-description)
   (ausleihe library-signature)
   (verkauf item)))

(defn- level-str [items path path-to-numbers]
  (str
   (when-let [section-title (last path)]
     (format "%s%s%s"
             (layout/section-numbers (get path-to-numbers path))
             (layout/translations section-title "FIXME")
             double-newline))
   (cond
     ;; handle the special case where the editorial or the recommendations are passed in the tree
     (#{:editorial :recommendation} (last path)) (md-to-text items)
     ;; handle a list of entries
     (sequential? items) (string/join double-newline (map entry-str items))
     :else (string/join double-newline (map #(level-str (get items %) (conj path %) path-to-numbers) (keys items))))))

(defn- standard-catalog?
  "If `items` is a map, i.e. are grouped by genre, then we assume that
  we are dealing with a standard catalog. Otherwise if the items are
  just a flat list then we have a custom catalog."
  [items]
  (map? items))

(defmulti document-str (fn [items _] (if (standard-catalog? items) :standard :custom)))

(defn- impressum []
  (let [creator (layout/translations :sbs)]
    (string/join
     dos-newline
     ["Herausgeber:"
      creator
      "Grubenstrasse 12"
      "CH-8045 Zürich"
      "Fon +41 43 333 32 32"
      "Fax +41 43 333 32 33"
      "www.sbs.ch"
      "nutzerservice@sbs.ch"
      (format "© %s" creator)])))

(defmethod document-str :standard
  [items {:keys [year issue editorial recommendation]}]
  (let [title (layout/translations :catalog-all)
        items (cond-> items
                (not (string/blank? editorial)) (assoc :editorial editorial)
                (not (string/blank? recommendation)) (assoc :recommendation recommendation))
        path-to-numbers (layout/path-to-number items)]
    (string/join
     double-newline
     (concat
      [title
       (format "%s-%s" year issue)
       (impressum)]
      (map #(level-str (get items %) [%] path-to-numbers) (keys items))))))

(def ^:private date-formatter (time.format/formatter "dd.MM.YYYY"))

(defmethod document-str :custom
  [items {:keys [query customer]}]
  (let [title (layout/translations :catalog-custom)
        date (time.core/now)
        path-to-numbers (layout/path-to-number items)]
    (string/join double-newline
     [title
      (format "Stand %s" (time.format/unparse date-formatter date))
      query
      (format "für %s" customer)
      (impressum)
      (level-str items [] path-to-numbers)])))

(defn text
  [items options]
  (document-str items options))

(ns catalog.layout.text
  "Render catalog items as plain text"
  (:require [catalog.layout.common :as layout :refer [empty-or-blank? wrap]]
            [clj-time
             [core :as time.core]
             [format :as time.format]]
            [clojure
             [set :as set]
             [string :as string]
             [walk :as walk]]
            [endophile.core :as endophile]))

(def ^:private dos-newline "\r\n")
(def ^:private double-newline (str dos-newline dos-newline))

(defmulti to-text (fn [{:keys [tag attrs content]}] tag))

(defmethod to-text :a [{content :content {href :href} :attrs}]
  (if (not-empty content) content href))
(defmethod to-text :h1 [{content :content}] (str content double-newline))
(defmethod to-text :h2 [{content :content}] (str  content double-newline))
(defmethod to-text :h3 [{content :content}] (str  content double-newline))
(defmethod to-text :ul [{content :content}] [:list {:type "ul"} content])
(defmethod to-text :li [{content :content}] [:li content])
(defmethod to-text :br [_] dos-newline)
(defmethod to-text :default [{content :content}] content) ; just assume :p

(defn- node? [node]
  (and (map? node) (or (set/subset? #{:tag :content} (set (keys node))) (= (:tag node) :br))))

(defn- visitor [node]
  (if (node? node)
    (to-text node)
    node))

(defn md-to-text [markdown]
  (->>
   markdown
   endophile/mp
   endophile/to-clj
   (walk/postwalk #(visitor %))
   string/join))

(def ^:private line-length 72)

(defn wrap-line [text]
  ;; see http://rosettacode.org/wiki/Word_wrap#Clojure
  (string/join dos-newline (re-seq (re-pattern (str ".{1," line-length "}(?:\\s|\\z)")) text)))

(defn- entry-heading-str
  [{:keys [creator title subtitles name-of-part source-publisher source-date]}]
  (wrap-line
   (str
    (wrap creator "" ": " false)
    (->> [(wrap title) (for [s subtitles] (wrap s)) (wrap name-of-part)]
         flatten
         (remove empty-or-blank?)
         (string/join " "))
    (when (or source-publisher source-date) " - ")
    (wrap source-publisher "" (if source-date ", " "") false) (wrap (layout/year source-date)))))

(defmulti entry-str (fn [{fmt :format}] fmt))

(defn- ausleihe
  [library-signature]
  (when library-signature
    (wrap-line
     (str "Ausleihe: " (layout/braille-signatures library-signature)))))

(defn- ausleihe-simple
  [library-signature]
  (when library-signature
    (wrap library-signature "Ausleihe: ")))

(defn- verkauf
  [{:keys [product-number price price-on-request?]}]
  (when (or product-number price-on-request?)
    (wrap-line
     (str "Verkauf: "
          (wrap price "" ". " false)
          (layout/braille-signatures product-number)))))

(defn- description-str
  [description]
  (wrap-line (wrap description)))

(defn- producer-str
  ([producer-brief]
   (wrap producer-brief))
  ([producer-brief rucksackbuch-number]
   (wrap producer-brief "" ", " false) (wrap rucksackbuch-number "Rucksackbuch Nr. ")))

(defn- genre-str
  [genre-text]
  (wrap genre-text "Genre: "))

(defn- join [& more]
  (->> more
   (remove empty-or-blank?)
   (string/join dos-newline)))

(defmethod entry-str :braille
  [{:keys [genre-text description producer-brief
           rucksackbuch? rucksackbuch-number
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (if rucksackbuch?
     (producer-str producer-brief rucksackbuch-number)
     (producer-str producer-brief))
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :musiknoten
  [{:keys [creator title subtitles name-of-part source-publisher
           source-date genre-text description producer-brief
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (description-str description)
   (producer-str producer-brief)
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :taktilesbuch
  [{:keys [creator title subtitles name-of-part source-publisher
           source-date genre-text description producer-brief
           library-signature] :as item}]
  (join
   (entry-heading-str item)
   (description-str description)
   (producer-str producer-brief)
   (ausleihe library-signature)
   (verkauf item)))

(defmethod entry-str :hörbuch
  [{:keys [genre-text description duration narrators producer-brief
           produced-commercially? library-signature
           product-number price price-on-request?] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (str (wrap duration "" " Min., " false) (layout/render-narrators narrators))
   (if produced-commercially?
     (wrap producer-brief "" ", Hörbuch aus dem Handel")
     (producer-str producer-brief))
   (ausleihe-simple library-signature)
   (when (or product-number price-on-request?)
     (str "Verkauf: " (when product-number (str product-number ", ")) price))))

(defmethod entry-str :grossdruck
  [{:keys [genre-text description library-signature volumes
           product-number price price-on-request?] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (when library-signature
     (str "Ausleihe: " library-signature (wrap volumes ", " " Bd. " false)))
   (when (or product-number price-on-request?)
     (str "Verkauf: " price))))

(defmethod entry-str :e-book
  [{:keys [genre-text description library-signature] :as item}]
  (join
   (entry-heading-str item)
   (genre-str genre-text)
   (description-str description)
   (ausleihe-simple library-signature)))

(defmethod entry-str :hörfilm
  [{:keys [personel-text movie_country genre-text
           description producer library-signature] :as item}]
  (join
   (entry-heading-str item)
   (wrap personel-text)
   (wrap movie_country)
   (genre-str genre-text)
   (description-str description)
   (producer-str producer)
   (ausleihe-simple library-signature)))

(defmethod entry-str :ludo
  [{:keys [source-publisher genre-text description
           game-description library-signature] :as item}]
  (join
   (entry-heading-str item)
   (wrap source-publisher)
   (genre-str genre-text)
   (description-str description)
   (wrap game-description)
   (ausleihe library-signature)
   (verkauf item)))

(defn- level-str [items path path-to-numbers]
  (str
   (when-let [section-title (last path)]
     (format "%s%s%s"
             (layout/section-numbers (get path-to-numbers path))
             (layout/translations section-title "FIXME")
             double-newline))
   (cond
     ;; handle the special case where the editorial or the recommendations are passed in the tree
     (#{:editorial :recommendation} (last path)) (md-to-text items)
     ;; handle a list of entries
     (sequential? items) (string/join double-newline (map entry-str items))
     :else (string/join double-newline (map #(level-str (get items %) (conj path %) path-to-numbers) (keys items))))))

(defn- standard-catalog?
  "If `items` is a map, i.e. are grouped by genre, then we assume that
  we are dealing with a standard catalog. Otherwise if the items are
  just a flat list then we have a custom catalog."
  [items]
  (map? items))

(defmulti document-str (fn [items _] (if (standard-catalog? items) :standard :custom)))

(defn- impressum []
  (let [creator (layout/translations :sbs)]
    (string/join
     dos-newline
     ["Herausgeber:"
      creator
      "Grubenstrasse 12"
      "CH-8045 Zürich"
      "Fon +41 43 333 32 32"
      "Fax +41 43 333 32 33"
      "www.sbs.ch"
      "nutzerservice@sbs.ch"
      (format "© %s" creator)])))

(defmethod document-str :standard
  [items {:keys [year issue editorial recommendation]}]
  (let [title (layout/translations :catalog-all)
        items (cond-> items
                (not (string/blank? editorial)) (assoc :editorial editorial)
                (not (string/blank? recommendation)) (assoc :recommendation recommendation))
        path-to-numbers (layout/path-to-number items)]
    (string/join
     double-newline
     (concat
      [title
       (format "%s-%s" year issue)
       (impressum)]
      (map #(level-str (get items %) [%] path-to-numbers) (keys items))))))

(def ^:private date-formatter (time.format/formatter "dd.MM.YYYY"))

(defmethod document-str :custom
  [items {:keys [query customer]}]
  (let [title (layout/translations :catalog-custom)
        date (time.core/now)
        path-to-numbers (layout/path-to-number items)]
    (string/join double-newline
     [title
      (format "Stand %s" (time.format/unparse date-formatter date))
      query
      (format "für %s" customer)
      (impressum)
      (level-str items [] path-to-numbers)])))

(defn text
  [items options]
  (document-str items options))

Remove unused parameters

Remove unused parameters


(ns cljs-editor.server
  (:require [clojure.java.io :as io]
            [cljs-editor.dev :refer [is-dev? inject-devmode-html browser-repl start-figwheel]]
            [compojure.core :refer [GET defroutes]]
            [compojure.route :refer [resources]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [net.cgrand.reload :refer [auto-reload]]
            [ring.middleware.reload :as reload]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [environ.core :refer [env]]
            [ring.adapter.jetty :refer [run-jetty]])
  (:gen-class))

(deftemplate page (io/resource "index.html") []
  [:body] (if is-dev? inject-devmode-html identity))

(defroutes routes
  (resources "/")
  (resources "/react" {:root "react"})
  (GET "/*" req (page)))

(def http-handler
  (if is-dev?
    (reload/wrap-reload (wrap-defaults #'routes api-defaults))
    (wrap-defaults routes api-defaults)))

(defn run-web-server [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (println (format "Starting web server on port %d." port))
    (run-jetty http-handler {:port port :join? false})))

(defn run-auto-reload [& [port]]
  (auto-reload *ns*)
  (start-figwheel))

(defn run [& [port]]
  (when is-dev?
    (run-auto-reload))
  (run-web-server port))

(defn -main [& [port]]
  (run port))

(ns cljs-editor.server
  (:require [clojure.java.io :as io]
            [cljs-editor.dev :refer [is-dev? inject-devmode-html browser-repl start-figwheel]]
            [environ.core :refer [env]]
            [compojure.core :refer [GET POST defroutes routes context]]
            [compojure.route :refer [resources]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [net.cgrand.reload :refer [auto-reload]]
            [ring.middleware.reload :as reload]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [ring.util.response :as res]
            [ring.middleware.format :refer [wrap-restful-format]]
            [ring.adapter.jetty :refer [run-jetty]])
  (:gen-class))

(deftemplate page (io/resource "index.html") []
  [:body] (if is-dev? inject-devmode-html identity))

(def file-contents (atom {"foo" "foo\nfoo\nfoo"
                          "bar" "bar\nbar\nbar"
                          "baz" "baz\nbaz\nbaz"}))

(defn response [status]
  (fn f
    ([] (f {}))
    ([data]
     (res/response (merge {:status status} data)))))

(def ok (response :ok))
(def fail (response :failure))

(def api-routes
  (-> (routes
       (GET "/filenames" []
            (ok {:names (vec (keys @file-contents))}))
       (GET "/files/:filename" [filename]
            (ok {:content (get @file-contents filename)}))
       (POST "/files/:filename" [filename content]
             (swap! file-contents assoc filename content)
             (ok)))
      (wrap-restful-format :formats [:edn])))

(defroutes app-routes
  (context "/api" [] #'api-routes)
  (GET "/" [] (page))
  (resources "/")
  (resources "/react" {:root "react"}))

(def http-handler
  (if is-dev?
    (reload/wrap-reload (wrap-defaults #'app-routes api-defaults))
    (wrap-defaults app-routes api-defaults)))

(defn run-web-server [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (println (format "Starting web server on port %d." port))
    (run-jetty http-handler {:port port :join? false})))

(defn run-auto-reload [& [port]]
  (auto-reload *ns*)
  (start-figwheel))

(defn run [& [port]]
  (when is-dev?
    (run-auto-reload))
  (run-web-server port))

(defn -main [& [port]]
  (run port))

Implement sever side APIs

Implement sever side APIs


(ns greffe.doc-comps
  (:require
   [om.core :as om :include-macros true]
   [om.dom :as dom :include-macros true]
   [cljs-xml.core :as cx]
   [gmark.core :as gm]
   [gmark.tei-elems :as gmt]
   [greffe.markup :as mk]))

(def tei (gmt/tagtypes mk/markup))

(defn element-attributes-component [attrs owner]
  (reify
    om/IRender
    (render [_]
      (apply dom/ul #js {:className "attributes"}
       (map #(dom/li nil (str (first %) " " (second %))) attrs)))))

(defmulti element-component (fn [el]
                              (let [val (om/value el)]
                               (cond
                                 (string? val)
                                 :text

                                 (and
                                   (contains? val :content)
                                   (contains? val :tag))
                                 (let [el-type (get-in mk/markup [(:tag val) :type])]
                                   (cond
                                     (#{:container :multi-chunk :chunk} el-type)
                                     :elem

                                     (= :inner el-type)
                                     :inner-elem

                                     (= :empty el-type)
                                     :empty-elem))

                                 true
                                 :wtf))))

(defmethod element-component :text [elem owner]
  (reify
    om/IRenderState
    (render-state [_ state]
      (dom/span #js {:className "xml-text-element"} elem))))

(defmethod element-component :elem [elem owner]
  (reify
    om/IInitState
    (init-state [_] {:hoverTimeout nil
                     :showButton false
                     :editText false    ; are we in editing mode?
                     :editContent nil}) ; "cache" for editing content

    om/IRenderState
    (render-state [_ state]
      (dom/div #js {:className (str "xml-" (name (:tag elem)) " tei-block col-md-12")
                    :onMouseEnter
                    (fn [ev]
                      (om/set-state! owner :hoverTimeout
                        (.setTimeout
                          js/window
                          (fn []
                            (.log js/console "show button true")
                            (om/set-state! owner :showButton true))
                          200)))
                    :onMouseLeave
                    (fn [ev]
                      (when-not (om/get-state owner :editText)
                        (.clearTimeout js/window (om/get-state owner :hoverTimeout))
                        (om/set-state! owner :hoverTimeout nil)
                        (om/set-state! owner :showButton false)))}

        (dom/div #js {:className "row"}
         (dom/div #js {:className "block-data col-md-1"}
           (dom/div #js {:className "name"}
             (name (:tag elem)))
           (om/build element-attributes-component (:attrs elem))
           (when (:showButton state)
             (dom/div #js {:className "controls"}
               (let [elem-as-text (gm/to-gmark elem tei)]
                 (dom/a #js {:onClick (fn [ev]
                                        (om/set-state! owner :editContent elem-as-text)
                                        (om/set-state!
                                          owner
                                          :editText
                                          (not (om/get-state owner :editText))))}
                  "Editer"))))
           (when (:editText state)
             (dom/textarea #js {:value (:editContent state)
                                :cols "50" :rows "10"
                             :onChange
                                (fn [ev]
                                  (let [new-val (-> ev .-target .-value)]
                                    (om/set-state! owner :editContent new-val)
                                    (om/transact! elem
                                      (fn [el]
                                        (if-let [new-el
                                                 (gm/parse-gmark-text
                                                   new-val
                                                   mk/inner-tokens
                                                   (assoc el :content []))]
                                          new-el
                                          el)))))})))
         (when (pos? (count (:content elem)))
           (apply dom/div #js {:className "block-contents col-md-10"}
             (om/build-all element-component (:content elem)))))))))

(defmethod element-component :inner-elem [elem owner]
  (reify
    om/IRender
    (render [_]
      (apply dom/span #js {:className (str "xml-" (name (:tag elem)) " tei-inner")}
        (om/build-all element-component (:content elem))))))

(defmethod element-component :empty-elem [elem owner]
  (reify
    om/IRender
    (render [_]
      (dom/span #js {:className (str "xml-" (name (:tag elem)) " tei-empty")}
        " "))))

(defmethod element-component :wtf [elem owner]
  (reify
    om/IRender
    (render [_]
      (.log js/console "WTF?")
      (dom/div nil (str "WTF? " (type (om/value elem)) " " elem)))))

(ns greffe.doc-comps
  (:require
   [om.core :as om :include-macros true]
   [om.dom :as dom :include-macros true]
   [cljs-xml.core :as cx]
   [gmark.core :as gm]
   [gmark.tei-elems :as gmt]
   [greffe.markup :as mk]))

(def tei (gmt/tagtypes mk/markup))

(defn element-attributes-component [attrs owner]
  (reify
    om/IRender
    (render [_]
      (apply dom/ul #js {:className "attributes"}
       (map #(dom/li nil (str (first %) " " (second %))) attrs)))))

(defn dispatch-on-element-type [el]
  (let [val (om/value el)]
    (cond
      (string? val)
      :text

      (and
        (contains? val :content)
        (contains? val :tag))
      (let [el-type (get-in mk/markup [(:tag val) :type])]
        (cond
          (#{:container :multi-chunk :chunk} el-type)
          :elem

          (= :inner el-type)
          :inner-elem

          (= :empty el-type)
          :empty-elem))

      true
      :wtf)))

(defmulti element-component dispatch-on-element-type)

(defmethod element-component :text [elem owner]
  (reify
    om/IRenderState
    (render-state [_ state]
      (dom/span #js {:className "xml-text-element"} elem))))

(defmethod element-component :elem [elem owner]
  (reify
    om/IInitState
    (init-state [_] {:hoverTimeout nil
                     :showButton false
                     :editText false    ; are we in editing mode?
                     :editContent nil}) ; "cache" for editing content

    om/IRenderState
    (render-state [_ state]
      (dom/div #js {:className (str "xml-" (name (:tag elem)) " tei-block col-md-12")
                    :onMouseEnter
                    (fn [ev]
                      (om/set-state! owner :hoverTimeout
                        (.setTimeout
                          js/window
                          (fn []
                            (.log js/console "show button true")
                            (om/set-state! owner :showButton true))
                          200)))
                    :onMouseLeave
                    (fn [ev]
                      (when-not (om/get-state owner :editText)
                        (.clearTimeout js/window (om/get-state owner :hoverTimeout))
                        (om/set-state! owner :hoverTimeout nil)
                        (om/set-state! owner :showButton false)))}

        (dom/div #js {:className "row"}
         (dom/div #js {:className "block-data col-md-1"}
           (dom/div #js {:className "name"}
             (name (:tag elem)))
           (om/build element-attributes-component (:attrs elem))
           (when (:showButton state)
             (dom/div #js {:className "controls"}
               (let [elem-as-text (gm/to-gmark elem tei)]
                 (dom/a #js {:onClick (fn [ev]
                                        (om/set-state! owner :editContent elem-as-text)
                                        (om/set-state!
                                          owner
                                          :editText
                                          (not (om/get-state owner :editText))))}
                  "Editer"))))
           (when (:editText state)
             (dom/textarea #js {:value (:editContent state)
                                :cols "50" :rows "10"
                             :onChange
                                (fn [ev]
                                  (let [new-val (-> ev .-target .-value)]
                                    (om/set-state! owner :editContent new-val)
                                    (om/transact! elem
                                      (fn [el]
                                        (if-let [new-el
                                                 (gm/parse-gmark-text
                                                   new-val
                                                   mk/inner-tokens
                                                   (assoc el :content []))]
                                          new-el
                                          el)))))})))
         (when (pos? (count (:content elem)))
           (apply dom/div #js {:className "block-contents col-md-10"}
             (om/build-all element-component (:content elem)))))))))

(defmethod element-component :inner-elem [elem owner]
  (reify
    om/IRender
    (render [_]
      (apply dom/span #js {:className (str "xml-" (name (:tag elem)) " tei-inner")}
        (om/build-all element-component (:content elem))))))

(defmethod element-component :empty-elem [elem owner]
  (reify
    om/IRender
    (render [_]
      (dom/span #js {:className (str "xml-" (name (:tag elem)) " tei-empty")}
        " "))))

(defmethod element-component :wtf [elem owner]
  (reify
    om/IRender
    (render [_]
      (.log js/console "WTF?")
      (dom/div nil (str "WTF? " (type (om/value elem)) " " elem)))))

break out dispatch function

break out dispatch function


(ns retroboard.client
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [retroboard.config :as config]
            [retroboard.resource :refer [temprid]]
            [cljs.core.async :refer [chan <! put! pub sub unsub]]
            [goog.events :as events]
            [cljs.reader :as reader]
            [clojure.string :refer [split]])
  (:require-macros [retroboard.macros :refer [defactions]]
                   [cljs.core.async.macros :refer [go go-loop]])
  (:import goog.net.WebSocket
           goog.net.WebSocket.EventType))

(enable-console-print!)

(defn web-socket []
  (let [ws (WebSocket.)
        to-send (chan 5)
        incoming (chan 5)]
    (events/listen ws EventType.OPENED
                   (fn [e]
                     (go-loop []
                              (let [msg (pr-str (<! to-send))]
                                (.send ws msg))
                              (recur))))
    (events/listen ws EventType.MESSAGE
                   (fn [e]
                     (let [msg (reader/read-string (.-message e))]
                       (put! incoming msg))))
    (.open ws config/ws-url)
    {:to-send to-send :incoming (pub incoming :cmd) :websocket ws}))

(defn new-environment [{:keys [to-send incoming]}]
  (let [env-chan (chan)
        return-chan (chan)]
    (sub incoming :environment-id env-chan)
    (go
     (let [env-id (:environment-id (<! env-chan))]
       (unsub incoming :environment-id env-chan)
       (>! return-chan env-id)))
    (put! to-send {:cmd :new-environment})
    return-chan))

(defactions apply-action
  (new-column [id header state]
              (assoc state id {:header header :notes {}}))
  (delete-column [id state]
                 state (dissoc state id))
  (new-note [id column-id text state]
            (assoc-in state [column-id :notes id] {:text text :votes #{}}))
  (delete-note [column-id id state]
               (update-in state [column-id :notes] dissoc id))
  (new-vote [id column-id note-id state]
            (update-in state [column-id :notes note-id :votes] conj id))
  (edit-note [id column-id new-text state]
             (assoc-in state [column-id :notes id :text] new-text)))

(defn apply-actions [actions initial-state]
  (reduce (fn [state action]
            ((apply-action action) state))
          initial-state actions))

(defn column-placeholder []
  (str "Add a Column (e.g. "
       (first (shuffle ["What Went Well"
                        "What Needs Improvement"
                        "Action Items"
                        "Keep Doing"
                        "Start Doing"
                        "Stop Doing"]))
       ")"))

(defn create-column-button [connection owner]
  (reify
    om/IInitState
    (init-state [_] {:header ""})
    om/IRenderState
    (render-state [this {:keys [header]}]
      (letfn [(create-column []
                (when (seq header)
                  (new-column (om/value connection) (temprid) header)
                  (om/set-state! owner :header "")))]
        (dom/div #js {:id "create-column"}
                 (dom/input #js {:id "new-column" :name "new-column"
                                 :type "text"
                                 :placeholder (column-placeholder)
                                 :value header
                                 :onKeyUp (fn [e]
                                            (when (= 13 (.-keyCode e))
                                              (create-column)))
                                 :onChange (fn [e]
                                             (om/set-state! owner :header
                                                            (.. e -target -value)))})
                 (dom/span #js {:onClick create-column
                                :className "add-column"
                                :disabled (empty? header)}))))))

(defn display [show]
  (if show
    #js {}
    #js {:display "none"}))

(defn delete-column-button [app owner]
  (reify
    om/IInitState
    (init-state [_] {:deleting-column false})
    om/IRenderState
    (render-state [this {:keys [deleting-column]}]
      (let [{:keys [connection column-id]} app
            begin-delete-column (fn [el]
                             (om/set-state! owner :deleting-column true))
            end-delete-column (fn [el]
                             (om/set-state! owner :deleting-column false))
            delete-column (fn []
                            (delete-column (om/value connection) column-id)
                            (end-delete-column))]
        (dom/div nil
                 (dom/div #js {:onClick begin-delete-column
                               :style (display (not deleting-column))
                               :className "delete-column"}
                          "Delete Column")
                 (dom/div #js {:style (display deleting-column)
                               :className "are-you-sure"}
                          (dom/span nil "Are You Sure?")
                          (dom/div #js {:onClick delete-column
                                        :className "confirm-delete"}
                                   "Yes")
                          (dom/div #js {:onClick end-delete-column
                                        :className "cancel-delete"}
                                   "No")))))))

(defn note-placeholder []
  (first (shuffle ["I just think that..."
                   "What if we..."
                   "Why do we always..."
                   "Maybe next time we could..."
                   "I like that we..."
                   "We're doing better about..."])))

(defn create-note-button [app owner]
  (reify
    om/IInitState
    (init-state [_] {:text ""})
    om/IRenderState
    (render-state [this {:keys [text]}]
      (let [{:keys [connection column-id]} app
            create-note (fn []
                          (when (seq text)
                            (new-note (om/value connection) (temprid) column-id text)
                            (om/set-state! owner :text "")))]
        (dom/div nil
                 (dom/textarea #js {:id "new-note" :name "new-note"
                                    :placeholder (note-placeholder)
                                    :type "text"
                                    :value text
                                    :onKeyUp (fn [e]
                                               (when (= 13 (.-keyCode e))
                                                 (create-note)))
                                    :onChange (fn [e]
                                                (om/set-state! owner :text
                                                               (.. e -target -value)))})
                 (dom/div #js {:onClick create-note
                               :className "add-note"
                               :disabled (empty? text)}
                          "Add note"))))))

(defn delete-note-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note-id]} app
            delete-note (fn []
                          (delete-note (om/value connection) column-id note-id))]
        (dom/div #js {:onClick delete-note
                         :className "delete-note"}
                    "✖")))))

(defn create-vote-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note-id]} app
            create-vote (fn []
                          (new-vote (om/value connection) (temprid) column-id note-id))]
        (dom/div #js {:onClick create-vote
                         :className "vote"}
                    "✚")))))

(defn change-env [env-id]
  (set! (.-pathname js/location) (str "e/" env-id)))

(defn create-environment-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection]} app
            create-env (fn []
                         (go
                          (let [env-id (<! (new-environment @connection))]
                            (change-env env-id))))]
        (dom/button #js {:onClick create-env
                         :className "new-environment"}
                    "New Environment")))))

(defn handle-change [e data edit-key owner]
  (om/transact! data edit-key (fn [_] (.. e -target -value))))

(defn end-edit [text owner cb]
  (om/set-state! owner :editing false)
  (cb text))

(defn focus-and-set-cursor [textarea]
  (let [val (.-value textarea)]
    (.focus textarea)
    (set! (.-value textarea) "")
    (set! (.-value textarea) val)))

(defn editable [data owner {:keys [edit-key on-edit] :as opts}]
  (reify
    om/IInitState
    (init-state [_]
      {:editing false})
    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (when (and (om/get-state owner :editing)
                 (not (:editing prev-state)))
        (focus-and-set-cursor (om/get-node owner "input"))))
    om/IRenderState
    (render-state [_ {:keys [editing]}]
      (let [text (get data edit-key)]
        (dom/div #js {:className "note-content"}
                (dom/p #js {:style (display (not editing))
                            :onClick (fn [el] (om/set-state! owner :editing true))}
                          text)
                (dom/textarea
                 #js {:className "edit-content-input"
                      :style (display editing)
                      :value text
                      :ref "input"
                      :onChange #(handle-change % data edit-key owner)
                      :onKeyDown #(case (.-keyCode %)
                                    13 (end-edit text owner on-edit)
                                    nil)
                      :onBlur (fn [e]
                                (when (om/get-state owner :editing)
                                  (end-edit text owner on-edit)))})
                (dom/div
                 #js {:className "edit-note-button"
                      :style (display (not editing))
                      :onClick #(om/set-state! owner :editing true)}
                 "Edit"))))))

(defn note-view [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note]} app
            [id note] note]
        (dom/div #js {:className "note-wrapper"}
                 (dom/div {:className "note"}
                          (om/build editable note
                                    {:opts {:edit-key :text
                                            :on-edit (partial edit-note connection id column-id)}}))
                 (dom/div #js {:className "vote-delete-row"}
                          (om/build create-vote-button {:connection connection
                                                        :column-id column-id
                                                        :note-id id})
                          (dom/div #js {:className "votes"}
                                   "+ " (count (:votes note)))
                          (om/build delete-note-button {:connection connection
                                                        :column-id column-id
                                                        :note-id id})))))))

(defn column-view [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column]} app
            [id column] column]
        (dom/div #js {:className "column"}
                 (dom/h1 nil (:header column))
                 (om/build create-note-button {:connection connection
                                               :column-id id})
                 (apply dom/div nil
                        (map (fn [note] (om/build note-view {:connection connection
                                                            :column-id id
                                                            :note note}))
                             (sort-by first > (:notes column))))
                 (om/build create-note-button {:connection connection
                                               :column-id id}))))))

(defn error-handler [app]
  (let [error-chan (chan)]
    (sub (get-in app [:connection :incoming]) :error error-chan)
    (go-loop []
             (let [error (:error (<! error-chan))]
               (case error
                 :no-such-environment (om/update! app :connected :no-such-environment))))))

(defn view [app owner]
  (reify
    om/IInitState
    (init-state [_] {})
    om/IWillMount
    (will-mount [_]
      (let [action-chan (chan)]
        (error-handler app)
        (if (:id app)
          (put! (get-in (if (om/rendering?) app @app) [:connection :to-send])
                {:cmd :register :action (:id app)}))
        (sub (get-in app [:connection :incoming]) :cmds action-chan)
        (go-loop []
                 (let [actions (:commands (<! action-chan))]
                   (om/update! app :connected :connected)
                   (om/transact! app :state (partial apply-actions actions))
                   (recur)))))
    om/IRenderState
    (render-state [this state]
      (let [connection (om/value (:connection app))
            columns (:state app)]
        (dom/div nil
                 (if (:id app)
                   (case (:connected app)
                     nil
                     (dom/h3 nil "Connecting...")
                     :no-such-environment
                     (dom/h3 nil "Sorry. That environment doesn't exist. Why not make a new one?")
                     :connected
                     (dom/div #js {:className "board"}
                              (om/build create-column-button (:connection app))
                              (apply dom/div #js {:id "columns"}
                                     (map (fn [col]
                                            (om/build column-view {:connection connection
                                                                   :column col}))
                                          (sort-by first columns)))))
                   (dom/div nil
                            (om/build create-environment-button app))))))))

(def app-state (atom {:state {} :connection (web-socket)}))

(defn get-env-id []
  (let [pathname (.-pathname js/location)
        env-id (second (re-find #"e/([0-9]+)" pathname))]
    (if env-id
      (js/parseInt env-id)
      nil)))

(defn setup! []
  (swap! app-state assoc :id (get-env-id))
  (om/root
   view
   app-state
   {:target (. js/document (getElementById "retroboard"))}))

(set! (.-onload js/window) setup!)

(ns retroboard.client
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [retroboard.config :as config]
            [retroboard.resource :refer [temprid]]
            [cljs.core.async :refer [chan <! put! pub sub unsub]]
            [goog.events :as events]
            [cljs.reader :as reader]
            [clojure.string :refer [split]])
  (:require-macros [retroboard.macros :refer [defactions]]
                   [cljs.core.async.macros :refer [go go-loop]])
  (:import goog.net.WebSocket
           goog.net.WebSocket.EventType))

(enable-console-print!)

(defn web-socket []
  (let [ws (WebSocket.)
        to-send (chan 5)
        incoming (chan 5)]
    (events/listen ws EventType.OPENED
                   (fn [e]
                     (go-loop []
                              (let [msg (pr-str (<! to-send))]
                                (.send ws msg))
                              (recur))))
    (events/listen ws EventType.MESSAGE
                   (fn [e]
                     (let [msg (reader/read-string (.-message e))]
                       (put! incoming msg))))
    (.open ws config/ws-url)
    {:to-send to-send :incoming (pub incoming :cmd) :websocket ws}))

(defn new-environment [{:keys [to-send incoming]}]
  (let [env-chan (chan)
        return-chan (chan)]
    (sub incoming :environment-id env-chan)
    (go
     (let [env-id (:environment-id (<! env-chan))]
       (unsub incoming :environment-id env-chan)
       (>! return-chan env-id)))
    (put! to-send {:cmd :new-environment})
    return-chan))

(defactions apply-action
  (new-column [id header state]
              (assoc state id {:header header :notes {}}))
  (delete-column [id state]
                 state (dissoc state id))
  (new-note [id column-id text state]
            (assoc-in state [column-id :notes id] {:text text :votes #{}}))
  (delete-note [column-id id state]
               (update-in state [column-id :notes] dissoc id))
  (new-vote [id column-id note-id state]
            (update-in state [column-id :notes note-id :votes] conj id))
  (edit-note [id column-id new-text state]
             (assoc-in state [column-id :notes id :text] new-text)))

(defn apply-actions [actions initial-state]
  (reduce (fn [state action]
            ((apply-action action) state))
          initial-state actions))

(defn column-placeholder []
  (str "Add a Column (e.g. "
       (first (shuffle ["What Went Well"
                        "What Needs Improvement"
                        "Action Items"
                        "Keep Doing"
                        "Start Doing"
                        "Stop Doing"]))
       ")"))

(defn create-column-button [connection owner]
  (reify
    om/IInitState
    (init-state [_] {:header ""})
    om/IRenderState
    (render-state [this {:keys [header]}]
      (letfn [(create-column []
                (when (seq header)
                  (new-column (om/value connection) (temprid) header)
                  (om/set-state! owner :header "")))]
        (dom/div #js {:id "create-column"}
                 (dom/input #js {:id "new-column" :name "new-column"
                                 :type "text"
                                 :placeholder (column-placeholder)
                                 :value header
                                 :onKeyUp (fn [e]
                                            (when (= 13 (.-keyCode e))
                                              (create-column)))
                                 :onChange (fn [e]
                                             (om/set-state! owner :header
                                                            (.. e -target -value)))})
                 (dom/span #js {:onClick create-column
                                :className "add-column"
                                :disabled (empty? header)}))))))

(defn display [show]
  (if show
    #js {}
    #js {:display "none"}))

(defn delete-column-button [app owner]
  (reify
    om/IInitState
    (init-state [_] {:deleting-column false})
    om/IRenderState
    (render-state [this {:keys [deleting-column]}]
      (let [{:keys [connection column-id]} app
            begin-delete-column (fn []
                             (om/set-state! owner :deleting-column true))
            end-delete-column (fn []
                             (om/set-state! owner :deleting-column false))
            delete-column (fn []
                            (delete-column (om/value connection) column-id)
                            (end-delete-column))]
        (dom/div nil
                 (dom/div #js {:onClick begin-delete-column
                               :style (display (not deleting-column))
                               :className "delete-column"}
                          "Delete Column")
                 (dom/div #js {:style (display deleting-column)
                               :className "are-you-sure"}
                          (dom/span nil "Are You Sure?")
                          (dom/div #js {:onClick delete-column
                                        :className "confirm-delete"}
                                   "Yes")
                          (dom/div #js {:onClick end-delete-column
                                        :className "cancel-delete"}
                                   "No")))))))

(defn note-placeholder []
  (first (shuffle ["I just think that..."
                   "What if we..."
                   "Why do we always..."
                   "Maybe next time we could..."
                   "I like that we..."
                   "We're doing better about..."])))

(defn create-note-button [app owner]
  (reify
    om/IInitState
    (init-state [_] {:text ""})
    om/IRenderState
    (render-state [this {:keys [text]}]
      (let [{:keys [connection column-id]} app
            create-note (fn []
                          (when (seq text)
                            (new-note (om/value connection) (temprid) column-id text)
                            (om/set-state! owner :text "")))]
        (dom/div nil
                 (dom/textarea #js {:id "new-note" :name "new-note"
                                    :placeholder (note-placeholder)
                                    :type "text"
                                    :value text
                                    :onKeyUp (fn [e]
                                               (when (= 13 (.-keyCode e))
                                                 (create-note)))
                                    :onChange (fn [e]
                                                (om/set-state! owner :text
                                                               (.. e -target -value)))})
                 (dom/div #js {:onClick create-note
                               :className "add-note"
                               :disabled (empty? text)}
                          "Add note"))))))

(defn delete-note-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note-id]} app
            delete-note (fn []
                          (delete-note (om/value connection) column-id note-id))]
        (dom/div #js {:onClick delete-note
                         :className "delete-note"}
                    "✖")))))

(defn create-vote-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note-id]} app
            create-vote (fn []
                          (new-vote (om/value connection) (temprid) column-id note-id))]
        (dom/div #js {:onClick create-vote
                         :className "vote"}
                    "✚")))))

(defn change-env [env-id]
  (set! (.-pathname js/location) (str "e/" env-id)))

(defn create-environment-button [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection]} app
            create-env (fn []
                         (go
                          (let [env-id (<! (new-environment @connection))]
                            (change-env env-id))))]
        (dom/button #js {:onClick create-env
                         :className "new-environment"}
                    "New Environment")))))

(defn handle-change [e data edit-key owner]
  (om/transact! data edit-key (fn [_] (.. e -target -value))))

(defn end-edit [text owner cb]
  (om/set-state! owner :editing false)
  (cb text))

(defn focus-and-set-cursor [textarea]
  (let [val (.-value textarea)]
    (.focus textarea)
    (set! (.-value textarea) "")
    (set! (.-value textarea) val)))

(defn editable [data owner {:keys [edit-key on-edit] :as opts}]
  (reify
    om/IInitState
    (init-state [_]
      {:editing false})
    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (when (and (om/get-state owner :editing)
                 (not (:editing prev-state)))
        (focus-and-set-cursor (om/get-node owner "input"))))
    om/IRenderState
    (render-state [_ {:keys [editing]}]
      (let [text (get data edit-key)]
        (dom/div #js {:className "note-content"}
                (dom/p #js {:style (display (not editing))
                            :onClick (fn [el] (om/set-state! owner :editing true))}
                          text)
                (dom/textarea
                 #js {:className "edit-content-input"
                      :style (display editing)
                      :value text
                      :ref "input"
                      :onChange #(handle-change % data edit-key owner)
                      :onKeyDown #(case (.-keyCode %)
                                    13 (end-edit text owner on-edit)
                                    nil)
                      :onBlur (fn [e]
                                (when (om/get-state owner :editing)
                                  (end-edit text owner on-edit)))})
                (dom/div
                 #js {:className "edit-note-button"
                      :style (display (not editing))
                      :onClick #(om/set-state! owner :editing true)}
                 "Edit"))))))

(defn note-view [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column-id note]} app
            [id note] note]
        (dom/div #js {:className "note-wrapper"}
                 (dom/div {:className "note"}
                          (om/build editable note
                                    {:opts {:edit-key :text
                                            :on-edit (partial edit-note connection id column-id)}}))
                 (dom/div #js {:className "vote-delete-row"}
                          (om/build create-vote-button {:connection connection
                                                        :column-id column-id
                                                        :note-id id})
                          (dom/div #js {:className "votes"}
                                   "+ " (count (:votes note)))
                          (om/build delete-note-button {:connection connection
                                                        :column-id column-id
                                                        :note-id id})))))))

(defn column-view [app owner]
  (reify
    om/IRender
    (render [_]
      (let [{:keys [connection column]} app
            [id column] column]
        (dom/div #js {:className "column"}
                 (dom/h1 nil (:header column))
                 (om/build create-note-button {:connection connection
                                               :column-id id})
                 (apply dom/div nil
                        (map (fn [note] (om/build note-view {:connection connection
                                                            :column-id id
                                                            :note note}))
                             (sort-by first > (:notes column))))
                 (om/build create-note-button {:connection connection
                                               :column-id id}))))))

(defn error-handler [app]
  (let [error-chan (chan)]
    (sub (get-in app [:connection :incoming]) :error error-chan)
    (go-loop []
             (let [error (:error (<! error-chan))]
               (case error
                 :no-such-environment (om/update! app :connected :no-such-environment))))))

(defn view [app owner]
  (reify
    om/IInitState
    (init-state [_] {})
    om/IWillMount
    (will-mount [_]
      (let [action-chan (chan)]
        (error-handler app)
        (if (:id app)
          (put! (get-in (if (om/rendering?) app @app) [:connection :to-send])
                {:cmd :register :action (:id app)}))
        (sub (get-in app [:connection :incoming]) :cmds action-chan)
        (go-loop []
                 (let [actions (:commands (<! action-chan))]
                   (om/update! app :connected :connected)
                   (om/transact! app :state (partial apply-actions actions))
                   (recur)))))
    om/IRenderState
    (render-state [this state]
      (let [connection (om/value (:connection app))
            columns (:state app)]
        (dom/div nil
                 (if (:id app)
                   (case (:connected app)
                     nil
                     (dom/h3 nil "Connecting...")
                     :no-such-environment
                     (dom/h3 nil "Sorry. That environment doesn't exist. Why not make a new one?")
                     :connected
                     (dom/div #js {:className "board"}
                              (om/build create-column-button (:connection app))
                              (apply dom/div #js {:id "columns"}
                                     (map (fn [col]
                                            (om/build column-view {:connection connection
                                                                   :column col}))
                                          (sort-by first columns)))))
                   (dom/div nil
                            (om/build create-environment-button app))))))))

(def app-state (atom {:state {} :connection (web-socket)}))

(defn get-env-id []
  (let [pathname (.-pathname js/location)
        env-id (second (re-find #"e/([0-9]+)" pathname))]
    (if env-id
      (js/parseInt env-id)
      nil)))

(defn setup! []
  (swap! app-state assoc :id (get-env-id))
  (om/root
   view
   app-state
   {:target (. js/document (getElementById "retroboard"))}))

(set! (.-onload js/window) setup!)

remove extra args

[WR] remove extra args