diff --git a/ChangeLog.md b/ChangeLog.md index 612ba67..2f7e000 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,9 @@ HEAD ==== +- Add multi-line input support +- Add finaliser option to control REPL exit on + 0.3.0.0 ======= diff --git a/Example.hs b/Example.hs index cbff552..54b81b7 100644 --- a/Example.hs +++ b/Example.hs @@ -50,7 +50,7 @@ final1 = return Exit repl1 :: IO () repl1 = flip evalStateT Set.empty $ - evalRepl (pure "_proto> ") cmd1 opts1 (Just ':') (Word completer1) init1 final1 + evalRepl (const $ pure "_proto> ") cmd1 opts1 (Just ':') Nothing (Word completer1) init1 final1 ------------------------------------------------------------------------------- -- Command options @@ -84,7 +84,7 @@ final2 = do return Exit repl2 :: IO () -repl2 = evalRepl (pure "example2> ") cmd2 opts2 (Just ':') (Word comp2) init2 final2 +repl2 = evalRepl (const $ pure "example2> ") cmd2 opts2 (Just ':') Nothing (Word comp2) init2 final2 ------------------------------------------------------------------------------- -- Mixed Completion @@ -130,7 +130,7 @@ final3 :: Repl3 ExitDecision final3 = return Exit repl3 :: IO () -repl3 = evalRepl (pure "example3> ") cmd3 opts3 (Just ':') (Prefix (wordCompleter byWord) defaultMatcher) init3 final3 +repl3 = evalRepl (const $ pure "example3> ") cmd3 opts3 (Just ':') Nothing (Prefix (wordCompleter byWord) defaultMatcher) init3 final3 ------------------------------------------------------------------------------- -- diff --git a/examples/Prefix.hs b/examples/Prefix.hs index fcdef90..6b56149 100644 --- a/examples/Prefix.hs +++ b/examples/Prefix.hs @@ -55,7 +55,7 @@ final :: Repl ExitDecision final = return Exit repl :: IO () -repl = evalRepl (pure ">>> ") cmd opts Nothing (Prefix (wordCompleter byWord) defaultMatcher) inits final +repl = evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Prefix (wordCompleter byWord) defaultMatcher) inits final main :: IO () main = pure () diff --git a/examples/Simple.hs b/examples/Simple.hs index 42d9352..d9d4c42 100644 --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -42,17 +42,22 @@ final = do repl_alt :: IO () repl_alt = evalReplOpts $ ReplOpts - { banner = pure ">>> " - , command = cmd - , options = opts - , prefix = Just ':' - , tabComplete = (Word0 completer) - , initialiser = ini - , finaliser = final + { banner = const $ pure ">>> " + , command = cmd + , options = opts + , prefix = Just ':' + , multilineCommand = Just "paste" + , tabComplete = (Word0 completer) + , initialiser = ini + , finaliser = final } +customBanner :: MultiLine -> Repl String +customBanner SingleLine = pure ">>> " +customBanner MultiLine = pure "| " + repl :: IO () -repl = evalRepl (pure ">>> ") cmd opts (Just ':') (Word0 completer) ini final +repl = evalRepl (const $ pure ">>> ") cmd opts (Just ':') (Just "paste") (Word0 completer) ini final main :: IO () main = pure () diff --git a/examples/Stateful.hs b/examples/Stateful.hs index ff0fa55..0e59d57 100644 --- a/examples/Stateful.hs +++ b/examples/Stateful.hs @@ -50,7 +50,7 @@ final = return Exit repl :: IO () repl = flip evalStateT Set.empty $ - evalRepl (pure ">>> ") cmd opts Nothing (Word comp) ini final + evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Word comp) ini final main :: IO () main = pure () diff --git a/src/System/Console/Repline.hs b/src/System/Console/Repline.hs index 474a56b..48e823a 100644 --- a/src/System/Console/Repline.hs +++ b/src/System/Console/Repline.hs @@ -26,7 +26,9 @@ -- -- * Command prefix character: Optional command prefix ( passing Nothing ignores the Options argument ). -- --- * Banner: Text Displayed at initialisation. +-- * Multi-line command: Optional command name that switches to a multi-line input. (Press to exit and commit the multi-line input). Passing Nothing disables multi-line input support. +-- +-- * Banner: Text Displayed at initialisation. It takes an argument so it can take into account if the current line is part of a multi-line input. -- -- * Initialiser: Run at initialisation. -- @@ -69,7 +71,7 @@ -- > , ("say", say) -- :say -- > ] -- --- The banner function is simply an IO action that is called at the start of the shell. +-- The initialiser function is simply an IO action that is called at the start of the shell. -- -- > ini :: Repl () -- > ini = liftIO $ putStrLn "Welcome!" @@ -84,12 +86,13 @@ -- -- > main_alt :: IO () -- > main_alt = evalReplOpts $ ReplOpts --- > { banner = pure ">>> " --- > , command = cmd --- > , options = opts --- > , prefix = Just ':' --- > , tabComplete = (Word0 completer) --- > , initialiser = ini +-- > { banner = const (pure ">>> ") +-- > , command = cmd +-- > , options = opts +-- > , prefix = Just ':' +-- > , multilineCommand = Nothing +-- > , tabComplete = (Word0 completer) +-- > , initialiser = ini -- > } -- -- Putting this in a file we can test out our cow-trek shell. @@ -134,6 +137,7 @@ module System.Console.Repline CompleterStyle (..), Command, ExitDecision (..), + MultiLine (..), -- * Completers CompletionFunc, -- re-export @@ -249,21 +253,26 @@ abort = throwM H.Interrupt replLoop :: (Functor m, MonadMask m, MonadIO m) => -- | banner function - HaskelineT m String -> + (MultiLine -> HaskelineT m String) -> -- | command function Command (HaskelineT m) -> -- | options function Options (HaskelineT m) -> -- | options prefix Maybe Char -> + -- | multi-line command + Maybe String -> -- | Finaliser ( runs on ) HaskelineT m ExitDecision -> HaskelineT m () -replLoop banner cmdM opts optsPrefix finalz = loop +replLoop banner cmdM opts optsPrefix multiCommand finalz = loop where loop = do - prefix <- banner + prefix <- banner SingleLine minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix + handleCommands minput + + handleCommands minput = case minput of Nothing -> finalz >>= \case @@ -275,6 +284,10 @@ replLoop banner cmdM opts optsPrefix finalz = loop | Just prefix_ == optsPrefix -> case words cmds of [] -> loop + (cmd : _args) + | Just cmd == multiCommand -> do + outputStrLn "-- Entering multi-line mode. Press to finish." + loopMultiLine [] (cmd : args) -> do let optAction = optMatcher cmd opts args result <- H.handleInterrupt (return Nothing) $ Just <$> optAction @@ -282,6 +295,14 @@ replLoop banner cmdM opts optsPrefix finalz = loop Just input -> do handleInput input loop + + loopMultiLine prevs = do + prefix <- banner MultiLine + minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix + case minput of + Nothing -> handleCommands . Just . unlines $ reverse prevs + Just x -> loopMultiLine $ x : prevs + handleInput input = H.handleInterrupt exit $ cmdM input exit = return () @@ -301,17 +322,22 @@ data ExitDecision = Continue -- ^ Keep the REPL open | Exit -- ^ Close the REPL and exit +-- | Context for the current line if it is part of a multi-line input or not +data MultiLine = MultiLine | SingleLine deriving (Eq, Show) + -- | REPL Options datatype data ReplOpts m = ReplOpts { -- | Banner - banner :: HaskelineT m String, + banner :: MultiLine -> HaskelineT m String, -- | Command function command :: Command (HaskelineT m), -- | Options list and commands options :: Options (HaskelineT m), -- | Optional command prefix ( passing Nothing ignores the Options argument ) prefix :: Maybe Char, + -- | Optional multi-line command ( passing Nothing disables multi-line support ) + multilineCommand :: Maybe String, -- | Tab completion function tabComplete :: CompleterStyle m, -- | Initialiser @@ -329,6 +355,7 @@ evalReplOpts ReplOpts {..} = command options prefix + multilineCommand tabComplete initialiser finaliser @@ -338,13 +365,15 @@ evalRepl :: (MonadMask m, MonadIO m) => -- Terminal monad ( often IO ). -- | Banner - HaskelineT m String -> + (MultiLine -> HaskelineT m String) -> -- | Command function Command (HaskelineT m) -> -- | Options list and commands Options (HaskelineT m) -> -- | Optional command prefix ( passing Nothing ignores the Options argument ) Maybe Char -> + -- | Optional multi-line command ( passing Nothing disables multi-line support ) + Maybe String -> -- | Tab completion function CompleterStyle m -> -- | Initialiser @@ -352,9 +381,9 @@ evalRepl :: -- | Finaliser ( runs on Ctrl-D ) HaskelineT m ExitDecision -> m () -evalRepl banner cmd opts optsPrefix comp initz finalz = runHaskelineT _readline (initz >> monad) +evalRepl banner cmd opts optsPrefix multiCommand comp initz finalz = runHaskelineT _readline (initz >> monad) where - monad = replLoop banner cmd opts optsPrefix finalz + monad = replLoop banner cmd opts optsPrefix multiCommand finalz _readline = H.Settings { H.complete = mkCompleter comp,