diff --git a/editor/Main.elm b/editor/Main.elm index 2e142e27d..15b448400 100644 --- a/editor/Main.elm +++ b/editor/Main.elm @@ -1,5 +1,9 @@ module Main where +import Array +import Set +import Unison.Path (Path) +import Unison.Hash (Hash) import Unison.Styles as S import Unison.Layout as UL import Unison.Term as L @@ -11,46 +15,25 @@ import Graphics.Input(..) import Graphics.Input.Field(..) import Window --- each cell will consist of a single Element --- 'standard' input boxes not really --- flexible enough, since depending on --- scope, are overwriting different region of --- syntax tree -{- -source : Term -> Element +entry : Input (Maybe (Hash,Path)) +entry = input Nothing -idea: have just one input box, at the top -alternately, place input box above selection, -with a caret pointing down +nums : L.Term +nums = let f x = L.Lit (L.Number (toFloat x)) + in L.Lit (L.Vector (Array.fromList (map f [0..20]))) -f x = [x + 1 + 2 + 3] - ------------------- - | | - - ---------------- - \/ -f x = [x + 1 + 2 + 3] -need to create an input box --} +expr = L.App (L.App (L.Ref "foo") nums) (L.Ref "baz") -entry : Input Content -entry = input noContent - -midnightBlue = rgb 44 62 80 -turquoise = rgb 26 188 156 -greenSea = rgb 22 160 133 - -fieldStyle = - { padding = { left=8, right=8, top=11, bottom=12 } - , outline = { color=midnightBlue, width=uniformly 3, radius=0 } - , highlight = noHighlight - , style = let t = Text.defaultStyle - in { t | typeface <- ["Lato", "latin"], height <- Just 16 } } - -fld = field fieldStyle +scene : Int -> (Maybe (Hash,Path)) -> Element +scene w p = + flow down + [ S.codeText ("path: " ++ show p) + , L.render expr + { handle = entry.handle + , key = "bar" + , highlighted = [] + , availableWidth = w + , metadata h = MD.anonymousTerm } ] main : Signal Element -main = - let scene (w,h) content = container w h middle (f content) - f content = width 100 (fld entry.handle id "" content) - in scene <~ Window.dimensions ~ entry.signal - +main = scene <~ Window.width ~ entry.signal diff --git a/editor/Unison/Metadata.elm b/editor/Unison/Metadata.elm index 2fe91b1d3..f505d8679 100644 --- a/editor/Unison/Metadata.elm +++ b/editor/Unison/Metadata.elm @@ -23,6 +23,9 @@ type Metadata = { annotation : H.Hash } +anonymousTerm : Metadata +anonymousTerm = Metadata Term [] M.empty Nothing "unknown" + firstSymbol : String -> Metadata -> Symbol firstSymbol defaultName md = case md.names of [] -> { name = defaultName, fixity = Prefix, precedence = 9 } diff --git a/editor/Unison/Styles.elm b/editor/Unison/Styles.elm index 2cc0adc7c..8bfb145cf 100644 --- a/editor/Unison/Styles.elm +++ b/editor/Unison/Styles.elm @@ -32,27 +32,41 @@ outline2 : Color -> Element -> Element outline2 c e = container (widthOf e + 6) (heightOf e + 6) (topLeftAt (absolute 3) (absolute 3)) e |> color c -cell : String -> Element -cell x = codeText (" " ++ x ++ " ") |> color clouds +pad : Int -> Int -> Element -> Element +pad hpad vpad e = + container (widthOf e + hpad*2) (heightOf e + vpad*2) (topLeftAt (absolute hpad) (absolute vpad)) e + +-- vertically center each cell in the row +row : [Element] -> [Element] +row es = case es of + [] -> [empty] + _ -> let maxh = maximum (map heightOf es) + cell e = if heightOf e == maxh then e else container (widthOf e) maxh middle e + in map cell es + +cell : Element -> Element +cell = pad 10 2 cells : Element -> [Element] -> Element cells ifEmpty xs = - let space = cell " " + let space = cell (codeText " ") in if isEmpty xs then ifEmpty - else intersperse (spacer 1 (heightOf space) |> color silver) xs + else intersperse (spacer 1 (heightOf space) |> color silver) (map cell (row xs)) |> flow right - |> outline2 silver + |> fill white + |> outline silver verticalCells : Element -> [Element] -> Element verticalCells ifEmpty xs = if isEmpty xs then ifEmpty - else let maxw = maximum (map widthOf xs) + 1 - in intersperse (spacer maxw 1 |> color silver) xs + else let cells = map cell xs + maxw = maximum (map widthOf cells) + 1 + in intersperse (spacer maxw 1 |> color silver) (map cell xs) |> flow down - |> fill clouds - |> outline2 silver + |> fill white + |> outline silver -- http://flatuicolors.com/ turquoise = rgb 26 188 156 diff --git a/editor/Unison/Term.elm b/editor/Unison/Term.elm index 865961787..7b78b71ed 100644 --- a/editor/Unison/Term.elm +++ b/editor/Unison/Term.elm @@ -7,6 +7,7 @@ import Dict (Dict) import Json import Set import Set (Set) +import String import Graphics.Element as Element import Graphics.Input (Handle, hoverable) import Text(..) @@ -27,7 +28,7 @@ import Unison.Type as T data Literal = Number Float - | String String + | Str String | Vector (Array Term) data Term @@ -42,26 +43,28 @@ data Term render : Term -- term to render -> { handle : Handle (Maybe (Hash, Path)) , key : Hash - , highlighted : Set Path + , highlighted : [Path] , availableWidth : Int , metadata : Hash -> Metadata } -> Element render expr env = let md = env.metadata env.key + msg path b = if b then Just (env.key, path) else Nothing + go : Bool -> Int -> Int -> { path : Path, term : Term } -> Element go allowBreak ambientPrec availableWidth cur = case cur.term of Var n -> hoverable env.handle (msg cur.path) (codeText (Metadata.resolveLocal md cur.path n).name) Ref h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h))) Con h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h))) - Lit (Number n) -> hoverable env.handle (msg cur.path) (codeText (show n)) - Lit (String s) -> hoverable env.handle (msg cur.path) (codeText s) + Lit (Number n) -> hoverable env.handle (msg cur.path) (codeText (String.show n)) + Lit (Str s) -> hoverable env.handle (msg cur.path) (codeText s) _ -> case break env.key env.metadata cur.path cur.term of Prefix f args -> let f' = go False 9 availableWidth f lines = f' :: map (go False 10 0) args - unbroken = paren (ambientPrec > 9) cur.path (flow right (intersperse space lines)) + unbroken = paren (ambientPrec > 9) cur.path (flow right (intersperse space lines |> Styles.row)) in if not allowBreak || widthOf unbroken < availableWidth then unbroken else let args' = map (go True 10 (availableWidth - indentWidth)) args |> flow down @@ -97,8 +100,6 @@ render expr env = else flow down [argLayout, space2 `beside` go True 0 (availableWidth - indentWidth) body] |> paren (ambientPrec > 0) cur.path - msg path b = if b then Just (env.key, path) else Nothing - paren : Bool -> Path -> Element -> Element paren parenthesize path e = if parenthesize @@ -170,18 +171,15 @@ break hash md path expr = _ -> Lambda [{path = path, term = expr }] { path = path `push` Body, term = body } _ -> prefix expr [] path -todo : a -todo = todo - parseLiteral : Parser Literal parseLiteral = P.union' <| \t -> if | t == "Number" -> P.map Number P.number - | t == "String" -> P.map String P.string + | t == "String" -> P.map Str P.string | t == "Vector" -> P.map (Vector . Array.fromList) (P.array parseTerm) jsonifyLiteral l = case l of Number n -> J.tag' "Number" J.number n - String s -> J.tag' "String" J.string s + Str s -> J.tag' "String" J.string s Vector es -> J.tag' "Vector" (J.contramap Array.toList (J.array jsonifyTerm)) es parseTerm : Parser Term