From 2c50c13cee7cffe229adf1a2edba48b7d03f8194 Mon Sep 17 00:00:00 2001 From: Ben Price Date: Tue, 30 May 2023 20:12:57 +0100 Subject: [PATCH] select sig nodes correctly --- primer/src/Primer/API.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/primer/src/Primer/API.hs b/primer/src/Primer/API.hs index 8cda2e8fe..7b47978af 100644 --- a/primer/src/Primer/API.hs +++ b/primer/src/Primer/API.hs @@ -101,7 +101,7 @@ import Data.Tuple.Extra (curry3) import Optics (ifoldr, over, preview, to, traverseOf, view, (%), (^.), _Just) import Primer.API.NodeFlavor qualified as Flavor import Primer.API.RecordPair (RecordPair (RecordPair)) -import Primer.Action (Action (SetCursor), ActionError, ProgAction (BodyAction, MoveToDef), toProgActionInput, toProgActionNoInput) +import Primer.Action (Action (SetCursor), ActionError, ProgAction (BodyAction, MoveToDef, SigAction), toProgActionInput, toProgActionNoInput) import Primer.Action.Available qualified as Available import Primer.App ( App, @@ -1190,9 +1190,13 @@ data TypeOrKind = Type Tree | Kind Tree setSelection :: (MonadIO m, MonadThrow m, MonadAPILog l m) => SessionId -> Selection -> PrimerM m (Maybe TypeOrKind) setSelection = curry $ logAPI (noError SetSelection) $ \(sid, sel) -> - edit sid (App.Edit $ MoveToDef sel.def : maybeToList ((\n -> BodyAction [SetCursor n.id]) <$> sel.node)) + edit sid (App.Edit $ MoveToDef sel.def : selNode sel) >>= either (throwM . SetSelectionError sel) (pure . (viewTypeOrKind <=< progSelection)) where + selNode sel = case sel.node of + Nothing -> [] + Just NodeSelection{id, nodeType = BodyNode} -> [BodyAction [SetCursor id]] + Just NodeSelection{id, nodeType = SigNode} -> [SigAction [SetCursor id]] viewTypeOrKind :: App.Selection -> Maybe TypeOrKind viewTypeOrKind sel = either viewExprType viewTypeKind . (.meta) <$> sel.selectedNode trivialTree = Tree{nodeId = "seltype-0", childTrees = [], rightChild = Nothing, body = NoBody Flavor.EmptyHole}