Refactor of 2d-manip, hierarchy in progress.

--- src/exp/2d_manipulation.clj
+++ src/exp/2d_manipulation.clj
@@ -15,16 +15,17 @@
 ; Seems we need all the angelic machinery we had before, in general case.

 ;; State variables are (all keyworded, note!):
-; :const {[size] [freespace] [legal-go] [goal o] [map]...}
+; :const {[size] [freespace] [legal-go] [goal o] [base-offsets] [n-base-samples] [map]...}
 ;    freespace is set of free [x y] pairs (for base).
 ;    legal-go is set of allowed [gxo gyo] pairs
-;    goal is [[minx miny] [maxx maxy]] range -- inclusive.
-; [bx], [by] - current "base" coordinates.
-; [gxo], [gyo] - gripper x and y offsets.
-; [x o], [y o] - location of object
-; [at-goal? o] -
-; [object-at x y] - nil, object, or :border
-; [holding]
+;    goal is now set of allowed positions. Previously: [[minx miny] [maxx maxy]] range -- inclusive.
+;    base-offsets is randomized list of offset positions to drasp/drop at a position.
+; [base],  current "base" coordinates.
+; [gripper-offset], gripper coordinate offsets
+; [pos o], location of object
+; [at-goal? o] - true/false
+; [object-at [x y]] - nil, object, or :border
+; [holding] - object or nil
 ; [parked?]

 ; implicit obstacle border.
@@ -38,7 +39,30 @@
 ; pickup-l/r/d/u
 ; drop-l/r/d/u

-(def dirs [[:l -1 0] [:r 1 0] [:u 0 -1] [:d 0 1]])
+(def dirs [[:l [-1 0]] [:r [1 0]] [:u [0 -1]] [:d [0 1]]])
+
+(defn add-pos
+  ([[x1 y1] [x2 y2]] [(+ x1 x2) (+ y1 y2)])
+  ([[x1 y1] [x2 y2] [x3 y3]] [(+ x1 x2 x3) (+ y1 y2 y3)]))
+
+(defn region-contains? [[[minx miny] [maxx maxy]] [x y]]
+  (and (<= minx x maxx) (<= miny y maxy)))
+
+(defn region-cells [[[minx miny] [maxx maxy]]]
+  (for [x (range minx (inc maxx)), y (range miny (inc maxy))] [x y]))
+
+(defn make-random [seed]
+  (doto (Random. (long seed)) (.nextDouble) (.nextDouble)))
+
+(defn pseudo-shuffle [#^java.util.Collection coll #^Random r]
+  (seq (java.util.Collections/shuffle (java.util.ArrayList. coll) r)))
+
+(defn spiral-to [max-d]
+  (cons [0 0]
+    (apply concat
+      (for [d (range 1 (inc max-d)), i (range d)]
+        [[i (- d i)]     [(- i) (- i d)]
+         [(- d i) (- i)] [(- i d) i]]))))

 ; Note, unlike previous domains, here still require precondition verification.

@@ -46,108 +70,102 @@
   (env/FactoredPrimitive [:park] {[:parked?] false} {[:parked?] true} -5))

 (defn make-unpark [s]
-  (env/FactoredPrimitive [:unpark] {[:parked?] true [:gxo] 0 [:gyo] 0} {[:parked?] false} -5))
-
-(defn make-base-dir [s [dirname dx dy]]
+  (env/FactoredPrimitive [:unpark] {[:parked?] true [:gripper-offset] [0 0]} {[:parked?] false} -5))
+
+(defn make-base-dir [s [dirname dir]]
   (let [const (env/get-var s :const)
-        cx    (env/get-var s [:bx])
-        cy    (env/get-var s [:by])
-        nx    (+ cx dx)
-        ny    (+ cy dy)]
-    (when (contains? (get const [:freespace]) [nx ny])
+        base  (env/get-var s [:base])
+        nbase (add-pos base dir)]
+    (when (contains? (get const [:freespace]) nbase)
       (env/FactoredPrimitive
        [:base dirname]
-       {[:bx] cx [:by] cy [:parked?] false}
-       {[:bx] nx [:by] ny}
+       {[:base] base [:parked?] false}
+       {[:base] nbase}
        -2))))

-(defn make-gripper-dir [s [dirname dx dy]]
+(defn make-gripper-dir [s [dirname dir]]
   (let [const (env/get-var s :const)
-        cbx   (env/get-var s [:bx])
-        cby   (env/get-var s [:by])
-        cgxo  (env/get-var s [:gxo])
-        cgyo  (env/get-var s [:gyo])
-        ngxo  (+ cgxo dx)
-        ngyo  (+ cgyo dy)]
-    (when (contains? (get const [:legal-go]) [ngxo ngyo])
+        base  (env/get-var s [:base])
+        go    (env/get-var s [:gripper-offest])
+        ngo   (add-pos go dir)
+        npos  (add-pos ngo base)]
+    (when (contains? (get const [:legal-go]) ngo)
       (env/FactoredPrimitive
        [:gripper dirname]
-       {[:bx] cbx [:by] cby [:gxo] cgxo [:gyo] cgyo [:parked?] true
-        [:object-at (+ cbx ngxo) (+ cby ngyo)] nil}
-       {[:gxo] ngxo [:gyo] ngyo}
+       {[:base] base [:gripper-offset] go [:parked?] true
+        [:object-at npos] nil}
+       {[:gripper-offest] ngo}
        -1))))

-(defn make-pickup-dir [s [dirname dx dy]]
-  (let [cbx   (env/get-var s [:bx])
-        cby   (env/get-var s [:by])
-        cgxo  (env/get-var s [:gxo])
-        cgyo  (env/get-var s [:gyo])
-        ox    (+ cbx cgxo dx)
-        oy    (+ cby cgyo dy)
-        o     (env/get-var s [:object-at ox oy])]
+(defn make-pickup [dirname base go o opos]
+  (env/FactoredPrimitive
+   [:pickup dirname]
+   {[:base] base [:gripper-offset] go [:parked?] true
+    [:pos o] opos [:holding] nil [:at-goal? o] false}
+   {[:pos o] nil [:holding] o [:object-at opos] nil}
+   -1))
+
+(defn make-pickup-dir [s [dirname dir]]
+  (let [base  (env/get-var s [:base])
+        go    (env/get-var s [:gripper-offset])
+        opos  (add-pos base go dir)
+        o     (env/get-var s [:object-at opos])]
     (when (and o (not (= o :border)))
-      (env/FactoredPrimitive
-       [:pickup dirname]
-       {[:bx] cbx [:by] cby [:gxo] cgxo [:gyo] cgyo [:parked?] true
-        [:x o] ox [:y o] oy [:holding] nil [:at-goal? o] false}
-       {[:x o] nil [:y o] nil [:holding] o [:object-at ox oy] nil}
-       -1))))
-
-(defn region-contains? [[[minx miny] [maxx maxy]] [x y]]
-  (and (<= minx x maxx) (<= miny y maxy)))
-
-(defn make-putdown-dir [s [dirname dx dy]]
+      (make-pickup dirname base go o opos))))
+
+
+(defn make-putdown-dir [s [dirname dir]]
   (let [const (env/get-var s :const)
         o     (env/get-var s [:holding])
-        cbx   (env/get-var s [:bx])
-        cby   (env/get-var s [:by])
-        cgxo  (env/get-var s [:gxo])
-        cgyo  (env/get-var s [:gyo])
-        ox    (+ cbx cgxo dx)
-        oy    (+ cby cgyo dy)]
-    (when (and o (region-contains? (get const [:goal o]) [ox oy]))
+        base  (env/get-var s [:base])
+        go    (env/get-var s [:gripper-offset])
+        opos  (add-pos base go dir)]
+    (when (and o (contains? (get const [:goal o]) opos))
       (env/FactoredPrimitive
        [:putdown dirname]
-       {[:bx] cbx [:by] cby [:gxo] cgxo [:gyo] cgyo [:parked?] true
-        [:holding] o [:object-at ox oy] nil}
-       {[:x o] ox [:y o] oy [:holding] nil [:object-at ox oy] o [:at-goal? o] true}
+       {[:base] base [:gripper-offset] go [:parked?] true
+        [:holding] o [:object-at opos] nil}
+       {[:pos o] opos [:holding] nil [:object-at opos] o [:at-goal? o] true}
        -1))))

-; obstacles and goals are [[minx miny] [maxx maxy]]
-; objects are [name [cx cy] goal] -- no goal means static
+; obstacles are [[minx miny] [maxx maxy]]
+; goals are sets os positions.
+; objects are [name [cx cy] goal-pos-set] -- no goal means static
 ; g-rad is gripper "radius" -- diamond shaped.

-(defn region-cells [[[minx miny] [maxx maxy]]]
-  (for [x (range minx (inc maxx)), y (range miny (inc maxy))] [x y]))
-
-(defn make-2d-manipulation-env [size start obstacles objects g-rad]
+(defn make-2d-manipulation-env
+  ([size base obstacles objects g-rad]
+     (make-2d-manipulation-env size base obstacles objects g-rad Integer/MAX_VALUE))
+  ([size base obstacles objects g-rad n-base-samples]
+     (make-2d-manipulation-env size base obstacles objects g-rad n-base-samples (make-random 1)))
+  ([size base obstacles objects g-rad n-base-samples #^Random random]
   (let [[width height] size
-        [bx by]        start
         border-regions [[[0 0] [0 height]] [[width 0] [width height]]
                         [[0 0] [width 0]] [[0 height] [width height]]]
         border-cells   (set (mapcat region-cells border-regions))
         obstacle-cells (set (mapcat region-cells obstacles))
         all-cells      (set (region-cells [[0 0] size]))
         freespace      (clojure.set/difference all-cells border-cells obstacle-cells)
-        legal-go       (set (filter (fn [[x y]] (<= (+ (util/abs x) (util/abs y)) g-rad))
-                                    (region-cells [[(- g-rad) (- g-rad)] [g-rad g-rad]])))]
+        legal-go       (set (spiral-to g-rad))]
     (env/SimpleFactoredEnv
      (into {:const (into {[:size] size [:freespace] freespace [:legal-go] legal-go [:objects] objects
+                          [:base-offsets] (pseudo-shuffle (spiral-to (inc g-rad)) random)
+                          [:n-base-samples] n-base-samples
                           [:map] (reduce (fn [m [x y]] (assoc-in m [y x] \.))
                                    (reduce (fn [m [x y]] (assoc-in m [y x] \*))
                                       (vec (repeat (inc height) (vec (repeat (inc width) \ ))))
                                       border-cells)
                                    obstacle-cells)}
-                         (for [[o _ goal] objects :when goal] [[:goal o] goal]))
-            [:bx] bx [:by] by [:gxo] 0 [:gyo] 0 [:holding] nil [:parked?] true}
+                         (for [[o _ goal] objects :when goal] [[:goal o] (set goal)]))
+            [:base] base [:gripper-offset] [0 0] [:holding] nil [:parked?] true}
            (apply concat
-            (for [[x y] all-cells]     [[:object-at x y] nil])
-            (for [[x y] border-cells] [[:object-at x y] :border])
-            (for [[o [ox oy] goal] objects]
-              [[[:x o] ox] [[:y o] oy]
+            (for [cell all-cells]    [[:object-at cell] nil])
+            (for [cell border-cells] [[:object-at cell] :border])
+            (for [[o opos goal] objects]
+              [[[:pos o] opos]
                [[:at-goal? o] (if goal false true)]
-               [[:object-at ox oy] o]])))
+               [[:object-at opos] o]])))
      (fn [s]
        (filter #(and % (env/applicable? % s))
           (apply concat
@@ -155,22 +173,61 @@
             (for [dir dirs]
               [(make-base-dir s dir) (make-gripper-dir s dir)
                (make-pickup-dir s dir) (make-putdown-dir s dir)]))))
-     (into {[:parked?] true [:gxo] 0 [:gyo] 0}
-           (for [[o _ goal] objects :when goal] [[:at-goal? o] true])))))
+     (into {[:parked?] true [:gripper-offset] [0 0]}
+           (for [[o _ goal] objects :when goal] [[:at-goal? o] true]))))))
+
+; (print-state (initial-state (make-2d-manipulation-env [10 10] [1 1] [ [ [4 4] [6 6] ] ] [ [:a [5 5] #{ [4 4] } ] ] 2)))
+; (uniform-cost-search (make-2d-manipulation-env [10 10] [1 1] [ [ [4 4] [6 6] ] ] [ [:a [5 5] #{ [4 4] } ] ] 2))
+
+(comment
+ (defn make-2d-manipulation-env [size start obstacles objects g-rad]
+   (let [[width height] size
+         [bx by]        start
+         border-regions [[[0 0] [0 height]] [[width 0] [width height]]
+                         [[0 0] [width 0]] [[0 height] [width height]]]
+         border-cells   (set (mapcat region-cells border-regions))
+         obstacle-cells (set (mapcat region-cells obstacles))
+         all-cells      (set (region-cells [[0 0] size]))
+         freespace      (clojure.set/difference all-cells border-cells obstacle-cells)
+         legal-go       (set (filter (fn [[x y]] (<= (+ (util/abs x) (util/abs y)) g-rad))
+                                     (region-cells [[(- g-rad) (- g-rad)] [g-rad g-rad]])))]
+     (env/SimpleFactoredEnv
+      (into {:const (into {[:size] size [:freespace] freespace [:legal-go] legal-go [:objects] objects
+                           [:map] (reduce (fn [m [x y]] (assoc-in m [y x] \.))
+                                          (reduce (fn [m [x y]] (assoc-in m [y x] \*))
+                                                  (vec (repeat (inc height) (vec (repeat (inc width) \ ))))
+                                                  border-cells)
+                                          obstacle-cells)}
+                          (for [[o _ goal] objects :when goal] [[:goal o] goal]))
+             [:bx] bx [:by] by [:gxo] 0 [:gyo] 0 [:holding] nil [:parked?] true}
+            (apply concat
+                   (for [[x y] all-cells]     [[:object-at x y] nil])
+                   (for [[x y] border-cells] [[:object-at x y] :border])
+                   (for [[o [ox oy] goal] objects]
+                     [[[:x o] ox] [[:y o] oy]
+                      [[:at-goal? o] (if goal false true)]
+                      [[:object-at ox oy] o]])))
+      (fn [s]
+        (filter #(and % (env/applicable? % s))
+                (apply concat
+                       [(make-park s) (make-unpark s)]
+                       (for [dir dirs]
+                         [(make-base-dir s dir) (make-gripper-dir s dir)
+                          (make-pickup-dir s dir) (make-putdown-dir s dir)]))))
+      (into {[:parked?] true [:gxo] 0 [:gyo] 0}
+            (for [[o _ goal] objects :when goal] [[:at-goal? o] true]))))))

 (defn state-map [s]
   (let [const   (env/get-var s :const)
-        bx      (env/get-var s [:bx])
-        by      (env/get-var s [:by])
-        gxo     (env/get-var s [:gxo])
-        gyo     (env/get-var s [:gyo])]
+        base    (env/get-var s [:base])
+        go      (env/get-var s [:gripper-offset])]
     (reduce (partial apply assoc-in)
             (get const [:map])
             (concat
-             [[[(+ bx gxo) (+ by gyo)] \G]
-              [[bx by]                 \B]]
+             [[(add-pos base go) \G]
+              [base              \B]]
              (for [[o] (get const [:objects])]
-               [[(env/get-var s [:x o]) (env/get-var s [:y o])] (first (name o))])))))
+               [(env/get-var s [:pos o]) (first (name o))])))))

 (defn state-str [s]
   (apply str (util/str-join "\n" (map (partial apply str) (state-map s))) "\n"
@@ -180,4 +237,111 @@
 (defn print-state [s] (print (state-str s)))

+
+(defn reach-context [s]
+  (into #{[:bx] [:by] [:gxo] [:gyo]}
+        (let [bx (env/get-var s [:bx])
+              by (env/get-var s [:by])]
+          (for [[xo yo] (util/safe-get (env/get-var s :const) [:legal-go])]
+            [:object-at (+ bx xo) (+ by yo)]))))
+
+(deftype ReachHLA [env dx dy] :as this
+  env/Action                (action-name [] [:reach dx dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s] (reach-context s))
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                             (if (and (= dx (env/get-var s [:bx]))
+                                      (= dy (env/get-var s [:by])))
+                               [[]]
+                               (for [dir dirs
+                                     :let [a (make-gripper-dir s dir)]
+                                     :when (and a (env/applicable? a s))]
+                                 [a this])))
+                            (cycle-level- [s] 1))
+; manhattan, SLD?  range?
+
+(deftype GraspHLA [env o] :as this
+  env/Action                (action-name [] [:grasp o])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s]
+                              (conj (reach-context s) [:x o] [:y o] [:at-goal? o] [:holding]))
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                             (let [bx (env/get-var s [:bx]), by (env/get-var s [:by])
+                                   ox (env/get-var s [:x o]), oy (env/get-var s [:y o])]
+                               (for [[dirname dx dy] dirs]
+                                 [(ReachHLA env (- ox dx) (- oy dy))
+                                  (make-pickup dirname bx by (- ox dx) (- oy dy) o ox oy)])))
+                            (cycle-level- [s] nil))
+;manhattan
+;pess: SLD?
+
+
+(deftype DropAtHLA [env o dx dy] :as this
+  env/Action                (action-name [] [:dropat o dx dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s]
+                              (conj (reach-context s) [:holding]))
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                             (let [bx (env/get-var s [:bx]), by (env/get-var s [:by])
+                                   ox (env/get-var s [:x o]), oy (env/get-var s [:y o])]
+                               (for [[dirname dx dy] dirs]
+                                 [(ReachHLA env (- ox dx) (- oy dy))
+                                  (make-pickup dirname bx by (- ox dx) (- oy dy) o ox oy)])))
+                            (cycle-level- [s] nil))
+;manhattan
+;pess: SLD?
+
+
+
+
+
+
+
+;; TODO: should nav be done by external alg, (fairest between angelic/not) or explicit?
+(deftype NavHLA [env dx dy] :as this
+  env/Action                (action-name [] [:nav dx dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s] #{[:bx] [:by]})
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                             (if (and (= dx (env/get-var s [:bx]))
+                                      (= dy (env/get-var s [:by])))
+                               [[]]
+                               (for [dir dirs
+                                     :let [a (make-base-dir s dir)]
+                                     :when (and a (env/applicable? a s))]
+                                 [a this])))
+                            (cycle-level- [s] 1))
+; manhattan
+; pess? SLD? (try direct line, if occ then -inf).
+
+(deftype MoveBaseHLA [env dx dy] :as this
+  env/Action                (action-name [] [:movebase dx dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s] #{[:bx] [:by] [:parked?] [:gxo] [:gyo]})
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                             (let [bx (env/get-var s [:bx]), by (env/get-var s [:by])]
+                               (if (and (= dx bx) (= dy by))
+                                  [[]]
+                                 [[(ReachHLA env bx by) (make-unpark s)
+                                   (NavHLA dx dy) (make-park s)]])))
+                            (cycle-level- [s] nil))
+; manhattan + park (if appl)
+; pess? SLD?
+
+
+
+
+; DropFrom
+; Drop
+; GoGrasp
+; GoDropAt
+; GoDrop
+; MoveToGoal
+; Act
+
+;; Do we sample base, drop positions, or enumerate ?
+
+
+
+
 ; (print-state (initial-state (make-2d-manipulation-env [10 10] [1 1] [ [ [4 4] [6 6] ] ] [ [:a [5 5] [ [4 4] [4 4] ] ] ] 2)))


