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