module UI.Butcher.Monadic.Interactive
( simpleCompletion
, shellCompletionWords
, interactiveHelpDoc
, partDescStrings
)
where
#include "prelude.inc"
import qualified Text.PrettyPrint as PP
import UI.Butcher.Monadic.Internal.Types
import UI.Butcher.Monadic.Internal.Core
import UI.Butcher.Monadic.Pretty
simpleCompletion
:: String
-> CommandDesc ()
-> String
-> String
simpleCompletion :: String -> CommandDesc () -> String -> String
simpleCompletion line :: String
line cdesc :: CommandDesc ()
cdesc pcRest :: String
pcRest = case String -> String
forall a. [a] -> [a]
reverse String
line of
[] -> String
compl
' ' : _ -> String
compl
_ | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pcRest -> ""
_ -> String
compl
where
compl :: String
compl = Int -> String -> String
forall a. Int -> [a] -> [a]
List.drop (String -> Int
forall a. [a] -> Int
List.length String
lastWord) ([String] -> String
longestCommonPrefix [String]
choices)
longestCommonPrefix :: [String] -> String
longestCommonPrefix [] = ""
longestCommonPrefix (c1 :: String
c1 : cr :: [String]
cr) =
case (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\s :: String
s -> (String -> Bool) -> [String] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
List.all (String
s String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
cr) ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. [a] -> [[a]]
List.inits String
c1 of
Nothing -> ""
Just x :: String
x -> String
x
nameDesc :: CommandDesc ()
nameDesc = case CommandDesc () -> Maybe (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc ()
cdesc of
Nothing -> CommandDesc ()
cdesc
Just (_, parent :: CommandDesc ()
parent) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pcRest Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lastWord) -> CommandDesc ()
parent
Just{} -> CommandDesc ()
cdesc
lastWord :: String
lastWord = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
line
choices :: [String]
choices :: [String]
choices = [[String]] -> [String]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
[ [ String
r
| (Just r :: String
r, _) <- Deque (Maybe String, CommandDesc ())
-> [(Maybe String, CommandDesc ())]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (CommandDesc () -> Deque (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc ()
nameDesc)
, String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
r
, String
lastWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
r
]
, [ String
s
| String
s <- PartDesc -> [String]
partDescStrings (PartDesc -> [String]) -> [PartDesc] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CommandDesc () -> [PartDesc]
forall out. CommandDesc out -> [PartDesc]
_cmd_parts CommandDesc ()
nameDesc
, String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
, String
lastWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
s
]
]
shellCompletionWords
:: String
-> CommandDesc ()
-> String
-> [CompletionItem]
shellCompletionWords :: String -> CommandDesc () -> String -> [CompletionItem]
shellCompletionWords line :: String
line cdesc :: CommandDesc ()
cdesc pcRest :: String
pcRest = [CompletionItem]
choices
where
nameDesc :: CommandDesc ()
nameDesc = case CommandDesc () -> Maybe (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc ()
cdesc of
Nothing -> CommandDesc ()
cdesc
Just (_, parent :: CommandDesc ()
parent) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pcRest Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lastWord) -> CommandDesc ()
parent
Just{} -> CommandDesc ()
cdesc
lastWord :: String
lastWord = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
line
choices :: [CompletionItem]
choices :: [CompletionItem]
choices = [[CompletionItem]] -> [CompletionItem]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
[ [ String -> CompletionItem
CompletionString String
r
| (Just r :: String
r, _) <- Deque (Maybe String, CommandDesc ())
-> [(Maybe String, CommandDesc ())]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (CommandDesc () -> Deque (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc ()
nameDesc)
, String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
r
, String
lastWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
r
]
, [ CompletionItem
c
| CompletionItem
c <- PartDesc -> [CompletionItem]
partDescCompletions (PartDesc -> [CompletionItem]) -> [PartDesc] -> [CompletionItem]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CommandDesc () -> [PartDesc]
forall out. CommandDesc out -> [PartDesc]
_cmd_parts CommandDesc ()
cdesc
, case CompletionItem
c of
CompletionString s :: String
s -> String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s Bool -> Bool -> Bool
&& String
lastWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
s
_ -> Bool
True
]
]
interactiveHelpDoc
:: String
-> CommandDesc ()
-> String
-> Int
-> PP.Doc
interactiveHelpDoc :: String -> CommandDesc () -> String -> Int -> Doc
interactiveHelpDoc cmdline :: String
cmdline desc :: CommandDesc ()
desc pcRest :: String
pcRest maxLines :: Int
maxLines = if
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmdline -> Doc
helpStrShort
| String -> Char
forall a. [a] -> a
List.last String
cmdline Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' -> Doc
helpStrShort
| Bool
otherwise -> Doc
helpStr
where
helpStr :: Doc
helpStr = if [(String, String)] -> Int
forall a. [a] -> Int
List.length [(String, String)]
optionLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLines
then
[Doc] -> Doc
PP.fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (String -> Doc
PP.text "|") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text (String -> Doc)
-> ((String, String) -> String) -> (String, String) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> Doc) -> [(String, String)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
optionLines
else [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [(String, String)]
optionLines [(String, String)] -> ((String, String) -> Doc) -> [Doc]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
(s :: String
s, "") -> String -> Doc
PP.text String
s
(s :: String
s, h :: String
h ) -> String -> Doc
PP.text String
s Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
h
where
nameDesc :: CommandDesc ()
nameDesc = case CommandDesc () -> Maybe (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc ()
desc of
Nothing -> CommandDesc ()
desc
Just (_, parent :: CommandDesc ()
parent) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pcRest -> CommandDesc ()
parent
Just{} -> CommandDesc ()
desc
lastWord :: String
lastWord = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
cmdline
optionLines :: [(String, String)]
optionLines :: [(String, String)]
optionLines =
[[(String, String)]] -> [(String, String)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
[ [ (String
s, String
e)
| (Just s :: String
s, c :: CommandDesc ()
c) <- Deque (Maybe String, CommandDesc ())
-> [(Maybe String, CommandDesc ())]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (CommandDesc () -> Deque (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc ()
nameDesc)
, String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
, let e :: String
e = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
[ [ " ARGS" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PartDesc] -> Bool) -> [PartDesc] -> Bool
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> [PartDesc]
forall out. CommandDesc out -> [PartDesc]
_cmd_parts CommandDesc ()
c ]
, [ " CMDS" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Deque (Maybe String, CommandDesc ()) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Deque (Maybe String, CommandDesc ()) -> Bool)
-> Deque (Maybe String, CommandDesc ()) -> Bool
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> Deque (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc ()
c ]
, [ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show Doc
h | Just h :: Doc
h <- [CommandDesc () -> Maybe Doc
forall out. CommandDesc out -> Maybe Doc
_cmd_help CommandDesc ()
c] ]
]
]
, [ (String
s, "")
| String
s <- PartDesc -> [String]
partDescStrings (PartDesc -> [String]) -> [PartDesc] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CommandDesc () -> [PartDesc]
forall out. CommandDesc out -> [PartDesc]
_cmd_parts CommandDesc ()
nameDesc
, String
lastWord String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
]
]
helpStrShort :: Doc
helpStrShort = CommandDesc () -> Doc
forall a. CommandDesc a -> Doc
ppUsageWithHelp CommandDesc ()
desc
partDescStrings :: PartDesc -> [String]
partDescStrings :: PartDesc -> [String]
partDescStrings = \case
PartLiteral s :: String
s -> [String
s]
PartVariable _ -> []
PartOptional x :: PartDesc
x -> PartDesc -> [String]
partDescStrings PartDesc
x
PartAlts alts :: [PartDesc]
alts -> [PartDesc]
alts [PartDesc] -> (PartDesc -> [String]) -> [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [String]
partDescStrings
PartSeq [] -> []
PartSeq (x :: PartDesc
x:_) -> PartDesc -> [String]
partDescStrings PartDesc
x
PartDefault _ x :: PartDesc
x -> PartDesc -> [String]
partDescStrings PartDesc
x
PartSuggestion ss :: [CompletionItem]
ss x :: PartDesc
x -> [ String
s | CompletionString s :: String
s <- [CompletionItem]
ss ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ PartDesc -> [String]
partDescStrings PartDesc
x
PartRedirect _ x :: PartDesc
x -> PartDesc -> [String]
partDescStrings PartDesc
x
PartReorder xs :: [PartDesc]
xs -> [PartDesc]
xs [PartDesc] -> (PartDesc -> [String]) -> [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [String]
partDescStrings
PartMany x :: PartDesc
x -> PartDesc -> [String]
partDescStrings PartDesc
x
PartWithHelp _h :: Doc
_h x :: PartDesc
x -> PartDesc -> [String]
partDescStrings PartDesc
x
PartHidden{} -> []
partDescCompletions :: PartDesc -> [CompletionItem]
partDescCompletions :: PartDesc -> [CompletionItem]
partDescCompletions = \case
PartLiteral s :: String
s -> [String -> CompletionItem
CompletionString String
s]
PartVariable _ -> []
PartOptional x :: PartDesc
x -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartAlts alts :: [PartDesc]
alts -> [PartDesc]
alts [PartDesc] -> (PartDesc -> [CompletionItem]) -> [CompletionItem]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [CompletionItem]
partDescCompletions
PartSeq [] -> []
PartSeq (x :: PartDesc
x:_) -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartDefault _ x :: PartDesc
x -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartSuggestion ss :: [CompletionItem]
ss x :: PartDesc
x -> [CompletionItem]
ss [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. [a] -> [a] -> [a]
++ PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartRedirect _ x :: PartDesc
x -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartReorder xs :: [PartDesc]
xs -> [PartDesc]
xs [PartDesc] -> (PartDesc -> [CompletionItem]) -> [CompletionItem]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PartDesc -> [CompletionItem]
partDescCompletions
PartMany x :: PartDesc
x -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartWithHelp _h :: Doc
_h x :: PartDesc
x -> PartDesc -> [CompletionItem]
partDescCompletions PartDesc
x
PartHidden{} -> []