make stones-to-js function non-public

make stones-to-js function non-public

--- src/greybear/pages/game.clj
+++ src/greybear/pages/game.clj
@@ -2,7 +2,7 @@
   (:use [hiccup element page]
         [greybear.model :only [read-game]]))

-(defn stones-to-js
+(defn- stones-to-js
   "Transforms a string of chars into a JSON array
   e.g. \"00120\" becomes: [\"0\", \"0\", \"1\", \"2\", \"0\"]
   "


fixing table layout

fixing table layout

--- src/amindblowingworld/view_index.clj
+++ src/amindblowingworld/view_index.clj
@@ -69,9 +69,9 @@
               [:input#registerUser {:type "button" :value "Login and damage!"}]]
             [:br {:style "clear: right;"}]]
           [:h3 "Tribes and settlements"]
-          [:div#tableDiv]
+          [:div#tableDiv
             [:table#tribesAndSettlements {:class "display" :cellspacing "0" :width "100%"}
               [:thead (table-headers)]
-              [:tfoot (table-headers)]]]
+              [:tfoot (table-headers)]]]]
         [:div#notLoggedInDialog {:title "Please Login"} [:p "You must LogIn to be able to damage the world"]]]
     ]))


remove superflous code and add a control mechanism

--- test/example/composed_dubstep.clj
+++ test/example/composed_dubstep.clj
@@ -10,6 +10,7 @@
          kick (* (* kickenv 7) (sin-osc (+ 40 (* kickenv kickenv kickenv 200))))]
      (clip2 kick 1))))

+
 (defcgen snare-drum
   "basic synthesised snare drum"
   [bpm {:default 120 :doc "tempo of snare in beats per minute"}]
@@ -17,6 +18,7 @@
    (let [snare (* 3 (pink-noise [1 1]) (apply + (* (decay (impulse (/ bpm 240) 0.5) [0.4 2]) [1 0.05])))
          snare (+ snare (bpf (* 4 snare) 2000))]
      (clip2 snare 1))))
+

 (defcgen wobble
   "wobble an input src"
@@ -29,9 +31,9 @@
          wob   (+ wob (bpf wob 1500 2))]
      (+ wob (* 0.2 (g-verb wob 9 0.7 0.7))))))

