(ns cbfg.net-test
  (:require-macros [cbfg.ago :refer [achan aclose ago ago-loop aput atake]])
  (:require [cbfg.net :refer [make-net]]))

(defn e [n result expect result-nil]
  (let [pass (= result expect)
        my-n (swap! n inc)]
    (when (not pass)
      (println (str my-n ":") "FAIL:" result expect))
    (and pass (nil? result-nil))))

(defn test-net [actx]
  (ago tn actx
       (let [n (atom 0)]
         (if (and
              ; Closing listen-ch should shutdown net.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)]
                (aclose tn listen-ch)
                (e n (atake tn net) :done (atake tn net)))
              ; Closing connect-ch should shutdown net.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)]
                (aclose tn connect-ch)
                (e n (atake tn net) :done (atake tn net)))
              ; Closing listen-ch should shutdown net and accept-ch's.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn listen-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (e n (atake tn net) :done (atake tn net)))))
              ; Closing connect-ch should shutdown net and accept-ch's.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn connect-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (e n (atake tn net) :done (atake tn net)))))
              ; 2nd listen on same addr/port should fail.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)
                    listen-result-ch2 (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aput tn listen-ch [:addr-a 1000 listen-result-ch2])
                  (and (e n (atake tn listen-result-ch2) nil nil)
                       (do (aclose tn listen-ch)
                           (aclose tn connect-ch)
                           (and (e n (atake tn accept-ch) nil nil)
                                (e n (atake tn net) :done (atake tn net)))))))
              ; Connecting to unlistened to port should fail.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    connect-result-ch (achan tn)]
                (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                (and (e n (atake tn connect-result-ch) nil nil)
                     (do (aclose tn listen-ch)
                         (aclose tn connect-ch)
                         (e n (atake tn net) :done (atake tn net)))))
              ; Close of close-accept-ch should close accept-ch and fail new connects.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn close-accept-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (let [connect-result-ch (achan tn)]
                         (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                         (and (e n (atake tn connect-result-ch) nil nil)
                              (do (aclose tn listen-ch)
                                  (aclose tn connect-ch)
                                  (e n (atake tn net) :done (atake tn net))))))))
              ; Try sending msgs between client and server.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (and (e n (not (nil? close-accept-ch)) true nil)
                       (e n (not (nil? accept-ch)) true nil)
                       (e n (atake tn listen-result-ch) nil nil)
                       (let [connect-result-ch (achan tn)]
                         (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                         (let [[client-send-ch client-recv-ch close-client-recv-ch] (atake tn connect-result-ch)]
                           (and (e n (not (nil? client-send-ch)) true nil)
                                (e n (not (nil? client-recv-ch)) true nil)
                                (e n (not (nil? close-client-recv-ch)) true nil)
                                (e n (atake tn connect-result-ch) nil nil)
                                (let [[server-send-ch server-recv-ch close-server-recv-ch] (atake tn accept-ch)]
                                  (and (e n (not (nil? server-send-ch)) true nil)
                                       (e n (not (nil? server-recv-ch)) true nil)
                                       (e n (not (nil? close-server-recv-ch)) true nil)
                                       (do (aput tn client-send-ch [:hi-from-client])
                                           (and (e n (atake tn server-recv-ch) :hi-from-client nil)
                                                (do (aput tn server-send-ch [:hi-from-server])
                                                    (and (e n (atake tn client-recv-ch) :hi-from-server nil)
                                                         (do (aclose tn close-server-recv-ch)
                                                             (aclose tn close-client-recv-ch)
                                                             (aclose tn server-send-ch)
                                                             (aclose tn client-send-ch)
                                                             (aclose tn listen-ch)
                                                             (aclose tn connect-ch)
                                                             (e n (atake tn net) :done (atake tn net))))))))))))))))
           "pass"
           (str "FAIL: on test-net #" @n)))))

(defn test [actx opaque]
  (ago test actx
       {:opaque opaque
        :result {"test-net"
                 (let [ch (test-net test)
                       cv (atake test ch)
                       _  (atake test ch)]
                   cv)}}))

(ns cbfg.net-test
  (:require-macros [cbfg.ago :refer [achan aclose ago ago-loop aput atake]])
  (:require [cbfg.net :refer [make-net]]))

(defn e [n result expect result-nil]
  (let [pass (= result expect)
        my-n (swap! n inc)]
    (when (not pass)
      (println (str my-n ":") "FAIL:" result expect))
    (and pass (nil? result-nil))))

(defn test-net [actx]
  (ago tn actx
       (let [n (atom 0)]
         (if (and
              ; Closing listen-ch should shutdown net.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)]
                (aclose tn listen-ch)
                (e n (atake tn net) :done (atake tn net)))
              ; Closing connect-ch should shutdown net.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)]
                (aclose tn connect-ch)
                (e n (atake tn net) :done (atake tn net)))
              ; Closing listen-ch should shutdown net and accept-ch's.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn listen-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (e n (atake tn net) :done (atake tn net)))))
              ; Closing connect-ch should shutdown net and accept-ch's.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn connect-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (e n (atake tn net) :done (atake tn net)))))
              ; 2nd listen on same addr/port should fail.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)
                    listen-result-ch2 (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aput tn listen-ch [:addr-a 1000 listen-result-ch2])
                  (and (e n (atake tn listen-result-ch2) nil nil)
                       (do (aclose tn listen-ch)
                           (aclose tn connect-ch)
                           (and (e n (atake tn accept-ch) nil nil)
                                (e n (atake tn net) :done (atake tn net)))))))
              ; Connecting to unlistened to port should fail.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    connect-result-ch (achan tn)]
                (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                (and (e n (atake tn connect-result-ch) nil nil)
                     (do (aclose tn listen-ch)
                         (aclose tn connect-ch)
                         (e n (atake tn net) :done (atake tn net)))))
              ; Close of close-accept-ch should close accept-ch and fail new connects.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (aclose tn close-accept-ch)
                  (and (e n (atake tn accept-ch) nil nil)
                       (let [connect-result-ch (achan tn)]
                         (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                         (and (e n (atake tn connect-result-ch) nil nil)
                              (do (aclose tn listen-ch)
                                  (aclose tn connect-ch)
                                  (e n (atake tn net) :done (atake tn net))))))))
              ; Try sending msgs between client and server.
              (let [listen-ch (achan tn)
                    connect-ch (achan tn)
                    net (make-net tn listen-ch connect-ch)
                    listen-result-ch (achan tn)]
                (aput tn listen-ch [:addr-a 1000 listen-result-ch])
                (let [[close-accept-ch accept-ch] (atake tn listen-result-ch)]
                  (and (e n (not (nil? close-accept-ch)) true nil)
                       (e n (not (nil? accept-ch)) true nil)
                       (e n (atake tn listen-result-ch) nil nil)
                       (let [connect-result-ch (achan tn)]
                         (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                         (let [[client-send-ch client-recv-ch close-client-recv-ch] (atake tn connect-result-ch)]
                           (and (e n (not (nil? client-send-ch)) true nil)
                                (e n (not (nil? client-recv-ch)) true nil)
                                (e n (not (nil? close-client-recv-ch)) true nil)
                                (e n (atake tn connect-result-ch) nil nil)
                                (let [[server-send-ch server-recv-ch close-server-recv-ch] (atake tn accept-ch)]
                                  (and (e n (not (nil? server-send-ch)) true nil)
                                       (e n (not (nil? server-recv-ch)) true nil)
                                       (e n (not (nil? close-server-recv-ch)) true nil)
                                       (do (aput tn client-send-ch [:hi-from-client])
                                           (and (e n (atake tn server-recv-ch) :hi-from-client nil)
                                                (do (aput tn server-send-ch [:hi-from-server])
                                                    (and (e n (atake tn client-recv-ch) :hi-from-server nil)
                                                         (do (aclose tn close-server-recv-ch)
                                                             (aclose tn close-client-recv-ch)
                                                             (aclose tn server-send-ch)
                                                             (aclose tn client-send-ch)
                                                             (e n (atake tn server-recv-ch) nil nil)
                                                             (e n (atake tn client-recv-ch) nil nil)
                                                             (aclose tn listen-ch)
                                                             (aclose tn connect-ch)
                                                             (e n (atake tn net) :done (atake tn net))))))))))))))))
           "pass"
           (str "FAIL: on test-net #" @n)))))

(defn test [actx opaque]
  (ago test actx
       {:opaque opaque
        :result {"test-net"
                 (let [ch (test-net test)
                       cv (atake test ch)
                       _  (atake test ch)]
                   cv)}}))

Test that recv ch's are closed.

Test that recv ch's are closed.


(ns closure-deps-graph
  (:require [clojure.java.io :as io])
  (:import [java.io File]
           [com.google.javascript.jscomp SourceFile BasicErrorManager]
           [com.google.javascript.jscomp.deps DepsGenerator DepsGenerator$InclusionStrategy]))

(defn js-files-in
  "Return a sequence of all .js files in the given directory."
  [dir]
  (filter
    #(let [name (.getName ^File %)]
       (and (.endsWith name ".js")
            (not= \. (first name))))
    (file-seq dir)))

(spit (io/file "deps/closure-library/closure/goog/transit_deps.js")
  (.computeDependencyCalls
    (DepsGenerator. (map #(SourceFile/fromFile (io/file %)) '("deps/closure-library/closure/goog/deps.js"))
      (map #(SourceFile/fromFile %)
        (mapcat (comp js-files-in io/file)
          ["src"]))
      DepsGenerator$InclusionStrategy/ALWAYS
      (.getAbsolutePath (io/file "deps/closure-library/closure/goog"))
      (proxy [BasicErrorManager] []
        (report [level error]
          (println error))
        (println [level error]
          (println error))))))

(ns closure-deps-graph
  (:require [clojure.java.io :as io])
  (:import [java.io File]
           [com.google.javascript.jscomp SourceFile BasicErrorManager]
           [com.google.javascript.jscomp.deps DepsGenerator
            DepsGenerator$InclusionStrategy ModuleLoader
            ModuleLoader$PathResolver ModuleLoader$ResolutionMode]))

(defn js-files-in
  "Return a sequence of all .js files in the given directory."
  [dir]
  (filter
    #(let [name (.getName ^File %)]
       (and (.endsWith name ".js")
            (not= \. (first name))))
    (file-seq dir)))

