path: root/src/tags.clj

(ns tags
  (:import java.lang.System
           java.util.Date)
  (:use clojure.contrib.sql
        clojure.contrib.def
        clojure.contrib.fcase
        clojure.contrib.json.write
        clojure.contrib.str-utils
        config
        compojure
        utils))

(defn validate-tag [tag]
  (if (re-matches #"[A-Za-z]{3,12}" tag)
    (.toLowerCase tag)))

; save all spaces in tags as dashes?
(defn normalize-tag-for-db [tag]
  (lower-case tag))
;  (.replace tag " " "-"))
; todo: remove unicode escape sequences and line breaks and stuff?

; maybe show all dashes as spaces on output?
(defn normalize-tag-for-out [tag] (str tag))

; lol "Can't remove struct key" (jdbc thing returns structified data)
(defn remove-tags-for-output [row]
  (dissoc (into {} row) :tags))

(defn get-json-tags [row]
  (assoc row :tags_json (json-str (row :tags))))

; turn "a 1 b 2" to ({:nick a :tag 1}, {:nick b :tag 2})
; also: i can't figure out how to access array indexes directly in StringTemplate templates
;; (defn parse-tags-from-row [row]
;;   (assoc row :tags
;;     (for [t (partition 2 (.split (row :tags) " "))]
;;        {"nick" (first t) "tag" (last t)})))

(defn parse-tags-from-string [string]
  (partition 2 (.split string " ")))

(defn build-tag-map [tags nick-tag]
  (let [nick (first nick-tag) tag (last nick-tag)]
    (if (tags tag)
      (assoc tags tag (conj (tags tag) nick))
      (assoc tags tag [nick]))))

; making something like {"tag1": ["nick a", "nick b"], "tag2": ["nick c", "nick d"]}
; from the db data which looks like "nicka:tag1 nickb:tag1 nickc:tag2 nickd:tag2"
(defn parse-tags-from-row-as-tag-map [row]
  (if (row :tags)
    (assoc row :tags
      (reduce build-tag-map {} (parse-tags-from-string (row :tags))))
    row))

