add prio field to app triggers, set builtin triggers lower

packages/menu/lib/Ribosome/Menu.hs

@@ -54,6 +54,7 @@ import Ribosome.Menu.App (
   notPrompt,
   onlyPrompt,
   promptControl,
+  triggerPrio,
   withInsert,
   )
 import Ribosome.Menu.Data.Entry (Entries, Entry (..))

packages/menu/lib/Ribosome/Menu/App.hs

@@ -25,20 +25,28 @@ import Ribosome.Menu.Data.InputParams (
   )
 import Ribosome.Menu.Prompt.Data.Prompt (PromptControl (PromptControlApp, PromptControlItems), PromptState)
 
+newtype TriggerPrio =
+  TriggerPrio Int
+  deriving stock (Eq, Show, Generic)
+  deriving newtype (Num, Real, Enum, Integral, Ord)
+
 data AppTrigger =
-  AppMapping MappingLhs InputDomain
+  AppMapping TriggerPrio MappingLhs InputDomain
   |
-  AppPrompt PromptControl
+  AppPrompt TriggerPrio PromptControl
   deriving stock (Eq, Show, Ord, Generic)
 
+userPrioValue :: TriggerPrio
+userPrioValue = 5
+
 instance IsString AppTrigger where
-  fromString key = AppMapping (fromString key) (InputDomain {modes = [MapNormal], prompt = Nothing})
+  fromString key = AppMapping userPrioValue (fromString key) (InputDomain {modes = [MapNormal], prompt = Nothing})
 
 type InputDispatch s r result =
   InputParams -> Maybe (MenuWidget s r result)
 
 domain :: Traversal' AppTrigger InputDomain
-domain = #_AppMapping . _2
+domain = #_AppMapping . _3
 
 modesLens :: Traversal' AppTrigger (NonEmpty MapMode)
 modesLens = domain . #modes
@@ -67,51 +75,65 @@ onlyPrompt = controlLens ?~ PromptControlApp
 notPrompt :: AppTrigger -> AppTrigger
 notPrompt = controlLens ?~ PromptControlItems
 
+triggerPrio :: TriggerPrio -> AppTrigger -> AppTrigger
+triggerPrio new = \case
+  AppMapping _ lhs dom -> AppMapping new lhs dom
+  AppPrompt _ ctrl -> AppPrompt new ctrl
+
+builtinPrio :: AppTrigger -> AppTrigger
+builtinPrio = triggerPrio 0
+
+userPrio :: AppTrigger -> AppTrigger
+userPrio = triggerPrio userPrioValue
+
 type MenuApp s r result =
   Map AppTrigger (MenuWidget s r result)
 
-inputMatrix :: AppTrigger -> MenuWidget s r result -> [(InputParams, MenuWidget s r result)]
-inputMatrix (AppMapping lhs InputDomain {..}) widget =
+inputMatrix :: AppTrigger -> MenuWidget s r result -> [(InputParams, (TriggerPrio, MenuWidget s r result))]
+inputMatrix (AppMapping prio lhs InputDomain {..}) widget =
   [
-    (InputParams {trigger = InputMapping lhs, mode = InputMode {mode = m, prompt = p}}, widget)
+    (InputParams {trigger = InputMapping lhs, mode = InputMode {mode = m, prompt = p}}, (prio, widget))
     | m <- toList modes
     , p <- controls prompt
   ]
   where
     controls = \case
       Just p -> [p]
       Nothing -> [PromptControlApp, PromptControlItems]
-inputMatrix (AppPrompt control) widget =
+inputMatrix (AppPrompt prio control) widget =
   [
-    (InputParams {trigger = InputPrompt, mode = InputMode {mode = m, prompt = control}}, widget)
+    (InputParams {trigger = InputPrompt, mode = InputMode {mode = m, prompt = control}}, (prio, widget))
     | m <- [MapNormal, MapInsert]
   ]
 
 appDispatch :: MenuApp s r result -> InputDispatch s r result
 appDispatch app =
   flip Map.lookup matrix
   where
-    matrix = Map.fromList (uncurry inputMatrix =<< Map.toList app)
+    matrix = snd <$> Map.fromListWith choose (uncurry inputMatrix =<< Map.toList app)
+
+    choose l@(prioL, _) r@(prioR, _) | prioL > prioR = l
+                                     | otherwise = r
 
 appMappings :: MenuApp s r result -> [MappingSpec]
 appMappings app =
   flip mapMaybe (Map.keys app) \case
-    AppMapping lhs InputDomain {modes} -> Just (MappingSpec lhs modes)
-    AppPrompt _ -> Nothing
+    AppMapping _ lhs InputDomain {modes} -> Just (MappingSpec lhs modes)
+    AppPrompt _ _ -> Nothing
 
 builtinHandlers :: MenuApp s r result
 builtinHandlers =
