Merge pull request #26 from basile-henry/multi-line

Add multi-line input support

ChangeLog.md

@@ -1,6 +1,9 @@
 HEAD
 ====
 
+- Add multi-line input support
+- Add finaliser option to control REPL exit on <Ctrl-D>
+
 0.3.0.0
 =======
 

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

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 ()

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 ()

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 ()

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 <Ctrl-D> 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 <Ctrl-D> )
   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,13 +284,25 @@ 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 <Ctrl-D> to finish."
+                  loopMultiLine []
               (cmd : args) -> do
                 let optAction = optMatcher cmd opts args
                 result <- H.handleInterrupt (return Nothing) $ Just <$> optAction
                 maybe exit (const loop) result
         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,23 +365,25 @@ 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
   HaskelineT m a ->
   -- | 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,