(spit (io/file "deps/closure-library/closure/goog/transit_deps.js")
  (.computeDependencyCalls
    (DepsGenerator. (map #(SourceFile/fromFile (io/file %)) '("deps/closure-library/closure/goog/deps.js"))
      (map #(SourceFile/fromFile %)
        (mapcat (comp js-files-in io/file)
          ["src"]))
      DepsGenerator$InclusionStrategy/ALWAYS
      (.getAbsolutePath (io/file "deps/closure-library/closure/goog"))
      (proxy [BasicErrorManager] []
        (report [level error]
          (println error))
        (println [level error]
          (println error)))
      (ModuleLoader. nil [] []
        ModuleLoader$PathResolver/ABSOLUTE
        ModuleLoader$ResolutionMode/LEGACY))))

fix deps graph script

fix deps graph script


(ns c2.event
  (:use [cljs.reader :only [read-string]]
        [c2.core :only [node-data]])
  (:require [c2.dom :as dom]
            [goog.events :as gevents]))

(defn on-load
  "Execute fn when browser load event fires."
  [f]
  (.listen goog.events js/window goog.events.EventType.LOAD f))

(defn on-raw
  "Attach `event-type` handler `f` to `node`, a CSS selector or live DOM node.
   Event type is something like `:click` or `:mousemove`."
  [node event-type f]
  (gevents/listen (dom/->dom node) (name event-type) f))

(defn on
  "Attach delegate `event-type` event handler `f` to `node` whose children were created via `c2.core/unify!`, scoped by optional `selector`.
   Handler is called with datum, $node, and the event object.

   Example usage:

       (unify! \"#scatterplot\" data-set (fn [[x y]] [:circle {:cx x :cy y}]))
       (on \"#scatterplot\" :click (fn [d] (p (str \"circle clicked:\" (prn-str d)))))

   This method should be preferred over attaching event handlers to individual nodes created by a `unify!` call because it creates a single event handler on the parent instead of a handler on each child."
  ([node event-type f] (on node "*" event-type f))
  ([node selector event-type f]
     (gevents/listen (dom/->dom node)
                     (name event-type)
                     (fn [event]
                       ;;Check to see if the target is what we want to listen to.
                       ;;This could be, say, a data-less button that is a child of a node with c2 data.
                       (if (dom/matches-selector? (.-target event) selector)
                         ;;Loop through the parent nodes of the event origin node, event.target, until we reach one with c2 data attached.
                         (loop [$node (.-target event)]
                           (if-let [d (node-data $node)]
                             ;;Then, call the handler on this node
                             (f d $node event)
                             (if-let [parent (dom/parent $node)]
                               (recur parent)))))))))

(ns c2.event
  (:use [cljs.reader :only [read-string]]
        [c2.core :only [node-data]])
  (:require [c2.dom :as dom]
            [goog.events :as gevents]))

(defn on-load
  "Execute fn when browser load event fires."
  [f]
  (.listen goog.events js/window goog.events.EventType.LOAD f))

(defn on-raw
  "Attach `event-type` handler `f` to `node`, a CSS selector or live DOM node.
   Event type is something like `:click` or `:mousemove`.
   Optional :capture boolean kwarg to fire listener in capture phase (default false)."
  [node event-type f
   & {:keys [capture]
      :or {capture false}}]
  (gevents/listen (dom/->dom node) (name event-type) f capture))

(defn on
  "Attach delegate `event-type` event handler `f` to `node` whose children were created via `c2.core/unify!`, scoped by optional `selector`.
   Handler is called with datum, $node, and the event object.
   Optional :capture boolean kwarg to fire listener in capture phase (default false).

   Example usage:

       (unify! \"#scatterplot\" data-set (fn [[x y]] [:circle {:cx x :cy y}]))
       (on \"#scatterplot\" :click (fn [d] (p (str \"circle clicked:\" (prn-str d)))))

   This method should be preferred over attaching event handlers to individual nodes created by a `unify!` call because it creates a single event handler on the parent instead of a handler on each child."
  ([node event-type f] (on node "*" event-type f))
  ([node selector event-type f
    & {:keys [capture]
       :or {capture false}}]
     (gevents/listen (dom/->dom node)
                     (name event-type)
                     (fn [event]
                       ;;Check to see if the target is what we want to listen to.
                       ;;This could be, say, a data-less button that is a child of a node with c2 data.
                       (if (dom/matches-selector? (.-target event) selector)
                         ;;Loop through the parent nodes of the event origin node, event.target, until we reach one with c2 data attached.
                         (loop [$node (.-target event)]
                           (if-let [d (node-data $node)]
                             ;;Then, call the handler on this node
                             (f d $node event)
                             (if-let [parent (dom/parent $node)]
                               (recur parent))))))
                     capture)))

Add optional :capture boolean kwarg to event listener wrappers.


(ns custard.parser
  (:require [clojure.string :as str]
            [clojure.walk :refer [keywordize-keys]]
            [clj-yaml.core :as yaml]
            [gitiom.blob :as git-blob]
            [gitiom.commit :as git-commit]
            [gitiom.repo :as git-repo]
            [gitiom.tree :as git-tree]
            [me.raynes.fs :as fs]
            [custard.files :refer [relative-path]]))

;;;; Path utilities

(defn strip-extension [path]
  (last (first (re-seq #"(.*)\..*$" path))))

(defn path->segments [path]
  (fs/split (strip-extension path)))

;;;; Node idents and links

(defn node->ident [node]
  [:node (:name node)])

(defn node->link [node]
  {:name (:name node)})

;;;; Parsing

(def kind-aliases
  {"project" ["project" "p"]
   "requirement" ["requirement" "req" "r"]
   "component" ["component" "comp" "c"]
   "work-item" ["work-item" "work" "w"]
   "tag" ["tag" "t"]})

(defn parse-kind [kind]
  (when-let [kind (cond-> kind (map? kind) (get "kind"))]
    (ffirst (filter #(some #{kind} (second %)) kind-aliases))))

(defn parse-markdown-data [data]
  (let [text (or (data "description") (data "content") "")
        lines (str/split-lines text)
        title-pattern #"#\s+(([a-z]+):\s*)?(.*)"
        tag-pattern #"\+([a-zA-Z0-9-_\/:]+)"]
    (letfn [(parse-md-kind-and-title [res line]
              (if-not (and (:kind res) (:title res))
                (if-let [match (re-matches title-pattern line)]
                  (let [[_ _ kind title] match]
                    (let [res (-> res
                                  (assoc :kind (parse-kind kind))
                                  (assoc :title title))]
                      res))
                  (update res :lines conj line))
                (update res :lines conj line)))
            (parse-md-tags [res line]
              (let [tags (map second (re-seq tag-pattern line))]
                (-> res
                    (dissoc :lines)
                    (update :tags (comp distinct concat) tags))))
            (parse-md-step [res line]
              (merge (parse-md-kind-and-title res line)
                     (parse-md-tags res line)))]
      (let [res (reduce parse-md-step {} lines)
            text (str/join "\n" (reverse (:lines res)))]
        (-> res
            (dissoc :lines)
            (assoc :text text))))))

(defn parse-common [data]
  (let [markdown-data (parse-markdown-data data)]
    {:title (or (data "title") (:title markdown-data))
     :kind (or (parse-kind data) (:kind markdown-data))
     :marker (data "marker")
     :description (if (:title markdown-data)
                    (:text markdown-data)
                    (or (data "description")
                        (data "content")))
     :mapped-here (mapv #(hash-map :name %) (data "mapped-here"))
     :tags (into []
             (concat (mapv #(hash-map :name %) (data "tags"))
                     (mapv #(hash-map :name %) (:tags markdown-data))))}))

(defn parse-project [data]
  {:copyright (data "copyright")})

(defn parse-requirement [data]
  {})

(defn parse-component [data]
  {})

(defn parse-work-item [data]
  {})

(defn parse-tag [data]
  {})

(def kind-parsers
  {"project" parse-project
   "requirement" parse-requirement
   "component" parse-component
   "work-item" parse-work-item
   "tag" parse-tag})

(defn custard-node? [node]
  (contains? node :kind))

(defn process-down [node f ctx]
  (let [{:keys [node ctx]} (f node ctx)]
    (-> node
        (update :children
                (fn [children]
                  (mapv #(process-down % f ctx) children))))))

(declare parse-nodes)

(defn parse-children [name-segments parent-name data]
  (letfn [(parse-child [[name-segment data]]
            (parse-nodes (conj name-segments name-segment)
                         parent-name data))]
    (->> data
         (filter #(map? (second %)))
         (map parse-child)
         (apply concat)
         (into []))))

(defn parse-nodes [name-segments parent-name data]
  {:pre [(map? data)]}
  (let [common (parse-common data)
        parser (kind-parsers (:kind common))]
    (if (and (:kind common) parser)
      (let [name (str/join "/" name-segments)
            basic {:name name
                   :parent parent-name
                   :children (parse-children name-segments name data)}]
        [(merge basic
                (parse-common data)
                (parser data))])
      (parse-children name-segments parent-name data))))

(defn parse-tree [data]
  (letfn [(parse-step [root [name-segment data]]
            (let [nodes (parse-nodes [name-segment] nil data)]
              (update root :children concat nodes)))]
    (let [root {:name nil :children []}
          tree (reduce parse-step root data)]
      tree)))

(defn flatten-tree [node]
  (letfn [(collect-step [m node]
            (merge m (flatten-tree node)))]
    (reduce collect-step
            (if-not (nil? (:name node))
              {(:name node) node}
              {})
            (:children node))))

(defn build-graph [flat-tree]
  (letfn [(parse-node [graph node]
            (let [ident (node->ident node)
                  child-links (mapv node->link (:children node))
                  linked-node (assoc node :children child-links)]
              (-> graph
                  (update :nodes conj ident)
                  (assoc-in ident linked-node))))
          (build-step [graph [name node]]
            (parse-node graph node))]
    (reduce build-step {:node {} :nodes []} flat-tree)))

(defn recursive-merge [a b]
  (if (and (map? a) (map? b))
    (merge-with recursive-merge a b)
    (merge a b)))

(defn merge-file-data [m [path data]]
  (update-in m (path->segments path) recursive-merge data))

(defn create-mapped-to-links [graph]
  (letfn [(lookup-mapped-to [graph ident]
            (let [nodes (mapv #(get-in graph %) (:nodes graph))]
              (filterv #(some #{ident} (:mapped-here %)) nodes)))
          (create-mapped-to [graph ident]
            (let [node (get-in graph ident)
                  link (node->link node)
                  targets (lookup-mapped-to graph link)]
              (assoc-in graph
                        (conj ident :mapped-to)
                        (mapv node->link targets))))]
    (reduce create-mapped-to graph (:nodes graph))))

(defn create-tagged-links [graph]
  (letfn [(lookup-tag [graph link]
            (let [nodes (mapv #(get-in graph %) (:nodes graph))]
              (filterv #(some #{link} (:tags %)) nodes)))
          (create-tagged [graph ident]
            (let [node (get-in graph ident)]
              (if (= "tag" (:kind node))
                (let [link (node->link node)
                      sources (lookup-tag graph link)]
                  (assoc-in graph
                            (conj ident :tagged)
                            (mapv node->link sources)))
                graph)))]
    (reduce create-tagged graph (:nodes graph))))

(defn process-files [path->data]
  (let [data (reduce merge-file-data {} path->data)
        tree (parse-tree data)
        flat-tree (flatten-tree tree)
        graph (build-graph flat-tree)]
    (-> graph
        create-mapped-to-links
        create-tagged-links)))

(defn parse-yaml [data]
  (try
    (yaml/parse-string data :keywords false)
    (catch Exception e
      {:error (str e)})))

(defn parse-uncommitted [dir]
  (let [files (filter fs/file? (fs/find-files dir #".*\.yaml$"))
        paths (map #(relative-path dir %) files)
        datas (map #(parse-yaml (slurp %)) files)
        path->data (zipmap paths datas)]
    (process-files path->data)))

(defn parse-commit [repo commit]
  (let [tree (git-commit/tree repo commit)
        walk (git-tree/walk repo [tree] true)
        lazy-walk (take-while #(.next %) (repeat walk))]
    (letfn [(parse-entry [res walk]
              (if (and (not (.isSubtree walk))
                       (re-matches #".*\.yaml$" (.getNameString walk)))
                (let [oid (.getObjectId walk 0)
                      blob (git-blob/load repo oid)
                      data (String. (:data blob))]
                  (assoc res
                         (.getPathString walk)
                         (parse-yaml data)))
                res))]
      (process-files (reduce parse-entry {} lazy-walk)))))

(ns custard.parser
  (:require [clojure.string :as str]
            [clojure.walk :refer [keywordize-keys]]
            [clj-yaml.core :as yaml]
            [gitiom.blob :as git-blob]
            [gitiom.commit :as git-commit]
            [gitiom.repo :as git-repo]
            [gitiom.tree :as git-tree]
            [me.raynes.fs :as fs]
            [custard.files :refer [relative-path]]))

;;;; Path utilities

(defn strip-extension [path]
  (last (first (re-seq #"(.*)\..*$" path))))

(defn path->segments [path]
  (fs/split (strip-extension path)))

;;;; Node idents and links

(defn node->ident [node]
  [:node (:name node)])

(defn node->link [node]
  {:name (:name node)})

;;;; Parsing

(def kind-aliases
  {"project" ["project" "p"]
   "requirement" ["requirement" "req" "r"]
   "component" ["component" "comp" "c"]
   "work-item" ["work-item" "work" "w"]
   "tag" ["tag" "t"]})

(defn parse-kind [kind]
  (when-let [kind (cond-> kind (map? kind) (get "kind"))]
    (ffirst (filter #(some #{kind} (second %)) kind-aliases))))

(defn parse-markdown-data [data]
  (let [text (or (data "description") (data "content") "")
        lines (str/split-lines text)
        title-pattern #"#\s+(([a-z]+):\s*)?(.*)"
        tag-pattern #"\+([a-zA-Z0-9-_\/:]+)"]
    (letfn [(parse-md-kind-and-title [res line]
              (if-not (and (:kind res) (:title res))
                (if-let [match (re-matches title-pattern line)]
                  (let [[_ _ kind title] match]
                    (let [res (-> res
                                  (assoc :kind (parse-kind kind))
                                  (assoc :title title))]
                      res))
                  (update res :lines conj line))
                (update res :lines conj line)))
            (parse-md-tags [res line]
              (let [tags (map second (re-seq tag-pattern line))]
                (-> res
                    (dissoc :lines)
                    (update :tags (comp distinct concat) tags))))
            (parse-md-step [res line]
              (merge (parse-md-kind-and-title res line)
                     (parse-md-tags res line)))]
      (let [res (reduce parse-md-step {} lines)
            text (str/join "\n" (reverse (:lines res)))]
        (-> res
            (dissoc :lines)
            (assoc :text text))))))

(defn parse-common [data]
  (let [markdown-data (parse-markdown-data data)]
    {:title (or (data "title") (:title markdown-data))
     :kind (or (parse-kind data) (:kind markdown-data))
     :description (if (:title markdown-data)
                    (:text markdown-data)
                    (or (data "description")
                        (data "content")))
     :mapped-here (mapv #(hash-map :name %) (data "mapped-here"))
     :tags (into []
             (concat (mapv #(hash-map :name %) (data "tags"))
                     (mapv #(hash-map :name %) (:tags markdown-data))))}))

(defn parse-project [data]
  {:copyright (data "copyright")
   :sort-by (let [possible-values ["title" "location" "name"]
                  value (or (data "sort-by") "location")]
              (if (some #{value} possible-values) value "location"))})

(defn parse-requirement [data]
  {})

(defn parse-component [data]
  {})

(defn parse-work-item [data]
  {})

(defn parse-tag [data]
  {:marker (data "marker")})

(def kind-parsers
  {"project" parse-project
   "requirement" parse-requirement
   "component" parse-component
   "work-item" parse-work-item
   "tag" parse-tag})

(defn custard-node? [node]
  (contains? node :kind))

(defn process-down [node f ctx]
  (let [{:keys [node ctx]} (f node ctx)]
    (-> node
        (update :children
                (fn [children]
                  (mapv #(process-down % f ctx) children))))))

(declare parse-nodes)

(defn parse-children [name-segments parent-name data]
  (letfn [(parse-child [[name-segment data]]
            (parse-nodes (conj name-segments name-segment)
                         parent-name data))]
    (->> data
         (filter #(map? (second %)))
         (map parse-child)
         (apply concat)
         (into []))))

(defn parse-nodes [name-segments parent-name data]
  {:pre [(map? data)]}
  (let [common (parse-common data)
        parser (kind-parsers (:kind common))]
    (if (and (:kind common) parser)
      (let [name (str/join "/" name-segments)
            basic {:name name
                   :parent parent-name
                   :children (parse-children name-segments name data)}]
        [(merge basic
                (parse-common data)
                (parser data))])
      (parse-children name-segments parent-name data))))

(defn parse-tree [data]
  (letfn [(parse-step [root [name-segment data]]
            (let [nodes (parse-nodes [name-segment] nil data)]
              (update root :children concat nodes)))]
    (let [root {:name nil :children []}
          tree (reduce parse-step root data)]
      tree)))

(defn flatten-tree [node]
  (letfn [(collect-step [m node]
            (merge m (flatten-tree node)))]
    (reduce collect-step
            (if-not (nil? (:name node))
              {(:name node) node}
              {})
            (:children node))))

(defn build-graph [flat-tree]
  (letfn [(parse-node [graph node]
            (let [ident (node->ident node)
                  child-links (mapv node->link (:children node))
                  linked-node (assoc node :children child-links)]
              (-> graph
                  (update :nodes conj ident)
                  (assoc-in ident linked-node))))
          (build-step [graph [name node]]
            (parse-node graph node))]
    (reduce build-step {:node {} :nodes []} flat-tree)))

(defn recursive-merge [a b]
  (if (and (map? a) (map? b))
    (merge-with recursive-merge a b)
    (merge a b)))

(defn merge-file-data [m [path data]]
  (update-in m (path->segments path) recursive-merge data))

(defn create-mapped-to-links [graph]
  (letfn [(lookup-mapped-to [graph ident]
            (let [nodes (mapv #(get-in graph %) (:nodes graph))]
              (filterv #(some #{ident} (:mapped-here %)) nodes)))
          (create-mapped-to [graph ident]
            (let [node (get-in graph ident)
                  link (node->link node)
                  targets (lookup-mapped-to graph link)]
              (assoc-in graph
                        (conj ident :mapped-to)
                        (mapv node->link targets))))]
    (reduce create-mapped-to graph (:nodes graph))))

(defn create-tagged-links [graph]
  (letfn [(lookup-tag [graph link]
            (let [nodes (mapv #(get-in graph %) (:nodes graph))]
              (filterv #(some #{link} (:tags %)) nodes)))
          (create-tagged [graph ident]
            (let [node (get-in graph ident)]
              (if (= "tag" (:kind node))
                (let [link (node->link node)
                      sources (lookup-tag graph link)]
                  (assoc-in graph
                            (conj ident :tagged)
                            (mapv node->link sources)))
                graph)))]
    (reduce create-tagged graph (:nodes graph))))

(defn process-files [path->data]
  (let [data (reduce merge-file-data {} path->data)
        tree (parse-tree data)
        flat-tree (flatten-tree tree)
        graph (build-graph flat-tree)]
    (-> graph
        create-mapped-to-links
        create-tagged-links)))

(defn parse-yaml [data]
  (try
    (yaml/parse-string data :keywords false)
    (catch Exception e
      {:error (str e)})))

(defn parse-uncommitted [dir]
  (let [files (filter fs/file? (fs/find-files dir #".*\.yaml$"))
        paths (map #(relative-path dir %) files)
        datas (map #(parse-yaml (slurp %)) files)
        path->data (zipmap paths datas)]
    (process-files path->data)))

(defn parse-commit [repo commit]
  (let [tree (git-commit/tree repo commit)
        walk (git-tree/walk repo [tree] true)
        lazy-walk (take-while #(.next %) (repeat walk))]
    (letfn [(parse-entry [res walk]
              (if (and (not (.isSubtree walk))
                       (re-matches #".*\.yaml$" (.getNameString walk)))
                (let [oid (.getObjectId walk 0)
                      blob (git-blob/load repo oid)
                      data (String. (:data blob))]
                  (assoc res
                         (.getPathString walk)
                         (parse-yaml data)))
                res))]
      (process-files (reduce parse-entry {} lazy-walk)))))

Add "sort-by: <value>" in nodes with kind: project

Allowed values are: location (position in YAML), title and name.
The default is location.


(ns discuss.views
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [om-bootstrap.panel :as panel]
            [om-bootstrap.grid :as grid]
            [cljs.pprint :refer [pprint]]
            [discuss.communication :as com]
            [discuss.history :as history]
            [discuss.lib :as lib]))

;; Elements
(defn control-buttons []
  (dom/div #js {:className "text-center"}
           (dom/h3 nil
                   (dom/i #js {:className "fa fa-angle-double-left pointer"
                               :onClick lib/init!})
                   " "
                   (dom/i #js {:className "fa fa-angle-left pointer"
                               :onClick history/back!})
                   " "
                   (dom/i #js {:className "fa fa-angle-right pointer"}))))

(defn login-view [data _owner]
  (grid/grid {:class "text-muted"}
             (grid/row {}
                       (if (get-in data [:extras :logged_in])
                         (do
                           (grid/col {:md 6}
                                     (str "Logged in as " (get-in data [:extras :users_name])))
                           (grid/col {:md 6 :class "text-right"}
                                     "Logout"))
                         (grid/col {:md-offset 5 :md 6 :class "text-right"}
                                   "Login")))))

;; Views
(defn clipboard-view []
  (reify om/IRender
    (render [_]
      (dom/div #js {:id "foo"}
               (dom/h5 nil "discuss")
               (dom/hr #js {:className "line-double"})
               (dom/div #js {:id (lib/prefix-name "clipboard-topic")})
               (dom/hr nil)
               (dom/div #js {:id (lib/prefix-name "clipboard-arguments")})))))

(defn item-view [item _owner]
  (reify om/IRender
    (render [_]
      (dom/li #js {:className "pointer"
                   :onClick #(com/ajax-get (:url item))}
              (dom/input #js {:id        (:id item)
                              :type      "radio"
                              :className (lib/prefix-name "dialogue-items")
                              :name      (lib/prefix-name "dialogue-items-group")
                              :value     (:url item)})
              " "
              (:title item)))))

(defn main-view [data owner]
  (reify om/IRender
    (render [_]
      (dom/div #js {:id (lib/prefix-name "dialogue-main")
                    :className "container"}
               (dom/h3 nil
                       (dom/i #js {:className "fa fa-comments"})
                       (str " " (get-in data [:layout :title])))
               (dom/div #js {:className "text-center"}
                        (:intro (:layout data))
                        (dom/br nil)
                        (dom/strong nil (:info (:issues data))))
               (panel/panel nil
                            (dom/h4 #js {:id (lib/prefix-name "dialogue-topic")
                                         :className "text-center"}
                                    (get-in data [:discussion :heading :intro])
                                    (get-in data [:discussion :heading :bridge])
                                    (get-in data [:discussion :heading :outro])
                                    )
                            (apply dom/ul #js {:id (lib/prefix-name "items-main")}
                                   (om/build-all item-view (:items data)))
                            (control-buttons)
                            (login-view data owner))))))

(defn debug-view [data _owner]
  (reify om/IRender
    (render [_]
      (dom/div nil
               (dom/h4 nil "Last API call")
               (dom/pre nil (get-in data [:debug :last-api]))

               (dom/h4 nil "Last response")
               ;(pprint data)
               (dom/pre nil
                        (apply dom/ul nil
                               (map (fn [[k v]] (dom/li nil (str k ": " v))) (get-in data [:debug :response]))))))))

(ns discuss.views
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [om-bootstrap.panel :as panel]
            [om-bootstrap.grid :as grid]
            [cljs.pprint :refer [pprint]]
            [discuss.communication :as com]
            [discuss.history :as history]
            [discuss.lib :as lib]))

;; Elements
(defn control-buttons []
  (dom/div #js {:className "text-center"}
           (dom/h3 nil
                   (dom/i #js {:className "fa fa-angle-double-left pointer"
                               :onClick lib/init!})
                   " "
                   (dom/i #js {:className "fa fa-angle-left pointer"
                               :onClick history/back!})
                   " "
                   (dom/i #js {:className "fa fa-angle-right pointer"}))))

(defn login-view-buttons [data _owner]
  (grid/grid {:class "text-muted"}
             (grid/row {}
                       (if (get-in data [:extras :logged_in])
                         (do
                           (grid/col {:md 6}
                                     (str "Logged in as " (get-in data [:extras :users_name])))
                           (grid/col {:md 6 :class "text-right"}
                                     "Logout"))
                         (grid/col {:md-offset 5 :md 6 :class "text-right"}
                                   "Login")))))

;; Views
(defn clipboard-view []
  (reify om/IRender
    (render [_]
      (dom/div #js {:id "foo"}
               (dom/h5 nil "discuss")
               (dom/hr #js {:className "line-double"})
               (dom/div #js {:id (lib/prefix-name "clipboard-topic")})
               (dom/hr nil)
               (dom/div #js {:id (lib/prefix-name "clipboard-arguments")})))))

(defn item-view [item _owner]
  (reify om/IRender
    (render [_]
      (dom/li #js {:className "pointer"
                   :onClick #(com/ajax-get (:url item))}
              (dom/input #js {:id        (:id item)
                              :type      "radio"
                              :className (lib/prefix-name "dialogue-items")
                              :name      (lib/prefix-name "dialogue-items-group")
                              :value     (:url item)})
              " "
              (:title item)))))

(defn main-view [data owner]
  (reify om/IRender
    (render [_]
      (dom/div #js {:id (lib/prefix-name "dialogue-main")
                    :className "container"}
               (dom/h3 nil
                       (dom/i #js {:className "fa fa-comments"})
                       (str " " (get-in data [:layout :title])))
               (dom/div #js {:className "text-center"}
                        (:intro (:layout data))
                        (dom/br nil)
                        (dom/strong nil (:info (:issues data))))
               (panel/panel nil
                            (dom/h4 #js {:id (lib/prefix-name "dialogue-topic")
                                         :className "text-center"}
                                    (get-in data [:discussion :heading :intro])
                                    (get-in data [:discussion :heading :bridge])
                                    (get-in data [:discussion :heading :outro])
                                    )
                            (apply dom/ul #js {:id (lib/prefix-name "items-main")}
                                   (om/build-all item-view (:items data)))
                            (control-buttons)
                            (login-view-buttons data owner))))))

(defn debug-view [data _owner]
  (reify om/IRender
    (render [_]
      (dom/div nil
               (dom/h4 nil "Last API call")
               (dom/pre nil (get-in data [:debug :last-api]))

               (dom/h4 nil "Last response")
               ;(pprint data)
               (dom/pre nil
                        (apply dom/ul nil
                               (map (fn [[k v]] (dom/li nil (str k "\t\t" v))) (get-in data [:debug :response]))))))))

Rename login buttons

Rename login buttons


(ns metabase.driver.postgres-test
  (:require [clojure.java.jdbc :as jdbc]
            [expectations :refer :all]
            [honeysql.core :as hsql]
            [toucan.db :as db]
            [toucan.util.test :as tt]
            [metabase.driver :as driver]
            [metabase.driver.generic-sql :as sql]
            (metabase.models [database :refer [Database]]
                             [field :refer [Field]]
                             [table :refer [Table]])
            [metabase.query-processor-test :refer [rows]]
            [metabase.query-processor.expand :as ql]
            [metabase.sync-database :as sync-db]
            [metabase.test.data :as data]
            (metabase.test.data [datasets :refer [expect-with-engine]]
                                [interface :as i])
            [metabase.test.util :as tu]
            [metabase.util :as u])
  (:import metabase.driver.postgres.PostgresDriver))

(def ^:private ^PostgresDriver pg-driver (PostgresDriver.))

;; # Check that SSL params get added the connection details in the way we'd like
;; ## no SSL -- this should *not* include the key :ssl (regardless of its value) since that will cause the PG driver to use SSL anyway
(expect
  {:user        "camsaul"
   :classname   "org.postgresql.Driver"
   :subprotocol "postgresql"
   :subname     "//localhost:5432/bird_sightings"
   :sslmode     "disable"}
  (sql/connection-details->spec pg-driver {:ssl    false
                                           :host   "localhost"
                                           :port   5432
                                           :dbname "bird_sightings"
                                           :user   "camsaul"}))

;; ## ssl - check that expected params get added
(expect
  {:ssl         true
   :sslmode     "require"
   :classname   "org.postgresql.Driver"
   :subprotocol "postgresql"
   :user        "camsaul"
   :sslfactory  "org.postgresql.ssl.NonValidatingFactory"
   :subname     "//localhost:5432/bird_sightings"}
  (sql/connection-details->spec pg-driver {:ssl    true
                                           :host   "localhost"
                                           :port   5432
                                           :dbname "bird_sightings"
                                           :user   "camsaul"}))

;; Verify that we identify JSON columns and mark metadata properly during sync
(expect-with-engine :postgres
  :type/SerializedJSON
  (data/with-temp-db
    [_
     (i/create-database-definition "Postgres with a JSON Field"
       ["venues"
        [{:field-name "address", :base-type {:native "json"}}]
        [[(hsql/raw "to_json('{\"street\": \"431 Natoma\", \"city\": \"San Francisco\", \"state\": \"CA\", \"zip\": 94103}'::text)")]]])]
    (db/select-one-field :special_type Field, :id (data/id :venues :address))))

;;; # UUID Support
(i/def-database-definition ^:private with-uuid
  ["users"
   [{:field-name "user_id", :base-type :type/UUID}]
   [[#uuid "4f01dcfd-13f7-430c-8e6f-e505c0851027"]
    [#uuid "4652b2e7-d940-4d55-a971-7e484566663e"]
    [#uuid "da1d6ecc-e775-4008-b366-c38e7a2e8433"]
    [#uuid "7a5ce4a2-0958-46e7-9685-1a4eaa3bd08a"]
    [#uuid "84ed434e-80b4-41cf-9c88-e334427104ae"]]])

;; Check that we can load a Postgres Database with a :type/UUID
(expect-with-engine :postgres
  [{:name "id",      :base_type :type/Integer}
   {:name "user_id", :base_type :type/UUID}]
  (->> (data/dataset metabase.driver.postgres-test/with-uuid
         (data/run-query users))
       :data
       :cols
       (mapv (u/rpartial select-keys [:name :base_type]))))

;; Check that we can filter by a UUID Field
(expect-with-engine :postgres
  [[2 #uuid "4652b2e7-d940-4d55-a971-7e484566663e"]]
  (rows (data/dataset metabase.driver.postgres-test/with-uuid
          (data/run-query users
            (ql/filter (ql/= $user_id "4652b2e7-d940-4d55-a971-7e484566663e"))))))

;; check that a nil value for a UUID field doesn't barf (#2152)
(expect-with-engine :postgres
  []
  (rows (data/dataset metabase.driver.postgres-test/with-uuid
          (data/run-query users
            (ql/filter (ql/= $user_id nil))))))

;; Make sure that Tables / Fields with dots in their names get escaped properly
(i/def-database-definition ^:private dots-in-names
  ["objects.stuff"
   [{:field-name "dotted.name", :base-type :type/Text}]
   [["toucan_cage"]
    ["four_loko"]
    ["ouija_board"]]])

(expect-with-engine :postgres
  {:columns ["id" "dotted.name"]
   :rows    [[1 "toucan_cage"]
             [2 "four_loko"]
             [3 "ouija_board"]]}
  (-> (data/dataset metabase.driver.postgres-test/dots-in-names
        (data/run-query objects.stuff))
      :data (dissoc :cols :native_form)))

;; Make sure that duplicate column names (e.g. caused by using a FK) still return both columns
(i/def-database-definition ^:private duplicate-names
  ["birds"
   [{:field-name "name", :base-type :type/Text}]
   [["Rasta"]
    ["Lucky"]]]
  ["people"
   [{:field-name "name", :base-type :type/Text}
    {:field-name "bird_id", :base-type :type/Integer, :fk :birds}]
   [["Cam" 1]]])

(expect-with-engine :postgres
  {:columns ["name" "name_2"]
   :rows    [["Cam" "Rasta"]]}
  (-> (data/dataset metabase.driver.postgres-test/duplicate-names
        (data/run-query people
          (ql/fields $name $bird_id->birds.name)))
      :data (dissoc :cols :native_form)))

;;; Check support for `inet` columns
(i/def-database-definition ^:private ip-addresses
  ["addresses"
   [{:field-name "ip", :base-type {:native "inet"}}]
   [[(hsql/raw "'192.168.1.1'::inet")]
    [(hsql/raw "'10.4.4.15'::inet")]]])

;; Filtering by inet columns should add the appropriate SQL cast, e.g. `cast('192.168.1.1' AS inet)` (otherwise this wouldn't work)
(expect-with-engine :postgres
  [[1]]
  (rows (data/dataset metabase.driver.postgres-test/ip-addresses
          (data/run-query addresses
            (ql/aggregation (ql/count))
            (ql/filter (ql/= $ip "192.168.1.1"))))))

;;; Util Fns

(defn- drop-if-exists-and-create-db! [db-name]
  (let [spec (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))]
    ;; kill any open connections
    (jdbc/query spec ["SELECT pg_terminate_backend(pg_stat_activity.pid)
                         FROM pg_stat_activity
                        WHERE pg_stat_activity.datname = ?;" db-name])
    ;; create the DB
    (jdbc/execute! spec [(format "DROP DATABASE IF EXISTS %s;
                                  CREATE DATABASE %s;"
                                 db-name db-name)]
                   {:transaction? false})))

;; Check that we properly fetch materialized views.
;; As discussed in #2355 they don't come back from JDBC `DatabaseMetadata` so we have to fetch them manually.
(expect-with-engine :postgres
  {:tables #{{:schema "public", :name "test_mview"}}}
  (do
    (drop-if-exists-and-create-db! "materialized_views_test")
    (jdbc/execute! (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))
                   ["DROP DATABASE IF EXISTS materialized_views_test;
                     CREATE DATABASE materialized_views_test;"]
                   {:transaction? false})
    (let [details (i/database->connection-details pg-driver :db {:database-name "materialized_views_test"})]
      (jdbc/execute! (sql/connection-details->spec pg-driver details)
                     ["DROP MATERIALIZED VIEW IF EXISTS test_mview;
                       CREATE MATERIALIZED VIEW test_mview AS
                       SELECT 'Toucans are the coolest type of bird.' AS true_facts;"])
      (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "materialized_views_test")}]
        (driver/describe-database pg-driver database)))))

;; Check that we properly fetch foreign tables.
(expect-with-engine :postgres
  {:tables #{{:schema "public", :name "foreign_table"} {:schema "public", :name "local_table"}}}
  (do
    (drop-if-exists-and-create-db! "fdw_test")
    (let [details (i/database->connection-details pg-driver :db {:database-name "fdw_test"})]
      (jdbc/execute! (sql/connection-details->spec pg-driver details)
                     [(str "CREATE EXTENSION IF NOT EXISTS postgres_fdw;
                            CREATE SERVER foreign_server
                                FOREIGN DATA WRAPPER postgres_fdw
                                OPTIONS (host '" (:host details) "', port '" (:port details) "', dbname 'fdw_test');
                            CREATE TABLE public.local_table (data text);
                            CREATE FOREIGN TABLE foreign_table (data text)
                                SERVER foreign_server
                                OPTIONS (schema_name 'public', table_name 'local_table');")])
      (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "fdw_test")}]
        (driver/describe-database pg-driver database)))))

;; make sure that if a view is dropped and recreated that the original Table object is marked active rather than a new one being created (#3331)
(expect
  [{:name "angry_birds", :active true}]
  (let [details (i/database->connection-details pg-driver :db {:database-name "dropped_views_test"})
        spec    (sql/connection-details->spec pg-driver details)
        exec!   #(doseq [statement %]
                   (jdbc/execute! spec [statement]))]
    ;; create the postgres DB
    (drop-if-exists-and-create-db! "dropped_views_test")
    ;; create the DB object
    (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "dropped_views_test")}]
      (let [sync! #(sync-db/sync-database! database, :full-sync? true)]
        ;; populate the DB and create a view
        (exec! ["CREATE table birds (name VARCHAR UNIQUE NOT NULL);"
                "INSERT INTO birds (name) VALUES ('Rasta'), ('Lucky'), ('Kanye Nest');"
                "CREATE VIEW angry_birds AS SELECT upper(name) AS name FROM birds;"])
        ;; now sync the DB
        (sync!)
        ;; drop the view
        (exec! ["DROP VIEW angry_birds;"])
        ;; sync again
        (sync!)
        ;; recreate the view
        (exec! ["CREATE VIEW angry_birds AS SELECT upper(name) AS name FROM birds;"])
        ;; sync one last time
        (sync!)
        ;; now take a look at the Tables in the database related to the view. THERE SHOULD BE ONLY ONE!
        (db/select [Table :name :active] :db_id (u/get-id database), :name "angry_birds")))))

;;; timezone tests

(tu/resolve-private-vars metabase.driver.generic-sql.query-processor
  run-query-with-timezone)

(defn- get-timezone-with-report-timezone [report-timezone]
  (ffirst (:rows (run-query-with-timezone pg-driver
                                          {:report-timezone report-timezone}
                                          (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))
                                          {:query "SELECT current_setting('TIMEZONE') AS timezone;"}))))

;; check that if we set report-timezone to US/Pacific that the session timezone is in fact US/Pacific
(expect-with-engine :postgres
  "US/Pacific"
  (get-timezone-with-report-timezone "US/Pacific"))

;; check that we can set it to something else: America/Chicago
(expect-with-engine :postgres
  "America/Chicago"
  (get-timezone-with-report-timezone "America/Chicago"))

;; ok, check that if we try to put in a fake timezone that the query still reëxecutes without a custom timezone. This should give us the same result as if we didn't try to set a timezone at all
(expect-with-engine :postgres
  (get-timezone-with-report-timezone nil)
  (get-timezone-with-report-timezone "Crunk Burger"))

;; make sure connection details w/ extra params work as expected
(expect
  "//localhost:5432/cool?prepareThreshold=0"
  (:subname (sql/connection-details->spec pg-driver {:host               "localhost"
                                                     :port               "5432"
                                                     :dbname             "cool"
                                                     :additional-options "prepareThreshold=0"})))

(ns metabase.driver.postgres-test
  (:require [clojure.java.jdbc :as jdbc]
            [expectations :refer :all]
            [honeysql.core :as hsql]
            [toucan.db :as db]
            [toucan.util.test :as tt]
            [metabase.driver :as driver]
            [metabase.driver.generic-sql :as sql]
            (metabase.models [database :refer [Database]]
                             [field :refer [Field]]
                             [table :refer [Table]])
            [metabase.query-processor-test :refer [rows]]
            [metabase.query-processor.expand :as ql]
            [metabase.sync-database :as sync-db]
            [metabase.test.data :as data]
            (metabase.test.data [datasets :refer [expect-with-engine]]
                                [interface :as i])
            [metabase.test.util :as tu]
            [metabase.util :as u])
  (:import metabase.driver.postgres.PostgresDriver))

(def ^:private ^PostgresDriver pg-driver (PostgresDriver.))

;; # Check that SSL params get added the connection details in the way we'd like
;; ## no SSL -- this should *not* include the key :ssl (regardless of its value) since that will cause the PG driver to use SSL anyway
(expect
  {:user        "camsaul"
   :classname   "org.postgresql.Driver"
   :subprotocol "postgresql"
   :subname     "//localhost:5432/bird_sightings"
   :sslmode     "disable"}
  (sql/connection-details->spec pg-driver {:ssl    false
                                           :host   "localhost"
                                           :port   5432
                                           :dbname "bird_sightings"
                                           :user   "camsaul"}))

;; ## ssl - check that expected params get added
(expect
  {:ssl         true
   :sslmode     "require"
   :classname   "org.postgresql.Driver"
   :subprotocol "postgresql"
   :user        "camsaul"
   :sslfactory  "org.postgresql.ssl.NonValidatingFactory"
   :subname     "//localhost:5432/bird_sightings"}
  (sql/connection-details->spec pg-driver {:ssl    true
                                           :host   "localhost"
                                           :port   5432
                                           :dbname "bird_sightings"
                                           :user   "camsaul"}))

;; Verify that we identify JSON columns and mark metadata properly during sync
(expect-with-engine :postgres
  :type/SerializedJSON
  (data/with-temp-db
    [_
     (i/create-database-definition "Postgres with a JSON Field"
       ["venues"
        [{:field-name "address", :base-type {:native "json"}}]
        [[(hsql/raw "to_json('{\"street\": \"431 Natoma\", \"city\": \"San Francisco\", \"state\": \"CA\", \"zip\": 94103}'::text)")]]])]
    (db/select-one-field :special_type Field, :id (data/id :venues :address))))

;;; # UUID Support
(i/def-database-definition ^:private with-uuid
  ["users"
   [{:field-name "user_id", :base-type :type/UUID}]
   [[#uuid "4f01dcfd-13f7-430c-8e6f-e505c0851027"]
    [#uuid "4652b2e7-d940-4d55-a971-7e484566663e"]
    [#uuid "da1d6ecc-e775-4008-b366-c38e7a2e8433"]
    [#uuid "7a5ce4a2-0958-46e7-9685-1a4eaa3bd08a"]
    [#uuid "84ed434e-80b4-41cf-9c88-e334427104ae"]]])

;; Check that we can load a Postgres Database with a :type/UUID
(expect-with-engine :postgres
  [{:name "id",      :base_type :type/Integer}
   {:name "user_id", :base_type :type/UUID}]
  (->> (data/dataset metabase.driver.postgres-test/with-uuid
         (data/run-query users))
       :data
       :cols
       (mapv (u/rpartial select-keys [:name :base_type]))))

;; Check that we can filter by a UUID Field
(expect-with-engine :postgres
  [[2 #uuid "4652b2e7-d940-4d55-a971-7e484566663e"]]
  (rows (data/dataset metabase.driver.postgres-test/with-uuid
          (data/run-query users
            (ql/filter (ql/= $user_id "4652b2e7-d940-4d55-a971-7e484566663e"))))))

;; check that a nil value for a UUID field doesn't barf (#2152)
(expect-with-engine :postgres
  []
  (rows (data/dataset metabase.driver.postgres-test/with-uuid
          (data/run-query users
            (ql/filter (ql/= $user_id nil))))))

;; Make sure that Tables / Fields with dots in their names get escaped properly
(i/def-database-definition ^:private dots-in-names
  ["objects.stuff"
   [{:field-name "dotted.name", :base-type :type/Text}]
   [["toucan_cage"]
    ["four_loko"]
    ["ouija_board"]]])

(expect-with-engine :postgres
  {:columns ["id" "dotted.name"]
   :rows    [[1 "toucan_cage"]
             [2 "four_loko"]
             [3 "ouija_board"]]}
  (-> (data/dataset metabase.driver.postgres-test/dots-in-names
        (data/run-query objects.stuff))
      :data (dissoc :cols :native_form)))

;; Make sure that duplicate column names (e.g. caused by using a FK) still return both columns
(i/def-database-definition ^:private duplicate-names
  ["birds"
   [{:field-name "name", :base-type :type/Text}]
   [["Rasta"]
    ["Lucky"]]]
  ["people"
   [{:field-name "name", :base-type :type/Text}
    {:field-name "bird_id", :base-type :type/Integer, :fk :birds}]
   [["Cam" 1]]])

(expect-with-engine :postgres
  {:columns ["name" "name_2"]
   :rows    [["Cam" "Rasta"]]}
  (-> (data/dataset metabase.driver.postgres-test/duplicate-names
        (data/run-query people
          (ql/fields $name $bird_id->birds.name)))
      :data (dissoc :cols :native_form)))

;;; Check support for `inet` columns
(i/def-database-definition ^:private ip-addresses
  ["addresses"
   [{:field-name "ip", :base-type {:native "inet"}}]
   [[(hsql/raw "'192.168.1.1'::inet")]
    [(hsql/raw "'10.4.4.15'::inet")]]])

;; Filtering by inet columns should add the appropriate SQL cast, e.g. `cast('192.168.1.1' AS inet)` (otherwise this wouldn't work)
(expect-with-engine :postgres
  [[1]]
  (rows (data/dataset metabase.driver.postgres-test/ip-addresses
          (data/run-query addresses
            (ql/aggregation (ql/count))
            (ql/filter (ql/= $ip "192.168.1.1"))))))

;;; Util Fns

(defn- drop-if-exists-and-create-db! [db-name]
  (let [spec (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))]
    ;; kill any open connections
    (jdbc/query spec ["SELECT pg_terminate_backend(pg_stat_activity.pid)
                         FROM pg_stat_activity
                        WHERE pg_stat_activity.datname = ?;" db-name])
    ;; create the DB
    (jdbc/execute! spec [(format "DROP DATABASE IF EXISTS %s;
                                  CREATE DATABASE %s;"
                                 db-name db-name)]
                   {:transaction? false})))

;; Check that we properly fetch materialized views.
;; As discussed in #2355 they don't come back from JDBC `DatabaseMetadata` so we have to fetch them manually.
(expect-with-engine :postgres
  {:tables #{{:schema "public", :name "test_mview"}}}
  (do
    (drop-if-exists-and-create-db! "materialized_views_test")
    (jdbc/execute! (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))
                   ["DROP DATABASE IF EXISTS materialized_views_test;
                     CREATE DATABASE materialized_views_test;"]
                   {:transaction? false})
    (let [details (i/database->connection-details pg-driver :db {:database-name "materialized_views_test"})]
      (jdbc/execute! (sql/connection-details->spec pg-driver details)
                     ["DROP MATERIALIZED VIEW IF EXISTS test_mview;
                       CREATE MATERIALIZED VIEW test_mview AS
                       SELECT 'Toucans are the coolest type of bird.' AS true_facts;"])
      (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "materialized_views_test")}]
        (driver/describe-database pg-driver database)))))

;; Check that we properly fetch foreign tables.
(expect-with-engine :postgres
  {:tables #{{:schema "public", :name "foreign_table"} {:schema "public", :name "local_table"}}}
  (do
    (drop-if-exists-and-create-db! "fdw_test")
    (let [details (i/database->connection-details pg-driver :db {:database-name "fdw_test"})]
      (jdbc/execute! (sql/connection-details->spec pg-driver details)
                     [(str "CREATE EXTENSION IF NOT EXISTS postgres_fdw;
                            CREATE SERVER foreign_server
                                FOREIGN DATA WRAPPER postgres_fdw
                                OPTIONS (host '" (:host details) "', port '" (:port details) "', dbname 'fdw_test');
                            CREATE TABLE public.local_table (data text);
                            CREATE FOREIGN TABLE foreign_table (data text)
                                SERVER foreign_server
                                OPTIONS (schema_name 'public', table_name 'local_table');")])
      (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "fdw_test")}]
        (driver/describe-database pg-driver database)))))

;; make sure that if a view is dropped and recreated that the original Table object is marked active rather than a new one being created (#3331)
(expect
  [{:name "angry_birds", :active true}]
  (let [details (i/database->connection-details pg-driver :db {:database-name "dropped_views_test"})
        spec    (sql/connection-details->spec pg-driver details)
        exec!   #(doseq [statement %]
                   (jdbc/execute! spec [statement]))]
    ;; create the postgres DB
    (drop-if-exists-and-create-db! "dropped_views_test")
    ;; create the DB object
    (tt/with-temp Database [database {:engine :postgres, :details (assoc details :dbname "dropped_views_test")}]
      (let [sync! #(sync-db/sync-database! database, :full-sync? true)]
        ;; populate the DB and create a view
        (exec! ["CREATE table birds (name VARCHAR UNIQUE NOT NULL);"
                "INSERT INTO birds (name) VALUES ('Rasta'), ('Lucky'), ('Kanye Nest');"
                "CREATE VIEW angry_birds AS SELECT upper(name) AS name FROM birds;"])
        ;; now sync the DB
        (sync!)
        ;; drop the view
        (exec! ["DROP VIEW angry_birds;"])
        ;; sync again
        (sync!)
        ;; recreate the view
        (exec! ["CREATE VIEW angry_birds AS SELECT upper(name) AS name FROM birds;"])
        ;; sync one last time
        (sync!)
        ;; now take a look at the Tables in the database related to the view. THERE SHOULD BE ONLY ONE!
        (map (partial into {}) (db/select [Table :name :active] :db_id (u/get-id database), :name "angry_birds"))))))

;;; timezone tests

(tu/resolve-private-vars metabase.driver.generic-sql.query-processor
  run-query-with-timezone)

(defn- get-timezone-with-report-timezone [report-timezone]
  (ffirst (:rows (run-query-with-timezone pg-driver
                                          {:report-timezone report-timezone}
                                          (sql/connection-details->spec pg-driver (i/database->connection-details pg-driver :server nil))
                                          {:query "SELECT current_setting('TIMEZONE') AS timezone;"}))))

;; check that if we set report-timezone to US/Pacific that the session timezone is in fact US/Pacific
(expect-with-engine :postgres
  "US/Pacific"
  (get-timezone-with-report-timezone "US/Pacific"))

;; check that we can set it to something else: America/Chicago
(expect-with-engine :postgres
  "America/Chicago"
  (get-timezone-with-report-timezone "America/Chicago"))

;; ok, check that if we try to put in a fake timezone that the query still reëxecutes without a custom timezone. This should give us the same result as if we didn't try to set a timezone at all
(expect-with-engine :postgres
  (get-timezone-with-report-timezone nil)
  (get-timezone-with-report-timezone "Crunk Burger"))

;; make sure connection details w/ extra params work as expected
(expect
  "//localhost:5432/cool?prepareThreshold=0"
  (:subname (sql/connection-details->spec pg-driver {:host               "localhost"
                                                     :port               "5432"
                                                     :dbname             "cool"
                                                     :additional-options "prepareThreshold=0"})))

Test fix :wrench:

Test fix :wrench:


(ns galleon
  (:require [immutant.web :as web]
            [helmsman]
            [galleon.applications]
            [galleon.cli]
            [datomic.api :as d]
            [clojure.edn]
            [gangway.util :as gw-util]
            [gangway.worker :as gw-worker])
  (:import (java.io File)))

(def default-config-path "/etc/galleon.edn")
(def system nil)

(defn file-exists?
  [path]
  (prn path)
  (if
    (.isFile (File. path)) true false))

(defn load-system-config
  [path]
  {:datomic-url "datomic:mem://galleon-test"}
  #_(if (file-exists? path)
    (clojure.edn/read-string (slurp path))
    (throw (Exception. (str "Config file missing: " path)))))

(defn init-system!
  "Creates the system state from the config and applications maps."
  [config-map applications]
  (let [datomic-uri (:datomic-url config-map)
        db-create-rval (d/create-database datomic-uri)
        db-conn (d/connect datomic-uri)
        system {:db-conn db-conn
                :config config-map}]
    (doseq [app applications]
      (when (fn? (:init-fn! app))
        ((:init-fn! app) system)))
    system))

(defn start-system!
  [_] ;; TODO: handle incoming system here?
  (let [apps galleon.applications/system-applications
        system (init-system!
                (load-system-config "to/some/path") ;; TODO: Make this configurable.
                 apps)]

    #_
    (gw-util/start-queues! gw-util/queues)

    ;;; Lets get some app-magic started, shall we?
    (loop [system-startup-state system
           app (first apps)
           remaining-apps (vec (rest apps))]
      (if (nil? app)
        system-startup-state
        (recur
          (if-let [start-fn! (:start-fn! app nil)]
            (start-fn! system-startup-state)
            system-startup-state)
          (first remaining-apps)
          (vec (rest remaining-apps)))))

    (assoc-in system [:web-server :immutant]
              (web/start galleon.applications/system-handler))))

(defn stop-system!
  [system]
  (web/stop)
  (let [apps galleon.applications/system-applications]
    (loop [system-shutdown-state system
           app (last apps)
           remaining-apps (vec (butlast apps))]
      (if (nil? app)
        system-shutdown-state
        (recur
          (if-let [stop-fn! (:stop-fn! app)]
            (stop-fn! system-shutdown-state)
            system-shutdown-state)
          (last remaining-apps)
          (vec (butlast remaining-apps)))))))

;;; We can't use this anymore. Should we even keep it?
#_(defn -main [& args]
    (alter-var-root #'*read-eval* (constantly false))
    (start-system!
      (let [opts (galleon.cli/get-opts args)]
        (start-system!
          (:config opts default-config-path))))
    1)

(ns galleon
  (:require [immutant.web :as web]
            [helmsman]
            [galleon.applications]
            [galleon.cli]
            [datomic.api :as d]
            [clojure.edn]
            [gangway.util :as gw-util]
            [gangway.worker :as gw-worker])
  (:import (java.io File)))

(def default-config-path "/etc/galleon.edn")
(def system nil)

(defn file-exists?
  [path]
  (prn path)
  (if
    (.isFile (File. path)) true false))

(defn load-system-config
  [path]
  {:datomic-url "datomic:mem://galleon-test"}
  #_(if (file-exists? path)
    (clojure.edn/read-string (slurp path))
    (throw (Exception. (str "Config file missing: " path)))))

(defn init-system!
  "Creates the system state from the config and applications maps."
  [config-map applications]
  (let [datomic-uri (:datomic-url config-map)
        db-create-rval (d/create-database datomic-uri)
        db-conn (d/connect datomic-uri)
        system {:db-conn db-conn
                :config config-map}]
    (doseq [app applications]
      (when (fn? (:init-fn! app))
        ((:init-fn! app) system)))
    system))

(defn start-system!
  [_] ;; TODO: handle incoming system here?
  (let [apps galleon.applications/system-applications
        system (init-system!
                (load-system-config "to/some/path") ;; TODO: Make this configurable.
                 apps)]

    ;;; Lets get some app-magic started, shall we?
    (loop [system-startup-state system
           app (first apps)
           remaining-apps (vec (rest apps))]
      (if (nil? app)
        system-startup-state
        (recur
          (if-let [start-fn! (:start-fn! app nil)]
            (start-fn! system-startup-state)
            system-startup-state)
          (first remaining-apps)
          (vec (rest remaining-apps)))))

    (assoc-in system [:web-server :immutant]
              (web/start galleon.applications/system-handler))))

(defn stop-system!
  [system]
  (web/stop)
  (let [apps galleon.applications/system-applications]
    (loop [system-shutdown-state system
           app (last apps)
           remaining-apps (vec (butlast apps))]
      (if (nil? app)
        system-shutdown-state
        (recur
          (if-let [stop-fn! (:stop-fn! app)]
            (stop-fn! system-shutdown-state)
            system-shutdown-state)
          (last remaining-apps)
          (vec (butlast remaining-apps)))))))

;;; We can't use this anymore. Should we even keep it?
#_(defn -main [& args]
    (alter-var-root #'*read-eval* (constantly false))
    (start-system!
      (let [opts (galleon.cli/get-opts args)]
        (start-system!
          (:config opts default-config-path))))
    1)

remove old startup hack for queues

remove old startup hack for queues


(ns vip.data-processor.s3
  (:require [aws.sdk.s3 :as s3]
            [clojure.java.io :as io]
            [turbovote.resource-config :refer [config]]
            [korma.core :as korma]
            [clojure.string :refer [join]]
            [vip.data-processor.db.postgres :as postgres]
            [vip.data-processor.util :as util])
  (:import [java.io File]
           [java.nio.file Files CopyOption StandardCopyOption]
           [java.nio.file.attribute FileAttribute]
           [net.lingala.zip4j.core ZipFile]
           [net.lingala.zip4j.model ZipParameters]
           [net.lingala.zip4j.util Zip4jConstants]))

(defn- get-object [key]
  (s3/get-object (config [:aws :creds])
                 (config [:aws :s3 :unprocessed-bucket])
                 key))

(defn put-object [key value]
  (s3/put-object (config [:aws :creds])
                 (config [:aws :s3 :processed-bucket])
                 key value))

(def tmp-path-prefix "vip-data-processor")

(defn download
  "Downloads the file named `key` from the configured S3 bucket to a
  temporary file and returns that path."
  [key]
  (let [tmp-path (Files/createTempFile tmp-path-prefix key
                                       (into-array FileAttribute []))
        s3-object (get-object key)]
    (Files/copy (:content s3-object)
                tmp-path
                (into-array [StandardCopyOption/REPLACE_EXISTING]))
    tmp-path))

(defn format-fips [fips]
  (cond
    (nil? fips) "XX"
    (< (count fips) 3) (format "%02d" (Integer/parseInt fips))
    (< (count fips) 5) (format "%05d" (Integer/parseInt fips))
    :else fips))

(defn format-state
  [state]
  (if (nil? state)
    "YY"
    (clojure.string/replace (clojure.string/trim state) #"\s" "-")))

(defn zip-filename* [fips state election-date]
  (let [fips (format-fips fips)
        state (format-state state)
        date (util/format-date election-date)]
    (str (join "-" ["vipfeed" fips state date]) ".zip")))

(defn zip-filename
  [{:keys [spec-version tables import-id] :as ctx}]
  (condp = @spec-version
    "3.0"
    (let [fips (-> tables
                   :sources
                   korma/select
                   first
                   :vip_id)
          state (-> tables
                    :state
                    korma/select
                    first
                    :name)
          election-date (-> tables
                            :elections
                            korma/select
                            first
                            :date)]
      (zip-filename* fips state election-date))

    "5.1"
    (let [fips (postgres/find-value-for-simple-path
                import-id "VipObject.Source.VipId")
          state (postgres/find-value-for-simple-path
                 import-id "VipObject.State.Name")
          election-date (postgres/find-value-for-simple-path
                         import-id "VipObject.Election.Date")]
      (zip-filename* fips state election-date))))

(defn upload-to-s3
  "Uploads the generated xml file to the specified S3 bucket."
  [{:keys [xml-output-file] :as ctx}]
  (let [zip-name (zip-filename ctx)
        zip-dir (Files/createTempDirectory tmp-path-prefix
                                           (into-array FileAttribute []))
        zip-file (File. (.toFile zip-dir) zip-name)
        zip (ZipFile. zip-file)
        zip-params (doto (ZipParameters.)
                     (.setCompressionLevel
                      Zip4jConstants/DEFLATE_LEVEL_NORMAL))
        xml-file (if (instance? File xml-output-file)
                   xml-output-file
                   (.toFile xml-output-file))]
    (.createZipFile zip xml-file zip-params)
    (put-object zip-name zip-file)
    (-> ctx
        (assoc :generated-xml-filename zip-name)
        (update :to-be-cleaned concat [zip-file zip-dir]))))

(ns vip.data-processor.s3
  (:require [aws.sdk.s3 :as s3]
            [clojure.java.io :as io]
            [turbovote.resource-config :refer [config]]
            [korma.core :as korma]
            [clojure.string :refer [join]]
            [vip.data-processor.db.postgres :as postgres]
            [vip.data-processor.util :as util])
  (:import [java.io File]
           [java.nio.file Files CopyOption StandardCopyOption]
           [java.nio.file.attribute FileAttribute]
           [net.lingala.zip4j.core ZipFile]
           [net.lingala.zip4j.model ZipParameters]
           [net.lingala.zip4j.util Zip4jConstants]))

(defn- get-object [key]
  (s3/get-object (config [:aws :creds])
                 (config [:aws :s3 :unprocessed-bucket])
                 key))

(defn put-object [key value]
  (s3/put-object (config [:aws :creds])
                 (config [:aws :s3 :processed-bucket])
                 key value))

(def tmp-path-prefix "vip-data-processor")

(defn download
  "Downloads the file named `key` from the configured S3 bucket to a
  temporary file and returns that path."
  [key]
  (let [tmp-path (Files/createTempFile tmp-path-prefix key
                                       (into-array FileAttribute []))
        s3-object (get-object key)]
    (Files/copy (:content s3-object)
                tmp-path
                (into-array [StandardCopyOption/REPLACE_EXISTING]))
    tmp-path))

(defn format-fips [fips]
  (cond
    (nil? fips) "XX"
    (< (count fips) 3) (format "%02d" (Integer/parseInt fips))
    (< (count fips) 5) (format "%05d" (Integer/parseInt fips))
    :else fips))

(defn format-state
  [state]
  (if (nil? state)
    "YY"
    (clojure.string/replace (clojure.string/trim state) #"\s" "-")))

(defn zip-filename* [fips state election-date]
  (let [fips (format-fips fips)
        state (format-state state)
        date (util/format-date election-date)]
    (str (join "-" ["vipfeed" fips state date]) ".zip")))

(defn zip-filename
  [{:keys [spec-version tables import-id] :as ctx}]
  (condp = @spec-version
    "3.0"
    (let [fips (-> tables
                   :sources
                   korma/select
                   first
                   :vip_id)
          state (-> tables
                    :states
                    korma/select
                    first
                    :name)
          election-date (-> tables
                            :elections
                            korma/select
                            first
                            :date)]
      (zip-filename* fips state election-date))

    "5.1"
    (let [fips (postgres/find-value-for-simple-path
                import-id "VipObject.Source.VipId")
          state (postgres/find-value-for-simple-path
                 import-id "VipObject.State.Name")
          election-date (postgres/find-value-for-simple-path
                         import-id "VipObject.Election.Date")]
      (zip-filename* fips state election-date))))

(defn upload-to-s3
  "Uploads the generated xml file to the specified S3 bucket."
  [{:keys [xml-output-file] :as ctx}]
  (let [zip-name (zip-filename ctx)
        zip-dir (Files/createTempDirectory tmp-path-prefix
                                           (into-array FileAttribute []))
        zip-file (File. (.toFile zip-dir) zip-name)
        zip (ZipFile. zip-file)
        zip-params (doto (ZipParameters.)
                     (.setCompressionLevel
                      Zip4jConstants/DEFLATE_LEVEL_NORMAL))
        xml-file (if (instance? File xml-output-file)
                   xml-output-file
                   (.toFile xml-output-file))]
    (.createZipFile zip xml-file zip-params)
    (put-object zip-name zip-file)
    (-> ctx
        (assoc :generated-xml-filename zip-name)
        (update :to-be-cleaned concat [zip-file zip-dir]))))

Fix 3.0 zip filename NPE

Fix 3.0 zip filename NPE


(ns get-here.ferry
  (:require [clj-time.core :as t]
            [clj-time.format :as f]
            [clj-time.predicates :as pr]
            [clj-time.coerce :as c])
  (:import (org.joda.time LocalTime)))

;; http://www.sayvilleferry.com/schedule-pines.php

(def eastern (t/time-zone-for-id "US/Eastern"))

(def noon (LocalTime. 12 00))

(defn within?
  [[y1 m1 d1] [y2 m2 d2]]
  (let [ld1 (t/local-date y1 m1 d1)
        ld2 (t/local-date y2 m2 d2)]
    (fn [test-ld]
      (t/within? (.toDateTimeAtStartOfDay ld1 eastern)
                 (t/plus (.toDateTimeAtStartOfDay ld2 eastern)
                         (t/days 1))
                 (.toDateTime test-ld noon)))))

(defn on
  [year month day]
  (let [ld (t/local-date year month day)]
    (fn [test]
      (let [start-of-day (.toDateTimeAtStartOfDay ld eastern)]
        (t/within? start-of-day
                   (t/plus start-of-day (t/days 1))
                   (.toDateTime test noon))))))

(def not-on (comp complement on))

(def times
  {(within? [2015 6 26] [2015 9 13])
   {(every-pred pr/monday?
                (not-on 2015 9 7))
    [{(some-fn (not-on 2015 9 7)
               (on 2015 9 8))
      "5:45 AM"}
     "7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "9:15 PM"]

    (some-fn pr/tuesday?
             pr/wednesday?)
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "9:15 PM"]

    pr/thursday?
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "8:30 PM"
     "10:15 PM"]

    (some-fn (every-pred pr/friday?
                         (not-on 2015 7 3))
             (on 2015 7 2))
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "4:30 PM"
     "5:30 PM"
     "6:30 PM"
     "7:00 PM"
     "7:30 PM"
     "8:00 PM"
     "8:30 PM"
     "9:30 PM"
     "10:30 PM"]

    (some-fn (every-pred pr/saturday?
                         (not-on 2015 7 4))
             (on 2015 7 3))
    "12:15 AM"

    (some-fn pr/saturday?
             pr/sunday?
             (on 2015 7 3))
    ["8:00 AM"
     "9:25 AM"
     "10:25 AM"
     "11:25 AM"
     "12:25 PM"
     "1:25 PM"
     "2:20 PM"
     "3:20 PM"
     "4:20 PM"
     "5:20 PM"
     "6:20 PM"
     "7:20 PM"
     "8:20 PM"
     "9:20 PM"
     "10:30 PM"]}})

(defn parse-ferry-time
  [time-s]
  (LocalTime/parse time-s (f/formatter "hh:mm aa")))

(defn times-for
  ([d]
     (times-for d times))
  ([d x]
   (println "Type: " (type d))
   (cond (string? x)
         [(c/to-date (.toDateTime d (parse-ferry-time x) eastern))]

         (vector? x)
         (mapcat (partial times-for d) x)

         (map? x)
         (mapcat (fn [[pred? time]]
                   (when (pred? d) (times-for d time)))
                 x))))

(ns get-here.ferry
  (:require [clj-time.core :as t]
            [clj-time.format :as f]
            [clj-time.predicates :as pr]
            [clj-time.coerce :as c])
  (:import (org.joda.time LocalTime)))

;; http://www.sayvilleferry.com/schedule-pines.php

(def eastern (t/time-zone-for-id "US/Eastern"))

(def noon (LocalTime. 12 00))

(defn within?
  [[y1 m1 d1] [y2 m2 d2]]
  (let [ld1 (t/local-date y1 m1 d1)
        ld2 (t/local-date y2 m2 d2)]
    (fn [test-ld]
      (t/within? (.toDateTimeAtStartOfDay ld1 eastern)
                 (t/plus (.toDateTimeAtStartOfDay ld2 eastern)
                         (t/days 1))
                 (.toDateTime test-ld noon)))))

(defn on
  [year month day]
  (let [ld (t/local-date year month day)]
    (fn [test]
      (let [start-of-day (.toDateTimeAtStartOfDay ld eastern)]
        (t/within? start-of-day
                   (t/plus start-of-day (t/days 1))
                   (.toDateTime test noon))))))

(def not-on (comp complement on))

(def times
  {(within? [2015 6 26] [2015 9 13])
   {(every-pred pr/monday?
                (not-on 2015 9 7))
    [{(some-fn (not-on 2015 9 7)
               (on 2015 9 8))
      "5:45 AM"}
     "7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "9:15 PM"]

    (some-fn pr/tuesday?
             pr/wednesday?)
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "9:15 PM"]

    pr/thursday?
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "5:30 PM"
     "7:30 PM"
     "8:30 PM"
     "10:15 PM"]

    (some-fn (every-pred pr/friday?
                         (not-on 2015 7 3))
             (on 2015 7 2))
    ["7:00 AM"
     "8:00 AM"
     "9:30 AM"
     "11:30 AM"
     "1:30 PM"
     "3:30 PM"
     "4:30 PM"
     "5:30 PM"
     "6:30 PM"
     "7:00 PM"
     "7:30 PM"
     "8:00 PM"
     "8:30 PM"
     "9:30 PM"
     "10:30 PM"]

    (some-fn (every-pred pr/saturday?
                         (not-on 2015 7 4))
             (on 2015 7 3))
    "12:15 AM"

    (some-fn pr/saturday?
             pr/sunday?
             (on 2015 7 3))
    ["8:00 AM"
     "9:25 AM"
     "10:25 AM"
     "11:25 AM"
     "12:25 PM"
     "1:25 PM"
     "2:20 PM"
     "3:20 PM"
     "4:20 PM"
     "5:20 PM"
     "6:20 PM"
     "7:20 PM"
     "8:20 PM"
     "9:20 PM"
     "10:30 PM"]}})

(defn parse-ferry-time
  [time-s]
  (LocalTime/parse time-s (f/formatter "hh:mm aa")))

(defn times-for
  ([d]
     (times-for d times))
  ([d x]
   (cond (string? x)
         [(c/to-date (.toDateTime d (parse-ferry-time x) eastern))]

         (vector? x)
         (mapcat (partial times-for d) x)

         (map? x)
         (mapcat (fn [[pred? time]]
                   (when (pred? d) (times-for d time)))
                 x))))

Remove debugging println

Remove debugging println