add modifyFocus', returning an additional value

tek · Oct 7, 2023 · 0beacf8 · 0beacf8
1 parent 96875b1
commit 0beacf8
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 5 deletions.
diff --git a/packages/menu/lib/Ribosome/Menu.hs b/packages/menu/lib/Ribosome/Menu.hs
@@ -128,6 +128,7 @@ import Ribosome.Menu.ItemLens (
 import Ribosome.Menu.Items (
   deleteSelected,
   modifyFocus,
+  modifyFocus',
   traverseSelection_,
   updateEntry,
   withFocus,

diff --git a/packages/menu/lib/Ribosome/Menu/Items.hs b/packages/menu/lib/Ribosome/Menu/Items.hs
@@ -197,14 +197,25 @@ updateEntry index newEntry = do
   entries %= overEntry index (const newEntry)
   items . ix (fromIntegral newEntry.index) .= newEntry.item
 
+modifyFocus' ::
+  ∀ s a r .
+  MenuState s =>
+  Member (Menu s) r =>
+  (Entry (Item s) -> (Entry (Item s), a)) ->
+  Sem r (Maybe a)
+modifyFocus' f =
+  menuState do
+    CursorIndex curs <- use #cursor
+    use focusEntry >>= traverse \ e -> do
+      let (new, result) = f e
+      updateEntry (fromIntegral curs) new
+      histories .= mempty
+      pure result
+
 modifyFocus ::
   MenuState s =>
   Member (Menu s) r =>
   (Entry (Item s) -> Entry (Item s)) ->
   Sem r ()
 modifyFocus f =
-  menuState do
-    CursorIndex curs <- use #cursor
-    use focusEntry >>= traverse_ \ e -> do
-      updateEntry (fromIntegral curs) (f e)
-      histories .= mempty
+  void $ modifyFocus' \ e -> (f e, ())