diff --git a/editor/src/Editor.hs b/editor/src/Editor.hs new file mode 100644 index 000000000..0c8241e4a --- /dev/null +++ b/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 () + diff --git a/editor/src/HelloWorld.hs b/editor/src/HelloWorld.hs deleted file mode 100644 index c4866a3aa..000000000 --- a/editor/src/HelloWorld.hs +++ /dev/null @@ -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 () - diff --git a/editor/src/Unison/DocView.hs b/editor/src/Unison/DocView.hs index 4df275f2f..11b375a02 100644 --- a/editor/src/Unison/DocView.hs +++ b/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 () diff --git a/editor/src/Unison/Woot.hs b/editor/src/Unison/Woot.hs deleted file mode 100644 index 7eb38d739..000000000 --- a/editor/src/Unison/Woot.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Unison.Woot where - -import qualified Unison.ABT as ABT - -x :: Int -x = 42 diff --git a/editor/stylesheets/reset.css b/editor/stylesheets/reset.css new file mode 100644 index 000000000..73614e17a --- /dev/null +++ b/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; +} diff --git a/editor/stylesheets/styles.css b/editor/stylesheets/styles.css index 0c950f0c5..bd4218fa7 100644 --- a/editor/stylesheets/styles.css +++ b/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'); diff --git a/editor/unison-editor.cabal b/editor/unison-editor.cabal index f9b33bb67..12ee3aede 100644 --- a/editor/unison-editor.cabal +++ b/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 diff --git a/shared/src/Unison/Node/MemStore.hs b/shared/src/Unison/Node/MemStore.hs index 4b926139f..bb142a553 100644 --- a/shared/src/Unison/Node/MemStore.hs +++ b/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