Editor pulling information from node now

editor/src/Editor.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
+
+module Main where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Reflex
+import Reflex.Dom
+import Unison.Dimensions (Width(..),X(..),Y(..))
+import Unison.Term
+import Unison.Type (defaultSymbol)
+import Unison.UI (mouseMove')
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import qualified Reflex.Dynamic as Dynamic
+import qualified Unison.Reference as Reference
+import qualified Unison.DocView as DocView
+import qualified Unison.Metadata as Metadata
+import qualified Unison.Node as Node
+import qualified Unison.Node.MemNode as MemNode
+import qualified Unison.Note as Note
+import qualified Unison.Term as Term
+import qualified Unison.Type as Type
+
+builtin n = ref (Reference.Builtin n)
+
+term = builtin "Vector.concatenate" `app`
+         (vector (map num [0..5])) `app`
+         (vector ([builtin "Number.plus" `app` num 1 `app` num 1, num 2, num 9]))
+
+termDoc = view defaultSymbol term
+
+main :: IO ()
+main = mainWidget $ do
+  node <- liftIO MemNode.make
+  symbols <- (liftIO . Note.run . Node.metadatas node . Set.toList . Term.dependencies') term
+  let firstName (Metadata.Names (n:_)) = n
+  let lookupSymbol ref = maybe (defaultSymbol ref) (firstName . Metadata.names) (Map.lookup ref symbols)
+  let termDoc = view lookupSymbol term
+  (e, dims, path) <- el "div" $ DocView.widget (Width 300) termDoc
+  highlightedType <- holdDyn (Type.v' "..") =<< dyn =<< mapDyn (liftIO . Note.run . Node.typeAt node term) path
+  el "div" $ do
+     text "type: "
+     el "pre" $ display highlightedType
+  return ()
+

editor/src/HelloWorld.hs

@@ -1,28 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
-module Main where
-
-import Control.Monad
-import Reflex
-import Reflex.Dom
-import Unison.Term
-import Unison.Type (defaultSymbol)
-import Unison.Dimensions (Width(..),X(..),Y(..))
-import qualified Unison.Doc as Doc
-import qualified Unison.DocView as DocView
-import qualified Reflex.Dynamic as Dynamic
-import Unison.UI (mouseMove')
-
-term = var' "foo" `app`
-       vector (map num [0..5]) `app`
-       var' "bar" `app`
-       (var' "baz" `app` num 42)
-
-termDoc = view defaultSymbol term
-
-main :: IO ()
-main = mainWidget $ do
-  _ <- el' "div" $ DocView.widget (Width 300) termDoc
-  return ()
-

editor/src/Unison/DocView.hs

@@ -12,7 +12,7 @@ import Data.These (These(This,That,These))
 import Reflex.Dom
 import Unison.Doc (Doc)
 import Unison.Dom (Dom)
-import Unison.Dimensions (X(..), Y(..), Width(..), Height(..), Region)
+import Unison.Dimensions (X(..), Y(..), Width(..), Height(..))
 import Unison.Path (Path)
 import qualified Data.Map as Map
 import qualified Data.Text as Text
@@ -26,7 +26,7 @@ import qualified Unison.UI as UI
 import qualified Unison.Signals as S
 
 widget :: (Show p, Path p, Eq p, MonadWidget t m)
-       => Width -> Doc Text p -> m (El t, (Width,Height))
+       => Width -> Doc Text p -> m (El t, (Width,Height), Dynamic t p)
 widget available d =
   let
     leaf txt = Text.replace " " " " txt
@@ -83,7 +83,7 @@ widget available d =
     region <- Dynamic.traceDyn "region" <$> mapDyn (Doc.region b) path
     sel <- mapDyn (selectionLayer h) region
     _ <- widgetHold (pure ()) (Dynamic.updated sel)
-    pure $ (e, (w,h))
+    pure $ (e, (w,h), path)
 
 selectionLayer :: MonadWidget t m => Height -> (X,Y,Width,Height) -> m ()
 selectionLayer (Height h0) (X x, Y y, Width w, Height h) =
@@ -92,10 +92,10 @@ selectionLayer (Height h0) (X x, Y y, Width w, Height h) =
     style = intercalate ";"
       [ "pointer-events:none"
       , "position:relative"
-      , "width:" ++ show (w+4) ++ "px"
-      , "height:" ++ show (h+4) ++ "px"
-      , "left:" ++ show (fromIntegral x - 2 `max` 0 :: Int) ++ "px"
-      , "top:" ++ show (fromIntegral y - fromIntegral h0 - 2 :: Int) ++ "px" ]
+      , "width:" ++ show (w+6) ++ "px"
+      , "height:" ++ show h ++ "px"
+      , "left:" ++ show (((fromIntegral x :: Int) - 4) `max` 0) ++ "px"
+      , "top:" ++ show (fromIntegral y - fromIntegral h0 - 1 :: Int) ++ "px" ]
   in do
     elAttr "div" attrs $ pure ()
     pure ()

editor/src/Unison/Woot.hs

@@ -1,6 +0,0 @@
-module Unison.Woot where
-
-import qualified Unison.ABT as ABT
-
-x :: Int
-x = 42

editor/stylesheets/reset.css

@@ -0,0 +1,47 @@
+/* http://meyerweb.com/eric/tools/css/reset/ 
+   v2.0 | 20110126
+   License: none (public domain)
+*/
+html, body, div, span, applet, object, iframe,
+h1, h2, h3, h4, h5, h6, p, blockquote, pre,
+a, abbr, acronym, address, big, cite, code,
+del, dfn, em, img, ins, kbd, q, s, samp,
+small, strike, strong, sub, sup, tt, var,
+b, u, i, center,
+dl, dt, dd, ol, ul, li,
+fieldset, form, label, legend,
+table, caption, tbody, tfoot, thead, tr, th, td,
+article, aside, canvas, details, embed, 
+figure, figcaption, footer, header, hgroup, 
+menu, nav, output, ruby, section, summary,
+time, mark, audio, video {
+	margin: 0;
+	padding: 0;
+	border: 0;
+	font-size: 100%;
+	font: inherit;
+	vertical-align: baseline;
+}
+/* HTML5 display-role reset for older browsers */
+article, aside, details, figcaption, figure, 
+footer, header, hgroup, menu, nav, section {
+	display: block;
+}
+body {
+	line-height: 1;
+}
+ol, ul {
+	list-style: none;
+}
+blockquote, q {
+	quotes: none;
+}
+blockquote:before, blockquote:after,
+q:before, q:after {
+	content: '';
+	content: none;
+}
+table {
+	border-collapse: collapse;
+	border-spacing: 0;
+}

editor/stylesheets/styles.css

@@ -1,3 +1,5 @@
+/*@import url("reset.css");*/
+
 @font-face {
     font-family: 'fira-code-regular';
     src: url('../fonts/fira-code.webfont/fira-code_regular.eot');

editor/unison-editor.cabal

@@ -49,7 +49,6 @@ library
     Unison.Dom
     Unison.HTML
     Unison.UI
-    Unison.Woot
 
   build-depends:
     base,
@@ -75,7 +74,7 @@ library
     ghc-options: -v0
 
 executable editor
-  main-is: HelloWorld.hs
+  main-is: Editor.hs
   hs-source-dirs: src
   ghc-options: -Wall -fno-warn-name-shadowing -threaded -rtsopts -with-rtsopts=-N -v0
 

shared/src/Unison/Node/MemStore.hs

@@ -28,17 +28,19 @@ make = store <$> MVar.newMVar (S Map.empty Map.empty Map.empty) where
     readTerm s hash =
       Note.fromMaybe (unknown "hash" hash) $ Map.lookup hash (terms' s)
     writeTerm s hash t =
-      Note.lift . MVar.putMVar v $ s { terms' = Map.insert hash t (terms' s) }
+      Note.lift . set v $ s { terms' = Map.insert hash t (terms' s) }
     typeOfTerm s ref =
       Note.fromMaybe (unknown "reference" ref) $ Map.lookup ref (typeOfTerm' s)
     annotateTerm s ref t =
-      Note.lift . MVar.putMVar v $ s { typeOfTerm' = Map.insert ref t (typeOfTerm' s) }
+      Note.lift . set v $ s { typeOfTerm' = Map.insert ref t (typeOfTerm' s) }
     readMetadata s ref =
       Note.fromMaybe (unknown "reference" ref) $ Map.lookup ref (metadata' s)
     writeMetadata s ref md =
-      Note.lift . MVar.putMVar v $ s { metadata' = Map.insert ref md (metadata' s) }
+      Note.lift . set v $ s { metadata' = Map.insert ref md (metadata' s) }
     unknown :: Show r => String -> r -> String
     unknown msg r = "unknown " ++ msg ++ ": " ++ show r
+    set :: MVar.MVar a -> a -> IO ()
+    set v a = MVar.modifyMVar_ v (\_ -> pure a)
 
 withS :: MVar.MVar (S v) -> (S v -> i -> Noted IO o) -> i -> Noted IO o
 withS s f i = Note.lift (MVar.readMVar s) >>= \s -> f s i