(defn does-tag-exist? 
  ([tags tag]
    (contains? tags tag))
  ([tags tag from-nick]
    (if (contains? tags tag)
        (some #{from-nick} (tags tag)))))

(defn add-favorited-flag [row session]
  (if (does-tag-exist? (row :tags) "favorite" (session :nick))
      (assoc row :favorited true)
      row))

(defn add-fav-count [row]
  (assoc row :favcount (count ((row :tags) "favorite"))))

(def user-fav-query "
SELECT v
FROM UNNEST(?) as v
WHERE EXISTS
    (SELECT 1 FROM tags
     WHERE user_id = ?
     AND message_id = v
     AND tag = 'favorite')
")

(defn add-user-favs-to-msgs [msgs user-id]
  (let [faved-ids  (set
		    (map :v
			 (do-select [user-fav-query
				     (sql-array "int" (map :message_id msgs))
				     user-id])))]
    (for [m msgs]
      (assoc m :favorited
             (contains? faved-ids (:message_id m))))))

(defn explain-query [query] (str "EXPLAIN ANALYZE " query))

(defn fetch-dumps-by-room-query [image-only] (str
" SELECT 
    m.content, m.message_id, m.created_on, 
    u.nick, u.avatar, 
    array_to_string(ARRAY(SELECT nick || ' ' || tag
      FROM tags, users
      WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags
  FROM users u, messages m 
  WHERE room_id = ?
    AND m.user_id = u.user_id "
    (if image-only "AND m.is_image = true " "")
" ORDER BY created_on DESC
  LIMIT ? OFFSET ?"))

;; unoptimized
;; the room join here is very bad on large offsets... 
(defn fetch-dumps-by-nick-query [image-only] (str
" SELECT 
    m.content, m.message_id, m.created_on, 
    u.nick, u.avatar, r.key, 
    array_to_string(ARRAY(SELECT nick || ' ' || tag
      FROM tags, users
      WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags
  FROM messages m, users u, rooms r
  WHERE m.user_id = u.user_id AND u.user_id = (select user_id from users where lower(nick) = lower(?))
    AND r.room_id = m.room_id AND r.admin_only = false "
    (if image-only "AND m.is_image = true " "")
" ORDER BY created_on DESC
  LIMIT ? OFFSET ?"))

(defn lookup-direction [d]
  (case d
        :backward ["DESC" "<="]
        :forward  ["ASC" ">="]
        (except! "Unknown direction: " d)))

(defnk fetch-dumps [:nick nil :room nil
                    :date nil :msg-id nil :direction :backward
                    :image-only true
                    :user-tag-id nil :hide-vip true :limit 21]
  (cond
   (and nick room)             (except! "Cannot provide both nick and room for fetch-image-dumps")
   (not (or nick room))        (except! "Must provide nick or room for fetch-image-dumps")
   (and date msg-id)           (except! "Cannot provide both date and msg-id for fetch-image-dumps")
   (and nick (not image-only)) (except! "messages_user_created_on_image_only_idx only covers image messages")
   :else (let [[direction comp-str] (lookup-direction direction)]
           (do-select
            (build-query
             :select ["m.content, m.message_id, m.created_on, m.is_image"
                      "u.nick, u.avatar, r.key"
                      (if user-tag-id
                        "t.created_on IS NOT NULL as favorited")]
             :from   ["messages m"]
             :ljoin  ["rooms r ON r.room_id = m.room_id"
                      "users u ON u.user_id = m.user_id"
                      (if user-tag-id
                        ["tags t ON t.message_id = m.message_id AND t.user_id = ? AND t.tag = 'favorite'"
                         user-tag-id])]
             :where  [(cond
                       nick ["m.user_id = (SELECT user_id FROM users WHERE LOWER(nick) = lower(?))" nick]
                       room ["m.room_id = (SELECT room_id FROM rooms where LOWER(key) = lower(?))" room])
                      (if image-only "m.is_image = true")
                      (if hide-vip "r.admin_only = false")
                      (cond date   [(format "m.created_on::date %s ?" comp-str) (to-sql-date date)]
                            msg-id [(format "m.created_on %s
                                             (SELECT created_on FROM messages WHERE message_id = ?)" comp-str)
                                    msg-id])]
             :order (format "m.created_on %s" direction)
             :limit limit)))))

(defnk fetch-tagged-dumps [:nick nil :date nil :msg-id nil :tag "favorite" :direction :backward
                           :user-tag-id nil :hide-vip true :limit 21]
  (cond
   (not nick) (except! "Must provide nick for fetch-tagged-dumps")
   :else (let [select-user-id "(SELECT user_id FROM users WHERE LOWER(nick) = lower(?))"
               [dir comp-str] (lookup-direction direction)]
           (do-select
            (build-query
             :select ["m.content, m.message_id, m.created_on"
                      "u.nick, u.avatar, r.key"
                      "t.created_on as tagged_on"
                      (if user-tag-id
                        [(str "EXISTS(SELECT 1 FROM tags WHERE tag = 'favorite' "
                              "AND message_id = m.message_id AND user_id = ?) AS favorited")
                         user-tag-id])]
             :from   ["tags t, messages m, rooms r, users u"]
             :where [[(str "t.user_id = " select-user-id) nick]
                     "t.message_id = m.message_id"
                     ["t.tag = ?" tag]
                     "m.user_id = u.user_id"
                     "m.room_id = r.room_id"
                     (if hide-vip "r.admin_only = false")
                     (cond date   [(format "t.created_on::date %s ?" comp-str)
                                   (to-sql-date date)]
                           msg-id [(format (str "t.created_on %s (SELECT created_on FROM tags "
                                                "WHERE message_id = ? " "AND tag = ? AND user_id = %s)")
                                           comp-str select-user-id)
                                   msg-id tag nick])]
             :order (format "t.created_on %s" dir)
             :limit limit)))))

;; SPEED HACK
;; explicit use of room ids, but fast
;; (not used yet)
(defnk fetch-dumps-by-user-id-query [:image-only true :with-tags true] (str
" SELECT 
    m.content, m.message_id, m.created_on, 
    u.nick, u.avatar, r.key"
    (if with-tags ", 
      array_to_string(ARRAY(SELECT nick || ' ' || tag
        FROM tags, users
        WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags " "")
" FROM (SELECT message_id
        FROM messages as m
        WHERE m.user_id = ?
        AND m.room_id IN (1) "
        (if image-only "AND m.is_image = true " "")
      " ORDER BY m.message_id DESC
        LIMIT ? OFFSET ?
  ) as sq, messages m, users u, rooms r
  WHERE m.message_id = sq.message_id
    AND m.user_id = u.user_id
    AND r.room_id = m.room_id"))

(defnk fetch-dumps-by-message-id-query [:with-tags true :num-messages 1] (str
" SELECT
    m.content, m.message_id, m.created_on,
    u.nick, u.avatar, r.key, r.admin_only"
    (if with-tags ",
      array_to_string(ARRAY(SELECT nick || ' ' || tag
        FROM tags, users
        WHERE message_id = m.message_id AND tags.user_id = users.user_id
        ORDER BY tags.created_on), ' ') as tags " "")
" FROM messages m, users u, rooms r
  WHERE
    m.message_id IN (" (str-join ", " (take num-messages (repeat "?"))) ") " 
  " AND m.user_id = u.user_id
    AND r.room_id = m.room_id"))


(defnk fetch-dumps-by-tag-query [:image-only true :message-user-id false :tag-user-id false :with-tags true :include-vip false] (str
" SELECT
    m.content, m.message_id, m.created_on, 
    u.nick, u.avatar, r.key "
    (if with-tags ", 
      array_to_string(ARRAY(SELECT nick || ' ' || tag
        FROM tags, users
        WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags " "")
"  FROM (SELECT
          m.message_id
          FROM messages as m, tags as t
          WHERE lower(t.tag) = ? "
          (if message-user-id "AND m.user_id = ? " "")
          (if tag-user-id "AND t.user_id = ? " "")
          (if image-only "AND m.is_image = true " "")
        "   AND m.message_id = t.message_id
          ORDER BY m.message_id DESC
          LIMIT ? OFFSET ?
  ) as sq, messages m, users u, rooms r
  WHERE m.message_id = sq.message_id
    AND m.user_id = u.user_id
    AND r.room_id = m.room_id "
    (if include-vip "" "AND r.admin_only = false")))

;; todo: only return distinct dumps? sorted by tag.created_on?
;; tag intersections
;; timb: just realized this is implemented wrongly... looking up "foo+bar" will also match stuff tagged "foo" by two people
(defnk fetch-dumps-by-tags-query [:image-only true :num-tags 1 :message-user-id false :tag-user-id false :with-tags true :include-vip false] (str
" SELECT
    m.content, m.message_id, m.created_on, 
    u.nick, u.avatar, r.key "
    (if with-tags ", 
      array_to_string(ARRAY(SELECT nick || ' ' || tag
        FROM tags, users
        WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags " "")
" FROM (SELECT
          m.message_id"
        "  FROM messages as m
          INNER JOIN tags USING (message_id) 
          WHERE lower(tags.tag) IN (" (str-join ", " (take num-tags (repeat "?"))) ") "
          (if message-user-id "AND m.user_id = ? " "")
          (if tag-user-id "AND tags.user_id = ? " "")
          (if image-only "AND m.is_image = true " "")
        " GROUP BY m.message_id HAVING COUNT(*) = " (str num-tags) " 
          ORDER BY m.message_id DESC
          LIMIT ? OFFSET ?
  ) as sq, messages m, users u, rooms r
  WHERE m.message_id = sq.message_id
    AND m.user_id = u.user_id
    AND r.room_id = m.room_id "
    (if include-vip "" "AND r.admin_only = false")))

(defnk fetch-altars-query [:with-tags true :page-type false :with-user-id false] (str
" SELECT
    m.content, m.message_id, m.created_on,
    u.nick, u.avatar, r.key "
    (if with-tags ",
      array_to_string(ARRAY(SELECT nick || ' ' || tag
        FROM tags, users
        WHERE message_id = m.message_id AND tags.user_id = users.user_id), ' ') as tags " "")
" FROM (SELECT
          message_id
          FROM image_altars WHERE TRUE " ;; just have this so i can assume there's an AND in front of each cond.
          (if (= page-type :next) "AND message_id <= ? " "")
          (if (= page-type :prev) "AND message_id >= ? " "")
          (if with-user-id "AND user_id = ? " "")
          (if (= page-type :prev)
              " ORDER BY message_id ASC"
              " ORDER BY message_id DESC")
        " LIMIT ? OFFSET ?
  ) as sq, messages m, users u, rooms r
  WHERE m.message_id = sq.message_id
    AND m.user_id = u.user_id
    AND r.room_id = m.room_id 
  ORDER BY message_id DESC " ;; needed in case subquery was selected ASC
))

(defn fetch-dumps-by-ids
  ([ids] (fetch-dumps-by-ids ids nil))
  ([ids viewer-nick]
     (if-not (empty? ids)
       (let [ids          (map maybe-parse-int ids)
             query        (fetch-dumps-by-message-id-query :num-messages (count ids))
             raw-rows     (do-select (vec (concat [query] ids)))
             tagged-rows  (map parse-tags-from-row-as-tag-map raw-rows)]
         (for [m (sort-by-index-in tagged-rows ids :message_id)]
           (let [favers          (get (:tags m) "favorite")
                 favorited       (and viewer-nick
                                      (boolean (some #(= % viewer-nick) favers)))
                 filtered-favers (filter #(not= % (:nick m)) favers)]
             (assoc m
               :favers    filtered-favers
               :favorited favorited
               :count  (count filtered-favers))))))))

(defn fetch-dump-by-id
  ([m-id]
     (first (fetch-dumps-by-ids [m-id])))
  ([m-id viewer-nick]
     (first (fetch-dumps-by-ids [m-id] viewer-nick))))

(defnk fetch-altars [:message-id 0 :user-id false :amount *dumps-per-page* :offset 0]
  (let [message-id      (maybe-parse-int message-id 0)
        abs-m-id        (if (neg? message-id) (- message-id) message-id)
        page-type       (cond 
                          (> message-id 0) :next
                          (< message-id 0) :prev
                          :else false)
        query           (fetch-altars-query :page-type page-type :with-user-id user-id)
        query-vars      [amount offset]
        query-vars      (if user-id (concat [user-id] query-vars) query-vars)
        query-vars      (if page-type (concat [abs-m-id] query-vars) query-vars)
        rows            (do-select (vec (concat [query] query-vars)))]
    (map parse-tags-from-row-as-tag-map rows)))

(defnk fetch-dumps-by-room [:room-id 1 :image-only true :amount *dumps-per-page* :offset 0]
  (let [query (fetch-dumps-by-room-query image-only)]
    (let [rows (do-select [query room-id amount offset])]
      (map parse-tags-from-row-as-tag-map rows))))

(defnk fetch-dumps-by-nick [:nick "anon" :image-only true :amount *dumps-per-page* :offset 0]
  (let [query (fetch-dumps-by-nick-query image-only)]
    (let [rows (do-select [query nick amount offset])]
    (map parse-tags-from-row-as-tag-map rows))))

(defnk fetch-dumps-by-user-id [user-id :image-only true :amount *dumps-per-page* :offset 0]
  (let [query (fetch-dumps-by-user-id-query image-only)]
    (let [rows (do-select [query user-id amount offset])]
    (map parse-tags-from-row-as-tag-map rows))))

(defnk fetch-dumps-by-tag [:tags "favorite" 
                           :message-user-id false 
                           :tag-user-id false 
                           :image-only true 
                           :amount *dumps-per-page* 
                           :offset 0
                           :with-tags true
                           :include-vip false]
  (let [tags (if (string? tags) [tags] tags)
        query (if (= 1 (count tags))
                (fetch-dumps-by-tag-query  :image-only image-only 
                                           :message-user-id message-user-id 
                                           :tag-user-id tag-user-id
                                           :with-tags with-tags
                                           :include-vip include-vip)
                (fetch-dumps-by-tags-query :image-only image-only 
                                           :message-user-id message-user-id 
                                           :tag-user-id tag-user-id 
                                           :num-tags (count tags)
                                           :with-tags with-tags
                                           :include-vip include-vip))
        query-vars [amount offset]
        query-vars (if message-user-id (concat [message-user-id] query-vars ) query-vars)
        query-vars (if tag-user-id (concat [tag-user-id] query-vars ) query-vars)
        rows (do-select (vec (concat [query] tags query-vars)))]
    (map parse-tags-from-row-as-tag-map rows)))

      
(def fav-map (ref {}))

(defn filter-old-favs [fs]
  (let [threshold (new Date (ms-in-future -60000))]
    (filter #(.after (:added %) threshold)
            fs)))

(defn insert-fav-notification! [to-nick from-nick from-avatar msg]
  (dosync
   (let [favs       (ensure fav-map)
         cur-favs   (filter-old-favs (or (favs to-nick) []))
         fav        {:from   from-nick
                     :avatar from-avatar
                     :msg    msg
                     :added  (new Date)}
         new-fs     (conj cur-favs fav)]
     (alter fav-map assoc to-nick new-fs))))