💋

resources/public/css/shCoreDefault.css

@@ -7,7 +7,7 @@
  *
  * @version
  * 3.0.83 (July 02 2010)
- * 
+ *
  * @copyright
  * Copyright (C) 2004-2010 Alex Gorbatchev.
  *

src/walton/analyzer.clj

@@ -0,0 +1,24 @@
+(ns walton.analyzer)
+
+(defn fns-for-ns
+  "Returns a sequence of strings of the public functions in a
+  namespace."
+  [nspace]
+  (map (comp str first) (ns-publics nspace)))
+
+(def ^{:private true} clojure-core-fns (fns-for-ns 'clojure.core))
+
+(defn starts-with-core-fn?
+  "Returns true if the form starts with a readable core function,
+   else returns nil.
+
+  Usage: (starts-with-core-fn? \"(if true 1 2)\") => true"
+  [s]
+  (some #(= % ((comp str first) (safe-read s))) clojure-core-fns))
+
+(defn contains-readable-core-fn?
+  "Returns true if the sexp contains a readable core function,
+   else returns nil."
+  [s]
+  (let [safe-form-set (set (map str (flatten (safe-read s))))]
+    (some safe-form-set clojure-core-fns)))

src/walton/core.clj

@@ -28,19 +28,24 @@
 
 (defn multiple-sexps?
   "Returns true or false if there is more than 1 s-expression for a
-  given log line."  [sexps]
+  given log line."
+  [sexps]
   (> (count sexps) 1))
 
 (defn run-sandboxed-sexp
   "Safely read a sexp and run it in the sandbox capturing the
   value. Captures *out* in case the expression being evaluated prints
   to *out*. Returns a map of the input, value, and out if there is any."
-  [sexp]
+  [nickname timestamp sexp]
   (with-open [writer (StringWriter.)]
     (let [bindings {#'*out* writer}
           value (sb (safe-read sexp) bindings)
           out (str writer)]
-      {:input sexp :value value :out out})))
+      {:input sexp,
+       :value value,
+       :out out,
+       :nickname nickname,
+       :timestamp timestamp})))
 
 (defn init-walton!
   "Scrape all logfiles, and for each log line that contains one or
@@ -50,31 +55,16 @@
   (doseq [f scrape/local-logfiles]
     (println (.getName f))
     (doseq [line (get-lines-with-sexps f)]
-      (let [sexps (:sexp line)]
-        (try (doseq [s sexps]
+      (let [{:keys [sexps nickname timestamp]} line]
+        (try (if (multiple-sexps? line)
+               (doseq [expression sexps]
+                 (db/insert-expression
+                  (run-sandboxed-sexp nickname timestamp expression)))
                (db/insert-expression
-                (run-sandboxed-sexp s)))
+                (run-sandboxed-sexp nickname timestamp sexps)))
              (catch TimeoutException _ "Execution timed out!")
              (catch Throwable t))))))
 
-(defn fns-for-ns
-  "Returns a sequence of strings of the public functions in a
-  namespace."
-  [nspace]
-  (map (comp str first) (ns-publics nspace)))
-
-(def clojure-core-fns (fns-for-ns 'clojure.core))
-
-(defn starts-with-core-fn? [s]
-  (some #(= % ((comp str first) (safe-read s))) clojure-core-fns))
-
-(defn contains-readable-core-fn? [s]
-  (let [safe-form-set (set (map str (flatten (safe-read s))))]
-    (some safe-form-set clojure-core-fns)))
-
-(defn shuffle-and-take [lim coll]
-  (take lim (shuffle coll)))
-
 (defn print-sexp-map [sexp-map]
   (let [{:keys [input value out]} sexp-map]
     (println "Input:" input)
@@ -84,7 +74,7 @@
 
 (defn print-sexp-maps [query-fn query-str & [lim]]
   (let [query-op (query-fn query-str)
-        query-results (if lim (shuffle-and-take lim query-op) query-op)]
+        query-results (if lim (util/shuffle-and-take lim query-op) query-op)]
     (doseq [sexp-map query-results]
       (print-sexp-map sexp-map))))
 
@@ -94,13 +84,29 @@
 (defn walton [kw query-str & [lim]]
   (print-sexp-maps (resolve-query-fn kw) query-str lim))
 
-(defn walton-html [kw query-str]
-  (let [query-op (resolve-query-fn kw)]
-    (query-op query-str)))
+;; (defn walton-html [kw query-str]
+;;   (let [query-op (resolve-query-fn kw)]
+;;     (query-op query-str)))
+
+(defn walton-html-input [query-str]
+  (db/exprs-where-input query-str))
+
+(defn walton-html-value [query-str]
+  (db/exprs-where-value query-str))
+
+(defn walton-html-out [query-str]
+  (db/exprs-where-out query-str))
+
+(defn walton-html [kw query-str & [lim]]
+  (let [query-results ((resolve-query-fn kw) query-str)]
+    (if lim
+      (util/shuffle-and-take lim query-results)
+      query-results)))
 
 (comment
+  (set! *print-length* 10)
+  (set! *print-level* 10)
   (def background-init-walton (.start (Thread. (fn [] (dorun (init-walton!))))))
-
   (defn run-single-file-through-sandbox [f]
     (doseq [event (get-lines-with-sexps f)]
       (let [sexps (:sexp event)]

src/walton/datomic_cons.clj

@@ -0,0 +1,67 @@
+(ns walton.datomic-cons
+  (:use [datomic.api :as d]))
+
+(def uri "datomic:mem://cons")
+(d/create-database uri)
+(def conn (d/connect uri))
+
+(def schema-txn
+  [{:db/id (d/tempid :db.part/db)
+    :db/ident :firstint
+    :db/valueType :db.type/long
+    :db/cardinality :db.cardinality/one
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/tempid :db.part/db)
+    :db/ident :firststring
+    :db/valueType :db.type/string
+    :db/cardinality :db.cardinality/one
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/tempid :db.part/db)
+    :db/ident :firstref
+    :db/valueType :db.type/ref
+    :db/cardinality :db.cardinality/one
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/tempid :db.part/db)
+    :db/ident :rest
+    :db/valueType :db.type/ref
+    :db/cardinality :db.cardinality/one
+    :db.install/_attribute :db.part/db}])
+
+@(d/transact conn schema-txn)
+
+(defmulti attr-for class)
+(defmethod attr-for String [_] :firststring)
+(defmethod attr-for Long [_] :firstint)
+(defmethod attr-for clojure.lang.PersistentList [_] :firstref)
+
+(defn datomic-list [lst]
+  (map-indexed
+   (fn [i x]
+     (merge {:db/id (d/tempid :db.part/user (- 0 (inc i))),
+             (attr-for x) x}
+            (when (not= i (dec (count lst)))
+              {:rest (d/tempid :db.part/user (- 0 (+ 2 i)))})))
+   lst))
+
+(def list-txn
+  [{:db/id (d/tempid :db.part/user -1)
+    :firstint 1
+    :rest (d/tempid :db.part/user -2)}
+   {:db/id (d/tempid :db.part/user -2)
+    :firstint 2
+    :rest (d/tempid :db.part/user -3)}
+   {:db/id (d/tempid :db.part/user -3)
+    :firstint 3}])
+
+(def f (d/transact conn (datomic-list '(1 2 "pants" 89))))
+
+(def rules '[[[value-of ?f ?v]
+              [?f :firstint ?v]]
+             [[value-of ?f ?v]
+              [?f :firststring ?v]]])
+
+(def query '[:find ?f ?v
+             :in $ %
+             :where (value-of ?f ?v)])
+
+(d/q query (db conn) rules)

src/walton/scraper.clj

@@ -7,6 +7,30 @@
 
 (def dates-url "http://clojure-log.n01se.net/date/")
 
+(defn remote-logfiles []
+  (let [html-re #"\>(.*\.html)\<"]
+    (map second (re-seq html-re (apply str (slurp dates-url))))))
+
+(defn local-logfiles []
+  (filter #(re-find #".*\.html$" (str %))
+          (file-seq (io/file "logs"))))
+
+(defn missing-local-logfiles []
+  (s/difference
+   (set (butlast (sort (remote-logfiles))))
+   (set (map #(.getName %) (local-logfiles)))))
+
+(defn missing-logfiles? []
+  (when-not (empty? (missing-local-logfiles))
+    true))
+
+(defn get-missing-logfiles []
+  (if (missing-logfiles?)
+    (doseq [log missing-local-logfiles]
+      (println (str "Downloading " log "..."))
+      (let [log-data (slurp (str dates-url log))]
+        (spit (io/file "logs" log) log-data)))))
+
 (defn extract-expressions
   "Extracts sexps."
   [string]
@@ -38,30 +62,6 @@
            [(java.lang.StringBuilder.) '() :text 0]
            string)))
 
-(defn remote-logfiles []
-  (let [html-re #"\>(.*\.html)\<"]
-    (map second (re-seq html-re (apply str (slurp dates-url))))))
-
-(defn local-logfiles []
-  (filter #(re-find #".*\.html$" (str %))
-          (file-seq (io/file "logs"))))
-
-(defn missing-local-logfiles []
-  (s/difference
-   (set (butlast (sort (remote-logfiles))))
-   (set (map #(.getName %) (local-logfiles)))))
-
-(defn missing-logfiles? []
-  (when-not (empty? (missing-local-logfiles))
-    true))
-
-(defn get-missing-logfiles []
-  (if (missing-logfiles?)
-    (doseq [log missing-local-logfiles]
-      (println (str "Downloading " log "..."))
-      (let [log-data (slurp (str dates-url log))]
-        (spit (io/file "logs" log) log-data)))))
-
 (defn get-lines [f]
   (e/select (e/html-resource f) [:p]))
 

src/walton/server.clj

@@ -2,28 +2,48 @@
   (:use [noir.core]
         [hiccup core page form]
         [clojail.core :only (safe-read)])
-  (:require [clojure.pprint :as pp]
-            [clojure.string :as s]
+  (:require [clojure.string :as s]
             [noir.server :as server]
             [walton.core :as core]
+            [walton.db :as db]
+            [walton.view-helpers :as helpers]
             [walton.views.common :as common]))
 
 (server/load-views "src/walton/views")
 
-(defn format-code [code]
-  (pp/with-pprint-dispatch pp/code-dispatch code))
+;; (defn add-line-breaks [s]
+;;   (let [s (interpose [:br] (s/split-lines s))]))
 
-(defn link-to [path s attrs]
-  [:a (merge {:href path} attrs) s])
+;; (defn code* [s]
+;;   (let [codes (s/split-lines s)]
+;;     (interpose [:br]
+;;                (for [code codes]y
+;;                  [:script {:type "syntaxhighlighter" :class "brush: clojure;"}
+;;                   (str "<![CDATA[" (add-line-breaks s) "]]>")]))))
+
+;; (defn code [s]
+;;   (let [codes (s/split-lines s)]
+;;     (interpose [:br]
+;;                (for [code codes]
+;;                  [:pre {:class "brush: clojure;"} code]))))
 
 (defn search [results]
   (for [result results]
     (let [{:keys [input value out]} result]
-      (if-not (and (= value "nil"))
-        (html [:dt {:id "input"} [:pre {:class "brush: clojure;"} (format-code input)]]
-              [:dd {:id "value"} [:pre {:class "brush: clojure;"} (format-code value)]])
-        (html [:dt {:id "input"} [:pre {:class "brush: clojure;"} (format-code input)]]
-              [:dd {:id "out"} [:pre {:class "brush: clojure;"} (format-code out)]])))))
+      (if (= out "")
+        (html [:dt {:id "input"} [:pre {:class "brush: clojure;"} (helpers/format-input input)]]
+              [:dd {:id "value"} [:pre {:class "brush: clojure;"} value]])
+        (html [:dt {:id "input"} [:pre {:class "brush: clojure;"} (helpers/format-input input)]]
+              [:dd {:id "out"} [:pre {:class "brush: clojure;"} out]])))))
+
+;; (defn search [results]
+;;   (for [result results]
+;;     (let [{:keys [input value out]} result]
+;;       (if (= out "")
+;;         (html [:dt {:id "input"} (code (helpers/format-code input))]
+;;               [:dd {:id "value"} (code (helpers/format-code value))])
+;;         (html [:dt {:id "input"} (code (helpers/format-code input))]
+;;               [:dd {:id "out"}   (code (helpers/format-code out))])))))
 
 (defpartial search-input [{:keys [query]}]
   (label "query" "Search by Input: ")
@@ -41,43 +61,40 @@
   (common/layout
    [:h1 "getclojure"]
    [:div#search-input
-    (form-to
-        [:post "/search/input"]
-        (search-input query)
-      (submit-button "Search Input"))]
+    (form-to [:post "/search/input"]
+             (search-input query)
+             (submit-button "Search Input"))]
    [:div#search-value
-    (form-to
-        [:post "/search/value"]
-        (search-value query)
-      (submit-button "Search Value"))]
+    (form-to [:post "/search/value"]
+             (search-value query)
+             (submit-button "Search Value"))]
    [:div#search-out
-    (form-to
-        [:post "/search/out"]
-        (search-out query)
-      (submit-button "Search Output"))]))
+    (form-to [:post "/search/out"]
+             (search-out query)
+             (submit-button "Search Output"))]))
 
 (defpage [:post "/search/input"] {:keys [query]}
   (common/layout
-   (link-to "/" "search again" {:id "search-again"})
+   (helpers/link-to "/" "search again" {:id "search-again"})
    [:h1 (str "\"" query "\"" " examples")]
    [:dl (search (core/walton-html-input query))]))
 
 (defpage [:post "/search/value"] {:keys [query]}
   (common/layout
-   (link-to "/" "search again" {:id "search-again"})
+   (helpers/link-to "/" "search again" {:id "search-again"})
    [:h1 (str "\"" query "\"" " examples")]
    [:dl (search (core/walton-html-value query))]))
 
 (defpage [:post "/search/out"] {:keys [query]}
   (common/layout
-   (link-to "/" "search again" {:id "search-again"})
+   (helpers/link-to "/" "search again" {:id "search-again"})
    [:h1 (str "\"" query "\"" " examples")]
    [:dl (search (core/walton-html-out query))]))
 
-(defn -main [& m]
+(defn walton-server [& m]
   (let [mode (keyword (or (first m) :dev))
         port (Integer. (get (System/getenv) "PORT" "8080"))]
     (server/start port {:mode mode, :ns 'walton})))
 
 (comment
-  (def my-server (-main)))
+  (def my-server (walton-server)))

src/walton/util.clj

@@ -1,4 +1,6 @@
 (ns walton.util)
 
-(defn not-empty? [x]
-  (not (empty? x)))
+(def not-empty? (complement empty?))
+
+(defn shuffle-and-take [lim coll]
+  (take lim (shuffle coll)))