+
 (definst dubstep [bpm 120 wobble-factor 1 note 50]
- (let [trig (impulse:kr (/ bpm 120))
-       freq (midicps (lag note 0.25))
+ (let [freq (midicps (lag note 0.25))
        bass (apply + (saw (* freq [0.99 1.01])))
        bass (wobble bass wobble-factor)
        kick (kick-drum bpm :pattern [1 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0])
@@ -40,4 +42,5 @@
    (clip2 (+ bass kick snare) 1)))

 ;;(dubstep)
+;;(ctl dubstep :wobble-factor 3)
 ;;(stop)


Comments

Comments

--- src/circle/backend/load_balancer.clj
+++ src/circle/backend/load_balancer.clj
@@ -145,7 +145,7 @@
   "Returns a seq of instance-ids, all terminated instances attached to the LB"
   [lb-name]
   (->> (get-health lb-name)
-       (filter #(= "Instance is in terminated state." (:description %)))
+       (filter #(= "Instance is in terminated state." (:description %))) ;; there doesn't appear to be a useful, specific error code, so use the description string.
        (map :instanceId)))

 (defn healthy? [lb-name & instance-ids]


Add `!` suffix to `update-ModulesSelected-for-affected-days`

to indicate that there are side effects

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -716,724 +716,7 @@
     ; adjust rowspan of
     (attr $thElem "rowspan" (max nrNonEmptyRows 2))))

-(defn- create-lesson-div
-  "Creates a
 element for a new lesson using jQuery"
-  [& {:keys [moduleCode moduleName lessonType lessonGroup venue slotsOcc
-             bgColorCssClass isActuallySelected?]}]
-  (let [$divElem  ($ "
" (js-obj "class" "lesson"))]
-    (.addClass $divElem bgColorCssClass)
-    ; add background color css class
-    (.append $divElem (text ($ "
") (str moduleCode " " moduleName)))
-    (.append $divElem (text ($ "
") (str lessonType " [" lessonGroup "]")))
-    (.append $divElem (text ($ "
") venue))
-    (width $divElem (str (* half-hour-pixels slotsOcc) "px"))
-    ; make the
 less opaque for a lesson added by jQuery UI draggable
-    (if (not isActuallySelected?)
-        (.addClass $divElem "lesson-droppable-not-hover"))
-    $divElem))
-
-(defn- add-module-lesson!
-  "Adds a single lesson of a module the timetable.
-   Returns a `ModulesSelectedLessonInfo` object augmented with the `:divElem`,
-   `:moduleCode`, `:lessonType` and `:lessonGroup` keys."
-  [& {:keys [moduleCode moduleName lessonType lessonGroup
-             day startTime endTime venue
-             bgColorCssClass isActuallySelected?]}]
-  (let [rowNum    (find-free-row-for-lesson day startTime endTime)
-        slotsOcc  (- endTime startTime)
-
-        $divElem
-        (create-lesson-div :moduleCode moduleCode, :moduleName moduleName,
-                           :lessonType lessonType, :lessonGroup lessonGroup,
-                           :venue venue, :slotsOcc slotsOcc,
-                           :bgColorCssClass bgColorCssClass,
-                           :isActuallySelected? isActuallySelected?)]
-    ; Create new row if necessary
-    (if (= rowNum (timetable-day-get-nr-rows day))
-        (add-new-row-to-timetable-day! day))
-
-    ; Update in-memory representation of timetable
-    (timetable-add-lesson! day
-                           rowNum
-                           {:moduleCode moduleCode,
-                            :lessonType lessonType,
-                            :lessonGroup lessonGroup,
-                            :startTime startTime,
-                            :endTime endTime}
-                           $divElem)
-
-    (let [$td (html-timetable-get-td day rowNum startTime)]
-      (.append $td $divElem)
-      ; Increase colspan and delete the  after it that occupy the timeslot
-      ; of the lesson
-      (attr $td "colspan" slotsOcc)
-      (doseq [$siblingTd (take (- slotsOcc 1) (.nextAll $td))]
-        (.remove $siblingTd))
-
-      {:day day, :rowNum rowNum, :startTime startTime, :endTime endTime,
-       :moduleCode moduleCode, :lessonType lessonType, :lessonGroup lessonGroup,
-       :divElem $divElem})))
-
-(def ^{:doc     "Sequence of `TimetableLessonInfo` objects augmented with the
-                 `:divElem`, `:moduleCode`, `:lessonType`, `:lessonGroup` keys.
-                 These are 'fake' lessons created when a selected lesson is
-                 being dragged by the user, in order for him/her to switch to
-                 a different lesson group for that lesson type."
-       :private true}
-  Lessons-Created-By-Draggable nil)
-
-; Forward declaration
-(declare add-module-lesson-group!)
-(declare overall-timetable-prune-empty-rows)
-(declare add-missing-td-elements-replacing-lesson)
-(declare remove-lesson-group-html)
-(declare shift-lessons-upwards-to-replace-empty-slots!)
-(declare update-ModulesSelected-for-affected-days)
-
-(def ^{:doc     "Key for a data attribute added to a draggable
 helper
-                 when the helper has been dropped onto a droppable
.
-                 This is used to detect if a lesson group switch has occurred."
-       :private true}
-  LESSON-GROUP-CHANGE-KEY "lessonGroupChangeTo")
-
-(defn- lesson-draggable-start-evt-handler-maker
-  "Returns a function that can be used as the `start` event handler for a
-   draggable lesson.
-
-   Details of the returned function can be found here:
-
-       http://api.jqueryui.com/draggable/#event-start"
-  [moduleCode lessonType selectedLessonGroup bgColorCssClass]
-  (fn [evt ui]
-    (.addClass (aget ui "helper") "lesson-draggable-helper")
-    (.css (aget ui "helper") "cursor" "grabbing")
-    (let [allLessonGroups
-          (get-all-lesson-group-strings moduleCode lessonType)
-
-          notSelectedLessonGroups
-          (remove #{selectedLessonGroup} allLessonGroups)
-
-          ; Add all the
 elements
-          augmentedTTLessonInfoSeq
-          (doall
-            (flatten
-              (map (fn [unselectedLessonGroup]
-                     (add-module-lesson-group! moduleCode lessonType
-                                               unselectedLessonGroup
-                                               bgColorCssClass false))
-                   notSelectedLessonGroups)))]
-      (set! Lessons-Created-By-Draggable augmentedTTLessonInfoSeq))))
-
-(defn- $lesson-div-remove
-  "Removes the
 object of a lesson module, and replaces the former
-   columns occupied by its parent  with new  elements."
-  [$lessonDiv startTime endTime]
-  (let [$parentTd (parent $lessonDiv)]
-    (remove-attr $parentTd "colspan")
-    (.remove $lessonDiv)
-    (add-missing-td-elements-replacing-lesson $parentTd startTime endTime)))
-
-(defn- lesson-draggable-stop-evt-handler-maker
-  "Returns a function used as the `stop` event handler for a draggable lesson."
-  [moduleCode lessonType lessonGroup bgColorCssClass]
-  (fn [evt ui]
-    (let [$helper         (aget ui "helper")
-          destLessonGroup (data $helper LESSON-GROUP-CHANGE-KEY)
-
-          affectedDaysSet
-          (get-set-from-seq-of-maps-with-day-key Lessons-Created-By-Draggable)]
-
-      (doseq [augTTLessonInfo Lessons-Created-By-Draggable]
-        (timetable-remove-lesson! (:day augTTLessonInfo)
-                                  (:rowNum augTTLessonInfo)
-                                  (dissoc augTTLessonInfo :divElem :day
-                                          :rowNum)))
-
-      (doseq [augTTLessonInfo Lessons-Created-By-Draggable]
-        (let [$divElem  (:divElem augTTLessonInfo)]
-          ($lesson-div-remove $divElem (:startTime augTTLessonInfo)
-                              (:endTime augTTLessonInfo))))
-
-      (overall-timetable-prune-empty-rows affectedDaysSet)
-      (set! Lessons-Created-By-Draggable nil)
-
-      ; User has dropped the draggable helper
 onto a droppable
-      (if (not (nil? destLessonGroup))
-          (let [augTTLessonInfoSeq (remove-lesson-group-html moduleCode
-                                                             lessonType)
-                affectedDaysSet    (get-set-from-seq-of-maps-with-day-key
-                                     augTTLessonInfoSeq)]
-            ; remove the current lesson group
-            (doseq [augTTLessonInfo augTTLessonInfoSeq]
-              (let [day          (:day augTTLessonInfo)
-                    rowNum       (:rowNum augTTLessonInfo)
-                    ttLessonInfo (dissoc augTTLessonInfo :day :rowNum)]
-                (timetable-remove-lesson! day rowNum ttLessonInfo)))
-
-            (shift-lessons-upwards-to-replace-empty-slots! augTTLessonInfoSeq)
-            (overall-timetable-prune-empty-rows affectedDaysSet)
-            (update-ModulesSelected-for-affected-days affectedDaysSet)
-
-            ; add the newly selected lesson group
-            (add-module-lesson-group! moduleCode lessonType destLessonGroup
-                                      bgColorCssClass true)
-
-            (update-document-location-hash-with-changed-lesson-group!
-              moduleCode lessonType destLessonGroup))))))
-
-(defn- make-added-lessons-draggable
-  "Makes the
 elements of selected lessons draggable."
-  [$divElemSeq moduleCode lessonType lessonGroup bgColorCssClass]
-  ; And Drag event handler
-  (doseq [$divElem $divElemSeq]
-    (.css $divElem "cursor" "grab")
-    (.draggable $divElem
-                (js-obj "zIndex" 100
-                        "helper" "clone"
-                        "revert" "invalid"
-                        "start"  (lesson-draggable-start-evt-handler-maker
-                                   moduleCode lessonType lessonGroup
-                                   bgColorCssClass)
-                        "stop"   (lesson-draggable-stop-evt-handler-maker
-                                   moduleCode lessonType lessonGroup
-                                   bgColorCssClass)))))
-
-(defn- make-fake-lessons-droppable
-  "For 'fake' lessons created due to a lesson
 being dragged, we make
-   them droppable in order for the user to switch lesson groups."
-  [augModuleSelectedLessonInfoSeq]
-  (doseq [augModuleSelectedLessonInfo augModuleSelectedLessonInfoSeq]
-    (let [$divElem (:divElem augModuleSelectedLessonInfo)]
-      (.droppable
-        $divElem
-        (js-obj "tolerance" "intersect"
-
-                "over"
-                (fn [evt ui]
-                  (.removeClass $divElem "lesson-droppable-not-hover")
-                  (.addClass $divElem "lesson-droppable-hover"))
-
-                "out"
-                (fn [evt ui]
-                  (.removeClass $divElem "lesson-droppable-hover")
-                  (.addClass $divElem "lesson-droppable-not-hover"))
-
-                "drop"
-                (fn [evt ui]
-                  (let [$helper (aget ui "helper")]
-                    ; Set a data attribute on the draggable helper to signal
-                    ; that the user has dropped the
 on a droppable to
-                    ; change the lesson group
-                    (data $helper
-                          LESSON-GROUP-CHANGE-KEY
-                          (:lessonGroup augModuleSelectedLessonInfo)))))))))
-
-(defn- add-module-lesson-group!
-  "Adds a lesson group of a module to the timetable.
-
-   The `isActuallySelected?` param is used to indicate if the current lesson
-   group is selected by the user.
-   A value of `true` indicates that the user actually selected the lesson group.
-   A value of `false` indicates that the current lesson group is added by the
-   `lesson-draggable-start-evt-handler-maker` function and is not selected by
-   the user.
-
-   Returns a sequence of `ModulesSelectedLessonInfo` objects each augmented
-   with the `:divElem`, `:moduleCode`, `:lessonType`, `:lessonGroup` keys."
-  [moduleCode lessonType lessonGroup bgColorCssClass isActuallySelected?
-   & {:keys [addedViaUrlHashInit?] :or {addedViaUrlHashInit? false}}]
-  (if (module-has-lesson-group? moduleCode lessonType lessonGroup)
-      (let [moduleName          (get-module-name-from-module-code moduleCode)
-            modulesMapLessonSeq (get-ModulesMapLesson-seq moduleCode lessonType
-                                                          lessonGroup)
-
-            augLessonInfoSeq
-            (doall
-              (map (fn [modulesMapLesson]
-                     (add-module-lesson!
-                       :moduleCode moduleCode, :moduleName moduleName,
-                       :lessonType lessonType, :lessonGroup lessonGroup,
-                       :day        (:day modulesMapLesson),
-                       :startTime  (:startTime modulesMapLesson),
-                       :endTime    (:endTime modulesMapLesson),
-                       :venue      (:venue modulesMapLesson),
-                       :bgColorCssClass bgColorCssClass,
-                       :isActuallySelected? isActuallySelected?))
-                   modulesMapLessonSeq))
-
-            lessonInfoSeq       (map #(dissoc %1 :divElem :moduleCode
-                                              :lessonType :lessonGroup)
-                                     augLessonInfoSeq)
-            $divElemSeq         (map #(:divElem %1) augLessonInfoSeq)]
-        (if isActuallySelected?
-            (do
-              (update-ModulesSelected-with-lesson-group! moduleCode lessonType
-                                                         lessonGroup
-                                                         lessonInfoSeq)
-              (if (module-not-in-ModulesSelectedOrder? moduleCode)
-                  (do
-                    (add-to-ModulesSelectedOrder! moduleCode)
-                    ; Micro optimization for modules added via url hash
-                    ; during initialization
-                    (if (not addedViaUrlHashInit?)
-                        (select2-box-update-modules))))
-
-              ; Only lesson types with more than 1 option of lesson group
-              ; will be draggable
-              (if (module-lesson-type-has-multiple-choices? moduleCode
-                                                            lessonType)
-                  (make-added-lessons-draggable $divElemSeq moduleCode
-                                                lessonType lessonGroup
-                                                bgColorCssClass)))
-
-            ; lesson was added due to draggable

-            ; Make it droppable
-            (make-fake-lessons-droppable augLessonInfoSeq))
-        augLessonInfoSeq)))
-
-(defn add-module!
-  "Adds a module to the timetable.
-
-   A random lesson group of each type of lesson (Lecture, Tutorial, etc) will
-   be added."
-  [moduleCode]
-  (if (not (is-module-selected? moduleCode))
-      (let [lessonTypes     (get-all-lesson-types-for-module moduleCode)
-            bgColorCssClass (get-next-lesson-bg-color-css-class)
-
-            newModInfoSeq
-            (reduce (fn [moduleInfoSeq lessonType]
-                      (conj moduleInfoSeq
-                            {:moduleCode  moduleCode,
-                             :lessonType  lessonType,
-                             :lessonGroup
-                             (get-first-lesson-group-for-module-lesson-type
-                               moduleCode lessonType)}))
-                    []
-                    lessonTypes)]
-
-        (doseq [moduleInfo newModInfoSeq]
-          (add-module-lesson-group! (:moduleCode moduleInfo)
-                                    (:lessonType moduleInfo)
-                                    (:lessonGroup moduleInfo)
-                                    bgColorCssClass
-                                    true))
-
-        ; Update URL hash with newly added module
-        (update-document-location-hash-with-new-module!
-          {:moduleCode moduleCode,
-
-           :preToUrlHashLessonGroupSeqSorted
-           (sort-PreToUrlHashLessonGroup-seq
-             (map #(dissoc
-                     (assoc %1 :lessonType
-                            (Lesson-Type-Long-To-Short-Form (:lessonType %1)))
-                     :moduleCode)
-                  newModInfoSeq))}))))
-
-(defn- get-module-info-from-url-hash-module-info
-  "Computes the final module info sequence for modules added via the url hash
-   on page initialization.
-
-   NOTE: This function should only be called by
-         `add-module-lesson-groups-from-url-hash!`"
-  [moduleInfoSeq]
-  (let [moduleLessonGroupsMap
-        (reduce (fn [lgMap modInfo]
-                  ; Replaces earlier lesson groups with later ones if we
-                  ; encounter a duplicate lesson type
-                  (assoc-in lgMap [(:moduleCode modInfo) (:lessonType modInfo)]
-                            (:lessonGroup modInfo)))
-                {}
-                moduleInfoSeq)
-
-        moduleCodesSeq (distinct (map #(:moduleCode %1) moduleInfoSeq))
-
-        ; Map of Module Code -> Sequence of lesson type strings
-        moduleLessonTypes
-        (reduce (fn [lessonTypesMap moduleCode]
-                  (let [ltMap (get moduleLessonGroupsMap moduleCode)]
-                    (assoc lessonTypesMap moduleCode (keys ltMap))))
-                {}
-                moduleCodesSeq)
-
-        ; Similar to `moduleLessonTypes`, but contains the full sequence of
-        ; lesson type strings
-        moduleLessonTypesFull
-        (reduce (fn [lessonTypesMap moduleCode]
-                  (assoc lessonTypesMap moduleCode
-                         (get-all-lesson-types-for-module moduleCode)))
-                {}
-                moduleCodesSeq)
-
-        ; Obtained from the difference between `moduleLessonTypesFull` and
-        ; `moduleLessonTypes`
-        missingModuleLessonTypes
-        (reduce (fn [missingLessonTypesMap moduleCode]
-                  (let [missingLessonTypes
-                        (clojure.set/difference
-                          (set (get moduleLessonTypesFull moduleCode))
-                          (set (get moduleLessonTypes moduleCode)))]
-                    (if (empty? missingLessonTypes)
-                        missingLessonTypesMap
-                        (assoc missingLessonTypesMap moduleCode
-                               (seq missingLessonTypes)))))
-                {}
-                moduleCodesSeq)
-
-        ; similar to `moduleLessonGroupsMap`, but includes missing lesson types
-        moduleLessonGroupsMapFinal
-        (reduce (fn [lgMapFinal [moduleCode missingLessonTypes]]
-                  (reduce
-                    (fn [lgMap lessonType]
-                      (assoc-in lgMap [moduleCode lessonType]
-                                (get-first-lesson-group-for-module-lesson-type
-                                  moduleCode lessonType)))
-                    lgMapFinal
-                    missingLessonTypes))
-                moduleLessonGroupsMap
-                missingModuleLessonTypes)]
-
-    ; Produce the final module info sequence
-    (flatten
-      (map (fn [moduleCode]
-             (map (fn [[lessonType lessonGroup]]
-                    {:moduleCode  moduleCode
-                     :lessonType  lessonType
-                     :lessonGroup lessonGroup})
-                  (get moduleLessonGroupsMapFinal moduleCode)))
-           moduleCodesSeq))))
-
-(defn add-module-lesson-groups-from-url-hash!
-  "Adds the module lesson groups available in the url hash. Erroneous lesson
-   groups are ignored. If there are missing lesson groups for any module after
-   going through the url hash, a random lesson group is chosen.
-
-   NOTE: This function should only be called once."
-  [urlHash]
-  (let [moduleUrlHashArray                (.split urlHash "&")
-
-        modUrlHashRegex
-        #"^([A-Z]+\d{4}[A-Z]*)_(DL|L|LAB|PL|PT|R|SEM|ST|T|T2|T3)=([A-Z0-9]+)$"
-
-        ; Sequence of non-nil match arrays
-        matchArraySeq
-        (filter (fn [matchArray] (not (nil? matchArray)))
-                (map (fn [modUrlHash] (.exec modUrlHashRegex modUrlHash))
-                     moduleUrlHashArray))
-
-        ; Sequence of existing lesson groups
-        moduleInfoExistent
-        (filter
-          #(module-has-lesson-group? (:moduleCode %1) (:lessonType %1)
-                                     (:lessonGroup %1))
-          ; convert matchArrays to maps
-          (map (fn [matchArray]
-                 {:moduleCode  (nth matchArray 1)
-                  :lessonType  (Lesson-Type-Short-To-Long-Form
-                                 (nth matchArray 2))
-                  :lessonGroup (nth matchArray 3)})
-               matchArraySeq))
-
-        ; Module code to CSS class for lesson div background color
-        moduleToColorsMap
-        (reduce
-          (fn [m2cMap moduleCode]
-            (assoc m2cMap moduleCode (get-next-lesson-bg-color-css-class)))
-          {}
-          (distinct (map (fn [modInfo] (:moduleCode modInfo))
-                         moduleInfoExistent)))
-
-        moduleInfoFinal
-        (get-module-info-from-url-hash-module-info moduleInfoExistent)]
-
-    (.log js/console (str "moduleInfoExistent = " (.stringify js/JSON (clj->js moduleInfoExistent))))
-    (.log js/console (str "moduleInfoFinal = " (.stringify js/JSON (clj->js moduleInfoFinal))))
-    ; Add the module lesson groups
-    (doseq [modInfo moduleInfoFinal]
-      (let [moduleCode      (:moduleCode modInfo)
-            bgColorCssClass (get moduleToColorsMap moduleCode)]
-        (add-module-lesson-group! moduleCode
-                                  (:lessonType modInfo)
-                                  (:lessonGroup modInfo)
-                                  bgColorCssClass
-                                  true
-                                  :addedViaUrlHashInit? true)))
-
-    ; Update Select2 box, since this is not done in `add-module-lesson-group!`.
-    ; Repeated work will be done there if we did so
-    (select2-box-update-modules)
-    ; Update url hash
-    (set-document-location-hash-based-on-modules-order!)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;
-; Functions for Removing Modules
-;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- add-missing-td-elements-replacing-lesson
-  "Adds  elements that were removed by the `add-module-lesson!` function
-   to make way for the lesson."
-  [$parentTd startTime endTime]
-  (loop [$currentTd $parentTd
-         timeIdx    (inc startTime)]
-    (if (>= timeIdx endTime)
-        nil
-        (let [[hourClass minuteClass]
-              (get-css-hour-minute-classes-for-time timeIdx)
-
-              $newTdElem
-              ($ "" (js-obj "class" (str hourClass " " minuteClass)))]
-          ; Insert after new  after the current
-          (insert-after $newTdElem $currentTd)
-          ; Then use the new  as the current  in the next iteration
-          (recur $newTdElem (inc timeIdx))))))
-
-(defn- remove-lesson-group-html
-  "Removes a lesson group for a module from the HTML timetable.
-   This does NOT remove any empty rows / perform module shifting.
-
-   Returns a sequence of `ttLessonInfo` objects which contain
-   additional `:day` and `:rowNum` keys."
-  [moduleCode lessonType]
-  (let [lessonGroupDetails (get-in ModulesSelected [moduleCode lessonType])
-        lessonGroup        (:label lessonGroupDetails)
-        lessonInfoSeq      (:info lessonGroupDetails)]
-    (map (fn [modSelLessonInfo]
-           (let [day          (:day modSelLessonInfo)
-                 rowNum       (:rowNum modSelLessonInfo)
-                 startTime    (:startTime modSelLessonInfo)
-                 endTime      (:endTime modSelLessonInfo)
-                 ttLessonInfo {:moduleCode moduleCode, :lessonType lessonType,
-                               :lessonGroup lessonGroup, :startTime startTime,
-                               :endTime endTime}
-                 $lessonDiv   (timetable-get-lesson-div day rowNum
-                                                        ttLessonInfo)]
-             ($lesson-div-remove $lessonDiv startTime endTime)
-             (assoc ttLessonInfo :day day, :rowNum rowNum)))
-         lessonInfoSeq)))
-
-(defn- get-largest-consecutive-time-slot-freed-up-by-lesson
-  "Given a removed lesson, find the largest interval on the same row which is
-   freed up due to the its removal.
-
-   For instance, given this timetable row:
-
-   x | x | x |  |  |  | y | y | y | y |  |  | z | z
-
-   And we remove the lesson occupying the slots labelled 'y'. The 4 slots
-   currently occupied by 'y', along with the 3 empty slots to its left and the
-   2 empty slots to its right will be freed up.
-
-   Given that the first slot occupied by the label 'x' is the index 0, this
-   function will return the vector [3 11].
-
-   The parameter `removedAugTTLessonInfo` is a `TimetableLessonInfo` object
-   augmented with the `:day` and `:rowNum` keys."
-  [removedAugTTLessonInfo]
-  (let [day        (:day removedAugTTLessonInfo)
-        rowNum     (:rowNum removedAugTTLessonInfo)
-        startTime  (:startTime removedAugTTLessonInfo)
-        endTime    (:endTime removedAugTTLessonInfo)
-        minTimeIdx time-helper/TIME-INDEX-MIN
-        maxTimeIdx time-helper/TIME-INDEX-MAX]
-
-    (.log js/console "get-largest-consecutive-time-slot-freed-up-by-lesson")
-    [
-      ; Find the lesson right before the removed lesson
-      (let [immediateTTLessonInfoBefore
-            (timetable-get-closest-TimetableLessonInfo-before-time
-              day rowNum startTime)]
-        (if (nil? immediateTTLessonInfoBefore)
-            minTimeIdx
-            (:endTime immediateTTLessonInfoBefore)))
-
-      ; Find the lesson right after the removed lesson
-      (let [immediateTTLessonInfoAfter
-            (timetable-get-closest-TimetableLessonInfo-on-or-after-time
-              day rowNum endTime)]
-        (if (nil? immediateTTLessonInfoAfter)
-            maxTimeIdx
-            (dec (:startTime immediateTTLessonInfoAfter))))
-    ]))
-
-(defn- find-replacement-lessons-within-time
-  "For a removed lesson, find other lessons on the same day but in a row below
-   the removed lesson which could be shifted upwards and take the timeslots
-   freed up by the removed lesson.
-
-   The `removedAugTTLessonInfo` parameter is an `TimetableLessonInfo` object
-   augmented with the `:day` and `:rowNum` keys.
-
-   Returns a map, where keys are `TimetableLessonInfo` objects augmented with
-   `:day` and `:rowNum` keys, and values are jQuery
 objects for the
-   shifted lesson."
-  [{:keys [day rowNum startTime endTime] :as removedAugTTLessonInfo}]
-  (let [; This is the time range freed up by removal of the lesson
-        [lowTimeIdx highTimeIdx]
-        (get-largest-consecutive-time-slot-freed-up-by-lesson
-          removedAugTTLessonInfo)
-
-        not-occupied?
-        (fn [occupiedVec startTime endTime]
-          (.log js/console (str "inside not-occupied?, occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
-          (every? #(nil? %1)
-                  (map #(nth occupiedVec %1)
-                       (range startTime endTime))))]
-
-    (.log js/console "find-replacement-lessons-within-time")
-    (.log js/console (str "lowTimeIdx = " lowTimeIdx ", highTimeIdx = " highTimeIdx))
-    (:augTTLessonInfoMapToShift
-      (reduce
-        (fn [{:keys [augTTLessonInfoMapToShift occupiedVec]
-              :as   reduceResult}
-             rowIdx]
-          (if (timetable-row-empty? day rowIdx)
-              ; Skip empty row
-              reduceResult
-
-              ; Non-empty row
-              (let [ttLessonInfoToShift
-                    (timetable-row-get-lessons-satisfying-pred
-                      day rowIdx
-                      (fn [{:keys [startTime endTime]}]
-                        (and (>= startTime lowTimeIdx)
-                             (<= (dec endTime) highTimeIdx)
-                             (not-occupied? occupiedVec startTime endTime))))]
-                (.log js/console "suspect above")
-                (.log js/console (str "rowIdx = " rowIdx))
-                (.log js/console (str "occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
-                {:augTTLessonInfoMapToShift
-                 (reduce (fn [augTTLessonInfoMap [ttLessonInfo $divElem]]
-                           (.log js/console ":augTTLessonInfoMapToShift")
-                           (assoc augTTLessonInfoMap
-                                  (assoc ttLessonInfo :day day :rowNum rowIdx)
-                                  $divElem))
-                         augTTLessonInfoMapToShift
-                         ttLessonInfoToShift)
-
-                 :occupiedVec
-                 (reduce (fn [occVec [{:keys [startTime endTime]}  _]]
-                           (.log js/console ":occupiedVec")
-                           (reduce (fn [ov timeIdx] (assoc ov timeIdx true))
-                                   occVec
-                                   (range startTime endTime)))
-                         occupiedVec
-                         ttLessonInfoToShift)})))
-        {:augTTLessonInfoMapToShift {},
-         ; nil = free slot, true = occupied slot
-         :occupiedVec      (vec (map (fn [t] nil)
-                                     (range time-helper/TIME-INDEX-MIN
-                                            (inc time-helper/TIME-INDEX-MAX))))}
-        ; go through each row in the day, below the current row
-        (drop (inc rowNum) (range (timetable-day-get-nr-rows day)))))))
-
-(defn- shift-lesson-to-row!
-  "Shifts a lesson from its original row up to the given row.
-
-   The parameter `augTTLessonInfo` is a `TimetableLessonInfo` object augmented
-   with the `:day` and `:rowNum` keys."
-  [destinationRowNum {:keys [day rowNum startTime endTime] :as augTTLessonInfo}
-   $divElem]
-  (let [slotsOccupied (- endTime startTime)
-        $sourceTd     (html-timetable-get-td day rowNum startTime)
-        $destTd       (html-timetable-get-td day destinationRowNum startTime)
-        ttLessonInfo  (dissoc augTTLessonInfo :day :rowNum)]
-    (.log js/console (str "day = " day ", sourceRowNum = " rowNum ", destinationRowNum = " destinationRowNum))
-    ; Transfer lesson
 to the destination
-    (.append $destTd $divElem)
-    ; restore the colspan of the source
-    (remove-attr $sourceTd "colspan")
-    ; fill in removed  for the source
-    (add-missing-td-elements-replacing-lesson $sourceTd startTime endTime)
-    ; remove sibling  for the destination  to make way for columns
-    ; occupied by $divElem
-    (doseq [$siblingTd (take (dec slotsOccupied) (.nextAll $destTd))]
-      (.remove $siblingTd))
-    ; update colspan of destination
-    (attr $destTd "colspan" slotsOccupied)
-    ; update `Timetable` global
-    (timetable-remove-lesson! day rowNum ttLessonInfo)
-    (timetable-add-lesson! day destinationRowNum ttLessonInfo $divElem)))
-
-(defn- shift-lessons-upwards-to-replace-empty-slots!
-  "For each removed lesson, see if there are any lessons in rows below it that
-   can be shifted upwards to occupy the empty slots resulting from its removal.
-
-   The parameter `removedAugmentedTTLessonInfoSeq` is a sequence of
-   `TimetableLessonInfo` objects augmented with the `:day` and `:rowNum` keys."
-  [removedAugmentedTTLessonInfoSeq]
-  (let [; we do not consider any lessons on empty rows for ease of
-        ; implementation
-        exclude-lessons-on-empty-rows
-        (fn [lessonInfoSeq]
-          (filter (fn [{:keys [day rowNum]}]
-                    (timetable-row-not-empty? day rowNum))
-                  lessonInfoSeq))
-
-        sort-lesson-info-seq
-        (fn [lessonInfoSeq]
-          (sort #(let [dayA (:day %1)
-                       dayB (:day %2)]
-                   (if (= dayA dayB)
-                       (< (:rowNum %1) (:rowNum %2))
-                       (< dayA dayB)))
-                lessonInfoSeq))]
-
-    (.log js/console "Hoo hoo")
-    (loop [sortedAugTTLessonInfoSeq
-           (sort-lesson-info-seq (exclude-lessons-on-empty-rows
-                                   removedAugmentedTTLessonInfoSeq))
-
-           nextLessonInfoVec    []]
-      (.log js/console "Inside the loop, the loop")
-      (cond (and (empty? sortedAugTTLessonInfoSeq) (empty? nextLessonInfoVec))
-            nil
-
-            ; we're done for the current set of lessons. Move on to the
-            ; set of lessons that were shifted upwards.
-            (empty? sortedAugTTLessonInfoSeq)
-            (recur (sort-lesson-info-seq (exclude-lessons-on-empty-rows
-                                           nextLessonInfoVec))
-                   [])
-
-            ; find timeslot to shift up to replace gap
-            :else
-            (let [currentAugTTLessonInfo (first sortedAugTTLessonInfoSeq)
-                  rowNum                 (:rowNum currentAugTTLessonInfo)
-
-                  ; map of augmented `TimeTableLessonInfo` objects to the
-                  ; jQuery
 element
-                  augTTLessonInfoTo$DivElem
-                  (find-replacement-lessons-within-time currentAugTTLessonInfo)]
-
-              (doseq [[augTTLessonInfo $divElem] augTTLessonInfoTo$DivElem]
-                (.log js/console "shift-lesson-to-row")
-                (shift-lesson-to-row! rowNum augTTLessonInfo $divElem))
-              (.log js/console "gonna recur...")
-              (recur (rest sortedAugTTLessonInfoSeq)
-                     ; append newly shifted lessons to nextLessonInfoVec
-                     (reduce (fn [augTTLessonInfoVec [augTTLessonInfo _]]
-                               (conj augTTLessonInfoVec augTTLessonInfo))
-                             nextLessonInfoVec
-                             augTTLessonInfoTo$DivElem)))))))
-
-(defn- overall-timetable-prune-empty-rows
-  "Removes empty rows resulting from the removal of lessons on given days."
-  [affectedDaysSet]
-  (doseq [day affectedDaysSet]
-    (let [rowsPartition (timetable-day-get-empty-and-non-empty-rows day)]
-      (.log js/console (str "day = " day ", emptyRows = "
-                            (.stringify js/JSON (clj->js (:emptyRows rowsPartition)))
-                            ", nonEmptyRows = "
-                            (.stringify js/JSON (clj->js (:nonEmptyRows rowsPartition)))))
-
-      (timetable-prune-empty-rows-for-day! day rowsPartition)
-      (html-timetable-prune-empty-rows-for-day day rowsPartition))))
-
-(defn- update-ModulesSelected-for-affected-days
+(defn- update-ModulesSelected-for-affected-days!
   "Given a set of days that may possibly be affected by removal and shifting of
    lessons, update the individual entries in the `ModulesSelected` global."
   [affectedDaysSet]
@@ -1464,6 +747,722 @@
                          :startTime startTime,
                          :endTime endTime}))))))))))

+(defn- create-lesson-div
+  "Creates a
 element for a new lesson using jQuery"
+  [& {:keys [moduleCode moduleName lessonType lessonGroup venue slotsOcc
+             bgColorCssClass isActuallySelected?]}]
+  (let [$divElem  ($ "
" (js-obj "class" "lesson"))]
+    (.addClass $divElem bgColorCssClass)
+    ; add background color css class
+    (.append $divElem (text ($ "
") (str moduleCode " " moduleName)))
+    (.append $divElem (text ($ "
") (str lessonType " [" lessonGroup "]")))
+    (.append $divElem (text ($ "
") venue))
+    (width $divElem (str (* half-hour-pixels slotsOcc) "px"))
+    ; make the
 less opaque for a lesson added by jQuery UI draggable
+    (if (not isActuallySelected?)
+        (.addClass $divElem "lesson-droppable-not-hover"))
+    $divElem))
+
+(defn- add-module-lesson!
+  "Adds a single lesson of a module the timetable.
+   Returns a `ModulesSelectedLessonInfo` object augmented with the `:divElem`,
+   `:moduleCode`, `:lessonType` and `:lessonGroup` keys."
+  [& {:keys [moduleCode moduleName lessonType lessonGroup
+             day startTime endTime venue
+             bgColorCssClass isActuallySelected?]}]
+  (let [rowNum    (find-free-row-for-lesson day startTime endTime)
+        slotsOcc  (- endTime startTime)
+
+        $divElem
+        (create-lesson-div :moduleCode moduleCode, :moduleName moduleName,
+                           :lessonType lessonType, :lessonGroup lessonGroup,
+                           :venue venue, :slotsOcc slotsOcc,
+                           :bgColorCssClass bgColorCssClass,
+                           :isActuallySelected? isActuallySelected?)]
+    ; Create new row if necessary
+    (if (= rowNum (timetable-day-get-nr-rows day))
+        (add-new-row-to-timetable-day! day))
+
+    ; Update in-memory representation of timetable
+    (timetable-add-lesson! day
+                           rowNum
+                           {:moduleCode moduleCode,
+                            :lessonType lessonType,
+                            :lessonGroup lessonGroup,
+                            :startTime startTime,
+                            :endTime endTime}
+                           $divElem)
+
+    (let [$td (html-timetable-get-td day rowNum startTime)]
+      (.append $td $divElem)
+      ; Increase colspan and delete the  after it that occupy the timeslot
+      ; of the lesson
+      (attr $td "colspan" slotsOcc)
+      (doseq [$siblingTd (take (- slotsOcc 1) (.nextAll $td))]
+        (.remove $siblingTd))
+
+      {:day day, :rowNum rowNum, :startTime startTime, :endTime endTime,
+       :moduleCode moduleCode, :lessonType lessonType, :lessonGroup lessonGroup,
+       :divElem $divElem})))
+
+(def ^{:doc     "Sequence of `TimetableLessonInfo` objects augmented with the
+                 `:divElem`, `:moduleCode`, `:lessonType`, `:lessonGroup` keys.
+                 These are 'fake' lessons created when a selected lesson is
+                 being dragged by the user, in order for him/her to switch to
+                 a different lesson group for that lesson type."
+       :private true}
+  Lessons-Created-By-Draggable nil)
+
+; Forward declaration
+(declare add-module-lesson-group!)
+(declare overall-timetable-prune-empty-rows)
+(declare add-missing-td-elements-replacing-lesson)
+(declare remove-lesson-group-html)
+(declare shift-lessons-upwards-to-replace-empty-slots!)
+
+(def ^{:doc     "Key for a data attribute added to a draggable
 helper
+                 when the helper has been dropped onto a droppable
.
+                 This is used to detect if a lesson group switch has occurred."
+       :private true}
+  LESSON-GROUP-CHANGE-KEY "lessonGroupChangeTo")
+
+(defn- lesson-draggable-start-evt-handler-maker
+  "Returns a function that can be used as the `start` event handler for a
+   draggable lesson.
+
+   Details of the returned function can be found here:
+
+       http://api.jqueryui.com/draggable/#event-start"
+  [moduleCode lessonType selectedLessonGroup bgColorCssClass]
+  (fn [evt ui]
+    (.addClass (aget ui "helper") "lesson-draggable-helper")
+    (.css (aget ui "helper") "cursor" "grabbing")
+    (let [allLessonGroups
+          (get-all-lesson-group-strings moduleCode lessonType)
+
+          notSelectedLessonGroups
+          (remove #{selectedLessonGroup} allLessonGroups)
+
+          ; Add all the
 elements
+          augmentedTTLessonInfoSeq
+          (doall
+            (flatten
+              (map (fn [unselectedLessonGroup]
+                     (add-module-lesson-group! moduleCode lessonType
+                                               unselectedLessonGroup
+                                               bgColorCssClass false))
+                   notSelectedLessonGroups)))]
+      (set! Lessons-Created-By-Draggable augmentedTTLessonInfoSeq))))
+
+(defn- $lesson-div-remove
+  "Removes the
 object of a lesson module, and replaces the former
+   columns occupied by its parent  with new  elements."
+  [$lessonDiv startTime endTime]
+  (let [$parentTd (parent $lessonDiv)]
+    (remove-attr $parentTd "colspan")
+    (.remove $lessonDiv)
+    (add-missing-td-elements-replacing-lesson $parentTd startTime endTime)))
+
+(defn- lesson-draggable-stop-evt-handler-maker
+  "Returns a function used as the `stop` event handler for a draggable lesson."
+  [moduleCode lessonType lessonGroup bgColorCssClass]
+  (fn [evt ui]
+    (let [$helper         (aget ui "helper")
+          destLessonGroup (data $helper LESSON-GROUP-CHANGE-KEY)
+
+          affectedDaysSet
+          (get-set-from-seq-of-maps-with-day-key Lessons-Created-By-Draggable)]
+
+      (doseq [augTTLessonInfo Lessons-Created-By-Draggable]
+        (timetable-remove-lesson! (:day augTTLessonInfo)
+                                  (:rowNum augTTLessonInfo)
+                                  (dissoc augTTLessonInfo :divElem :day
+                                          :rowNum)))
+
+      (doseq [augTTLessonInfo Lessons-Created-By-Draggable]
+        (let [$divElem  (:divElem augTTLessonInfo)]
+          ($lesson-div-remove $divElem (:startTime augTTLessonInfo)
+                              (:endTime augTTLessonInfo))))
+
+      (overall-timetable-prune-empty-rows affectedDaysSet)
+      (set! Lessons-Created-By-Draggable nil)
+
+      ; User has dropped the draggable helper
 onto a droppable
+      (if (not (nil? destLessonGroup))
+          (let [augTTLessonInfoSeq (remove-lesson-group-html moduleCode
+                                                             lessonType)
+                affectedDaysSet    (get-set-from-seq-of-maps-with-day-key
+                                     augTTLessonInfoSeq)]
+            ; remove the current lesson group
+            (doseq [augTTLessonInfo augTTLessonInfoSeq]
+              (let [day          (:day augTTLessonInfo)
+                    rowNum       (:rowNum augTTLessonInfo)
+                    ttLessonInfo (dissoc augTTLessonInfo :day :rowNum)]
+                (timetable-remove-lesson! day rowNum ttLessonInfo)))
+
+            (shift-lessons-upwards-to-replace-empty-slots! augTTLessonInfoSeq)
+            (overall-timetable-prune-empty-rows affectedDaysSet)
+            (update-ModulesSelected-for-affected-days! affectedDaysSet)
+
+            ; add the newly selected lesson group
+            (add-module-lesson-group! moduleCode lessonType destLessonGroup
+                                      bgColorCssClass true)
+
+            (update-document-location-hash-with-changed-lesson-group!
+              moduleCode lessonType destLessonGroup))))))
+
+(defn- make-added-lessons-draggable
+  "Makes the
 elements of selected lessons draggable."
+  [$divElemSeq moduleCode lessonType lessonGroup bgColorCssClass]
+  ; And Drag event handler
+  (doseq [$divElem $divElemSeq]
+    (.css $divElem "cursor" "grab")
+    (.draggable $divElem
+                (js-obj "zIndex" 100
+                        "helper" "clone"
+                        "revert" "invalid"
+                        "start"  (lesson-draggable-start-evt-handler-maker
+                                   moduleCode lessonType lessonGroup
+                                   bgColorCssClass)
+                        "stop"   (lesson-draggable-stop-evt-handler-maker
+                                   moduleCode lessonType lessonGroup
+                                   bgColorCssClass)))))
+
+(defn- make-fake-lessons-droppable
+  "For 'fake' lessons created due to a lesson
 being dragged, we make
+   them droppable in order for the user to switch lesson groups."
+  [augModuleSelectedLessonInfoSeq]
+  (doseq [augModuleSelectedLessonInfo augModuleSelectedLessonInfoSeq]
+    (let [$divElem (:divElem augModuleSelectedLessonInfo)]
+      (.droppable
+        $divElem
+        (js-obj "tolerance" "intersect"
+
+                "over"
+                (fn [evt ui]
+                  (.removeClass $divElem "lesson-droppable-not-hover")
+                  (.addClass $divElem "lesson-droppable-hover"))
+
+                "out"
+                (fn [evt ui]
+                  (.removeClass $divElem "lesson-droppable-hover")
+                  (.addClass $divElem "lesson-droppable-not-hover"))
+
+                "drop"
+                (fn [evt ui]
+                  (let [$helper (aget ui "helper")]
+                    ; Set a data attribute on the draggable helper to signal
+                    ; that the user has dropped the
 on a droppable to
+                    ; change the lesson group
+                    (data $helper
+                          LESSON-GROUP-CHANGE-KEY
+                          (:lessonGroup augModuleSelectedLessonInfo)))))))))
+
+(defn- add-module-lesson-group!
+  "Adds a lesson group of a module to the timetable.
+
+   The `isActuallySelected?` param is used to indicate if the current lesson
+   group is selected by the user.
+   A value of `true` indicates that the user actually selected the lesson group.
+   A value of `false` indicates that the current lesson group is added by the
+   `lesson-draggable-start-evt-handler-maker` function and is not selected by
+   the user.
+
+   Returns a sequence of `ModulesSelectedLessonInfo` objects each augmented
+   with the `:divElem`, `:moduleCode`, `:lessonType`, `:lessonGroup` keys."
+  [moduleCode lessonType lessonGroup bgColorCssClass isActuallySelected?
+   & {:keys [addedViaUrlHashInit?] :or {addedViaUrlHashInit? false}}]
+  (if (module-has-lesson-group? moduleCode lessonType lessonGroup)
+      (let [moduleName          (get-module-name-from-module-code moduleCode)
+            modulesMapLessonSeq (get-ModulesMapLesson-seq moduleCode lessonType
+                                                          lessonGroup)
+
+            augLessonInfoSeq
+            (doall
+              (map (fn [modulesMapLesson]
+                     (add-module-lesson!
+                       :moduleCode moduleCode, :moduleName moduleName,
+                       :lessonType lessonType, :lessonGroup lessonGroup,
+                       :day        (:day modulesMapLesson),
+                       :startTime  (:startTime modulesMapLesson),
+                       :endTime    (:endTime modulesMapLesson),
+                       :venue      (:venue modulesMapLesson),
+                       :bgColorCssClass bgColorCssClass,
+                       :isActuallySelected? isActuallySelected?))
+                   modulesMapLessonSeq))
+
+            lessonInfoSeq       (map #(dissoc %1 :divElem :moduleCode
+                                              :lessonType :lessonGroup)
+                                     augLessonInfoSeq)
+            $divElemSeq         (map #(:divElem %1) augLessonInfoSeq)]
+        (if isActuallySelected?
+            (do
+              (update-ModulesSelected-with-lesson-group! moduleCode lessonType
+                                                         lessonGroup
+                                                         lessonInfoSeq)
+              (if (module-not-in-ModulesSelectedOrder? moduleCode)
+                  (do
+                    (add-to-ModulesSelectedOrder! moduleCode)
+                    ; Micro optimization for modules added via url hash
+                    ; during initialization
+                    (if (not addedViaUrlHashInit?)
+                        (select2-box-update-modules))))
+
+              ; Only lesson types with more than 1 option of lesson group
+              ; will be draggable
+              (if (module-lesson-type-has-multiple-choices? moduleCode
+                                                            lessonType)
+                  (make-added-lessons-draggable $divElemSeq moduleCode
+                                                lessonType lessonGroup
+                                                bgColorCssClass)))
+
+            ; lesson was added due to draggable

+            ; Make it droppable
+            (make-fake-lessons-droppable augLessonInfoSeq))
+        augLessonInfoSeq)))
+
+(defn add-module!
+  "Adds a module to the timetable.
+
+   A random lesson group of each type of lesson (Lecture, Tutorial, etc) will
+   be added."
+  [moduleCode]
+  (if (not (is-module-selected? moduleCode))
+      (let [lessonTypes     (get-all-lesson-types-for-module moduleCode)
+            bgColorCssClass (get-next-lesson-bg-color-css-class)
+
+            newModInfoSeq
+            (reduce (fn [moduleInfoSeq lessonType]
+                      (conj moduleInfoSeq
+                            {:moduleCode  moduleCode,
+                             :lessonType  lessonType,
+                             :lessonGroup
+                             (get-first-lesson-group-for-module-lesson-type
+                               moduleCode lessonType)}))
+                    []
+                    lessonTypes)]
+
+        (doseq [moduleInfo newModInfoSeq]
+          (add-module-lesson-group! (:moduleCode moduleInfo)
+                                    (:lessonType moduleInfo)
+                                    (:lessonGroup moduleInfo)
+                                    bgColorCssClass
+                                    true))
+
+        ; Update URL hash with newly added module
+        (update-document-location-hash-with-new-module!
+          {:moduleCode moduleCode,
+
+           :preToUrlHashLessonGroupSeqSorted
+           (sort-PreToUrlHashLessonGroup-seq
+             (map #(dissoc
+                     (assoc %1 :lessonType
+                            (Lesson-Type-Long-To-Short-Form (:lessonType %1)))
+                     :moduleCode)
+                  newModInfoSeq))}))))
+
+(defn- get-module-info-from-url-hash-module-info
+  "Computes the final module info sequence for modules added via the url hash
+   on page initialization.
+
+   NOTE: This function should only be called by
+         `add-module-lesson-groups-from-url-hash!`"
+  [moduleInfoSeq]
+  (let [moduleLessonGroupsMap
+        (reduce (fn [lgMap modInfo]
+                  ; Replaces earlier lesson groups with later ones if we
+                  ; encounter a duplicate lesson type
+                  (assoc-in lgMap [(:moduleCode modInfo) (:lessonType modInfo)]
+                            (:lessonGroup modInfo)))
+                {}
+                moduleInfoSeq)
+
+        moduleCodesSeq (distinct (map #(:moduleCode %1) moduleInfoSeq))
+
+        ; Map of Module Code -> Sequence of lesson type strings
+        moduleLessonTypes
+        (reduce (fn [lessonTypesMap moduleCode]
+                  (let [ltMap (get moduleLessonGroupsMap moduleCode)]
+                    (assoc lessonTypesMap moduleCode (keys ltMap))))
+                {}
+                moduleCodesSeq)
+
+        ; Similar to `moduleLessonTypes`, but contains the full sequence of
+        ; lesson type strings
+        moduleLessonTypesFull
+        (reduce (fn [lessonTypesMap moduleCode]
+                  (assoc lessonTypesMap moduleCode
+                         (get-all-lesson-types-for-module moduleCode)))
+                {}
+                moduleCodesSeq)
+
+        ; Obtained from the difference between `moduleLessonTypesFull` and
+        ; `moduleLessonTypes`
+        missingModuleLessonTypes
+        (reduce (fn [missingLessonTypesMap moduleCode]
+                  (let [missingLessonTypes
+                        (clojure.set/difference
+                          (set (get moduleLessonTypesFull moduleCode))
+                          (set (get moduleLessonTypes moduleCode)))]
+                    (if (empty? missingLessonTypes)
+                        missingLessonTypesMap
+                        (assoc missingLessonTypesMap moduleCode
+                               (seq missingLessonTypes)))))
+                {}
+                moduleCodesSeq)
+
+        ; similar to `moduleLessonGroupsMap`, but includes missing lesson types
+        moduleLessonGroupsMapFinal
+        (reduce (fn [lgMapFinal [moduleCode missingLessonTypes]]
+                  (reduce
+                    (fn [lgMap lessonType]
+                      (assoc-in lgMap [moduleCode lessonType]
+                                (get-first-lesson-group-for-module-lesson-type
+                                  moduleCode lessonType)))
+                    lgMapFinal
+                    missingLessonTypes))
+                moduleLessonGroupsMap
+                missingModuleLessonTypes)]
+
+    ; Produce the final module info sequence
+    (flatten
+      (map (fn [moduleCode]
+             (map (fn [[lessonType lessonGroup]]
+                    {:moduleCode  moduleCode
+                     :lessonType  lessonType
+                     :lessonGroup lessonGroup})
+                  (get moduleLessonGroupsMapFinal moduleCode)))
+           moduleCodesSeq))))
+
+(defn add-module-lesson-groups-from-url-hash!
+  "Adds the module lesson groups available in the url hash. Erroneous lesson
+   groups are ignored. If there are missing lesson groups for any module after
+   going through the url hash, a random lesson group is chosen.
+
+   NOTE: This function should only be called once."
+  [urlHash]
+  (let [moduleUrlHashArray                (.split urlHash "&")
+
+        modUrlHashRegex
+        #"^([A-Z]+\d{4}[A-Z]*)_(DL|L|LAB|PL|PT|R|SEM|ST|T|T2|T3)=([A-Z0-9]+)$"
+
+        ; Sequence of non-nil match arrays
+        matchArraySeq
+        (filter (fn [matchArray] (not (nil? matchArray)))
+                (map (fn [modUrlHash] (.exec modUrlHashRegex modUrlHash))
+                     moduleUrlHashArray))
+
+        ; Sequence of existing lesson groups
+        moduleInfoExistent
+        (filter
+          #(module-has-lesson-group? (:moduleCode %1) (:lessonType %1)
+                                     (:lessonGroup %1))
+          ; convert matchArrays to maps
+          (map (fn [matchArray]
+                 {:moduleCode  (nth matchArray 1)
+                  :lessonType  (Lesson-Type-Short-To-Long-Form
+                                 (nth matchArray 2))
+                  :lessonGroup (nth matchArray 3)})
+               matchArraySeq))
+
+        ; Module code to CSS class for lesson div background color
+        moduleToColorsMap
+        (reduce
+          (fn [m2cMap moduleCode]
+            (assoc m2cMap moduleCode (get-next-lesson-bg-color-css-class)))
+          {}
+          (distinct (map (fn [modInfo] (:moduleCode modInfo))
+                         moduleInfoExistent)))
+
+        moduleInfoFinal
+        (get-module-info-from-url-hash-module-info moduleInfoExistent)]
+
+    (.log js/console (str "moduleInfoExistent = " (.stringify js/JSON (clj->js moduleInfoExistent))))
+    (.log js/console (str "moduleInfoFinal = " (.stringify js/JSON (clj->js moduleInfoFinal))))
+    ; Add the module lesson groups
+    (doseq [modInfo moduleInfoFinal]
+      (let [moduleCode      (:moduleCode modInfo)
+            bgColorCssClass (get moduleToColorsMap moduleCode)]
+        (add-module-lesson-group! moduleCode
+                                  (:lessonType modInfo)
+                                  (:lessonGroup modInfo)
+                                  bgColorCssClass
+                                  true
+                                  :addedViaUrlHashInit? true)))
+
+    ; Update Select2 box, since this is not done in `add-module-lesson-group!`.
+    ; Repeated work will be done there if we did so
+    (select2-box-update-modules)
+    ; Update url hash
+    (set-document-location-hash-based-on-modules-order!)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Functions for Removing Modules
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- add-missing-td-elements-replacing-lesson
+  "Adds  elements that were removed by the `add-module-lesson!` function
+   to make way for the lesson."
+  [$parentTd startTime endTime]
+  (loop [$currentTd $parentTd
+         timeIdx    (inc startTime)]
+    (if (>= timeIdx endTime)
+        nil
+        (let [[hourClass minuteClass]
+              (get-css-hour-minute-classes-for-time timeIdx)
+
+              $newTdElem
+              ($ "" (js-obj "class" (str hourClass " " minuteClass)))]
+          ; Insert after new  after the current
+          (insert-after $newTdElem $currentTd)
+          ; Then use the new  as the current  in the next iteration
+          (recur $newTdElem (inc timeIdx))))))
+
+(defn- remove-lesson-group-html
+  "Removes a lesson group for a module from the HTML timetable.
+   This does NOT remove any empty rows / perform module shifting.
+
+   Returns a sequence of `ttLessonInfo` objects which contain
+   additional `:day` and `:rowNum` keys."
+  [moduleCode lessonType]
+  (let [lessonGroupDetails (get-in ModulesSelected [moduleCode lessonType])
+        lessonGroup        (:label lessonGroupDetails)
+        lessonInfoSeq      (:info lessonGroupDetails)]
+    (map (fn [modSelLessonInfo]
+           (let [day          (:day modSelLessonInfo)
+                 rowNum       (:rowNum modSelLessonInfo)
+                 startTime    (:startTime modSelLessonInfo)
+                 endTime      (:endTime modSelLessonInfo)
+                 ttLessonInfo {:moduleCode moduleCode, :lessonType lessonType,
+                               :lessonGroup lessonGroup, :startTime startTime,
+                               :endTime endTime}
+                 $lessonDiv   (timetable-get-lesson-div day rowNum
+                                                        ttLessonInfo)]
+             ($lesson-div-remove $lessonDiv startTime endTime)
+             (assoc ttLessonInfo :day day, :rowNum rowNum)))
+         lessonInfoSeq)))
+
+(defn- get-largest-consecutive-time-slot-freed-up-by-lesson
+  "Given a removed lesson, find the largest interval on the same row which is
+   freed up due to the its removal.
+
+   For instance, given this timetable row:
+
+   x | x | x |  |  |  | y | y | y | y |  |  | z | z
+
+   And we remove the lesson occupying the slots labelled 'y'. The 4 slots
+   currently occupied by 'y', along with the 3 empty slots to its left and the
+   2 empty slots to its right will be freed up.
+
+   Given that the first slot occupied by the label 'x' is the index 0, this
+   function will return the vector [3 11].
+
+   The parameter `removedAugTTLessonInfo` is a `TimetableLessonInfo` object
+   augmented with the `:day` and `:rowNum` keys."
+  [removedAugTTLessonInfo]
+  (let [day        (:day removedAugTTLessonInfo)
+        rowNum     (:rowNum removedAugTTLessonInfo)
+        startTime  (:startTime removedAugTTLessonInfo)
+        endTime    (:endTime removedAugTTLessonInfo)
+        minTimeIdx time-helper/TIME-INDEX-MIN
+        maxTimeIdx time-helper/TIME-INDEX-MAX]
+
+    (.log js/console "get-largest-consecutive-time-slot-freed-up-by-lesson")
+    [
+      ; Find the lesson right before the removed lesson
+      (let [immediateTTLessonInfoBefore
+            (timetable-get-closest-TimetableLessonInfo-before-time
+              day rowNum startTime)]
+        (if (nil? immediateTTLessonInfoBefore)
+            minTimeIdx
+            (:endTime immediateTTLessonInfoBefore)))
+
+      ; Find the lesson right after the removed lesson
+      (let [immediateTTLessonInfoAfter
+            (timetable-get-closest-TimetableLessonInfo-on-or-after-time
+              day rowNum endTime)]
+        (if (nil? immediateTTLessonInfoAfter)
+            maxTimeIdx
+            (dec (:startTime immediateTTLessonInfoAfter))))
+    ]))
+
+(defn- find-replacement-lessons-within-time
+  "For a removed lesson, find other lessons on the same day but in a row below
+   the removed lesson which could be shifted upwards and take the timeslots
+   freed up by the removed lesson.
+
+   The `removedAugTTLessonInfo` parameter is an `TimetableLessonInfo` object
+   augmented with the `:day` and `:rowNum` keys.
+
+   Returns a map, where keys are `TimetableLessonInfo` objects augmented with
+   `:day` and `:rowNum` keys, and values are jQuery
 objects for the
+   shifted lesson."
+  [{:keys [day rowNum startTime endTime] :as removedAugTTLessonInfo}]
+  (let [; This is the time range freed up by removal of the lesson
+        [lowTimeIdx highTimeIdx]
+        (get-largest-consecutive-time-slot-freed-up-by-lesson
+          removedAugTTLessonInfo)
+
+        not-occupied?
+        (fn [occupiedVec startTime endTime]
+          (.log js/console (str "inside not-occupied?, occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
+          (every? #(nil? %1)
+                  (map #(nth occupiedVec %1)
+                       (range startTime endTime))))]
+
+    (.log js/console "find-replacement-lessons-within-time")
+    (.log js/console (str "lowTimeIdx = " lowTimeIdx ", highTimeIdx = " highTimeIdx))
+    (:augTTLessonInfoMapToShift
+      (reduce
+        (fn [{:keys [augTTLessonInfoMapToShift occupiedVec]
+              :as   reduceResult}
+             rowIdx]
+          (if (timetable-row-empty? day rowIdx)
+              ; Skip empty row
+              reduceResult
+
+              ; Non-empty row
+              (let [ttLessonInfoToShift
+                    (timetable-row-get-lessons-satisfying-pred
+                      day rowIdx
+                      (fn [{:keys [startTime endTime]}]
+                        (and (>= startTime lowTimeIdx)
+                             (<= (dec endTime) highTimeIdx)
+                             (not-occupied? occupiedVec startTime endTime))))]
+                (.log js/console "suspect above")
+                (.log js/console (str "rowIdx = " rowIdx))
+                (.log js/console (str "occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
+                {:augTTLessonInfoMapToShift
+                 (reduce (fn [augTTLessonInfoMap [ttLessonInfo $divElem]]
+                           (.log js/console ":augTTLessonInfoMapToShift")
+                           (assoc augTTLessonInfoMap
+                                  (assoc ttLessonInfo :day day :rowNum rowIdx)
+                                  $divElem))
+                         augTTLessonInfoMapToShift
+                         ttLessonInfoToShift)
+
+                 :occupiedVec
+                 (reduce (fn [occVec [{:keys [startTime endTime]}  _]]
+                           (.log js/console ":occupiedVec")
+                           (reduce (fn [ov timeIdx] (assoc ov timeIdx true))
+                                   occVec
+                                   (range startTime endTime)))
+                         occupiedVec
+                         ttLessonInfoToShift)})))
+        {:augTTLessonInfoMapToShift {},
+         ; nil = free slot, true = occupied slot
+         :occupiedVec      (vec (map (fn [t] nil)
+                                     (range time-helper/TIME-INDEX-MIN
+                                            (inc time-helper/TIME-INDEX-MAX))))}
+        ; go through each row in the day, below the current row
+        (drop (inc rowNum) (range (timetable-day-get-nr-rows day)))))))
+
+(defn- shift-lesson-to-row!
+  "Shifts a lesson from its original row up to the given row.
+
+   The parameter `augTTLessonInfo` is a `TimetableLessonInfo` object augmented
+   with the `:day` and `:rowNum` keys."
+  [destinationRowNum {:keys [day rowNum startTime endTime] :as augTTLessonInfo}
+   $divElem]
+  (let [slotsOccupied (- endTime startTime)
+        $sourceTd     (html-timetable-get-td day rowNum startTime)
+        $destTd       (html-timetable-get-td day destinationRowNum startTime)
+        ttLessonInfo  (dissoc augTTLessonInfo :day :rowNum)]
+    (.log js/console (str "day = " day ", sourceRowNum = " rowNum ", destinationRowNum = " destinationRowNum))
+    ; Transfer lesson
 to the destination
+    (.append $destTd $divElem)
+    ; restore the colspan of the source
+    (remove-attr $sourceTd "colspan")
+    ; fill in removed  for the source
+    (add-missing-td-elements-replacing-lesson $sourceTd startTime endTime)
+    ; remove sibling  for the destination  to make way for columns
+    ; occupied by $divElem
+    (doseq [$siblingTd (take (dec slotsOccupied) (.nextAll $destTd))]
+      (.remove $siblingTd))
+    ; update colspan of destination
+    (attr $destTd "colspan" slotsOccupied)
+    ; update `Timetable` global
+    (timetable-remove-lesson! day rowNum ttLessonInfo)
+    (timetable-add-lesson! day destinationRowNum ttLessonInfo $divElem)))
+
+(defn- shift-lessons-upwards-to-replace-empty-slots!
+  "For each removed lesson, see if there are any lessons in rows below it that
+   can be shifted upwards to occupy the empty slots resulting from its removal.
+
+   The parameter `removedAugmentedTTLessonInfoSeq` is a sequence of
+   `TimetableLessonInfo` objects augmented with the `:day` and `:rowNum` keys."
+  [removedAugmentedTTLessonInfoSeq]
+  (let [; we do not consider any lessons on empty rows for ease of
+        ; implementation
+        exclude-lessons-on-empty-rows
+        (fn [lessonInfoSeq]
+          (filter (fn [{:keys [day rowNum]}]
+                    (timetable-row-not-empty? day rowNum))
+                  lessonInfoSeq))
+
+        sort-lesson-info-seq
+        (fn [lessonInfoSeq]
+          (sort #(let [dayA (:day %1)
+                       dayB (:day %2)]
+                   (if (= dayA dayB)
+                       (< (:rowNum %1) (:rowNum %2))
+                       (< dayA dayB)))
+                lessonInfoSeq))]
+
+    (.log js/console "Hoo hoo")
+    (loop [sortedAugTTLessonInfoSeq
+           (sort-lesson-info-seq (exclude-lessons-on-empty-rows
+                                   removedAugmentedTTLessonInfoSeq))
+
+           nextLessonInfoVec    []]
+      (.log js/console "Inside the loop, the loop")
+      (cond (and (empty? sortedAugTTLessonInfoSeq) (empty? nextLessonInfoVec))
+            nil
+
+            ; we're done for the current set of lessons. Move on to the
+            ; set of lessons that were shifted upwards.
+            (empty? sortedAugTTLessonInfoSeq)
+            (recur (sort-lesson-info-seq (exclude-lessons-on-empty-rows
+                                           nextLessonInfoVec))
+                   [])
+
+            ; find timeslot to shift up to replace gap
+            :else
+            (let [currentAugTTLessonInfo (first sortedAugTTLessonInfoSeq)
+                  rowNum                 (:rowNum currentAugTTLessonInfo)
+
+                  ; map of augmented `TimeTableLessonInfo` objects to the
+                  ; jQuery
 element
+                  augTTLessonInfoTo$DivElem
+                  (find-replacement-lessons-within-time currentAugTTLessonInfo)]
+
+              (doseq [[augTTLessonInfo $divElem] augTTLessonInfoTo$DivElem]
+                (.log js/console "shift-lesson-to-row")
+                (shift-lesson-to-row! rowNum augTTLessonInfo $divElem))
+              (.log js/console "gonna recur...")
+              (recur (rest sortedAugTTLessonInfoSeq)
+                     ; append newly shifted lessons to nextLessonInfoVec
+                     (reduce (fn [augTTLessonInfoVec [augTTLessonInfo _]]
+                               (conj augTTLessonInfoVec augTTLessonInfo))
+                             nextLessonInfoVec
+                             augTTLessonInfoTo$DivElem)))))))
+
+(defn- overall-timetable-prune-empty-rows
+  "Removes empty rows resulting from the removal of lessons on given days."
+  [affectedDaysSet]
+  (doseq [day affectedDaysSet]
+    (let [rowsPartition (timetable-day-get-empty-and-non-empty-rows day)]
+      (.log js/console (str "day = " day ", emptyRows = "
+                            (.stringify js/JSON (clj->js (:emptyRows rowsPartition)))
+                            ", nonEmptyRows = "
+                            (.stringify js/JSON (clj->js (:nonEmptyRows rowsPartition)))))
+
+      (timetable-prune-empty-rows-for-day! day rowsPartition)
+      (html-timetable-prune-empty-rows-for-day day rowsPartition))))
+
 (defn remove-module!
   "Removes a module from the timetable.

@@ -1500,7 +1499,7 @@
         (.log js/console "Whats up")

         ; Update `ModulesSelected`
-        (update-ModulesSelected-for-affected-days affectedDaysSet)
+        (update-ModulesSelected-for-affected-days! affectedDaysSet)
         (.log js/console "Boo ya!")
         (.log js/console (str "ModulesSelected:" (.stringify js/JSON (clj->js ModulesSelected))))


use translation keys

use translation keys

--- src/cljs/salava/badge/ui/issuer.cljs
+++ src/cljs/salava/badge/ui/issuer.cljs
@@ -36,11 +36,13 @@
                 (init-issuer-connection issuer-id state))}))

-(defn remove-issuer-from-favourites [issuer-id state]
+(defn remove-issuer-from-favourites [issuer-id state init-fn]
   (ajax/POST
     (path-for (str "/obpv1/social/delete_connection_issuer/" issuer-id))
     {:handler (fn []
-                (init-issuer-connection issuer-id state))}))
+                (if init-fn
+                  init-fn
+                  (init-issuer-connection issuer-id state)))}))

 (defn- issuer-image [path]
   (when (not-empty path)
@@ -60,8 +62,8 @@
            ;TODO users not logged in don't see this
            [:div.pull-right
             (if-not @connected?
-              [:a {:href "#" :on-click #(add-issuer-to-favourites issuer-id state)} [:i {:class "fa fa-bookmark-o"}] " add to favourites"]
-              [:a {:href "#" :on-click #(remove-issuer-from-favourites issuer-id state)} [:i {:class "fa fa-bookmark"}] " remove from favourites"]
+              [:a {:href "#" :on-click #(add-issuer-to-favourites issuer-id state)} [:i {:class "fa fa-bookmark-o"}] (str " " (t :badge/Addtofavourites))]
+              [:a {:href "#" :on-click #(remove-issuer-from-favourites issuer-id state nil)} [:i {:class "fa fa-bookmark"}] (str " " (t :badge/Removefromfavourites))]
               )]
            ]
           [:h2.uppercase-header


Update api.clj

Update api.clj

--- src/clojure/org/stuff/events/api.clj
+++ src/clojure/org/stuff/events/api.clj
@@ -1,3 +1,5 @@
+;; ripped from 4clojure
+
 (ns org.stuff.events.api
   "Functions that interact with 4clojure API or fetch data directly."
   (:require [clojure.data.json :as json]


Fix two bugs regarding the sign-change key

First, removed possibility to sign-change the empty string

Second, backspace now removes the sign when deleting the last
number, rather than leaving a dangling sign.

--- src/clojure/warreq/kea/calc/calc.clj
+++ src/clojure/warreq/kea/calc/calc.clj
@@ -34,8 +34,9 @@

 (defn return-handler
   [_]
-  (swap! stack conj (read-string (deref input)))
-  (reset! input ""))
+  (when (> (count (deref input)) 0)
+    (swap! stack conj (read-string (deref input)))
+    (reset! input "")))

 (defn num-handler
   [n]
@@ -62,13 +63,16 @@
   [_]
   (let [cur (deref input)]
     (when (> (count cur) 0)
-      (reset! input (.substring ^String cur 0 (- (count cur) 1))))))
+      (reset! input (.substring ^String cur 0 (- (count cur) 1)))
+      (when (= "-" (deref input))
+        (reset! input "")))))

 (defn invert-handler
   [_]
   (let [cur (deref input)]
-    (if (= (.charAt ^String cur 0) \-)
-      (reset! input (.substring ^String cur 1 (count cur)))
-      (reset! input (str "-" cur)))))
+    (when (> (count cur) 0)
+      (if (= (.charAt ^String cur 0) \-)
+        (reset! input (.substring ^String cur 1 (count cur)))
+        (reset! input (str "-" cur))))))


support markdown for description fields

support markdown for description fields

--- src/clojure_playground/app/main.cljs
+++ src/clojure_playground/app/main.cljs
@@ -133,13 +133,14 @@
 (defn render-recipe-show [recipe]
   [:div.card-block
    [render-ingredients-show (:ingredients recipe)]
-   [:span {:on-click (fn [event]
+   [:div {:dangerouslySetInnerHTML  {:__html (md->html (:description recipe))}
+          :on-click (fn [event]
                 (swap! io/recipes
                        (fn [recipes]
                          (assoc-in recipes
                                    [(keyword (:id recipe)) :ui-state]
                                    :edit))))}
-    (md->html (:description recipe))]])
+    ]])

 (defn show-recipe-in-accordion [recipe accordion-id]


change how deep traces are applied

change how deep traces are applied

--- src/com/billpiel/sayid/workspace.clj
+++ src/com/billpiel/sayid/workspace.clj
@@ -48,20 +48,12 @@
          disj sym)
   (trace/untrace* type sym))

-(defn pre-apply-trace-set-restrictions!
-  [ws op type sym]
-  (cond (and (= op :add)
-             (= type :deep-fn))
-        ;; traces must be removed before deep traces can be applied
-        (if-let [dup (-> @ws
-                          :traced
-                          :fn
-                          (#(% sym)))]
-          (remove-trace-*! ws :fn dup))))
-
 (defn add-trace-*!
   [ws type sym]
-  (pre-apply-trace-set-restrictions! ws :add type sym)
+  (if (= type :deep-fn)
+    (remove-trace-*! ws  ;; deep traces must be applied to a clean surface
+                     :fn
+                     sym))
   (swap! ws (fn [ws'] (-> ws'
                           (update-in [:traced type]
                                      conj sym))))


Removes ':default 10' for wait flag on kill-topology

--- jvm/src/streamparse/commands/kill_topology.clj
+++ jvm/src/streamparse/commands/kill_topology.clj
@@ -30,7 +30,7 @@
   (let [[opts args banner]
          (cli args
               ["-h" "--help" "Show this help screen." :flag true :default false]
-              ["-w" "--wait" "Amount of time to wait for topology to gracefully stop." :default 10 :parse-fn #(Integer/parseInt %)]
+              ["-w" "--wait" "Amount of time to wait for topology to gracefully stop." :parse-fn #(Integer/parseInt %)]
               ["-n" "--host" "Hostname for Nimbus." :default "localhost"]
               ["-p" "--port" "Port for Nimbus." :default 6627 :parse-fn #(Integer/parseInt %)])]
     (when (or (not= (count args) 1) (:help opts))


flatten needs to come from contrib seq-utils

--- src/leiningen/classpath.clj
+++ src/leiningen/classpath.clj
@@ -1,5 +1,6 @@
 (ns leiningen.classpath
   (:use (clojure.contrib [io :only (file)]
+                         [seq-utils :only (flatten)]
                          [string :only (join)])
         [leiningen.checkout-deps :only [checkout-deps-paths]])
   (:import org.apache.tools.ant.types.Path))


Filter out non-existing path from classpath

--- src/leiningen/jdk_javac.clj
+++ src/leiningen/jdk_javac.clj
@@ -1,10 +1,17 @@
 (ns leiningen.jdk-javac
   (:require [clojure.string :as string]
-            [leiningen.classpath :as classpath]
+            [clojure.java.io :as io]
+            [leiningen.core.classpath :as classpath]
             [leiningen.core.eval :as eval]
             [leiningen.core.main :as main]
             [leiningen.core.project :as project])
   (:import javax.tools.ToolProvider))
+
+(defn- get-classpath [project]
+  (let [classpath (classpath/get-classpath project)]
+    (string/join
+      java.io.File/pathSeparatorChar
+      (filter #(.exists (io/as-file %)) classpath))))

 (defn- javac-args-array
   [project args]
@@ -15,7 +22,7 @@
       String
       (concat
         (:javac-options project)
-        ["-cp" (classpath/get-classpath-string project)
+        ["-cp" (get-classpath project)
          "-d" (:compile-path project)
          "-sourcepath" source-path]
         args))))


Selfie resource wrapped in resource

Selfie resource wrapped in resource

--- examples/selfie/src/selfie/api.clj
+++ examples/selfie/src/selfie/api.clj
@@ -10,16 +10,17 @@
    [schema.core :as s]
    [yada.methods :as m]
    [yada.protocols :as p]
-   [yada.yada :refer [yada]]))
+   [yada.yada :refer [yada] :as yada]))

 (defn selfie-index-resource []
-  {:description "POST your selfies here!"
-   :properties {}
-   :methods
-   {:get {:handler (fn [ctx] "Index")}
-    :post {:handler (fn [ctx]
-                      (throw (ex-info "TODO: body should be accessible somewhere"
-                                      {:request (:request ctx)})))}}})
+  (yada/resource
+   {:description "POST your selfies here!"
+    :properties {}
+    :methods
+    {:get {:handler (fn [ctx] "Index")}
+     :post {:handler (fn [ctx]
+                       (throw (ex-info "TODO: body should be accessible somewhere"
+                                       {:request (:request ctx)})))}}}))

 (defn api []
   ["" [["/selfie" (yada (selfie-index-resource))]]])


make deserialization user safe

make deserialization user safe

--- src/io/sarnowski/swagger1st/core.clj
+++ src/io/sarnowski/swagger1st/core.clj
@@ -303,7 +303,11 @@
         supported-content-types {"application/json" (fn [body] (json/read-json (slurp body)))}]
     (if (allowed-content-types content-type)                ; TODO could be checked on initialization of ring handler chain
       (if-let [deserialize-fn (get supported-content-types content-type)]
-        (deserialize-fn (:body request))
+        (try
+          (deserialize-fn (:body request))
+          (catch Exception e
+            (throw (ex-info "Malformed body." {:http-code    400
+                                               :content-type content-type}))))
         (:body request))
       (throw (ex-info "Content type not allowed."
                       {:http-code             406


Cleanup

Cleanup

--- modules/reitit-swagger/src/reitit/swagger.cljc
+++ modules/reitit-swagger/src/reitit/swagger.cljc
@@ -70,19 +70,19 @@
   [{:keys [::r/router ::r/match :request-method]}]
   (let [{:keys [id] :as swagger} (-> match :result request-method :data :swagger)
         swagger (set/rename-keys swagger {:id :x-id})
-        this-swagger? #(-> % second :swagger :id (= id))
-        transform-endpoint (fn [[method endpoint]]
-                             (let [coercion (-> endpoint :data :coercion)]
-                               (if (and endpoint (-> endpoint :data :no-doc not))
-                                 [method (meta-merge
-                                           (if coercion
-                                             (coercion/-get-apidocs coercion :swagger (-> endpoint :data)))
-                                           (-> endpoint :data (select-keys [:tags :summary :description]))
-                                           (-> endpoint :data :swagger (dissoc :id)))])))
+        accept-route #(-> % second :swagger :id (= id))
+        transform-endpoint (fn [[method {{:keys [coercion no-doc swagger] :as data} :data}]]
+                             (if (and data (not no-doc))
+                               [method
+                                (meta-merge
+                                  (if coercion
+                                    (coercion/-get-apidocs coercion :swagger data))
+                                  (select-keys data [:tags :summary :description])
+                                  (dissoc swagger :id))]))
         transform-path (fn [[p _ c]]
                          (if-let [endpoint (some->> c (keep transform-endpoint) (seq) (into {}))]
                            [p endpoint]))]
     (if id
-      (let [paths (->> router (r/routes) (filter this-swagger?) (map transform-path) (into {}))]
+      (let [paths (->> router (r/routes) (filter accept-route) (map transform-path) (into {}))]
         {:status 200
          :body (meta-merge swagger {:paths paths})}))))