-- |
--
-- 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.
    Menu a -> NonEmpty a
_menuItems :: NonEmpty a,
    -- | Banner printed before menu.
    Menu a -> Maybe (Stylized Text)
_menuBanner :: Maybe (Stylized Text),
    -- | Stylize an item's index.
    Menu a -> Int -> Stylized Text
_menuItemPrefix :: Int -> Stylized Text,
    -- | Printed after an item's index.
    Menu a -> Stylized Text
_menuItemSuffix :: Stylized Text,
    -- | Printed before the prompt.
    Menu a -> Maybe (Stylized Text)
_menuBeforePrompt :: Maybe (Stylized Text),
    -- | 'FromChoice' function.
    Menu a -> FromChoice a
_menuItemFromChoiceFunc :: FromChoice a
  }

instance Foldable Menu where
  foldMap :: (a -> m) -> Menu a -> m
foldMap a -> m
f Menu {Maybe (Stylized Text)
NonEmpty a
Stylized Text
Int -> Stylized Text
FromChoice a
_menuItemFromChoiceFunc :: FromChoice a
_menuBeforePrompt :: Maybe (Stylized Text)
_menuItemSuffix :: Stylized Text
_menuItemPrefix :: Int -> Stylized Text
_menuBanner :: Maybe (Stylized Text)
_menuItems :: NonEmpty a
_menuItemFromChoiceFunc :: forall a. Menu a -> FromChoice a
_menuBeforePrompt :: forall a. Menu a -> Maybe (Stylized Text)
_menuItemSuffix :: forall a. Menu a -> Stylized Text
_menuItemPrefix :: forall a. Menu a -> Int -> Stylized Text
_menuBanner :: forall a. Menu a -> Maybe (Stylized Text)
_menuItems :: forall a. Menu a -> NonEmpty a
..} = (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f NonEmpty a
_menuItems
  toList :: Menu a -> [a]
toList Menu {Maybe (Stylized Text)
NonEmpty a
Stylized Text
Int -> Stylized Text
FromChoice a
_menuItemFromChoiceFunc :: FromChoice a
_menuBeforePrompt :: Maybe (Stylized Text)
_menuItemSuffix :: Stylized Text
_menuItemPrefix :: Int -> Stylized Text
_menuBanner :: Maybe (Stylized Text)
_menuItems :: NonEmpty a
_menuItemFromChoiceFunc :: forall a. Menu a -> FromChoice a
_menuBeforePrompt :: forall a. Menu a -> Maybe (Stylized Text)
_menuItemSuffix :: forall a. Menu a -> Stylized Text
_menuItemPrefix :: forall a. Menu a -> Int -> Stylized Text
_menuBanner :: forall a. Menu a -> Maybe (Stylized Text)
_menuItems :: forall a. Menu a -> NonEmpty a
..} = NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
_menuItems
  null :: Menu a -> Bool
null Menu a
_ = Bool
False
  length :: Menu a -> Int
length Menu {Maybe (Stylized Text)
NonEmpty a
Stylized Text
Int -> Stylized Text
FromChoice a
_menuItemFromChoiceFunc :: FromChoice a
_menuBeforePrompt :: Maybe (Stylized Text)
_menuItemSuffix :: Stylized Text
_menuItemPrefix :: Int -> Stylized Text
_menuBanner :: Maybe (Stylized Text)
_menuItems :: NonEmpty a
_menuItemFromChoiceFunc :: forall a. Menu a -> FromChoice a
_menuBeforePrompt :: forall a. Menu a -> Maybe (Stylized Text)
_menuItemSuffix :: forall a. Menu a -> Stylized Text
_menuItemPrefix :: forall a. Menu a -> Int -> Stylized Text
_menuBanner :: forall a. Menu a -> Maybe (Stylized Text)
_menuItems :: forall a. Menu a -> NonEmpty a
..} = NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
_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 (Int -> Choice a -> ShowS
[Choice a] -> ShowS
Choice a -> String
(Int -> Choice a -> ShowS)
-> (Choice a -> String) -> ([Choice a] -> ShowS) -> Show (Choice a)
forall a. Show a => Int -> Choice a -> ShowS
forall a. Show a => [Choice a] -> ShowS
forall a. Show a => Choice a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choice a] -> ShowS
$cshowList :: forall a. Show a => [Choice a] -> ShowS
show :: Choice a -> String
$cshow :: forall a. Show a => Choice a -> String
showsPrec :: Int -> Choice a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Choice a -> ShowS
Show, Choice a -> Choice a -> Bool
(Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool) -> Eq (Choice a)
forall a. Eq a => Choice a -> Choice a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choice a -> Choice a -> Bool
$c/= :: forall a. Eq a => Choice a -> Choice a -> Bool
== :: Choice a -> Choice a -> Bool
$c== :: forall a. Eq a => Choice a -> Choice a -> Bool
Eq, a -> Choice b -> Choice a
(a -> b) -> Choice a -> Choice b
(forall a b. (a -> b) -> Choice a -> Choice b)
-> (forall a b. a -> Choice b -> Choice a) -> Functor Choice
forall a b. a -> Choice b -> Choice a
forall a b. (a -> b) -> Choice a -> Choice b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Choice b -> Choice a
$c<$ :: forall a b. a -> Choice b -> Choice a
fmap :: (a -> b) -> Choice a -> Choice b
$cfmap :: forall a b. (a -> b) -> Choice a -> Choice b
Functor, Choice a -> Bool
(a -> m) -> Choice a -> m
(a -> b -> b) -> b -> Choice a -> b
(forall m. Monoid m => Choice m -> m)
-> (forall m a. Monoid m => (a -> m) -> Choice a -> m)
-> (forall m a. Monoid m => (a -> m) -> Choice a -> m)
-> (forall a b. (a -> b -> b) -> b -> Choice a -> b)
-> (forall a b. (a -> b -> b) -> b -> Choice a -> b)
-> (forall b a. (b -> a -> b) -> b -> Choice a -> b)
-> (forall b a. (b -> a -> b) -> b -> Choice a -> b)
-> (forall a. (a -> a -> a) -> Choice a -> a)
-> (forall a. (a -> a -> a) -> Choice a -> a)
-> (forall a. Choice a -> [a])
-> (forall a. Choice a -> Bool)
-> (forall a. Choice a -> Int)
-> (forall a. Eq a => a -> Choice a -> Bool)
-> (forall a. Ord a => Choice a -> a)
-> (forall a. Ord a => Choice a -> a)
-> (forall a. Num a => Choice a -> a)
-> (forall a. Num a => Choice a -> a)
-> Foldable Choice
forall a. Eq a => a -> Choice a -> Bool
forall a. Num a => Choice a -> a
forall a. Ord a => Choice a -> a
forall m. Monoid m => Choice m -> m
forall a. Choice a -> Bool
forall a. Choice a -> Int
forall a. Choice a -> [a]
forall a. (a -> a -> a) -> Choice a -> a
forall m a. Monoid m => (a -> m) -> Choice a -> m
forall b a. (b -> a -> b) -> b -> Choice a -> b
forall a b. (a -> b -> b) -> b -> Choice a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Choice a -> a
$cproduct :: forall a. Num a => Choice a -> a
sum :: Choice a -> a
$csum :: forall a. Num a => Choice a -> a
minimum :: Choice a -> a
$cminimum :: forall a. Ord a => Choice a -> a
maximum :: Choice a -> a
$cmaximum :: forall a. Ord a => Choice a -> a
elem :: a -> Choice a -> Bool
$celem :: forall a. Eq a => a -> Choice a -> Bool
length :: Choice a -> Int
$clength :: forall a. Choice a -> Int
null :: Choice a -> Bool
$cnull :: forall a. Choice a -> Bool
toList :: Choice a -> [a]
$ctoList :: forall a. Choice a -> [a]
foldl1 :: (a -> a -> a) -> Choice a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Choice a -> a
foldr1 :: (a -> a -> a) -> Choice a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Choice a -> a
foldl' :: (b -> a -> b) -> b -> Choice a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Choice a -> b
foldl :: (b -> a -> b) -> b -> Choice a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Choice a -> b
foldr' :: (a -> b -> b) -> b -> Choice a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Choice a -> b
foldr :: (a -> b -> b) -> b -> Choice a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Choice a -> b
foldMap' :: (a -> m) -> Choice a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Choice a -> m
foldMap :: (a -> m) -> Choice a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Choice a -> m
fold :: Choice m -> m
$cfold :: forall m. Monoid m => Choice m -> m
Foldable, Functor Choice
Foldable Choice
Functor Choice
-> Foldable Choice
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Choice a -> f (Choice b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Choice (f a) -> f (Choice a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Choice a -> m (Choice b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Choice (m a) -> m (Choice a))
-> Traversable Choice
(a -> f b) -> Choice a -> f (Choice b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Choice (m a) -> m (Choice a)
forall (f :: * -> *) a.
Applicative f =>
Choice (f a) -> f (Choice a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Choice a -> m (Choice b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Choice a -> f (Choice b)
sequence :: Choice (m a) -> m (Choice a)
$csequence :: forall (m :: * -> *) a. Monad m => Choice (m a) -> m (Choice a)
mapM :: (a -> m b) -> Choice a -> m (Choice b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Choice a -> m (Choice b)
sequenceA :: Choice (f a) -> f (Choice a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Choice (f a) -> f (Choice a)
traverse :: (a -> f b) -> Choice a -> f (Choice b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Choice a -> f (Choice b)
$cp2Traversable :: Foldable Choice
$cp1Traversable :: Functor Choice
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 :: Int -> Stylized Text
numbered = Text -> Stylized Text
text (Text -> Stylized Text) -> (Int -> Text) -> Int -> Stylized Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%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 :: Menu a -> Text -> [a]
matchOnPrefix Menu a
config Text
input =
  (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
prefixCheck (NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall a b. (a -> b) -> a -> b
$ Menu a -> NonEmpty a
forall a. Menu a -> NonEmpty a
_menuItems Menu a
config)
  where
    asText :: a -> Text
asText a
i = RenderMode -> Stylized Text -> Text
renderText RenderMode
Plain (a -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText a
i)
    prefixCheck :: a -> Bool
prefixCheck a
i = Text
input Text -> Text -> Bool
`Text.isPrefixOf` a -> Text
forall a. ToStylizedText a => a -> Text
asText a
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 :: FromChoice a
defaultFromChoice Menu a
config Map Text a
prefixes Text
input =
  case Maybe a
uniquePrefix Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Key (Map Text a) -> Map Text a -> Maybe (Val (Map Text a))
forall t. StaticMap t => Key t -> t -> Maybe (Val t)
lookup Text
Key (Map Text a)
cleanInput Map Text a
prefixes of
    Maybe a
Nothing -> Text -> Choice a
forall a. Text -> Choice a
Other Text
input
    Just a
match -> a -> Choice a
forall a. a -> Choice a
Match a
match
  where
    cleanInput :: Text
    cleanInput :: Text
cleanInput = Text -> Text
Text.strip Text
input
    uniquePrefix :: Maybe a
    uniquePrefix :: Maybe a
uniquePrefix =
      let matches :: [a]
matches = Menu a -> Text -> [a]
forall a. ToStylizedText a => Menu a -> Text -> [a]
matchOnPrefix Menu a
config Text
cleanInput
       in if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
matches Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
            then [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a]
matches
            else Maybe a
forall a. Maybe a
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 :: Menu a -> CompletionFunc m
defaultCompFunc Menu a
config (Text
left, Text
_) =
  (Text, [Completion]) -> m (Text, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", [a] -> [Completion]
completions [a]
matches)
  where
    -- All matching menu items.
    matches :: [a]
matches =
      if Text -> Bool
Text.null Text
left
        then NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Menu a -> NonEmpty a
forall a. Menu a -> NonEmpty a
_menuItems Menu a
config)
        else Menu a -> Text -> [a]
forall a. ToStylizedText a => Menu a -> Text -> [a]
matchOnPrefix Menu a
config Text
left
    -- Convert a menu item to a String.
    asText :: a -> Text
asText a
i = RenderMode -> Stylized Text -> Text
renderText RenderMode
Plain (a -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText a
i)
    -- Convert menu items into Completion values.
    completions :: [a] -> [Completion]
completions = (a -> Completion) -> [a] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (\a
i -> Text -> Text -> Bool -> Completion
Completion (a -> Text
forall a. ToStylizedText a => a -> Text
asText a
i) (a -> Text
forall a. ToStylizedText a => a -> Text
asText a
i) Bool
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 :: NonEmpty a -> Menu a
menu NonEmpty a
items =
  Menu :: forall a.
NonEmpty a
-> Maybe (Stylized Text)
-> (Int -> Stylized Text)
-> Stylized Text
-> Maybe (Stylized Text)
-> FromChoice a
-> Menu a
Menu
    { _menuItems :: NonEmpty a
_menuItems = NonEmpty a
items,
      _menuBanner :: Maybe (Stylized Text)
_menuBanner = Maybe (Stylized Text)
forall a. Maybe a
Nothing,
      _menuItemPrefix :: Int -> Stylized Text
_menuItemPrefix = Int -> Stylized Text
numbered,
      _menuItemSuffix :: Stylized Text
_menuItemSuffix = Text -> Stylized Text
text Text
") ",
      _menuBeforePrompt :: Maybe (Stylized Text)
_menuBeforePrompt = Maybe (Stylized Text)
forall a. Maybe a
Nothing,
      _menuItemFromChoiceFunc :: FromChoice a
_menuItemFromChoiceFunc = FromChoice a
forall a. ToStylizedText a => FromChoice a
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 -> Menu a -> Menu a
menuBanner b
b Menu a
m = Menu a
m {_menuBanner :: Maybe (Stylized Text)
_menuBanner = Stylized Text -> Maybe (Stylized Text)
forall a. a -> Maybe a
Just (b -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText b
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 :: (Int -> Stylized Text) -> Menu a -> Menu a
menuPrefix Int -> Stylized Text
f Menu a
m = Menu a
m {_menuItemPrefix :: Int -> Stylized Text
_menuItemPrefix = Int -> Stylized Text
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 :: Stylized Text -> Menu a -> Menu a
menuSuffix Stylized Text
s Menu a
m = Menu a
m {_menuItemSuffix :: Stylized Text
_menuItemSuffix = Stylized Text
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 :: FromChoice a -> Menu a -> Menu a
menuFromChoiceFunc FromChoice a
f Menu a
m = Menu a
m {_menuItemFromChoiceFunc :: FromChoice a
_menuItemFromChoiceFunc = FromChoice a
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 :: Menu a -> b -> m (Choice a)
askWithMenu Menu a
m b
prompt =
  CompletionFunc IO -> m ()
forall (m :: * -> *). MonadByline m => CompletionFunc IO -> m ()
pushCompletionFunction (Menu a -> CompletionFunc IO
forall (m :: * -> *) a.
(Applicative m, ToStylizedText a) =>
Menu a -> CompletionFunc m
defaultCompFunc Menu a
m)
    m () -> m (Choice a) -> m (Choice a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Choice a)
go
    m (Choice a) -> m () -> m (Choice a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). MonadByline m => m ()
popCompletionFunction
  where
    go :: m (Choice a)
go = do
      Map Text a
prefixes <- m (Map Text a)
displayMenu
      Text
answer <- b -> Maybe Text -> m Text
forall (m :: * -> *) a.
(MonadByline m, ToStylizedText a) =>
a -> Maybe Text -> m Text
askLn b
prompt (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
firstItem)
      Choice a -> m (Choice a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Menu a -> FromChoice a
forall a. Menu a -> FromChoice a
_menuItemFromChoiceFunc Menu a
m Menu a
m Map Text a
prefixes Text
answer)
    -- The default menu item.
    firstItem :: Text
firstItem = Text -> Text
Text.strip (RenderMode -> Stylized Text -> Text
renderText RenderMode
Plain (Menu a -> Int -> Stylized Text
forall a. Menu a -> Int -> Stylized Text
_menuItemPrefix Menu a
m Int
1))
    -- Print the entire menu.
    displayMenu :: m (Map Text a)
displayMenu = do
      m () -> (Stylized Text -> m ()) -> Maybe (Stylized Text) -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
forall (f :: * -> *). Applicative f => f ()
pass ((Stylized Text -> Stylized Text -> Stylized Text
forall a. Semigroup a => a -> a -> a
<> Text -> Stylized Text
text Text
"\n") (Stylized Text -> Stylized Text)
-> (Stylized Text -> m ()) -> Stylized Text -> m ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Stylized Text -> m ()
forall (m :: * -> *) a.
(MonadByline m, ToStylizedText a) =>
a -> m ()
sayLn) (Menu a -> Maybe (Stylized Text)
forall a. Menu a -> Maybe (Stylized Text)
_menuBanner Menu a
m)
      Map Text a
cache <- (Map Text a -> (Int, a) -> m (Map Text a))
-> Map Text a -> [(Int, a)] -> m (Map Text a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Map Text a -> (Int, a) -> m (Map Text a)
listItem Map Text a
forall a. Monoid a => a
mempty ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall a b. (a -> b) -> a -> b
$ Menu a -> NonEmpty a
forall a. Menu a -> NonEmpty a
_menuItems Menu a
m))
      Stylized Text -> m ()
forall (m :: * -> *) a.
(MonadByline m, ToStylizedText a) =>
a -> m ()
sayLn (Stylized Text
-> (Stylized Text -> Stylized Text)
-> Maybe (Stylized Text)
-> Stylized Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stylized Text
forall a. Monoid a => a
mempty (Text -> Stylized Text
text Text
"\n" Stylized Text -> Stylized Text -> Stylized Text
forall a. Semigroup a => a -> a -> a
<>) (Menu a -> Maybe (Stylized Text)
forall a. Menu a -> Maybe (Stylized Text)
_menuBeforePrompt Menu a
m))
      Map Text a -> m (Map Text a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text a
cache
    -- Print a menu item and cache its prefix in a Map.
    listItem :: Map Text a -> (Int, a) -> m (Map Text a)
listItem Map Text a
cache (Int
index, a
item) = do
      let bullet :: Stylized Text
bullet = Menu a -> Int -> Stylized Text
forall a. Menu a -> Int -> Stylized Text
_menuItemPrefix Menu a
m Int
index
          rendered :: Text
rendered = RenderMode -> Stylized Text -> Text
renderText RenderMode
Plain Stylized Text
bullet
      Stylized Text -> m ()
forall (m :: * -> *) a.
(MonadByline m, ToStylizedText a) =>
a -> m ()
sayLn (Stylized Text -> m ()) -> Stylized Text -> m ()
forall a b. (a -> b) -> a -> b
$
        [Stylized Text] -> Stylized Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text -> Stylized Text
text Text
"  ", -- Indent.
            Stylized Text
bullet, -- Unique identifier.
            Menu a -> Stylized Text
forall a. Menu a -> Stylized Text
_menuItemSuffix Menu a
m, -- Spacer or marker.
            a -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText a
item -- The item.
          ]
      Map Text a -> m (Map Text a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OneItem (Map Text a) -> Map Text a
forall x. One x => OneItem x -> x
one (Text -> Text
Text.strip Text
rendered, a
item) Map Text a -> Map Text a -> Map Text a
forall a. Semigroup a => a -> a -> a
<> Map Text a
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 :: Menu a -> b -> e -> m a
askWithMenuRepeatedly Menu a
m b
prompt e
errprompt = Menu a -> m a
go Menu a
m
  where
    go :: Menu a -> m a
go Menu a
config = do
      Choice a
answer <- Menu a -> b -> m (Choice a)
forall (m :: * -> *) a b.
(MonadByline m, ToStylizedText a, ToStylizedText b) =>
Menu a -> b -> m (Choice a)
askWithMenu Menu a
config b
prompt
      case Choice a
answer of
        Other Text
_ -> Menu a -> m a
go (Menu a
config {_menuBeforePrompt :: Maybe (Stylized Text)
_menuBeforePrompt = Stylized Text -> Maybe (Stylized Text)
forall a. a -> Maybe a
Just (e -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText e
errprompt)})
        Match a
x -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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.