diff --git a/src/lib/Live/Eval.hs b/src/lib/Live/Eval.hs index 5363a2ee2..286e05160 100644 --- a/src/lib/Live/Eval.hs +++ b/src/lib/Live/Eval.hs @@ -13,11 +13,14 @@ module Live.Eval ( import Control.Concurrent import Control.Monad import Control.Monad.State.Strict +import Control.Monad.Reader import qualified Data.Map.Strict as M import Data.Aeson (ToJSON, ToJSONKey, toJSON, Value) import Data.Functor ((<&>)) -import Data.Maybe (fromJust) +import Data.Foldable (fold) +import Data.Maybe (fromJust, fromMaybe) import Data.Text (Text) +import Prelude hiding (span) import GHC.Generics import Actor @@ -317,14 +320,79 @@ data SourceBlockJSONData = SourceBlockJSONData , jdBlockId :: Int , jdLexemeList :: [SrcId] , jdASTInfo :: ASTInfo + , jdASTLims :: M.Map SrcId (SrcId, SrcId) -- precomputed leftmost and rightmost spans associated with each node , jdHTML :: String } deriving (Generic) instance ToJSON SourceBlockJSONData instance ToJSON SourceBlockWithId where toJSON b@(SourceBlockWithId blockId b') = toJSON $ SourceBlockJSONData - (sbLine b') blockId (unsnoc $ lexemeList $ sbLexemeInfo b') (sbASTInfo b') (pprintHtml b) + { jdLine = sbLine b' + , jdBlockId = blockId + , jdLexemeList = unsnoc $ lexemeList $ sbLexemeInfo b' + , jdASTInfo = sbASTInfo b' + , jdASTLims = computeASTLims (sbASTInfo b') (sbLexemeInfo b') + , jdHTML = pprintHtml b + } instance ToJSON Result where toJSON = toJSONViaHtml + toJSONViaHtml :: ToMarkup a => a -> Value toJSONViaHtml x = toJSON $ pprintHtml x + +-- === computing the linear lexeme limits on each SrcId === + +data OrdSrcId = OrdSrcId Int SrcId +newtype OrdSrcIdSpan = OrdSrcIdSpan (Maybe (OrdSrcId, OrdSrcId)) + +type SpanMap = M.Map SrcId OrdSrcIdSpan +type ComputeSpanM = ReaderT (ASTInfo, LexemeInfo) (State SpanMap) + +instance Eq OrdSrcId where + OrdSrcId x _ == OrdSrcId y _ = x == y + +instance Ord OrdSrcId where + compare (OrdSrcId x _) (OrdSrcId y _) = compare x y + +instance Monoid OrdSrcIdSpan where + mempty = OrdSrcIdSpan Nothing + +instance Semigroup OrdSrcIdSpan where + OrdSrcIdSpan Nothing <> s = s + s <> OrdSrcIdSpan Nothing = s + OrdSrcIdSpan (Just (l, r)) <> OrdSrcIdSpan (Just (l', r')) = + OrdSrcIdSpan $ Just (min l l', max r r') + +computeASTLims :: ASTInfo -> LexemeInfo -> M.Map SrcId (SrcId, SrcId) +computeASTLims astInfo lexemeInfo = + M.mapMaybe stripOrd $ flip execState mempty $ flip runReaderT (astInfo, lexemeInfo) $ + visitSrcId rootSrcId + where stripOrd :: OrdSrcIdSpan -> Maybe (SrcId, SrcId) + stripOrd (OrdSrcIdSpan s) = case s of + Just (OrdSrcId _ l, OrdSrcId _ r) -> Just (l, r) + Nothing -> Nothing + +insertSpan :: SrcId -> OrdSrcIdSpan -> ComputeSpanM () +insertSpan sid span = modify \m -> M.insert sid span m + +getSelfSpans :: SrcId -> ComputeSpanM [OrdSrcIdSpan] +getSelfSpans sid = do + lexemes <- asks $ lexemeInfo . snd + case M.lookup sid lexemes of + Nothing -> return [] + Just (_, (low, _)) -> do + let sidOrd = OrdSrcId low sid + return [OrdSrcIdSpan $ Just $ (sidOrd, sidOrd)] + +getChildren :: SrcId -> ComputeSpanM [SrcId] +getChildren sid = do + astInfo <- asks fst + return $ fromMaybe [] $ M.lookup sid $ astChildren astInfo + +visitSrcId :: SrcId -> ComputeSpanM OrdSrcIdSpan +visitSrcId sid = do + childSpans <- mapM visitSrcId =<< getChildren sid + selfSpans <- getSelfSpans sid + let finalSpan = fold $ selfSpans ++ childSpans + insertSpan sid finalSpan + return finalSpan diff --git a/src/lib/SourceIdTraversal.hs b/src/lib/SourceIdTraversal.hs index 565027294..9897bc360 100644 --- a/src/lib/SourceIdTraversal.hs +++ b/src/lib/SourceIdTraversal.hs @@ -49,7 +49,7 @@ instance IsTree Group where CPrim _ xs -> mapM_ visit xs CParens xs -> mapM_ visit xs CBrackets xs -> mapM_ visit xs - CBin b l r -> visit b >> visit l >> visit r + CBin b l r -> visit l >> visit b >> visit r CJuxtapose _ l r -> visit l >> visit r CPrefix l r -> visit l >> visit r CGivens (x,y) -> visit x >> visit y diff --git a/src/lib/Types/Source.hs b/src/lib/Types/Source.hs index 5c01c3f37..cdb0a47f4 100644 --- a/src/lib/Types/Source.hs +++ b/src/lib/Types/Source.hs @@ -56,6 +56,9 @@ newtype SourceOrInternalName (c::C) (n::S) = SourceOrInternalName (SourceNameOr -- XXX: 0 is reserved for the root newtype SrcId = SrcId Int deriving (Show, Eq, Ord, Generic) +rootSrcId :: SrcId +rootSrcId = SrcId 0 + -- This is just for syntax highlighting. It won't be needed if we have -- a separate lexing pass where we have a complete lossless data type for -- lexemes. diff --git a/static/index.js b/static/index.js index 7657b3024..836c0a11b 100644 --- a/static/index.js +++ b/static/index.js @@ -70,16 +70,16 @@ function render(renderMode) { } function selectSpan(cellCtx, srcId) { - let [cell, blockId, _] = cellCtx + let [cell, blockId, , ] = cellCtx return cell.querySelector("#span_".concat(blockId.toString(), "_", srcId.toString()));} function attachHovertip(cellCtx, srcId) { let span = selectSpan(cellCtx, srcId); - span.addEventListener("mouseover", (event) => enterSpan(event, cellCtx, srcId)); - span.addEventListener("mouseout" , (event) => leaveSpan(event, cellCtx, srcId));} + span.addEventListener("mouseover", (event) => toggleSpan(event, cellCtx, srcId)); + span.addEventListener("mouseout" , (event) => toggleSpan(event, cellCtx, srcId));} function getParent(cellCtx, srcId) { - let [ , , astInfo] = cellCtx; + let [ , , astInfo, ] = cellCtx; let parent = astInfo["astParent"][srcId.toString()] if (parent == undefined) { console.error(srcId, astInfo); @@ -89,7 +89,7 @@ function getParent(cellCtx, srcId) { }} function getChildren(cellCtx, srcId) { - let [ , , astInfo] = cellCtx; + let [ , , astInfo, ] = cellCtx; let children = astInfo["astChildren"][srcId.toString()] if (children == undefined) { return []; @@ -97,40 +97,43 @@ function getChildren(cellCtx, srcId) { return children; }} -function traverseSpans(cellCtx, srcId, f) { - let span = selectSpan(cellCtx, srcId) - if (span !== null) f(span); - getChildren(cellCtx, srcId).map(function (childId) { - traverseSpans(cellCtx, childId, f); - })} +function isLeafGroup(span) { + return span !== null && (span.classList.contains("keyword") || span.classList.contains("symbol")) +} -function enterSpan(event, cellCtx, srcId) { - event.stopPropagation(); - let parentId = getParent(cellCtx, srcId); - traverseSpans(cellCtx, parentId, function (span) { - span.style.backgroundColor = "lightblue"; - span.style.outlineColor = "lightblue"; - span.style.outlineStyle = "solid"; - }); - let siblingIds = getChildren(cellCtx, parentId); - siblingIds.map(function (siblingId) { - traverseSpans(cellCtx, siblingId, function (span) { - span.style.backgroundColor = "yellow"; - })})} +function toggleSrcIdHighlighting(cellCtx, srcId) { + let maybeLeaf = selectSpan(cellCtx, srcId) + // XXX: this is a bit of a hack. We should probably collect information + // about node types on the Haskell side + if (isLeafGroup(maybeLeaf)) { + maybeLeaf.classList.toggle("highlighted-leaf"); + } else { + getSrcIdSpans(cellCtx, srcId).map(function (span) { + span.classList.toggle("highlighted"); + })}} + +// All HTML spans associated with the srcId (these should be contiguous) +function getSrcIdSpans(cellCtx, srcId) { + let [ , , , nodeSpans] = cellCtx; + let [leftSrcId, rightSrcId] = nodeSpans[srcId]; + return spansBetween(selectSpan(cellCtx, leftSrcId), selectSpan(cellCtx, rightSrcId));} + +function spansBetween(l, r) { + let spans = [] + while (l !== null && !(Object.is(l, r))) { + spans.push(l); + l = l.nextSibling; + } + spans.push(r) + return spans;} -function leaveSpan(event, cellCtx, srcId) { +function toggleSpan(event, cellCtx, srcId) { event.stopPropagation(); let parentId = getParent(cellCtx, srcId); - traverseSpans(cellCtx, parentId, function (span) { - span.style.backgroundColor = null; - span.style.outlineColor = null; - span.style.outlineStyle = null; - }); let siblingIds = getChildren(cellCtx, parentId); siblingIds.map(function (siblingId) { - traverseSpans(cellCtx, siblingId, function (span) { - span.style.backgroundColor = null; - })})} + toggleSrcIdHighlighting(cellCtx, siblingId) + })} function setCellContents(cell, contents) { let source = contents[0]; @@ -200,7 +203,8 @@ function processUpdate(msg) { var blockId = source["jdBlockId"]; var astInfo = source["jdASTInfo"]; var lexemeList = source["jdLexemeList"]; - cellCtx = [cell, blockId, astInfo]; + var astLims = source["jdASTLims"]; + cellCtx = [cell, blockId, astInfo, astLims]; lexemeList.map(function (lexemeId) {attachHovertip(cellCtx, lexemeId)}) } }); diff --git a/static/style.css b/static/style.css index 0383c9578..6132484d0 100644 --- a/static/style.css +++ b/static/style.css @@ -100,6 +100,14 @@ code { color: #E07000; } +.highlighted { + background-color: yellow; +} + +.highlighted-leaf { + background-color: lightblue; +} + .type-name { color: #A80000; }