-- | Utilities when writing interactive programs that interpret commands,
-- e.g. a REPL.
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



-- | Derives a potential completion from a given input string and a given
-- 'CommandDesc'. Considers potential subcommands and where available the
-- completion info present in 'PartDesc's.
simpleCompletion
  :: String         -- ^ input string
  -> CommandDesc () -- ^ CommandDesc obtained on that input string
  -> String         -- ^ "remaining" input after the last successfully parsed
                    -- subcommand. See 'UI.Butcher.Monadic.runCmdParserExt'.
  -> String         -- ^ completion, i.e. a string that might be appended
                    -- to the current prompt when user presses tab.
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]
"" -- necessary to prevent subcommand completion
                        -- appearing before space that is, if you have command
                        -- "aaa" with subcommand "sss", we want completion
                        -- "sss" on "aaa " but not on "aaa".
  [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
        -- not finished writing a command. if we have commands abc and abcdef,
        -- we may want "def" as a completion after "abc".
    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
      ]
    ]


-- | Derives a list of completion items from a given input string and a given
-- 'CommandDesc'. Considers potential subcommands and where available the
-- completion info present in 'PartDesc's.
--
-- See 'addShellCompletion' which uses this.
shellCompletionWords
  :: String         -- ^ input string
  -> CommandDesc () -- ^ CommandDesc obtained on that input string
  -> String         -- ^ "remaining" input after the last successfully parsed
                    -- subcommand. See 'UI.Butcher.Monadic.runCmdParserExt'.
  -> [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
        -- not finished writing a command. if we have commands abc and abcdef,
        -- we may want "def" as a completion after "abc".
    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
      ]
    ]


-- | Produces a 'PP.Doc' as a hint for the user during interactive command
-- input. Takes the current (incomplete) prompt line into account. For example
-- when you have commands (among others) \'config set-email\' and
-- \'config get-email\', then on empty prompt there will be an item \'config\';
-- on the partial prompt \'config \' the help doc will contain the
-- \'set-email\' and \'get-email\' items.
interactiveHelpDoc
  :: String         -- ^ input string
  -> CommandDesc () -- ^ CommandDesc obtained on that input string
  -> String         -- ^ "remaining" input after the last successfully parsed
                    -- subcommand. See 'UI.Butcher.Monadic.runCmdParserExt'.
  -> Int            -- ^ max length of help text
  -> 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 = -- a list of potential words that make sense, given
                    -- the current input.
                  [[([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


-- | Obtains a list of "expected"/potential strings for a command part
-- described in the 'PartDesc'. In constrast to the 'simpleCompletion'
-- function this function does not take into account any current input, and
-- consequently the output elements can in general not be appended to partial
-- input to form valid input.
partDescStrings :: PartDesc -> [String]
partDescStrings :: PartDesc -> [[Char]]
partDescStrings = \case
  PartLiteral  [Char]
s      -> [[Char]
s]
  PartVariable [Char]
_      -> []
  -- TODO: we could handle seq of optional and such much better
  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 -- TODO: handle help
  PartHidden{}        -> []


-- | Obtains a list of "expected"/potential strings for a command part
-- described in the 'PartDesc'. In constrast to the 'simpleCompletion'
-- function this function does not take into account any current input, and
-- consequently the output elements can in general not be appended to partial
-- input to form valid input.
partDescCompletions :: PartDesc -> [CompletionItem]
partDescCompletions :: PartDesc -> [CompletionItem]
partDescCompletions = \case
  PartLiteral  [Char]
s      -> [[Char] -> CompletionItem
CompletionString [Char]
s]
  PartVariable [Char]
_      -> []
  -- TODO: we could handle seq of optional and such much better
  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 -- TODO: handle help
  PartHidden{}        -> []