(ns useful)

(defmacro assoc-if
  "Create mapping from keys to values in map if test returns true."
  [map test & kvs]
  (let [assoc (cons 'assoc (cons map kvs))]
    `(if ~test
       ~assoc
       ~map)))

(defn assoc-or
  "Create mapping from each key to val in map only if existing val is nil."
  ([map key val]
     (if (nil? (map key))
       (assoc map key val)
       map))
  ([map key val & kvs]
     (let [map (assoc-or map key val)]
       (if kvs
         (recur map (first kvs) (second kvs) (nnext kvs))
         map))))

(defn conj-vec
  "Conj onto collection ensuring it is a vector."
  [coll item]
  (conj (vec coll) item))

(defn conj-set
  "Conj onto collection ensuring it is a set."
  [coll item]
  (conj (set coll) item))

(defn into-vec
  "Returns a new vector consisting of to-coll with all of the items of from-coll conjoined."
  [to-coll from-coll]
  (into (vec to-coll) from-coll))

(defn include?
  "Check if val exists in coll."
  [val coll]
  (some (partial = val) coll))

(defn extract
  "Extracts the first item that matches pred from coll, returning a vector of that item
   followed by coll with the items removed."
  [pred coll]
  (loop [head ()
         tail (seq coll)]
    (let [item (first tail)
          tail (next tail)]
      (if (or (nil? tail) (pred item))
        [item (into tail head)]
        (recur (conj head item) tail)))))

(defn separate
  "Split coll into two sequences, one that matches pred and one that doesn't. Unlike, the
  version in clojure.contrib.seq-utils, this is not lazy, but pred is only called once per item."
  [pred coll]
  (loop [tail (seq coll)
         yes () no ()]
    (if (nil? tail)
      [(reverse yes) (reverse no)]
      (let [item (first tail)
            tail (next tail)]
        (if (pred item)
          (recur tail (conj yes item) no)
          (recur tail yes (conj no item)))))))

(defmacro if-ns [ns-reference then-form & [else-form]]
  "Try to load a namespace reference. If sucessful, evaluate then-form otherwise evaluate else-form."
  `(try (ns ~(ns-name *ns*) ~ns-reference)
        (eval '~then-form)
        (catch Exception e#
          (when (not (instance? java.io.FileNotFoundException e#))
            (println "Error loading" '~ns-reference (.getMessage e#)))
          (eval '~else-form))))

(defn tap
  "Call f on obj, presumably with side effects, then return obj. Useful for debugging when
   you want to print an object inline. e.g. (tap println foo)"
  [f obj]
  (f obj)
  obj)

(defn update
  "Update value in map where f is a function that takes the old value and the
   supplied args and returns the new value."
  [map key f & args]
  (if (sequential? key)
    (reduce #(apply update %1 %2 f args) map key)
    (let [old (get map key)
          new (apply f old args)]
      (if (= old new) map (assoc map key new)))))

(defn append
  "Merge two data structures by combining the contents. For maps, merge recursively by
  appending values with the same key. For collections, combine the right and left using
  into or conj. If the left value is a set and the right value is a map, the right value
  is assumed to be an existence map where the value determines whether the key is in the
  merged set. This makes sets unique from other collections because items can be deleted
  from them."
  [left right]
  (cond (map? left)
        (merge-with append left right)

        (and (set? left) (map? right))
        (reduce (fn [set [k v]] ((if v conj disj) set k))
                left right)

        (coll? left)
        ((if (coll? right) into conj) left right)

        :else right))

(defn merge-in
  "Merge two nested maps."
  [left right]
  (if (map? left)
    (merge-with merge-in left right)
    right))

(defmacro while-let
  "Repeatedly executes body while let binding is true."
  [bindings & body]
  (let [[form test] bindings]
    `(loop [~form ~test]
       (when ~form
         ~@body
         (recur ~test)))))

(defn queue
  "Create an empty persistent queue or a persistent queue from a sequence."
  ([]    clojure.lang.PersistentQueue/EMPTY)
  ([seq] (into (queue) seq)))

(defmacro absorb
  "Thread val through form if val is not nil."
  [val form]
  `(let [v# ~val]
     (when-not (nil? v#)
       (-> v# ~form))))

(defn abort
  "Print message then exit."
  [& message]
  (apply println message)
  (System/exit 1))

(defmacro rescue
  "Evaluate form, returning error-form on any Exception."
  [form error-form]
  `(try ~form (catch Exception e# ~error-form)))

(defmacro verify
  "Raise exception unless test returns true."
  [test exception]
  (when *assert*
    `(when-not ~test
       (throw (if (string? ~exception)
                (AssertionError. ~exception)
                ~exception)))))

(defn trap
  "Register signal handling function."
  [signal f]
  (sun.misc.Signal/handle
   (sun.misc.Signal. signal)
   (proxy [sun.misc.SignalHandler] []
     (handle [sig] (f sig)))))

(defmacro defm [name & fdecl]
  "Define a function with memoization. Takes the same arguments as defn."
  `(let [var (defn ~name ~@fdecl)]
     (alter-var-root var (fn [f#] (with-meta (memoize f#) (meta f#))))
     var))

(defmacro cond-let
  "An implementation of cond-let that is as similar as possible to if-let. Takes multiple
   test-binding/then-form pairs and evalutes the form if the binding is true. Also supports
   :else in the place of test-binding and always evaluates the form in that case.

   Example:
   (cond-let [b (bar 1 2 3)] (println :bar b)
             [f (foo 3 4 5)] (println :foo f)
             [b (baz 6 7 8)] (println :baz b)
             :else           (println :no-luck))"
  [test-binding then-form & more]
  (let [test-binding (if (= :else test-binding) `[t# true] test-binding)
        else-form    (when (seq more) `(cond-let ~@more))]
    `(if-let ~test-binding
       ~then-form
       ~else-form)))

(defn zip
  "Returns a lazy sequence of vectors of corresponding items from each collection.
   Stops when the shortest collection runs out."
  [& colls]
  (partition
   (count colls)
   (apply interleave colls)))

(defn find-with
  "Returns the val corresponding to the first key where (pred key) returns true."
  [pred keys vals]
  (last (first (filter (comp pred first) (zip keys vals)))))

(defn filter-keys-by-val
  "Returns a keys of map for which (pred value) returns true."
  [pred map]
  (if map
    (for [[key val] map :when (pred val)] key)))

(defn remove-keys-by-val
  "Returns a keys of map for which (pred value) returns false."
  [pred map]
  (filter-keys-by-val (complement pred) map))

(defn filter-vals
  "Returns a map that only contains values where (pred value) returns true."
  [pred map]
  (if map
    (select-keys map (filter-keys-by-val pred map))))

(defn remove-vals
  "Returns a map that only contains values where (pred value) returns false."
  [pred map]
  (filter-vals (complement pred) map))

(defn any
  "Takes a list of predicates and returns a new predicate that returns true if any do."
  [& preds]
  (fn [& args]
    (some #(apply % args) preds)))

(defn all
  "Takes a list of predicates and returns a new predicate that returns true if all do."
  [& preds]
  (fn [& args]
    (every? #(apply % args) preds)))

(defn slice
  "Divide coll into n approximately equal slices."
  [n coll]
  (loop [num n, slices [], items (vec coll)]
    (if (empty? items)
      slices
      (let [size (Math/ceil (/ (count items) num))]
        (recur (dec num) (conj slices (subvec items 0 size)) (subvec items size))))))

(defn pcollect
  "Like pmap but not lazy and more efficient for less computationally intensive functions
   because there is less coordination overhead. The collection is sliced among the
   available processors and f is applied to each sub-collection in parallel using map."
  [f coll]
  (let [n (.. Runtime getRuntime availableProcessors)]
    (mapcat #(deref %)
            (map #(future (map f %)) (slice n coll)))))

(defn assoc-in!
  "Associates a value in a nested associative structure, where ks is a sequence of keys
  and v is the new value and returns a new nested structure. The associative structure
  can have transients in it, but if any levels do not exist, non-transient hash-maps will
  be created."
  [m [k & ks :as keys] v]
  (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)]
    (if ks
      (assoc m k (assoc-in! (get m k) ks v))
      (assoc m k v))))

(defn update-in!
  "'Updates' a value in a nested associative structure, where ks is a sequence of keys and
  f is a function that will take the old value and any supplied args and return the new
  value, and returns a new nested structure. The associative structure can have transients
  in it, but if any levels do not exist, non-transient hash-maps will be created."
  [m [k & ks] f & args]
  (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)]
    (if ks
      (assoc m k (apply update-in! (get m k) ks f args))
      (assoc m k (apply f (get m k) args)))))

(defn thrush
  "Takes the first argument and applies the remaining arguments to it as functions from left to right.
   This tiny implementation was written by Chris Houser. http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux"
  [& args]
  (reduce #(%2 %1) args))

(defn comp-partial
  "Like comp, except all args but the last are passed to every function with the last arg threaded through
   these partial functions. So, the rightmost fn is applied to all arguments. Each fn is then applied to the
   original args with the last arg replaced by the result of the previous fn."
  [& fns]
  (fn [& args]
    (let [f (apply comp (map #(apply partial % (butlast args)) fns))]
      (f (last args)))))

(defn into-map
  "Convert a list of heterogeneous args into a map. Args can be alternating keys and values,
   maps of keys to values or collections of alternating keys and values."
  [& args]
  (loop [args args map {}]
    (if (empty? args)
      map
      (let [arg  (first args)
            args (rest args)]
       (cond
         (nil?  arg) (recur args map)
         (map?  arg) (recur args (merge map arg))
         (coll? arg) (recur (into args (reverse arg)) map)
         :else       (recur (rest args) (assoc map arg (first args))))))))

(defn pluralize
  "Return a pluralized phrase, appending an s to the singular form if no plural is provided.
   For example:
     (plural 5 \"month\") => \"5 months\"
     (plural 1 \"month\") => \"1 month\"
     (plural 1 \"radius\" \"radii\") => \"1 radius\"
     (plural 9 \"radius\" \"radii\") => \"9 radii\""
  [num singular & [plural]]
  (let [plural (or plural (str singular "s"))]
    (str num " " (if (= 1 num) singular plural))))

(defn construct
  "Construct a new instance of class using reflection."
  [class & args]
  (clojure.lang.Reflector/invokeConstructor class (into-array Object args)))

(defn invoke-private
  "Invoke a private or protected Java method. Be very careful when using this!
   I take no responsibility for the trouble you get yourself into."
  [instance method & params]
  (let [signature (into-array Class (map class params))]
    (when-let [method (first (remove nil? (for [c (ancestors (.getClass instance))]
                                            (try (.getDeclaredMethod c method signature)
                                                 (catch NoSuchMethodException e)))))]
      (let [accessible (.isAccessible method)]
        (.setAccessible method true)
        (let [result (.invoke method instance (into-array params))]
          (.setAccessible method false)
          result)))))

(defn- parse-opt [default opts arg]
  (let [m re-matches, key (comp keyword str)]
    (cond-let
     [[_ ks]  (m #"-(\w+)"           arg)] (apply merge-with into-vec opts (for [k ks] {(key k) [""]}))
     [[_ k v] (m #"--?([-\w]+)=(.+)" arg)] (update opts (key k) into-vec (.split #"," v))
     [[_ k]   (m #"--?([-\w]+)"      arg)] (update opts (key k) conj-vec "")
     :else                                 (update opts default conj-vec arg))))

(defn parse-opts
  "Parse command line args or the provided argument list. Returns a map of keys to
   vectors of repeated values. Named args begin with --keyname and are mapped to
   :keyname. Unnamed arguments are mapped to nil or default. Repeated named values can be
   specified by repeating a key or by using commas in the value. Single and double dashes
   are both supported though a single dash followed by word characters without internal
   dashes or an equal sign is assumed to be single character argument flags and are split
   accordingly.

   Example:
     (parse-opts [\"foo\" \"-vD\" \"bar\" \"-no-wrap\" \"-color=blue,green\" \"--style=baroque\" \"-color=red\"])
     => {:style [\"baroque\"], :color [\"blue\" \"green\" \"red\"], :no-wrap [\"\"], :D [\"\"], :v [\"\"], nil [\"foo\" \"bar\"]}"
  ([] (parse-opts nil *command-line-args*))
  ([args] (parse-opts nil args))
  ([default args] (reduce (partial parse-opt default) {} args)))

(ns useful)

(defmacro assoc-if
  "Create mapping from keys to values in map if test returns true."
  [map test & kvs]
  (let [assoc (cons 'assoc (cons map kvs))]
    `(if ~test
       ~assoc
       ~map)))

(defn assoc-or
  "Create mapping from each key to val in map only if existing val is nil."
  ([map key val]
     (if (nil? (map key))
       (assoc map key val)
       map))
  ([map key val & kvs]
     (let [map (assoc-or map key val)]
       (if kvs
         (recur map (first kvs) (second kvs) (nnext kvs))
         map))))

(defn conj-vec
  "Conj onto collection ensuring it is a vector."
  [coll item]
  (conj (vec coll) item))

(defn conj-set
  "Conj onto collection ensuring it is a set."
  [coll item]
  (conj (set coll) item))

(defn into-vec
  "Returns a new vector consisting of to-coll with all of the items of from-coll conjoined."
  [to-coll from-coll]
  (into (vec to-coll) from-coll))

(defn include?
  "Check if val exists in coll."
  [val coll]
  (some #{val} coll))

(defn extract
  "Extracts the first item that matches pred from coll, returning a vector of that item
   followed by coll with the items removed."
  [pred coll]
  (let [[head [item & tail]] (split-with (complement pred) coll)]
    [item (concat head tail)]))

(defn separate
  "Split coll into two sequences, one that matches pred and one that doesn't. Unlike, the
  version in clojure.contrib.seq-utils, this is not lazy, but pred is only called once per item."
  [pred coll]
  (reduce (fn [[yes no] item]
            (if (pred item)
              [(conj yes item) no]
              [yes (conj no item)]))
          [[] []]
          coll))

(defmacro if-ns [ns-reference then-form & [else-form]]
  "Try to load a namespace reference. If successful, evaluate then-form otherwise evaluate else-form."
  `(try (ns ~(ns-name *ns*) ~ns-reference)
        (eval '~then-form)
        (catch Exception e#
          (when-not (instance? java.io.FileNotFoundException e#)
            (println "Error loading" '~ns-reference (.getMessage e#)))
          (eval '~else-form))))

(defn tap
  "Call f on obj, presumably with side effects, then return obj. Useful for debugging when
   you want to print an object inline. e.g. (tap println foo)"
  [f obj]
  (f obj)
  obj)

(defn update
  "Update value in map where f is a function that takes the old value and the
   supplied args and returns the new value."
  [map key f & args]
  (if (sequential? key)
    (reduce #(apply update %1 %2 f args) map key)
    (let [old (get map key)
          new (apply f old args)]
      (if (= old new) map (assoc map key new)))))

(defn append
  "Merge two data structures by combining the contents. For maps, merge recursively by
  appending values with the same key. For collections, combine the right and left using
  into or conj. If the left value is a set and the right value is a map, the right value
  is assumed to be an existence map where the value determines whether the key is in the
  merged set. This makes sets unique from other collections because items can be deleted
  from them."
  [left right]
  (cond (map? left)
        (merge-with append left right)

        (and (set? left) (map? right))
        (reduce (fn [set [k v]] ((if v conj disj) set k))
                left right)

        (coll? left)
        ((if (coll? right) into conj) left right)

        :else right))

(defn merge-in
  "Merge two nested maps."
  [left right]
  (if (map? left)
    (merge-with merge-in left right)
    right))

(defmacro while-let
  "Repeatedly executes body while let binding is true."
  [bindings & body]
  (let [[form test] bindings]
    `(loop [~form ~test]
       (when ~form
         ~@body
         (recur ~test)))))

(defn queue
  "Create an empty persistent queue or a persistent queue from a sequence."
  ([]    clojure.lang.PersistentQueue/EMPTY)
  ([seq] (into (queue) seq)))

(defmacro absorb
  "Thread val through form if val is not nil."
  [val form]
  `(let [v# ~val]
     (when-not (nil? v#)
       (-> v# ~form))))

(defn abort
  "Print message then exit."
  [& message]
  (apply println message)
  (System/exit 1))

(defmacro rescue
  "Evaluate form, returning error-form on any Exception."
  [form error-form]
  `(try ~form (catch Exception e# ~error-form)))

(defmacro verify
  "Raise exception unless test returns true."
  [test exception]
  (when *assert*
    `(when-not ~test
       (throw (if (string? ~exception)
                (AssertionError. ~exception)
                ~exception)))))

(defn trap
  "Register signal handling function."
  [signal f]
  (sun.misc.Signal/handle
   (sun.misc.Signal. signal)
   (proxy [sun.misc.SignalHandler] []
     (handle [sig] (f sig)))))

(defmacro defm [name & fdecl]
  "Define a function with memoization. Takes the same arguments as defn."
  `(let [var (defn ~name ~@fdecl)]
     (alter-var-root var (fn [f#] (with-meta (memoize f#) (meta f#))))
     var))

(defmacro cond-let
  "An implementation of cond-let that is as similar as possible to if-let. Takes multiple
   test-binding/then-form pairs and evalutes the form if the binding is true. Also supports
   :else in the place of test-binding and always evaluates the form in that case.

   Example:
   (cond-let [b (bar 1 2 3)] (println :bar b)
             [f (foo 3 4 5)] (println :foo f)
             [b (baz 6 7 8)] (println :baz b)
             :else           (println :no-luck))"
  [test-binding then-form & more]
  (let [test-binding (if (= :else test-binding) `[t# true] test-binding)
        else-form    (when (seq more) `(cond-let ~@more))]
    `(if-let ~test-binding
       ~then-form
       ~else-form)))

(defn zip
  "Returns a lazy sequence of vectors of corresponding items from each collection.
   Stops when the shortest collection runs out."
  [& colls]
  (apply map vector colls))

(defn find-with
  "Returns the val corresponding to the first key where (pred key) returns true."
  [pred keys vals]
  (last (first (filter (comp pred first) (zip keys vals)))))

(defn filter-keys-by-val
  "Returns all keys in map for which (pred value) returns true."
  [pred map]
  (when map
    (for [[key val] map :when (pred val)] key)))

(defn remove-keys-by-val
  "Returns a keys of map for which (pred value) returns false."
  [pred map]
  (filter-keys-by-val (complement pred) map))

(defn filter-vals
  "Returns a map that only contains values where (pred value) returns true."
  [pred map]
  (when map
    (select-keys map (filter-keys-by-val pred map))))

(defn remove-vals
  "Returns a map that only contains values where (pred value) returns false."
  [pred map]
  (filter-vals (complement pred) map))

(defn any
  "Takes a list of predicates and returns a new predicate that returns true if any do."
  [& preds]
  (fn [& args]
    (some #(apply % args) preds)))

(defn all
  "Takes a list of predicates and returns a new predicate that returns true if all do."
  [& preds]
  (fn [& args]
    (every? #(apply % args) preds)))

(defn slice
  "Divide coll into n approximately equal slices."
  [n coll]
  (loop [num n, slices [], items (vec coll)]
    (if (empty? items)
      slices
      (let [size (Math/ceil (/ (count items) num))]
        (recur (dec num) (conj slices (subvec items 0 size)) (subvec items size))))))

(defn pcollect
  "Like pmap but not lazy and more efficient for less computationally intensive functions
   because there is less coordination overhead. The collection is sliced among the
   available processors and f is applied to each sub-collection in parallel using map."
  [f coll]
  (let [n (.. Runtime getRuntime availableProcessors)]
    (mapcat #(deref %)
            (map #(future (map f %)) (slice n coll)))))

(defn assoc-in!
  "Associates a value in a nested associative structure, where ks is a sequence of keys
  and v is the new value and returns a new nested structure. The associative structure
  can have transients in it, but if any levels do not exist, non-transient hash-maps will
  be created."
  [m [k & ks] v]
  (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)]
    (if ks
      (assoc m k (assoc-in! (get m k) ks v))
      (assoc m k v))))

(defn update-in!
  "'Updates' a value in a nested associative structure, where ks is a sequence of keys and
  f is a function that will take the old value and any supplied args and return the new
  value, and returns a new nested structure. The associative structure can have transients
  in it, but if any levels do not exist, non-transient hash-maps will be created."
  [m [k & ks] f & args]
  (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)]
    (if ks
      (assoc m k (apply update-in! (get m k) ks f args))
      (assoc m k (apply f (get m k) args)))))

(defn thrush
  "Takes the first argument and applies the remaining arguments to it as functions from left to right.
   This tiny implementation was written by Chris Houser. http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux"
  [& args]
  (reduce #(%2 %1) args))

(defn comp-partial
  "Like comp, except all args but the last are passed to every function with the last arg threaded through
   these partial functions. So, the rightmost fn is applied to all arguments. Each fn is then applied to the
   original args with the last arg replaced by the result of the previous fn."
  [& fns]
  (fn [& args]
    (let [f (apply comp (map #(apply partial % (butlast args)) fns))]
      (f (last args)))))

(defn into-map
  "Convert a list of heterogeneous args into a map. Args can be alternating keys and values,
   maps of keys to values or collections of alternating keys and values."
  [& args]
  (loop [args args map {}]
    (if (empty? args)
      map
      (let [arg  (first args)
            args (rest args)]
       (cond
         (nil?  arg) (recur args map)
         (map?  arg) (recur args (merge map arg))
         (coll? arg) (recur (into args (reverse arg)) map)
         :else       (recur (rest args) (assoc map arg (first args))))))))

(defn pluralize
  "Return a pluralized phrase, appending an s to the singular form if no plural is provided.
   For example:
     (plural 5 \"month\") => \"5 months\"
     (plural 1 \"month\") => \"1 month\"
     (plural 1 \"radius\" \"radii\") => \"1 radius\"
     (plural 9 \"radius\" \"radii\") => \"9 radii\""
  [num singular & [plural]]
  (let [plural (or plural (str singular "s"))]
    (str num " " (if (= 1 num) singular plural))))

(defn construct
  "Construct a new instance of class using reflection."
  [class & args]
  (clojure.lang.Reflector/invokeConstructor class (into-array Object args)))

(defn invoke-private
  "Invoke a private or protected Java method. Be very careful when using this!
   I take no responsibility for the trouble you get yourself into."
  [instance method & params]
  (let [signature (into-array Class (map class params))]
    (when-let [method (first (remove nil? (for [c (ancestors (.getClass instance))]
                                            (try (.getDeclaredMethod c method signature)
                                                 (catch NoSuchMethodException e)))))]
      (let [accessible (.isAccessible method)]
        (.setAccessible method true)
        (let [result (.invoke method instance (into-array params))]
          (.setAccessible method false)
          result)))))

(defn- parse-opt [default opts arg]
  (let [m re-matches, key (comp keyword str)]
    (cond-let
     [[_ ks]  (m #"-(\w+)"           arg)] (apply merge-with into-vec opts (for [k ks] {(key k) [""]}))
     [[_ k v] (m #"--?([-\w]+)=(.+)" arg)] (update opts (key k) into-vec (.split #"," v))
     [[_ k]   (m #"--?([-\w]+)"      arg)] (update opts (key k) conj-vec "")
     :else                                 (update opts default conj-vec arg))))

(defn parse-opts
  "Parse command line args or the provided argument list. Returns a map of keys to
   vectors of repeated values. Named args begin with --keyname and are mapped to
   :keyname. Unnamed arguments are mapped to nil or default. Repeated named values can be
   specified by repeating a key or by using commas in the value. Single and double dashes
   are both supported though a single dash followed by word characters without internal
   dashes or an equal sign is assumed to be single character argument flags and are split
   accordingly.

   Example:
     (parse-opts [\"foo\" \"-vD\" \"bar\" \"-no-wrap\" \"-color=blue,green\" \"--style=baroque\" \"-color=red\"])
     => {:style [\"baroque\"], :color [\"blue\" \"green\" \"red\"], :no-wrap [\"\"], :D [\"\"], :v [\"\"], nil [\"foo\" \"bar\"]}"
  ([] (parse-opts nil *command-line-args*))
  ([args] (parse-opts nil args))
  ([default args] (reduce (partial parse-opt default) {} args)))

Fix various non-idiomatic or unnecessarily-complicated implementations


(ns atom-finder.classifier
  (:require [atom-finder.util :refer :all]
            [schema.core :as s]
            [clojure.pprint :refer [pprint]]
            [clojure.string :as str]
            [swiss.arrows :refer :all]
            )
  (:import
   [org.eclipse.cdt.core.dom.ast IASTNode IASTBinaryExpression
    IASTExpression IASTStatement IASTTranslationUnit
    IASTExpressionList IASTExpressionStatement IASTForStatement
    IASTPreprocessorMacroDefinition IASTIfStatement]
   [org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTTranslationUnit]
   [org.eclipse.cdt.internal.core.dom.rewrite.astwriter ASTWriter]
   [org.eclipse.cdt.internal.core.parser.scanner ASTMacroDefinition]
   ))

(load-cljs-in-dir "classifier/")

(def AtomName s/Keyword)
(def AtomClassifier s/Keyword)
(s/defrecord Atom [name classifier finder])

(defmacro ValidatedAtom
  "Creates an Atom record, with each function wrapped in Schema validation code"
  [name classifier finder]
  `(Atom. (s/validate AtomName ~name)
          (s/fn ~(symbol (str name "-classifier")) :- Boolean [node# :- IASTNode] (~classifier node#))
          (s/fn ~(symbol (str name "-finder")) :- [IASTNode] [node# :- IASTNode] (~finder node#))
          ;(s/fn ~(symbol (str name "-classifier")) :- Boolean [node# :- IASTNode]
          ;  (log-err (str "atom " ~name "-classifier") false (~classifier node#)))
          ;(s/fn ~(symbol (str name "-finder")) :- [IASTNode]  [node# :- IASTNode]
          ;  (log-err (str "atom " ~name "-finder") nil (~finder node#)))
  ))

(def atoms
  [
   (ValidatedAtom :preprocessor-in-statement define-parent?              non-toplevel-defines)
   (ValidatedAtom :logic-as-control-flow     logic-as-control-flow-atom? logic-as-control-flow-atoms)
   (ValidatedAtom :conditional               conditional-atom?           (default-finder conditional-atom?))
   (ValidatedAtom :reversed-subscript        reversed-subscript-atom?    (default-finder reversed-subscript-atom?))
   (ValidatedAtom :literal-encoding          literal-encoding-atom?      (default-finder literal-encoding-atom?))
   (ValidatedAtom :post-increment            post-*crement-atom?         (default-finder post-*crement-atom?))
   (ValidatedAtom :pre-increment             pre-*crement-atom?          (default-finder pre-*crement-atom?))
   (ValidatedAtom :comma-operator            comma-operator-atom?        (default-finder comma-operator-atom?))
   (ValidatedAtom :omitted-curly-braces      omitted-curly-braces-atom?  (default-finder omitted-curly-braces-atom?))
   (ValidatedAtom :assignment-as-value       assignment-as-value-atom?   (default-finder assignment-as-value-atom?))
   (ValidatedAtom :macro-operator-precedence macro-def-precedence-atom?  macro-operator-precedence-atoms)
   (ValidatedAtom :operator-precedence       operator-precedence-atom?   (default-finder operator-precedence-atom?))
   (ValidatedAtom :repurposed-variable       repurposed-variable-atom?   repurposed-variable-atoms)
   (ValidatedAtom :implicit-predicate        implicit-predicate-atom?    (default-finder implicit-predicate-atom?))
  ])

(def atom-lookup (into {} (map #(vector (:name %1) %1) atoms)))

(defn find-all-atoms
  [root]
  (map-values (fn [atom] ((:finder atom) root)) atom-lookup))

(ns atom-finder.classifier
  (:require [atom-finder.util :refer :all]
            [schema.core :as s]
            [clojure.pprint :refer [pprint]]
            [clojure.string :as str]
            [swiss.arrows :refer :all]
            )
  (:import
   [org.eclipse.cdt.core.dom.ast IASTNode IASTBinaryExpression
    IASTExpression IASTStatement IASTTranslationUnit
    IASTExpressionList IASTExpressionStatement IASTForStatement
    IASTPreprocessorMacroDefinition IASTIfStatement]
   [org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTTranslationUnit]
   [org.eclipse.cdt.internal.core.dom.rewrite.astwriter ASTWriter]
   [org.eclipse.cdt.internal.core.parser.scanner ASTMacroDefinition]
   ))

(load-cljs-in-dir "classifier/")

(def AtomName s/Keyword)
(def AtomClassifier s/Keyword)
(s/defrecord Atom [name classifier finder])

(defmacro ValidatedAtom
  "Creates an Atom record, with each function wrapped in Schema validation code"
  [name classifier finder]
  `(Atom. (s/validate AtomName ~name)
          (s/fn ~(symbol (str name "-classifier")) :- Boolean [node# :- IASTNode] (~classifier node#))
          (s/fn ~(symbol (str name "-finder")) :- [IASTNode] [node# :- IASTNode] (~finder node#))
          ;(s/fn ~(symbol (str name "-classifier")) :- Boolean [node# :- IASTNode]
          ;  (log-err (str "atom " ~name "-classifier") false (~classifier node#)))
          ;(s/fn ~(symbol (str name "-finder")) :- [IASTNode]  [node# :- IASTNode]
          ;  (log-err (str "atom " ~name "-finder") nil (~finder node#)))
  ))

(def atoms
  [
   (ValidatedAtom :preprocessor-in-statement define-parent?              non-toplevel-defines)
   (ValidatedAtom :logic-as-control-flow     logic-as-control-flow-atom? logic-as-control-flow-atoms)
   (ValidatedAtom :conditional               conditional-atom?           (default-finder conditional-atom?))
   (ValidatedAtom :reversed-subscript        reversed-subscript-atom?    (default-finder reversed-subscript-atom?))
   (ValidatedAtom :literal-encoding          literal-encoding-atom?      (default-finder literal-encoding-atom?))
   (ValidatedAtom :post-increment            post-*crement-atom?         (default-finder post-*crement-atom?))
   (ValidatedAtom :pre-increment             pre-*crement-atom?          (default-finder pre-*crement-atom?))
   (ValidatedAtom :comma-operator            comma-operator-atom?        (default-finder comma-operator-atom?))
   (ValidatedAtom :omitted-curly-braces      omitted-curly-braces-atom?  (default-finder omitted-curly-braces-atom?))
   (ValidatedAtom :assignment-as-value       assignment-as-value-atom?   (default-finder assignment-as-value-atom?))
   (ValidatedAtom :macro-operator-precedence macro-def-precedence-atom?  macro-operator-precedence-atoms)
   (ValidatedAtom :operator-precedence       operator-precedence-atom?   (default-finder operator-precedence-atom?))
   (ValidatedAtom :repurposed-variable       repurposed-variable-atom?   repurposed-variable-atoms)
   (ValidatedAtom :implicit-predicate        implicit-predicate-atom?    (default-finder implicit-predicate-atom?))
   (ValidatedAtom :type-conversion           type-conversion-atom?       (default-finder type-conversion-atom?))
  ])

(def atom-lookup (into {} (map #(vector (:name %1) %1) atoms)))

(defn find-all-atoms
  [root]
  (map-values (fn [atom] ((:finder atom) root)) atom-lookup))

Add type-conversion

Add type-conversion


(ns babel.francais.lexicon
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.lexiconfn :refer (unify)]
   [babel.francais.morphology :refer [exception-generator phonize]]
   [babel.francais.pos :refer :all]
   [babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)]
   [dag-unify.core :refer [get-in]]))

(def lexicon-source
  {
   "abandoner" {:synsem {:cat :verb
                         :sem {:pred :abandon}}}

   "accepter" {:synsem {:cat :verb
                        :sem {:pred :accept}}}

   "accompagner" {:synsem {:cat :verb
                           :sem {:pred :accompany}}}

   "acheter" {:synsem {:cat :verb
                       :sem {:subj {:human true}
                             :pred :comprare}}}

   "aider" {:synsem {:cat :verb
                     :sem {:pred :aiutare}}}

   "aimer" {:synsem {:cat :verb
                     :sem {:pred :amare
                           :subj {:human true}}}}

   "aller" {:français {:future-stem "ir"
                       :present {:1sing "vais"
                                 :2sing "vas"
                                 :3sing "va"
                                 :1plur "allons"
                                 :2plur "allez"
                                 :3plur "vont"}}
            :synsem {:cat :verb
                     :essere true
                     :sem {:subj {:animate true}
                           :pred :go}}}

   "anoncier" {:synsem {:cat :verb
                        :sem {:pred :announce}}}

   "appeler" {:synsem {:cat :verb
                       :sem {:pred :call}}}

   "apporter" [{:synsem {:cat :verb
                         :sem {:pred :take}}}
               {:synsem {:cat :verb
                         :sem {:pred :carry}}}]

   ;;  CONJUGATES LIKE TENIR
   "apprendre" {:synsem {:cat :verb
                         :sem {:pred :imparare}}}

   "assurer" [{:synsem {:cat :verb
                        :sem {:pred :assure}}}
              {:synsem {:cat :verb
                        :sem {:pred :insure}}}]

   "attendre" {:synsem {:cat :verb
                        :sem {:pred :wait-for}}}

   "augmenter" {:synsem {:cat :verb
                         :sem {:pred :increase}}}
   "avoir"
   (let [common
         {:synsem {:essere false
                   :cat :verb}
          :français {:futuro-stem "aur"
                     :drop-e true
                     :past-participle "eu"
                     :imperfect-stem "av"
                     :present {:1sing "ai"
                               :2sing "as"
                               :3sing "a"
                               :1plur "avons"
                               :2plur "avez"
                               :3plur "ont"}}}]
     [(unify common {:synsem {:sem {:pred :avere
                                    :subj {:human true}}}})
      (unify common verb-aux
             {:synsem {:subcat {:2 {:essere false}}}})])

   "baisser" {:synsem {:cat :verb
                      :sem {:pred :lower}}}

   "boire" {:français {:past-participle "bu"
                       :boot-stem1 "boiv"
                       :boot-stem2 "buv"}
            :synsem {:cat :verb
                     :sem {:pred :drink}}}

   "changer" {:synsem {:cat :verb
                      :sem {:pred :cambiare}}}

   "chanter" {:synsem {:cat :verb
                       :sem {:pred :sing}}}

   "commencer" {:synsem {:cat :verb
                         :sem {:pred :begin}}}

   "commenter" {:synsem {:cat :verb
                         :sem {:pred :comment}}}

   "comprendre" {:synsem {:cat :verb
                          :sem {:pred :understand}}}

   "conserver" [{:synsem {:cat :verb
                          :sem {:pred :conserve}}}
                {:synsem {:cat :verb
                          :sem {:pred :preserve}}}]

   "considérer" {:synsem {:cat :verb
                         :sem {:pred :consider}}}

   "couper" {:synsem {:cat :verb
                      :sem {:pred :cut}}}

   "courir" {:synsem {:cat :verb
                      :sem {:pred :run}}}

   "créer" {:synsem {:cat :verb
                     :sem {:pred :create}}}

   "decider" {:synsem {:cat :verb
                       :sem {:pred :decide}}}

   "developer" {:synsem {:cat :verb
                        :sem {:pred :develop}}}
   "devoir"
   (let [common
         {:synsem {:essere false
                   :cat :verb}
          :français {:futuro-stem "devr"
                     :drop-e true
                     :past-participle "dû"
                     :imperfect-stem "dev"
                     :present {:1sing "dois"
                               :2sing "dois"
                               :3sing "doit"
                               :1plur "devons"
                               :2plur "devez"
                               :3plur "doivent"}}}]
     [(unify common {:synsem {:sem {:pred :have-to
                                    :subj {:human true}}}})

   "diviser" {:synsem {:cat :verb
                      :sem {:pred :divide}}}

   "croire" {:synsem {:cat :verb
                      :sem {:pred :believe}}}

   "décider" {:synsem {:cat :verb
                       :sem {:pred :decide}}}

   "désirer" {:synsem {:cat :verb
                       :sem {:pred :desire}}}

   "donner" {:synsem {:cat :verb
                      :sem {:pred :give}}}

   "dormir" {:synsem {:cat :verb
                      :sem {:pred :sleep}}}

   "echapper" {:synsem {:cat :verb
                        :sem {:pred :escape}}}

   "écouter" {:synsem {:cat :verb
                       :sem {:pred :listen-to}}}

   "effacer" {:synsem {:cat :verb
                       :sem {:pred :erase}}}
   "elle"
   [{:synsem {:cat :noun
             :pronoun true
             :case :nom
             :agr {:person :3rd
                   :number :sing
                   :gender :fem}
              :sem {:human true
                    :pred :lei}
              :subcat '()}}
    {:synsem {:cat :noun
             :pronoun true
             :case :nom
             :agr {:person :3rd
                   :number :sing
                   :gender :fem}
              :sem {:human false
                    :pred :lei}
             :subcat '()}}]
   "elles"
   {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :plur
                    :gender :fem}
              :sem {:gender :fem
                    :pred :loro}
              :subcat '()}}

   "enseigner" [{:synsem {:cat :verb
                         :sem {:pred :show}}}
               {:synsem {:cat :verb
                         :sem {:pred :teach}}}]

   "entrer" {:synsem {:cat :verb
                      :essere true
                      :sem {:pred :enter}}}

   "envoyer" {:synsem {:cat :verb
                       :sem {:pred :send}}}

   "essayer" {:synsem {:cat :verb
                      :sem {:pred :try}}}
   "être"
   (let [common
         {:synsem {:cat :verb
                   :essere false}
          :français {:futuro-stem "ser"
                     :infinitive "être"
                     :present {:1sing "suis"
                               :2sing "es"
                               :3sing "est"
                               :1plur "sommes"
                               :2plur "êtes"
                               :3plur "sont"}
                     :past-participle "été"
                     :imperfect {:1sing "étais"
                                 :2sing "étais"
                                 :3sing "était"
                                 :1plur "étions"
                                 :2plur "étiez"
                                 :3plur "étaient"}
                     :futuro {:1sing "serai"
                              :2sing "seras"
                              :3sing "sera"
                              :1plur "serons"
                              :2plur "serez"
                              :3plur "seront"}}}]
     [(unify common {:synsem {:sem {:pred :be}}})
      (unify common verb-aux
             {:synsem {:subcat {:2 {:essere true}}}})])
   ;; ^^ in auxiliary form, "être" only allows essere=true verbs.
   ;; compare with "avoir", which only allows essere=false verbs.

   "étudier" {:synsem {:cat :verb
                       :sem {:pred :study}}}

   "éviter" {:synsem {:cat :verb
                      :sem {:pred :avoid}}}

   "exister" {:synsem {:cat :verb
                       :sem {:pred :exist}}}

   "exprimer" {:synsem {:cat :verb
                        :sem {:pred :express}}}

   "expulser" {:synsem {:cat :verb
                        :sem {:pred :throw-out}}}

   "former" {:synsem {:cat :verb
                     :sem {:pred :form}}}

   "gagner" [{:synsem {:cat :verb
                       :sem {:pred :earn
                             :subj {:human true}}}}
             {:synsem {:cat :verb
                       :sem {:pred :win
                             :subj {:human true}}}}]

   "gérer" {:synsem {:cat :verb
                    :sem {:pred :manage}}}
   "il"
   [{:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :sing
                    :gender :masc}
              :sem {:human true
                    :pred :lui}
              :subcat
              '()}}
    {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :sing
                    :gender :masc}
              :sem {:human false
                    :pred :lui}
              :subcat
              '()}}]

    "ils"
    {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :plur
                    :gender :masc}
              :sem {:gender :masc
                    :pred :loro}
               :subcat '()}}

    "imaginer" {:synsem {:cat :verb
                       :sem {:pred :imagine}}}
  "importer" {:synsem {:cat :verb
                       :sem {:pred :import}}}

  "insister" {:synsem {:cat :verb
                       :sem {:pred :insist}}}

;;  "interessér" {:synsem {:cat :verb
;;                         :sem {:pred :interest??}}}

  "je"
  (let [common {:synsem {:cat :noun
                         :pronoun true
                         :case :nom
                         :agr {:person :1st
                               :number :sing}
                         :sem {:human true
                               :pred :I}
                         :subcat '()}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])

  "laisser" {:synsem {:cat :verb
                      :sem {:pred :leave-behind}}}

  "manger"
  {:synsem {:cat :verb
            :sem {:pred :mangiare}}}

  "manquer" {:synsem {:cat :verb
                      :sem {:pred :to-be-missing}}}

  "marcher" [{:synsem {:cat :verb
                       :sem {:pred :walk}}}
             {:synsem {:cat :verb
                       :sem {:subj {:human false}
                              :pred :work-nonhuman}}}]

  "mettre" {:synsem {:cat :verb
                     :sem {:pred :set}}}
  "nous"
  (let [common {:synsem {:case :nom
                         :agr {:person :1st
                               :number :plur}
                         :sem {:human true
                               :pred :noi}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])

   "observer" {:synsem {:cat :verb
                       :sem {:pred :observe}}}

   "oublier" {:synsem {:cat :verb
                      :sem {:pred :forget}}}
   "parler"
   [{:synsem {:cat :verb
              :sem {:pred :speak
                    :subj {:human true}}}}
    {:synsem {:cat :verb
              :sem {:pred :talk
                    :subj {:human true}}}}]

   "partager" {:synsem {:cat :verb
                       :sem {:pred :share}}}

   "participer" {:synsem {:cat :verb
                         :sem {:pred :participate}}}

   "peindre" {:français {:boot-stem1 "pein"
                         :boot-stem2 "peign"
                         :passé "peint"
                         :futuro-stem "paindr"
                         :imperfect "peign"}
              :synsem {:cat :verb
                       :sem {:pred :paint}}}
;  "profiter (de)" {:synsem {:cat :verb
;                            :sem {:pred :take-advantage-of}}}

  "regarder" [{:synsem {:cat :verb
                        :sem {:pred :look}}}
              {:synsem {:cat :verb
                        :sem {:pred :watch}}}]

  "remarquer" {:synsem {:cat :verb
                        :sem {:pred :note}}}

  "répondre" {:synsem {:cat :verb
                       :sem {:pred :answer}}}

;  "s'amuser" (let [subject-semantics (ref {:human true})
;                    subject-agr (ref :top)]
;                {:synsem {:cat :verb
;                          :essere true
;                          :sem {:pred :have-fun
;                                :reflexive true
;                                :subj subject-semantics
;                                :obj subject-semantics}
;                          :subcat {:1 {:agr subject-agr
;                                       :sem subject-semantics}
;                                   :2 {:agr subject-agr
;                                       :pronoun true
;                                       :reflexive true
;                                       :sem subject-semantics}}}})
  "soulever" {:synsem {:cat :verb
                       :sem {:pred :lift}}}

  "soutenir" {:synsem {:cat :verb
                       :sem {:pred :support}}}

  "terminer" {:synsem {:cat :verb
                       :sem {:pred :finish}}}

  "touer" {:synsem {:cat :verb
                    :sem {:pred :kill}}}
  "tu"
  (let [common {:synsem {:cat :noun
                         :case :nom
                         :agr {:person :2nd
                               :number :sing}
                         :sem {:human true
                               :pred :tu}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])
  "vous"
  (let [common {:synsem {:case :nom
                         :agr {:person :2nd
                               :number :plur}
                         :sem {:human true
                               :pred :voi}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])
   })

(def lexicon
  (future (-> (compile-lex lexicon-source exception-generator phonize)

              ;; make an intransitive version of every verb which has an
              ;; [:sem :obj] path.
              intransitivize

              ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
              transitivize

              ;; default: essere=false
              (map-function-on-map-vals
               (fn [k vals]
                 (map (fn [val]
                        ;; if: 1. the val's :cat is :verb
                        ;;     2. it is not true that essere=true (either essere=false or essere is not defined)
                        ;; then: essere=false
                        (cond (and (= (get-in val [:synsem :cat])
                                      :verb)
                                   (not (= true (get-in val [:synsem :essere] false))))
                              (unify val {:synsem {:essere false}})

                              true ;; otherwise, leave the verb alone
                              val))
                      vals)))

              ;; Cleanup functions can go here. Number them for ease of reading.
              ;; 1. this filters out any verbs without an inflection:
              ;; infinitive verbs should have inflection ':infinitive',
              ;; rather than not having any inflection.
              (map-function-on-map-vals
               (fn [k vals]
                 (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                              (not (= :none (get-in % [:synsem :infl] :none))))
                         vals))))))

(ns babel.francais.lexicon
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.lexiconfn :refer (unify)]
   [babel.francais.morphology :refer [exception-generator phonize]]
   [babel.francais.pos :refer :all]
   [babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)]
   [dag-unify.core :refer [get-in]]))

(def lexicon-source
  {
   "abandoner" {:synsem {:cat :verb
                         :sem {:pred :abandon}}}

   "accepter" {:synsem {:cat :verb
                        :sem {:pred :accept}}}

   "accompagner" {:synsem {:cat :verb
                           :sem {:pred :accompany}}}

   "acheter" {:synsem {:cat :verb
                       :sem {:subj {:human true}
                             :pred :comprare}}}

   "aider" {:synsem {:cat :verb
                     :sem {:pred :aiutare}}}

   "aimer" {:synsem {:cat :verb
                     :sem {:pred :amare
                           :subj {:human true}}}}

   "aller" {:français {:future-stem "ir"
                       :present {:1sing "vais"
                                 :2sing "vas"
                                 :3sing "va"
                                 :1plur "allons"
                                 :2plur "allez"
                                 :3plur "vont"}}
            :synsem {:cat :verb
                     :essere true
                     :sem {:subj {:animate true}
                           :pred :go}}}

   "anoncier" {:synsem {:cat :verb
                        :sem {:pred :announce}}}

   "appeler" {:synsem {:cat :verb
                       :sem {:pred :call}}}

   "apporter" [{:synsem {:cat :verb
                         :sem {:pred :take}}}
               {:synsem {:cat :verb
                         :sem {:pred :carry}}}]

   ;;  CONJUGATES LIKE TENIR
   "apprendre" {:synsem {:cat :verb
                         :sem {:pred :imparare}}}

   "assurer" [{:synsem {:cat :verb
                        :sem {:pred :assure}}}
              {:synsem {:cat :verb
                        :sem {:pred :insure}}}]

   "attendre" {:synsem {:cat :verb
                        :sem {:pred :wait-for}}}

   "augmenter" {:synsem {:cat :verb
                         :sem {:pred :increase}}}
   "avoir"
   (let [common
         {:synsem {:essere false
                   :cat :verb}
          :français {:futuro-stem "aur"
                     :drop-e true
                     :past-participle "eu"
                     :imperfect-stem "av"
                     :present {:1sing "ai"
                               :2sing "as"
                               :3sing "a"
                               :1plur "avons"
                               :2plur "avez"
                               :3plur "ont"}}}]
     [(unify common {:synsem {:sem {:pred :avere
                                    :subj {:human true}}}})
      (unify common verb-aux
             {:synsem {:subcat {:2 {:essere false}}}})])

   "baisser" {:synsem {:cat :verb
                      :sem {:pred :lower}}}

   "boire" {:français {:past-participle "bu"
                       :boot-stem1 "boiv"
                       :boot-stem2 "buv"}
            :synsem {:cat :verb
                     :sem {:pred :drink}}}

   "changer" {:synsem {:cat :verb
                      :sem {:pred :cambiare}}}

   "chanter" {:synsem {:cat :verb
                       :sem {:pred :sing}}}

   "commencer" {:synsem {:cat :verb
                         :sem {:pred :begin}}}

   "commenter" {:synsem {:cat :verb
                         :sem {:pred :comment}}}

   "comprendre" {:synsem {:cat :verb
                          :sem {:pred :understand}}}

   "conserver" [{:synsem {:cat :verb
                          :sem {:pred :conserve}}}
                {:synsem {:cat :verb
                          :sem {:pred :preserve}}}]

   "considérer" {:synsem {:cat :verb
                         :sem {:pred :consider}}}

   "couper" {:synsem {:cat :verb
                      :sem {:pred :cut}}}

   "courir" {:synsem {:cat :verb
                      :sem {:pred :run}}}

   "créer" {:synsem {:cat :verb
                     :sem {:pred :create}}}

   "croire" {:synsem {:cat :verb
                      :sem {:pred :believe}}}

   "decider" {:synsem {:cat :verb
                       :sem {:pred :decide}}}

   "developer" {:synsem {:cat :verb
                        :sem {:pred :develop}}}
   "devoir"
   (let [common
         {:synsem {:essere false
                   :cat :verb}
          :français {:futuro-stem "devr"
                     :drop-e true
                     :past-participle "dû"
                     :imperfect-stem "dev"
                     :present {:1sing "dois"
                               :2sing "dois"
                               :3sing "doit"
                               :1plur "devons"
                               :2plur "devez"
                               :3plur "doivent"}}}]
     [(unify common {:synsem {:sem {:pred :have-to
                                    :subj {:human true}}}})

   "diviser" {:synsem {:cat :verb
                      :sem {:pred :divide}}}

   "décider" {:synsem {:cat :verb
                       :sem {:pred :decide}}}

   "désirer" {:synsem {:cat :verb
                       :sem {:pred :desire}}}

   "donner" {:synsem {:cat :verb
                      :sem {:pred :give}}}

   "dormir" {:synsem {:cat :verb
                      :sem {:pred :sleep}}}

   "echapper" {:synsem {:cat :verb
                        :sem {:pred :escape}}}

   "écouter" {:synsem {:cat :verb
                       :sem {:pred :listen-to}}}

   "effacer" {:synsem {:cat :verb
                       :sem {:pred :erase}}}
   "elle"
   [{:synsem {:cat :noun
             :pronoun true
             :case :nom
             :agr {:person :3rd
                   :number :sing
                   :gender :fem}
              :sem {:human true
                    :pred :lei}
              :subcat '()}}
    {:synsem {:cat :noun
             :pronoun true
             :case :nom
             :agr {:person :3rd
                   :number :sing
                   :gender :fem}
              :sem {:human false
                    :pred :lei}
             :subcat '()}}]
   "elles"
   {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :plur
                    :gender :fem}
              :sem {:gender :fem
                    :pred :loro}
              :subcat '()}}

   "enseigner" [{:synsem {:cat :verb
                         :sem {:pred :show}}}
               {:synsem {:cat :verb
                         :sem {:pred :teach}}}]

   "entrer" {:synsem {:cat :verb
                      :essere true
                      :sem {:pred :enter}}}

   "envoyer" {:synsem {:cat :verb
                       :sem {:pred :send}}}

   "essayer" {:synsem {:cat :verb
                      :sem {:pred :try}}}
   "être"
   (let [common
         {:synsem {:cat :verb
                   :essere false}
          :français {:futuro-stem "ser"
                     :infinitive "être"
                     :present {:1sing "suis"
                               :2sing "es"
                               :3sing "est"
                               :1plur "sommes"
                               :2plur "êtes"
                               :3plur "sont"}
                     :past-participle "été"
                     :imperfect {:1sing "étais"
                                 :2sing "étais"
                                 :3sing "était"
                                 :1plur "étions"
                                 :2plur "étiez"
                                 :3plur "étaient"}
                     :futuro {:1sing "serai"
                              :2sing "seras"
                              :3sing "sera"
                              :1plur "serons"
                              :2plur "serez"
                              :3plur "seront"}}}]
     [(unify common {:synsem {:sem {:pred :be}}})
      (unify common verb-aux
             {:synsem {:subcat {:2 {:essere true}}}})])
   ;; ^^ in auxiliary form, "être" only allows essere=true verbs.
   ;; compare with "avoir", which only allows essere=false verbs.

   "étudier" {:synsem {:cat :verb
                       :sem {:pred :study}}}

   "éviter" {:synsem {:cat :verb
                      :sem {:pred :avoid}}}

   "exister" {:synsem {:cat :verb
                       :sem {:pred :exist}}}

   "exprimer" {:synsem {:cat :verb
                        :sem {:pred :express}}}

   "expulser" {:synsem {:cat :verb
                        :sem {:pred :throw-out}}}

   "former" {:synsem {:cat :verb
                     :sem {:pred :form}}}

   "gagner" [{:synsem {:cat :verb
                       :sem {:pred :earn
                             :subj {:human true}}}}
             {:synsem {:cat :verb
                       :sem {:pred :win
                             :subj {:human true}}}}]

   "gérer" {:synsem {:cat :verb
                    :sem {:pred :manage}}}
   "il"
   [{:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :sing
                    :gender :masc}
              :sem {:human true
                    :pred :lui}
              :subcat
              '()}}
    {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :sing
                    :gender :masc}
              :sem {:human false
                    :pred :lui}
              :subcat
              '()}}]

    "ils"
    {:synsem {:cat :noun
              :pronoun true
              :case :nom
              :agr {:person :3rd
                    :number :plur
                    :gender :masc}
              :sem {:gender :masc
                    :pred :loro}
               :subcat '()}}

    "imaginer" {:synsem {:cat :verb
                       :sem {:pred :imagine}}}
  "importer" {:synsem {:cat :verb
                       :sem {:pred :import}}}

  "insister" {:synsem {:cat :verb
                       :sem {:pred :insist}}}

;;  "interessér" {:synsem {:cat :verb
;;                         :sem {:pred :interest??}}}

  "je"
  (let [common {:synsem {:cat :noun
                         :pronoun true
                         :case :nom
                         :agr {:person :1st
                               :number :sing}
                         :sem {:human true
                               :pred :I}
                         :subcat '()}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])

  "laisser" {:synsem {:cat :verb
                      :sem {:pred :leave-behind}}}

  "manger"
  {:synsem {:cat :verb
            :sem {:pred :mangiare}}}

  "manquer" {:synsem {:cat :verb
                      :sem {:pred :to-be-missing}}}

  "marcher" [{:synsem {:cat :verb
                       :sem {:pred :walk}}}
             {:synsem {:cat :verb
                       :sem {:subj {:human false}
                              :pred :work-nonhuman}}}]

  "mettre" {:synsem {:cat :verb
                     :sem {:pred :set}}}
  "nous"
  (let [common {:synsem {:case :nom
                         :agr {:person :1st
                               :number :plur}
                         :sem {:human true
                               :pred :noi}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])

   "observer" {:synsem {:cat :verb
                       :sem {:pred :observe}}}

   "oublier" {:synsem {:cat :verb
                      :sem {:pred :forget}}}
   "parler"
   [{:synsem {:cat :verb
              :sem {:pred :speak
                    :subj {:human true}}}}
    {:synsem {:cat :verb
              :sem {:pred :talk
                    :subj {:human true}}}}]

   "partager" {:synsem {:cat :verb
                       :sem {:pred :share}}}

   "participer" {:synsem {:cat :verb
                         :sem {:pred :participate}}}

   "peindre" {:français {:boot-stem1 "pein"
                         :boot-stem2 "peign"
                         :passé "peint"
                         :futuro-stem "paindr"
                         :imperfect "peign"}
              :synsem {:cat :verb
                       :sem {:pred :paint}}}
;  "profiter (de)" {:synsem {:cat :verb
;                            :sem {:pred :take-advantage-of}}}

  "regarder" [{:synsem {:cat :verb
                        :sem {:pred :look}}}
              {:synsem {:cat :verb
                        :sem {:pred :watch}}}]

  "remarquer" {:synsem {:cat :verb
                        :sem {:pred :note}}}

  "répondre" {:synsem {:cat :verb
                       :sem {:pred :answer}}}

;  "s'amuser" (let [subject-semantics (ref {:human true})
;                    subject-agr (ref :top)]
;                {:synsem {:cat :verb
;                          :essere true
;                          :sem {:pred :have-fun
;                                :reflexive true
;                                :subj subject-semantics
;                                :obj subject-semantics}
;                          :subcat {:1 {:agr subject-agr
;                                       :sem subject-semantics}
;                                   :2 {:agr subject-agr
;                                       :pronoun true
;                                       :reflexive true
;                                       :sem subject-semantics}}}})
  "soulever" {:synsem {:cat :verb
                       :sem {:pred :lift}}}

  "soutenir" {:synsem {:cat :verb
                       :sem {:pred :support}}}

  "terminer" {:synsem {:cat :verb
                       :sem {:pred :finish}}}

  "touer" {:synsem {:cat :verb
                    :sem {:pred :kill}}}
  "tu"
  (let [common {:synsem {:cat :noun
                         :case :nom
                         :agr {:person :2nd
                               :number :sing}
                         :sem {:human true
                               :pred :tu}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])
  "vous"
  (let [common {:synsem {:case :nom
                         :agr {:person :2nd
                               :number :plur}
                         :sem {:human true
                               :pred :voi}}}]
    [(unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :fem}}})
     (unify gender-pronoun-agreement
            common
            {:synsem {:agr {:gender :masc}}})])
   })

(def lexicon
  (future (-> (compile-lex lexicon-source exception-generator phonize)

              ;; make an intransitive version of every verb which has an
              ;; [:sem :obj] path.
              intransitivize

              ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
              transitivize

              ;; default: essere=false
              (map-function-on-map-vals
               (fn [k vals]
                 (map (fn [val]
                        ;; if: 1. the val's :cat is :verb
                        ;;     2. it is not true that essere=true (either essere=false or essere is not defined)
                        ;; then: essere=false
                        (cond (and (= (get-in val [:synsem :cat])
                                      :verb)
                                   (not (= true (get-in val [:synsem :essere] false))))
                              (unify val {:synsem {:essere false}})

                              true ;; otherwise, leave the verb alone
                              val))
                      vals)))

              ;; Cleanup functions can go here. Number them for ease of reading.
              ;; 1. this filters out any verbs without an inflection:
              ;; infinitive verbs should have inflection ':infinitive',
              ;; rather than not having any inflection.
              (map-function-on-map-vals
               (fn [k vals]
                 (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                              (not (= :none (get-in % [:synsem :infl] :none))))
                         vals))))))

Update lexicon.clj

Update lexicon.clj


(ns bakyeono.litedocx.unit
  "Things for unit conversion."
  (:require [clojure.string :as str])
  (:use [bakyeono.litedocx.util])
  (:gen-class))

;;; Conversion rate constants
(defn- reverse-conversion-map
  [m]
  (into {}
    (for [[k v] m]
      [k (/ 1 (k m))])))

(defconst flat-unit-per-m
  {:cm       100
   :km       1/1000
   :m        1
   :mm       1000})

(defconst unit-per-inch
  {:cm       2.54
   :dxa      1440
   :emu      914400
   :feet     12
   :ft       12
   :in.      1
   :inch     1
   :km       0.0000254
   :m        0.0254
   :mm       25.4
   :pt       72
   :px       96
   :twip     1440
   :yard     36
   :yd       36})

(defconst inch-per-unit (reverse-conversion-map unit-per-inch))

(defconst unit-per-m
  (into (into {} (for [k (keys unit-per-inch)]
                   [k (* (inch-per-unit :m)
                         (k unit-per-inch))]))
        flat-unit-per-m))

(defconst m-per-unit (reverse-conversion-map unit-per-m))

;;; Conversion rate map selector
(defconst metric-set (set (keys flat-unit-per-m)))
(defconst inch-set (clojure.set/difference (set (keys unit-per-inch))
                                           metric-set))

;;; Functions
(defn- parse-unit
  "Takes a string expression of a number and returns it as a [number unit]
  vector."
  [s]
  (let [s (str/trim s)
        n (Double/parseDouble (re-find #"^-?\d+\.?\d*" s))
        unit (-> (re-find #"[a-z]+$" s) clojure.string/lower-case keyword)]
    [n unit]))

(defn- conversion-medium
  "Takes a keyword of unit and returns the preffered conversion medium of the
  unit."
  [u]
  (cond (metric-set u) [m-per-unit unit-per-m]
        (inch-set u) [inch-per-unit unit-per-inch]))

(defn- conversion-rate
  "Returns conversion rate for 'from' unit -> 'to' unit. The parameters should
  be keywords."
  [from to]
  (let [medium (conversion-medium from)
        medium-per-from (from (first medium))
        to-per-medium (to (second medium))]
    (if (and medium-per-from to-per-medium)
      (* medium-per-from to-per-medium)
      (throw (Exception. (str "Unsupported unit conversion: " from " -> " to))))))

(defn convert
  "Takes a string expression of a value and its unit and then converts it into
  given to-unit.

  Parameters:
  - value: <string> value with unit.
  - to: <string or keyword> target unit type.

  Supported Unit Types:
  - Length Units: inch, cm, km, m, mm, px, pt, dxa, emu

  Examples:
  - (convert \"10px\" \"mm\")
  - (convert \"29.7 cm\" :dxa)"
  [value to]
  (let [[n unit] (parse-unit value)
        rate (conversion-rate unit (keyword to))]
    (* n rate)))

(ns bakyeono.litedocx.unit
  "Things for unit conversion."
  (:require [clojure.string :as str])
  (:use [bakyeono.litedocx.util])
  (:gen-class))

;;; Conversion rate constants
(defn- reverse-conversion-map
  [m]
  (into {}
    (for [[k v] m]
      [k (/ 1 (k m))])))

(defconst flat-unit-per-m
  {:cm       100
   :km       1/1000
   :m        1
   :mm       1000})

(defconst unit-per-inch
  {:cm       2.54
   :dxa      1440
   :emu      914400
   :feet     12
   :ft       12
   :in.      1
   :inch     1
   :km       0.0000254
   :m        0.0254
   :mm       25.4
   :pt       72
   :px       96
   :twip     1440
   :yard     36
   :yd       36})

(defconst inch-per-unit (reverse-conversion-map unit-per-inch))

(defconst unit-per-m
  (into (into {} (for [k (keys unit-per-inch)]
                   [k (* (inch-per-unit :m)
                         (k unit-per-inch))]))
        flat-unit-per-m))

(defconst m-per-unit (reverse-conversion-map unit-per-m))

;;; Conversion rate map selector
(defconst metric-set (set (keys flat-unit-per-m)))
(defconst inch-set (clojure.set/difference (set (keys unit-per-inch))
                                           metric-set))

;;; Functions
(defn- parse-unit
  "Takes a string expression of a number and returns it as a [number unit]
  vector."
  [s]
  (let [s (str/trim s)
        n (Double/parseDouble (re-find #"^-?\d+\.?\d*" s))
        unit (-> (re-find #"[a-z]+.?$" s) clojure.string/lower-case keyword)]
    [n unit]))

(defn- conversion-medium
  "Takes a keyword of unit and returns the preffered conversion medium of the
  unit."
  [u]
  (cond (metric-set u) [m-per-unit unit-per-m]
        (inch-set u) [inch-per-unit unit-per-inch]))

(defn- conversion-rate
  "Returns conversion rate for 'from' unit -> 'to' unit. The parameters should
  be keywords."
  [from to]
  (let [medium (conversion-medium from)
        medium-per-from (from (first medium))
        to-per-medium (to (second medium))]
    (if (and medium-per-from to-per-medium)
      (* medium-per-from to-per-medium)
      (throw (Exception. (str "Unsupported unit conversion: " from " -> " to))))))

(defn convert
  "Takes a string expression of a value and its unit and then converts it into
  given to-unit.

  Parameters:
  - value: <string> value with unit.
  - to: <string or keyword> target unit type.

  Supported Unit Types:
  - Length Units: inch, cm, km, m, mm, px, pt, dxa, emu

  Examples:
  - (convert \"10px\" \"mm\")
  - (convert \"29.7 cm\" :dxa)"
  [value to]
  (let [[n unit] (parse-unit value)
        rate (conversion-rate unit (keyword to))]
    (* n rate)))

Fix litedocx.unit/parse-unit fn

Fix litedocx.unit/parse-unit fn


(ns overtunes.songs.at-all
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano]]))

(defn bpm [beats-per-minute]
  (let [start (now)
        ms-per-minute (* 60 1000)
        ms-per-beat (/ ms-per-minute beats-per-minute)]
    #(+ start (* ms-per-beat %))))

(defn from [offset timing] #(timing (+ offset %)))
(defn speed-up [factor timing] #(timing (/ % factor)))

(def scale 56)
(defn ground [note] (+ scale note))

(def note# (comp sampled-piano ground))
(defn chord# [chord] (doseq [note (vals chord)] (note# note)))

(def ionian #(let [interval (mod % 7)
                  note ([0 2 4 5 7 9 11] interval)
                  octave (quot (- % interval) 7)]
               (+ (* 12 octave) note)))

(defn triad [scale root]
  (zipmap [:i :iii :v]
          [(scale root)
           (scale (+ root 2))
           (scale (+ root 4))]))

(defn lower [note] (- note 12))
(defn with-base [chord]
  (assoc chord :base
         (lower (:i chord))))

(def I (with-base (triad ionian 0)))
(def II (with-base (triad ionian 1)))
(def V (with-base (triad ionian 4)))

(def progression [I I II II II V I (update-in V [:base] lower)])

(defn rhythm-n-bass# [timing [chord1 chord2 & chords]]
  (do
    (at (timing 0) (note# (:base chord1)))
    (at (timing 2) (chord# (dissoc chord1 :base)))
    (at (timing 3) (note# (:base chord1)))
    (at (timing 4) (note# (:base chord2)))
    (at (timing 6) (chord# (dissoc chord2 :base)))
    (let [next (from 8 timing)]
      (if chords
        (rhythm-n-bass# next chords)
        next))))

(defn even-melody# [timing [note & notes]]
  (do
    (at (timing 0) (note# note))
    (let [next (from 1 timing)]
      (if notes
        (even-melody# next notes)
        next))))

(defn intro# [timing]
    (even-melody# timing (take 32 (cycle [9 7])))
    (rhythm-n-bass# timing (take 8 (cycle progression))))

(defn first-bit# [timing]
    (even-melody# (speed-up 2 (from -1 timing)) (map ionian [2 4 5 4 4 2 4]))
    (even-melody# (speed-up 2 (from 7 timing)) (map ionian [-2 1 2 1 1 -2 1]))
    (even-melody# (speed-up 2 (from 15 timing)) (map ionian [-2 1 2 1 1 -2 1 2 3 4]))
    (even-melody# (speed-up 2 (from 23 timing)) (map ionian [-1 -2 -3 0 0 -3 0 1 0 -3]))
    (rhythm-n-bass# timing (take 8 (cycle progression))))

(defn play# [] (-> (bpm 150) intro# first-bit# first-bit#))

; (play#)

(ns overtunes.songs.at-all
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano]]))

(defn bpm [beats-per-minute]
  (let [start (now)
        ms-per-minute (* 60 1000)
        ms-per-beat (/ ms-per-minute beats-per-minute)]
    #(+ start (* ms-per-beat %))))

(defn from [timing offset] #(timing (+ offset %)))
(defn speed-up [timing factor] #(timing (/ % factor)))

(def scale 56)
(defn ground [note] (+ scale note))

(def note# (comp sampled-piano ground))
(defn chord# [chord] (doseq [note (vals chord)] (note# note)))

(def ionian #(let [interval (mod % 7)
                  note ([0 2 4 5 7 9 11] interval)
                  octave (quot (- % interval) 7)]
               (+ (* 12 octave) note)))

(defn triad [scale root]
  (zipmap [:i :iii :v]
          [(scale root)
           (scale (+ root 2))
           (scale (+ root 4))]))

(defn lower [note] (- note 12))
(defn with-base [chord]
  (assoc chord :base
         (lower (:i chord))))

(def I (with-base (triad ionian 0)))
(def II (with-base (triad ionian 1)))
(def V (with-base (triad ionian 4)))

(def progression [I I II II II V I (update-in V [:base] lower)])

(defn rhythm-n-bass# [timing [chord1 chord2 & chords]]
  (do
    (at (timing 0) (note# (:base chord1)))
    (at (timing 2) (chord# (dissoc chord1 :base)))
    (at (timing 3) (note# (:base chord1)))
    (at (timing 4) (note# (:base chord2)))
    (at (timing 6) (chord# (dissoc chord2 :base)))
    (let [next (from timing 8)]
      (if chords
        (rhythm-n-bass# next chords)
        next))))

(defn even-melody# [timing [note & notes]]
  (do
    (at (timing 0) (note# note))
    (let [next (from timing 1)]
      (if notes
        (even-melody# next notes)
        next))))

(defn intro# [timing]
    (even-melody# timing (take 32 (cycle [9 7])))
    (rhythm-n-bass# timing (take 8 (cycle progression))))

(defn first-bit# [timing]
    (even-melody# (speed-up (from timing -1) 2) (map ionian [2 4 5 4 4 2 4]))
    (even-melody# (speed-up (from timing 7) 2) (map ionian [-2 1 2 1 1 -2 1]))
    (even-melody# (speed-up (from timing 15) 2) (map ionian [-2 1 2 1 1 -2 1 2 3 4]))
    (even-melody# (speed-up (from timing 23) 2) (map ionian [-1 -2 -3 0 0 -3 0 1 0 -3]))
    (rhythm-n-bass# timing (take 8 (cycle progression))))

(defn play# [] (-> (bpm 120) (from 2) intro# first-bit# (speed-up 3/2) first-bit#))

(play#)

Put the order of from and speed-up back the other way - I didn't understand ->. Put a speed-up before the repetition.


(ns salava.user.routes
  (:require [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer :all]
            [ring.util.response :refer [redirect]]
            [salava.core.layout :as layout]
            [schema.core :as s]
            [salava.user.schemas :as schemas]
            [salava.user.db :as u]))

(defn route-def [ctx]
  (routes
    (context "/user" []
             (layout/main ctx "/login")
             (layout/main ctx "/login/:next-url")
             (layout/main ctx "/register")
             (layout/main ctx "/account")
             (layout/main ctx "/activate/:userid/:timestamp/:code"))

    (context "/obpv1/user" []
      (POST "/login" []
            ;:return ""
            :body [login-content schemas/LoginUser]
            :summary "User logs in"
            (let [{:keys [email password]} login-content
                 login-status (u/login-user ctx email password)]
              (if (= "success" (:status login-status))
                (assoc-in (ok login-status) [:session :identity] (select-keys login-status [:id :fullname]))
                (ok login-status))))

      (POST "/logout" []
            (assoc-in (ok) [:session :identity] nil))

      (POST "/register" []
            :return {:status (s/enum "success" "error")
                     :message (s/maybe s/Str)}
            :body [form-content schemas/RegisterUser]
            :summary "Create new user account"
            (let [{:keys [email first_name last_name country]} form-content]
              (ok (u/register-user ctx email first_name last_name country))))

      (POST "/activate" []
            :return {:status (s/enum "success" "error")
                     :message (s/maybe s/Str)}
            :body [activation-data schemas/ActivateUser]
            :summary "Set password and activate user account"
            (let [{:keys [user_id code password password_verify]} activation-data]
              (ok (u/set-password-and-activate ctx user_id code password password_verify)))))))

(ns salava.user.routes
  (:require [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer :all]
            [ring.util.response :refer [redirect]]
            [salava.core.layout :as layout]
            [schema.core :as s]
            [salava.user.schemas :as schemas]
            [salava.user.db :as u]))

(defn route-def [ctx]
  (routes
    (context "/user" []
             (layout/main ctx "/login")
             (layout/main ctx "/login/:next-url")
             (layout/main ctx "/register")
             (layout/main ctx "/account")
             (layout/main ctx "/activate/:userid/:timestamp/:code"))

    (context "/obpv1/user" []
      :tags ["user"]
      (POST "/login" []
            ;:return ""
            :body [login-content schemas/LoginUser]
            :summary "User logs in"
            (let [{:keys [email password]} login-content
                 login-status (u/login-user ctx email password)]
              (if (= "success" (:status login-status))
                (assoc-in (ok login-status) [:session :identity] (select-keys login-status [:id :fullname]))
                (ok login-status))))

      (POST "/logout" []
            (assoc-in (ok) [:session :identity] nil))

      (POST "/register" []
            :return {:status (s/enum "success" "error")
                     :message (s/maybe s/Str)}
            :body [form-content schemas/RegisterUser]
            :summary "Create new user account"
            (let [{:keys [email first_name last_name country]} form-content]
              (ok (u/register-user ctx email first_name last_name country))))

      (POST "/activate" []
            :return {:status (s/enum "success" "error")
                     :message (s/maybe s/Str)}
            :body [activation-data schemas/ActivateUser]
            :summary "Set password and activate user account"
            (let [{:keys [user_id code password password_verify]} activation-data]
              (ok (u/set-password-and-activate ctx user_id code password password_verify)))))))

Tag added for user plugin routes

Tag added for user plugin routes


(ns clojuredocs.anim
  (:require [dommy.core :as dom])
  (:require-macros [dommy.macros :refer [node sel1]]))

(defn offset-parents
  "a lazy seq of offset parents of `node`"
  [elem]
  (->> elem
       (iterate #(.-offsetParent %))
       (take-while identity)))

(defn offset-top [el]
  (->> el
       offset-parents
       (map #(.-offsetTop %))
       (reduce +)))

(defn tween [el opts]
  (js/morpheus el (clj->js opts)))

(defn scroll-to
    [elem & [{:keys [pad]}]]
    (let [body (sel1 :body)
          start (.-scrollTop body)
          end (- (offset-top elem) pad)]
      (.tween js/morpheus
        250
        (fn [pos]
          (aset body "scrollTop" pos))
        nil
        nil
        start
        end)))

(defn scroll-to-top []
  (scroll-to (sel1 :body)))

(defn scroll-into-view
  [elem & [opts]]
  (let [elem (node elem)
        {:keys [top bottom]} (dom/bounding-client-rect elem)]
    (when (or (< js/window.innerHeight
                (+ top (.-offsetHeight elem)))
              (< top 0))
      (scroll-to elem opts))))

(ns clojuredocs.anim
  (:require [dommy.core :as dom])
  (:require-macros [dommy.macros :refer [node sel1]]))

(defn offset-parents
  "a lazy seq of offset parents of `node`"
  [elem]
  (->> elem
       (iterate #(.-offsetParent %))
       (take-while identity)))

(defn offset-top [el]
  (->> el
       offset-parents
       (map #(.-offsetTop %))
       (reduce +)))

(defn tween [el opts]
  (js/morpheus el (clj->js opts)))

(defn scroll-to
    [elem & [{:keys [pad]}]]
    (let [body (sel1 :body)
          html (sel1 :html)
          start (max  (.-scrollTop body) (.-scrollTop html))
          end (- (offset-top elem) pad)]
      (.tween js/morpheus
        250
        (fn [pos]
          (aset body "scrollTop" pos)
          (aset html "scrollTop" pos))
        nil
        nil
        start
        end)))

(defn scroll-to-top []
  (scroll-to (sel1 :body)))

(defn scroll-into-view
  [elem & [opts]]
  (let [elem (node elem)
        {:keys [top bottom]} (dom/bounding-client-rect elem)]
    (when (or (< js/window.innerHeight
                (+ top (.-offsetHeight elem)))
              (< top 0))
      (scroll-to elem opts))))

Fix scroll-to in firefox

Fix scroll-to in firefox