module Ribosome.Test.MenuTest where import Conduit (ConduitT, yield, yieldMany) import Control.Concurrent.MVar.Lifted (modifyMVar_) import Control.Lens (view) import Control.Monad.Trans.Resource (ResourceT, runResourceT) import qualified Data.Map.Strict as Map (fromList) import Hedgehog ((===)) import Test.Tasty (TestTree, testGroup) import Ribosome.Control.StrictRibosome (StrictRibosome) import Ribosome.Menu.Action (menuContinue, menuExecute, menuQuit) import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem(FilteredMenuItem)) import qualified Ribosome.Menu.Data.FilteredMenuItem as FilteredMenuItem (item) import Ribosome.Menu.Data.Menu (Menu(Menu), MenuFilter(MenuFilter)) import qualified Ribosome.Menu.Data.Menu as Menu (items) import Ribosome.Menu.Data.MenuAction (MenuAction) import Ribosome.Menu.Data.MenuConfig (MenuConfig(MenuConfig)) import Ribosome.Menu.Data.MenuConsumer (MenuConsumer(MenuConsumer)) import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction) import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..)) import Ribosome.Menu.Data.MenuItem (MenuItem(MenuItem), simpleMenuItem) import qualified Ribosome.Menu.Data.MenuItem as MenuItem (MenuItem(_text), text) import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent) import qualified Ribosome.Menu.Data.MenuRenderEvent as MenuRenderEvent (MenuRenderEvent(..)) import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate)) import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt)) import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig), PromptFlag(StartInsert)) import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent) import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..)) import qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..)) import Ribosome.Menu.Prompt.Run (basicTransition, noPromptRenderer) import Ribosome.Menu.Run (runMenu) import Ribosome.Menu.Simple ( basicMenu, defaultMenu, deleteByFilteredIndex, fuzzyMenuItemMatcher, markedMenuItems, markedMenuItemsOnly, selectedMenuItem, simpleMenu, ) import Ribosome.System.Time (sleep) import Ribosome.Test.Run (UnitTest, unitTest) promptInput :: MonadIO m => [Text] -> ConduitT () PromptEvent m () promptInput chars = do lift $ sleep 0.1 yieldMany (PromptEvent.Character <$> chars) menuItems :: Monad m => [Text] -> ConduitT () [MenuItem Text] m () menuItems = yield . fmap (simpleMenuItem "name") storePrompt :: MonadBaseControl IO m => MVar [Prompt] -> MenuUpdate m a Text -> m (MenuConsumerAction m a, Menu Text) storePrompt prompts (MenuUpdate event menu) = check event where check (MenuEvent.PromptChange prompt) = store prompt check (MenuEvent.Mapping _ prompt) = store prompt check (MenuEvent.Quit _) = menuQuit menu check _ = menuContinue menu store prompt = modifyMVar_ prompts (return . (prompt :)) *> menuContinue menu render :: MonadIO m => MonadBaseControl IO m => MVar [[FilteredMenuItem Text]] -> MenuRenderEvent m a Text -> m () render varItems (MenuRenderEvent.Render _ (Menu _ items _ _ _ _)) = do modifyMVar_ varItems (return . (items :)) sleep 0.01 render _ (MenuRenderEvent.Quit _) = return () type TestM = StateT (StrictRibosome ()) (ResourceT IO) menuTest :: (MenuUpdate TestM a Text -> TestM (MenuAction TestM a, Menu Text)) -> [Text] -> [Text] -> IO [[FilteredMenuItem Text]] menuTest handler items chars = do itemsVar <- newMVar [] void $ runResourceT $ runMenu (conf itemsVar) `execStateT` def readMVar itemsVar where conf itemsVar = MenuConfig (menuItems items) (MenuConsumer handler) (render itemsVar) promptConfig def promptConfig = PromptConfig (promptInput chars) basicTransition noPromptRenderer [StartInsert] promptTest :: [Text] -> [Text] -> IO ([[FilteredMenuItem Text]], [Prompt]) promptTest items chars = do prompts <- newMVar [] itemsResult <- menuTest (basicMenu fuzzyMenuItemMatcher (storePrompt prompts)) items chars (itemsResult,) <$> readMVar prompts promptsTarget1 :: [Prompt] promptsTarget1 = uncurry one' <$> [ (1, PromptState.Insert), (0, PromptState.Normal), (0, PromptState.Normal), (1, PromptState.Insert) ] where one' c s = Prompt c s "i" items1 :: [Text] items1 = [ "i1", "j1", "i2", "i3", "j2", "i4" ] chars1 :: [Text] chars1 = [ "i", "esc", "k", "a", "2" ] itemsTarget1 :: [[MenuItem Text]] itemsTarget1 = [ item <$> ["i2"], item <$> ["i1", "i2", "i3", "i4"] ] where item = simpleMenuItem "name" test_pureMenuModeChange :: UnitTest test_pureMenuModeChange = do (items, prompts) <- liftIO (promptTest items1 chars1) itemsTarget1 === (view FilteredMenuItem.item <$$> take 2 items) promptsTarget1 === (take 4 $ reverse prompts) chars2 :: [Text] chars2 = ["l", "o", "n", "g", "-", "i", "t", "e", "m"] items2 :: [Text] items2 = [ "long", "short", "long-item", "longitem" ] itemsTarget :: [MenuItem Text] itemsTarget = [simpleMenuItem "name" "long-item"] test_pureMenuFilter :: UnitTest test_pureMenuFilter = do items <- liftIO (fst <$> promptTest items2 chars2) [itemsTarget] === (view FilteredMenuItem.item <$$> take 1 items) chars3 :: [Text] chars3 = ["i", "esc", "cr"] items3 :: [Text] items3 = [ "item1", "item2" ] exec :: MonadIO m => MVar [Text] -> Menu Text -> Prompt -> m (MenuConsumerAction m a, Menu Text) exec var m@(Menu _ items _ _ _ _) _ = swapMVar var (view (FilteredMenuItem.item . MenuItem.text) <$> items) *> menuQuit m test_pureMenuExecute :: UnitTest test_pureMenuExecute = do var <- newMVar [] _ <- liftIO (menuTest (simpleMenu (Map.fromList [("cr", exec var)])) items3 chars3) (items3 ===) =<< readMVar var charsMulti :: [Text] charsMulti = ["esc", "k", "k", "space", "space", "space", "space", "j", "space", "cr"] itemsMulti :: [Text] itemsMulti = [ "item1", "item2", "item3", "item4", "item5", "item6" ] execMulti :: MonadIO m => MVar (Maybe (NonEmpty Text)) -> Menu Text -> Prompt -> m (MenuConsumerAction m a, Menu Text) execMulti var m _ = swapMVar var (MenuItem._text <$$> markedMenuItems m) *> menuQuit m test_menuMultiMark :: UnitTest test_menuMultiMark = do var <- newMVar Nothing _ <- liftIO (menuTest (defaultMenu (Map.fromList [("cr", execMulti var)])) itemsMulti charsMulti) (Just ("item3" :| ["item4", "item5"]) ===) =<< readMVar var charsToggle :: [Text] charsToggle = ["esc", "k", "space", "*", "i", "a", "b", "cr"] itemsToggle :: [Text] itemsToggle = [ "a", "ab", "abc" ] execToggle :: MonadIO m => MVar (Maybe (NonEmpty Text)) -> Menu Text -> Prompt -> m (MenuConsumerAction m a, Menu Text) execToggle var m _ = swapMVar var (MenuItem._text <$$> markedMenuItemsOnly m) *> menuQuit m test_menuToggle :: UnitTest test_menuToggle = do var <- newMVar Nothing _ <- liftIO (menuTest (defaultMenu (Map.fromList [("cr", execToggle var)])) itemsToggle charsToggle) (Nothing ===) =<< readMVar var charsExecuteThunk :: [Text] charsExecuteThunk = ["esc", "cr", "k", "cr", "esc"] itemsExecuteThunk :: [Text] itemsExecuteThunk = [ "a", "b" ] execExecuteThunk :: MonadIO m => MonadBaseControl IO m => MVar [Text] -> Menu Text -> Prompt -> m (MenuConsumerAction m a, Menu Text) execExecuteThunk var m _ = menuExecute (modifyMVar_ var prepend) m where prepend a = pure $ a ++ maybeToList (MenuItem._text <$> selectedMenuItem m) test_menuExecuteThunk :: UnitTest test_menuExecuteThunk = do var <- newMVar [] _ <- liftIO (menuTest (defaultMenu (Map.fromList [("cr", execExecuteThunk var)])) itemsExecuteThunk charsExecuteThunk) (["a", "b"] ===) =<< readMVar var test_menuDeleteByFilteredIndex :: UnitTest test_menuDeleteByFilteredIndex = (target ===) . fmap (view MenuItem.text) . view Menu.items . deleteByFilteredIndex [1, 2] $ menu where target = ["1", "2", "3", "5", "7", "8"] menu = Menu items filtered 0 [] (MenuFilter "") Nothing items = simpleMenuItem () <$> ["1", "2", "3", "4", "5", "6", "7", "8"] filtered = uncurry FilteredMenuItem . second menuItem <$> [(1, "2"), (3, "4"), (5, "6"), (7, "8")] menuItem t = MenuItem () t t test_menu :: TestTree test_menu = testGroup "menu" [ unitTest "change mode" test_pureMenuModeChange, unitTest "filter items" test_pureMenuFilter, unitTest "execute an action" test_pureMenuExecute, unitTest "mark multiple items" test_menuMultiMark, unitTest "toggle marked items" test_menuToggle, unitTest "execute a thunk action" test_menuExecuteThunk, unitTest "delete by filtered index" test_menuDeleteByFilteredIndex ]