select sig nodes correctly

hackworthltd · May 30, 2023 · 2c50c13 · 2c50c13
1 parent c48d4fe
commit 2c50c13
Showing 1 changed file with 6 additions and 2 deletions.
diff --git 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}