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