-- | 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 :: 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 -> "" -- 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".
  _               -> 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
        -- 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 :: 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
      ]
    ]


-- | 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 :: 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
        -- 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 :: 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
      ]
    ]


-- | 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 :: 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 = -- a list of potential words that make sense, given
                    -- the current input.
                  [[(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


-- | 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 -> [String]
partDescStrings = \case
  PartLiteral  s :: String
s      -> [String
s]
  PartVariable _      -> []
  -- TODO: we could handle seq of optional and such much better
  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 -- 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  s :: String
s      -> [String -> CompletionItem
CompletionString String
s]
  PartVariable _      -> []
  -- TODO: we could handle seq of optional and such much better
  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 -- TODO: handle help
  PartHidden{}        -> []