Various explorer style tweaks

This commit is contained in:
Paul Chiusano 2015-02-23 15:28:16 -05:00
parent 1438ba0d02
commit 9a75ee0613
5 changed files with 47 additions and 15 deletions

View File

@ -122,6 +122,14 @@ pad eastWestPad northSouthPad l =
(Pt eastWestPad northSouthPad)
l
pad' : { left : Int, right : Int, top : Int, bottom : Int } -> Layout k -> Layout k
pad' padding l =
container (tag l)
(widthOf l + padding.left + padding.right)
(heightOf l + padding.top + padding.bottom)
(Pt padding.left padding.top)
l
outline : Color -> Int -> Layout k -> Layout k
outline c thickness l =
pad thickness thickness l |> transform (E.color c)

View File

@ -103,6 +103,12 @@ explorerViewEnv model =
, overrides path = Trie.lookup path model.overrides
, overall = model.term }
focus : Model -> Maybe Term
focus model = model.scope `Maybe.andThen` \scope -> Term.at scope.focus model.term
focusOr : Term -> Model -> Term
focusOr e model = Maybe.withDefault e (focus model)
keyedCompletions : Model -> List (String,Term,Element)
keyedCompletions model =
let f e i scope =
@ -118,14 +124,12 @@ keyedCompletions model =
{ path = scope.focus, term = e }
format e = (key e, e, render e)
box = Term.Embed (Layout.embed { path = [], selectable = False } Styles.currentSymbol)
appBlanks n e = if n <= 0 then e else appBlanks (n-1) (Term.App e Term.Blank)
showAppBlanks n e =
let go n e = if n <= 0 then e else go (n-1) (Term.App e box)
in render (go n e)
la cur n = (String.padLeft (n+1) '.' "", appBlanks n cur, showAppBlanks n cur)
appBlanks n e = List.foldl (\_ cur -> Term.App cur Term.Blank) e [0 .. n]
showAppBlanks n = render (List.foldl (\_ box -> Term.App box Term.Blank) box [0 .. n])
la cur n = (String.padLeft (n+1) '.' "", appBlanks n cur, showAppBlanks n)
currentApps = Debug.log "currentApps" <| case Term.at scope.focus model.term of
Nothing -> []
Just cur -> List.map (la cur) i.localApplications
Just cur -> (".", cur, Styles.currentSymbol) :: List.map (la cur) i.localApplications
ks = Debug.log "keys" (List.map (\(k,_,_) -> k) results)
results = currentApps ++ List.map format regulars
in results
@ -311,12 +315,17 @@ refreshExplorer searchbox model = case model.localInfo of
currentType = Element.flow Element.right
[ Styles.currentSymbol
, Styles.codeText (" : " ++ Type.key { metadata = metadata model } localInfo.current) ]
above = Element.flow Element.down <|
[ Element.spacer 1 5
, pad <| Styles.codeText (Type.key { metadata = metadata model } localInfo.admissible)
, Element.spacer 1 5
above0 = Element.flow Element.down <|
[ Element.spacer 1 10
, pad <| Styles.boldCodeText (Type.key { metadata = metadata model } localInfo.admissible)
, Element.spacer 1 12
, pad currentType ] ++
List.map render localInfo.locals ++ [ Element.spacer 1 5 ]
List.map render localInfo.locals
above = Element.flow Element.down
[ above0
, Element.spacer 1 10
, Styles.menuSeparator (Element.widthOf above0)
, Element.spacer 1 10 ]
explorer' : Explorer.Model
explorer' = model.explorer |> Maybe.map (\e ->

View File

@ -76,7 +76,7 @@ view origin searchbox model = case model of
statusColor = Styles.statusColor ok
fld = Field.field (Styles.autocomplete ok) searchbox s.prompt s.input
completions =
let fit e = E.width (E.widthOf s.above `max` E.widthOf e) e
let fit e = E.width (E.widthOf s.above - 12 `max` E.widthOf e) e
in List.indexedMap (\i e -> Layout.embed (Result.Ok i) (fit e)) s.completions
inside = Result.Err Inside
bottom = Styles.explorerOutline statusColor <|
@ -86,7 +86,7 @@ view origin searchbox model = case model of
, Layout.embed inside s.below ]
box = Layout.vertical inside
[ Layout.embed inside (E.flow E.right [E.spacer 9 1, Styles.carotUp 6 statusColor])
, Layout.embed inside (E.width (Layout.widthOf bottom `max` 60) fld)
, Layout.embed inside (E.width (Layout.widthOf bottom) fld)
, Layout.embed inside (E.spacer 1 6)
, bottom ]
boxTopLeft = origin

View File

@ -57,9 +57,20 @@ menuHeader =
codeText : String -> Element
codeText s = T.leftAligned (T.style code (T.fromString s))
boldCodeText : String -> Element
boldCodeText s = T.leftAligned (T.style { code | bold <- True } (T.fromString s))
centeredCodeText : String -> Element
centeredCodeText s = T.centered (T.style code (T.fromString s))
menuHeaderText : String -> Element
menuHeaderText s = T.leftAligned (T.style menuHeader (T.fromString s))
menuSeparator : Int -> Element
menuSeparator width =
let line = E.spacer (width - 20) 1 |> E.color clouds
in E.flow E.right [E.spacer 10 1, line, E.spacer 10 1]
okColor = midnightBlueA 0.4
notOkColor = alizarin
@ -115,7 +126,11 @@ verticalCells k ifEmpty ls = let cs = List.map (\l -> L.fill bg (L.pad 5 0 l)) (
explorerCells : k -> List (Layout k) -> Layout k
explorerCells k ls =
let cs = List.map (\l -> L.fill bg (L.pad 20 5 l)) (L.column ls)
let last l = L.fill bg (L.pad' { left = 10, right = 5, top = 6, bottom = 8 } l)
col = L.leftAlignedColumn ls
fmt l = L.fill bg (L.pad' { left = 10, right = 5, top = 6, bottom = 6 } l)
cs = List.map fmt (List.take (List.length col - 1) col) ++
List.map last (List.drop (List.length col - 1) col)
in case cs of
[] -> L.empty k
h :: _ -> let hsep = L.embed k (E.spacer 1 5)

View File

@ -78,7 +78,7 @@ node eval store =
annotatedLocals <- pure $ map (\(v,t) -> E.Var v `E.Ann` t) locals
let f focus = maybe (pure False) (\e -> Type.wellTyped readTypeOf e) (Path.set loc focus e)
let fi (e,_) = f e
let currentApplies = maybe [] (\e -> TE.applications e admissible) (Path.at loc e) `zip` [0..]
let currentApplies = maybe [] (\e -> drop 1 (TE.applications e admissible)) (Path.at loc e) `zip` [0..]
matchingCurrentApplies <- case Path.at loc e of
-- if we're pointing to a Var, matchingCurrentApplies is redundant with `matchingLocals`
Just (E.Var _) -> pure []