-- | -- -- Copyright: -- This file is part of the package byline. It is subject to the -- license terms in the LICENSE file found in the top-level -- directory of this distribution and at: -- -- https://github.com/pjones/byline -- -- No part of this package, including this file, may be copied, -- modified, propagated, or distributed except according to the -- terms contained in the LICENSE file. -- -- License: BSD-2-Clause module Byline.Menu ( -- * Menus with Tab Completion -- $usage -- * Building a Menu Menu, menu, menuBanner, menuPrefix, menuSuffix, FromChoice, menuFromChoiceFunc, -- * Prompting with a Menu askWithMenu, askWithMenuRepeatedly, Choice (..), -- * Re-exports module Byline, ) where import Byline import Byline.Completion import Byline.Internal.Stylized (RenderMode (..), renderText) import qualified Data.Text as Text import Relude.Extra.Map import Text.Printf (printf) -- | Opaque type representing a menu containing items of type @a@. -- -- @since 1.0.0.0 data Menu a = Menu { -- | Menu items. _menuItems :: NonEmpty a, -- | Banner printed before menu. _menuBanner :: Maybe (Stylized Text), -- | Stylize an item's index. _menuItemPrefix :: Int -> Stylized Text, -- | Printed after an item's index. _menuItemSuffix :: Stylized Text, -- | Printed before the prompt. _menuBeforePrompt :: Maybe (Stylized Text), -- | 'FromChoice' function. _menuItemFromChoiceFunc :: FromChoice a } instance Foldable Menu where foldMap f Menu {..} = foldMap f _menuItems toList Menu {..} = toList _menuItems null _ = False length Menu {..} = length _menuItems -- | A type representing the choice made by a user while working with -- a menu. -- -- @since 1.0.0.0 data Choice a = -- | User picked a menu item. Match a | -- | User entered text that doesn't match an item. Other Text deriving (Show, Eq, Functor, Foldable, Traversable) -- | A function that is given the input from a user while working in a -- menu and should translate that into a 'Choice'. -- -- The @Map@ contains the menu item indexes/prefixes (numbers or -- letters) and the items themselves. -- -- The default 'FromChoice' function allows the user to select a menu -- item by typing its index or part of its textual representation. As -- long as input from the user is a unique prefix of one of the menu -- items then that item will be returned. -- -- @since 1.0.0.0 type FromChoice a = Menu a -> Map Text a -> Text -> Choice a -- | Default prefix generator. Creates numbers aligned for two-digit -- prefixes. -- -- @since 1.0.0.0 numbered :: Int -> Stylized Text numbered = text . Text.pack . printf "%2d" -- | Helper function to produce a list of menu items matching the -- given user input. -- -- @since 1.0.0.0 matchOnPrefix :: ToStylizedText a => Menu a -> Text -> [a] matchOnPrefix config input = filter prefixCheck (toList $ _menuItems config) where asText i = renderText Plain (toStylizedText i) prefixCheck i = input `Text.isPrefixOf` asText i -- | Default 'FromChoice' function. Checks to see if the user has input -- a unique prefix for a menu item (matches the item text) or selected -- one of the generated item prefixes (such as those generated by the -- internal @numbered@ function). -- -- @since 1.0.0.0 defaultFromChoice :: forall a. ToStylizedText a => FromChoice a defaultFromChoice config prefixes input = case uniquePrefix <|> lookup cleanInput prefixes of Nothing -> Other input Just match -> Match match where cleanInput :: Text cleanInput = Text.strip input uniquePrefix :: Maybe a uniquePrefix = let matches = matchOnPrefix config cleanInput in if length matches == 1 then listToMaybe matches else Nothing -- | Default completion function. Matches all of the menu items. -- -- @since 1.0.0.0 defaultCompFunc :: (Applicative m, ToStylizedText a) => Menu a -> CompletionFunc m defaultCompFunc config (left, _) = pure ("", completions matches) where -- All matching menu items. matches = if Text.null left then toList (_menuItems config) else matchOnPrefix config left -- Convert a menu item to a String. asText i = renderText Plain (toStylizedText i) -- Convert menu items into Completion values. completions = map (\i -> Completion (asText i) (asText i) True) -- | Create a 'Menu' by giving a list of menu items and a function -- that can convert those items into stylized text. -- -- @since 1.0.0.0 menu :: ToStylizedText a => NonEmpty a -> Menu a menu items = Menu { _menuItems = items, _menuBanner = Nothing, _menuItemPrefix = numbered, _menuItemSuffix = text ") ", _menuBeforePrompt = Nothing, _menuItemFromChoiceFunc = defaultFromChoice } -- | Change the banner of a menu. The banner is printed just before -- the menu items are displayed. -- -- @since 1.0.0.0 menuBanner :: ToStylizedText b => b -> Menu a -> Menu a menuBanner b m = m {_menuBanner = Just (toStylizedText b)} -- | Change the prefix function. The prefix function should generate -- unique, stylized text that the user can use to select a menu item. -- The default prefix function numbers the menu items starting with 1. -- -- @since 1.0.0.0 menuPrefix :: (Int -> Stylized Text) -> Menu a -> Menu a menuPrefix f m = m {_menuItemPrefix = f} -- | Change the menu item suffix. It is displayed directly after the -- menu item prefix and just before the menu item itself. -- -- Default: @") "@ -- -- @since 1.0.0.0 menuSuffix :: Stylized Text -> Menu a -> Menu a menuSuffix s m = m {_menuItemSuffix = s} -- | Change the 'FromChoice' function. The function should -- compare the user's input to the menu items and their assigned -- prefix values and return a 'Choice'. -- -- @since 1.0.0.0 menuFromChoiceFunc :: FromChoice a -> Menu a -> Menu a menuFromChoiceFunc f m = m {_menuItemFromChoiceFunc = f} -- | Ask the user to choose an item from a menu. The menu will only -- be shown once and the user's choice will be returned in a 'Choice' -- value. -- -- If you want to force the user to only choose from the displayed -- menu items you should use 'askWithMenuRepeatedly' instead. -- -- @since 1.0.0.0 askWithMenu :: (MonadByline m, ToStylizedText a, ToStylizedText b) => -- | The 'Menu' to display. Menu a -> -- | The prompt. b -> -- | The 'Choice' the user selected. m (Choice a) askWithMenu m prompt = pushCompletionFunction (defaultCompFunc m) *> go <* popCompletionFunction where go = do prefixes <- displayMenu answer <- askLn prompt (Just firstItem) pure (_menuItemFromChoiceFunc m m prefixes answer) -- The default menu item. firstItem = Text.strip (renderText Plain (_menuItemPrefix m 1)) -- Print the entire menu. displayMenu = do maybe pass ((<> "\n") >>> sayLn) (_menuBanner m) cache <- foldlM listItem mempty (zip [1 ..] (toList $ _menuItems m)) sayLn (maybe mempty ("\n" <>) (_menuBeforePrompt m)) pure cache -- Print a menu item and cache its prefix in a Map. listItem cache (index, item) = do let bullet = _menuItemPrefix m index rendered = renderText Plain bullet sayLn $ mconcat [ text " ", -- Indent. bullet, -- Unique identifier. _menuItemSuffix m, -- Spacer or marker. toStylizedText item -- The item. ] pure (one (Text.strip rendered, item) <> cache) -- | Like 'askWithMenu' except that arbitrary input is not allowed. -- If the user doesn't correctly select a menu item then the menu will -- be repeated and an error message will be displayed. -- -- @since 1.0.0.0 askWithMenuRepeatedly :: (MonadByline m, ToStylizedText a, ToStylizedText b, ToStylizedText e) => -- | The 'Menu' to display. Menu a -> -- | The prompt. b -> -- | Error message when the user tried to select a non-menu item. e -> -- | The 'Choice' the user selected. m a askWithMenuRepeatedly m prompt errprompt = go m where go config = do answer <- askWithMenu config prompt case answer of Other _ -> go (config {_menuBeforePrompt = Just (toStylizedText errprompt)}) Match x -> pure x -- $usage -- -- Menus are used to provide the user with a choice of acceptable -- values. Each choice is labeled to make it easier for a user to -- select it, or the user may enter text that does not correspond to -- any of the menus items. -- -- For an example see the @menu.hs@ file in the @examples@ directory.