good enough eye candy

visualisers/hmvis/src/hmvis/annotated.cljs

@@ -24,62 +24,81 @@
 (defn formatln [fs & rest]
   (apply cl-format true (str fs "~%") rest))
 
-(defn Annotation [text visible?]
-  (if visible?
-      [:div {:class "annotation"}
-       text]
-      nil))
-
 (def nesting-rainbow (cycle ["red" "orange" "yellow"
                              "green" "blue" "purple"]))
 
-(defn Typed [t child]
+(defn text-colour-by-background [colour]
+  (match colour
+         "yellow" "black"
+         _        "white"))
+
+(defn Annotation [colour text hovering?]
+  [:div {:class (if @hovering?
+                    "annotation hovering"
+                    "annotation")
+         :on-mouse-enter #(reset! hovering? true)
+         :on-mouse-leave #(reset! hovering? false)
+         :style {:background colour
+                 :color (text-colour-by-background colour)}}
+   [:div {:class "annotation-text"}
+    text]])
+
+(defn Typed [colour t child]
   (let [hovering? (r/atom false)]
     (fn []
-        [:div {:class "annotation-wrapper"
-               :on-mouse-enter #(reset! hovering? true)
-               :on-mouse-leave #(reset! hovering? false)}
-         child
-         [Annotation t @hovering?]])))
+        [:div {:class "annotation-wrapper"}
+         [:div {:class (if @hovering?
+                           "typed-wrapper hovering"
+                           "typed-wrapper")
+                }
+          [:div {:class "code-wrapper"} child]]
+         [Annotation colour t hovering?]])))
 
 (declare Expr)
 
-(defn LambdaExpr [binds body]
+(defn LambdaExpr [colours binds body]
   [:<>
     [:code
       (hsep "λ" (apply hsep binds) "-> ")]
-    [Expr 0 body]])
+    [Expr colours 0 body]])
 
 (defn VarExpr [var-id]
   [:code var-id])
 
-(defn AppExpr [f x]
-  [:<> [Expr ppr/app-prec f]
+(defn AppExpr [colours f x]
+  [:<> [Expr colours ppr/app-prec f]
        " "
-       [Expr ppr/app-prec1 x]])
+       [Expr colours ppr/app-prec1 x]])
 
-(defn Expr [p {e :e t :type}]
+(defn Expr [[c & colours] p {e :e t :type}]
   (match e
     {:InL {:tag "LamF" :contents [bs body & _]}}
       (maybe-parens (< ppr/app-prec1 p)
-                    [Typed t [LambdaExpr bs body]])
+                    [Typed c t [LambdaExpr colours bs body]])
     {:InL {:tag "VarF" :contents var-id}}
-      [Typed t [VarExpr var-id]]
+      [Typed c t [VarExpr var-id]]
     {:InL {:tag "AppF" :contents [f x]}}
       (maybe-parens (< ppr/app-prec p)
-                    [Typed t [AppExpr f x]])
+                    [Typed c t [AppExpr colours f x]])
     :else [:code "<expr>"]))
 
+(def rainbow-cycle (cycle ["red"
+                           "orange"
+                           "yellow"
+                           "green"
+                           "blue"
+                           "violet"]))
+
 (defn render-decl [{name :name body :body}]
   [:code {:key name :display "block"}
-           (str name " = ") [Expr 0 body] #_ (render-expr body)
+           (str name " = ") [Expr rainbow-cycle 0 body] #_ (render-expr body)
            [:br]])
 
-(defn type-checker []
+(defn TypeChecker []
   [:div
    (map render-decl (or @tc-input []))])
 
-(defn init []
-  (rdom/render [type-checker]
-               (js/document.querySelector "#output")))
+; (defn init []
+;   (rdom/render [type-checker]
+;                (js/document.querySelector "#output")))
 

visualisers/hmvis/src/main.cljs

@@ -1,16 +1,21 @@
 (ns main
   (:require [clojure.spec.alpha :as s]
+            ["react-ace$default" :as AceEditor]
+            ["ace-builds/src-noconflict/mode-haskell"]
+            ["ace-builds/src-noconflict/theme-solarized_light"]
+            ["ace-builds/src-noconflict/keybinding-vim"]
             [wscljs.client :as ws]
             [wscljs.format :as fmt]
             [cljs.core.match :refer-macros [match]]
             [hmvis.annotated :as annotated]
+            [reagent.core :as r]
             [reagent.dom :as rdom]))
 
-(def *editor
-  (doto (js/ace.edit "editor")
-        (.setTheme "ace/theme/solarized_light")
-        (.setKeyboardHandler "ace/keyboard/vim")
-        (.setOption "mode" "ace/mode/haskell")))
+; (def *editor
+;   (doto (js/ace.edit "editor")
+;         (.setTheme "ace/theme/solarized_light")
+;         (.setKeyboardHandler "ace/keyboard/vim")
+;         (.setOption "mode" "ace/mode/haskell")))
 
 (def *output (.querySelector js/document "#output"))
 
@@ -42,20 +47,55 @@
 (defn send [msg]
   (ws/send *socket msg fmt/json))
 
-(defn init-type-check-button []
-  (let [b (.querySelector js/document "#type-check")]
-    (.addEventListener b "click"
-                       #(send {:command "annotate"
-                               :source (.getValue *editor)}))))
+; (defn init-type-check-button []
+;   (let [b (.querySelector js/document "#type-check")]
+;     (.addEventListener b "click"
+;                        #(send {:command "annotate"
+;                                :source (.getValue *editor)}))))
+
+(defonce *editor nil)
+
+(defn TypeCheckButton []
+  [:button {:id "type-check-button"
+            :on-click #(send {:command "annotate"
+                              :source (.getValue *editor)})}
+   "type-check"])
+
+(defn Editor []
+  [:div {:class "editor-container"}
+    [(r/adapt-react-class AceEditor)
+     {:mode "haskell"
+      :theme "solarized_light"
+      :keyboardHandler "vim"
+      :defaultValue (str "id = \\x -> x\n"
+                         "flip f x y = f y x\n")
+      :style {:width "100%"
+              :height "100%"}
+      :on-load (fn [editor]
+                 (set! *editor editor)
+                 (set! (.. editor -container -style -resize) "both")
+                 (js/document.addEventListener
+                   "mouseup"
+                   #(.resize editor)))
+      :name "editor"} ]])
+
+(defn Main []
+  [:<>
+    [:div {:class "main-view-container"}
+     [TypeCheckButton]
+     [Editor]
+     [annotated/TypeChecker]
+     #_ [:div {:id "type-check-output"}
+      "doge soge quoge"]]
+   #_ [annotated/TypeChecker]])
 
 ;; start is called by init and after code reloading finishes
 (defn ^:dev/after-load start []
-  ; (rdom/render [type-checker] (js/document.getElementById "output"))
-  (annotated/init)
+  (rdom/render [Main]
+               (js/document.getElementById "mount"))
   (js/console.log "start"))
 
 (defn init []
-  (init-type-check-button)
   ;; init is called ONCE when the page loads
   ;; this is called in the index.html and must be exported
   ;; so it is available even in :advanced release builds