-  [
+  Map.mapKeys builtinPrio [
     (withInsert "<esc>", menuEsc),
     (withInsert "<c-c>", menuQuit),
-    (AppPrompt PromptControlItems, menuOk)
+    (AppPrompt 0 PromptControlItems, menuOk)
   ]
 
 defaultHandlers ::
   MenuState s =>
   MenuApp s r result
 defaultHandlers =
-  [
+  Map.mapKeys builtinPrio [
     ("k", menuUp),
     (withInsert "<c-k>", menuUp),
     ("j", menuDown),
@@ -123,7 +145,7 @@ defaultHandlers =
 
 promptControl :: MenuWidget s r result -> MenuApp s r result -> MenuApp s r result
 promptControl widget =
-  Map.insert (AppPrompt PromptControlApp) widget
+  Map.insert (AppPrompt userPrioValue PromptControlApp) widget
 
 data PromptApp s r result =
   PromptApp {

packages/menu/lib/Ribosome/Menu/Prompt.hs

@@ -2,8 +2,19 @@ module Ribosome.Menu.Prompt (
   module Ribosome.Menu.Prompt.Data.Prompt,
   module Ribosome.Menu.Prompt.Data.PromptMode,
   module Ribosome.Menu.Prompt.Data.PromptEvent,
+  menuPrompt,
+  menuPromptState,
 ) where
 
+import Ribosome.Menu.Action (MenuSem)
 import Ribosome.Menu.Prompt.Data.Prompt
 import Ribosome.Menu.Prompt.Data.PromptEvent
 import Ribosome.Menu.Prompt.Data.PromptMode
+
+menuPromptState ::
+  MenuSem s r PromptState
+menuPromptState = ask
+
+menuPrompt ::
+  MenuSem s r Prompt
+menuPrompt = asks (.prompt)

packages/menu/lib/Ribosome/Menu/Prompt/Nvim.hs

@@ -1,3 +1,4 @@
+-- | Description: Legacy prompt implementation using @echo@
 module Ribosome.Menu.Prompt.Nvim where
 
 import qualified Data.Text as Text (singleton, splitAt, uncons)

packages/menu/ribosome-menu.cabal

@@ -172,6 +172,7 @@ test-suite ribosome-menu-test
       Ribosome.Menu.Test.NvimMenuTest
       Ribosome.Menu.Test.RefineManyTest
       Ribosome.Menu.Test.SliceTest
+      Ribosome.Menu.Test.TriggerPrioTest
       Ribosome.Menu.Test.Util
   hs-source-dirs:
       test

packages/menu/test/Main.hs

@@ -11,6 +11,7 @@ import Ribosome.Menu.Test.NativeInputTest (test_nativeInput)
 import Ribosome.Menu.Test.NoMatchTest (test_filterNoMatch)
 import Ribosome.Menu.Test.NvimMenuTest (test_nvimMenu)
 import Ribosome.Menu.Test.SliceTest (test_slice)
+import Ribosome.Menu.Test.TriggerPrioTest (test_triggerPrio)
 import Ribosome.Test.Skip (requireX)
 import Test.Tasty (TestTree, defaultMain, testGroup)
 
@@ -28,7 +29,8 @@ tests =
     unitTest "multiline with little space" test_multilineCramped,
     unitTest "query with no match" test_filterNoMatch,
     unitTest "clamp cursor after refining" test_clampCursor,
-    unitTest "use the menu as a kv editor" test_editMode
+    unitTest "use the menu as a kv editor" test_editMode,
+    unitTest "trigger priority" test_triggerPrio
   ]
 
 main :: IO ()

packages/menu/test/Ribosome/Menu/Test/FilterTest.hs

@@ -6,6 +6,7 @@ import Zeugma (runTest)
 
 import Ribosome.Menu.Combinators (sortEntriesText)
 import Ribosome.Menu.Data.Filter (fuzzy)
+import qualified Ribosome.Menu.Data.MenuItem
 import Ribosome.Menu.Data.MenuItem (Items, simpleItems, simpleMenuItem)
 import Ribosome.Menu.Data.State (modal)
 import Ribosome.Menu.Effect.MenuFilter (FilterJob (Initial), menuFilter)
@@ -38,8 +39,7 @@ test_filterNoSort =
     interpretFilter $ interpretMenuUiNvimNull $ interpretMenuDeps $ interpretMenus do
       testError $ withUi () $ menuParams (Stream.fromList noSortItems) (modal fuzzy) do
         assertWait currentEntries (assertEq (length noSortItems) . length)
-        dbgs =<< currentEntriesText
-        unit
+        assertEq ((.text) <$> noSortItems) =<< currentEntriesText
   where
     noSortItems = item <$> [1 :: Int .. 120]
 

packages/menu/test/Ribosome/Menu/Test/TriggerPrioTest.hs

@@ -0,0 +1,36 @@
+module Ribosome.Menu.Test.TriggerPrioTest where
+
+import Polysemy.Test (UnitTest, (===))
+
+import Ribosome.Menu.Action (menuAttachPrompt, menuDetachPrompt, menuSuccess)
+import Ribosome.Menu.App (notPrompt, onlyPrompt)
+import Ribosome.Menu.Data.Filter (substring)
+import Ribosome.Menu.Data.MenuResult (MenuResult (Success))
+import Ribosome.Menu.Data.State (modal)
+import qualified Ribosome.Menu.Effect.MenuTest as MenuTest
+import Ribosome.Menu.Effect.MenuTest (sendMapping, sendMappingPrompt)
+import Ribosome.Menu.Prompt (menuPrompt)
+import qualified Ribosome.Menu.Prompt.Data.Prompt
+import Ribosome.Menu.Scratch (menuScratch)
+import Ribosome.Menu.Test.Run (testStaticNvimMenu)
+import Ribosome.Menu.Test.Util (staticMenuItems)
+import Ribosome.Test.Embed (testEmbed_)
+
+test_triggerPrio :: UnitTest
+test_triggerPrio = do
+  testEmbed_ do
+    res <- testStaticNvimMenu its def (modal substring) (menuScratch & #maxSize ?~ 10) app do
+      sendMappingPrompt "x"
+      sendMappingPrompt "<esc>"
+      sendMapping "q"
+      MenuTest.result
+    Success "detached" === (res <&> (.text))
+  where
+    app =
+      [
+        (notPrompt "x", menuAttachPrompt (Just "attached")),
+        (onlyPrompt "<esc>", menuDetachPrompt (Just "detached")),
+        (notPrompt "q", menuSuccess =<< menuPrompt)
+      ]
+
+    its = staticMenuItems (show <$> [1 :: Int .. 10])