-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | A GHCi widget library for use in reflex applications
--
-- Run GHCi from within a Reflex FRP (https://reflex-frp.org)
-- application and interact with it using a functional reactive
-- interface.
--
@package reflex-ghci
@version 0.2.0.1
-- |
-- - Module: Reflex.Process.Repl
-- - Description: Run repl-like processes in a reflex application.
--
module Reflex.Process.Repl
-- | Output of a repl session
data Repl t
Repl :: Process t ByteString ByteString -> Event t (Map Int Cmd) -> Dynamic t (Int, Maybe Cmd) -> Event t ExitCode -> Repl t
-- | The underlying repl process, which can be used to access the process
-- handle, the raw output, and so on.
[_repl_process] :: Repl t -> Process t ByteString ByteString
-- | An event of commands that the repl has finished executing and their
-- associated output. The Int here represents the order in which
-- commands were submitted to the repl.
[_repl_finished] :: Repl t -> Event t (Map Int Cmd)
-- | A dynamic of the currently running command, if any, and its output.
-- The Int here represents the ordering of this command relative
-- to the ones in _repl_finished.
[_repl_started] :: Repl t -> Dynamic t (Int, Maybe Cmd)
-- | An event that fires when the repl exits
[_repl_exited] :: Repl t -> Event t ExitCode
-- | An individual command submitted to the repl, and its output
data Cmd
Cmd :: Command -> Lines -> Lines -> Cmd
[_cmd_stdin] :: Cmd -> Command
[_cmd_stdout] :: Cmd -> Lines
[_cmd_stderr] :: Cmd -> Lines
-- | An accumulator used to track and combine the repl's output streams
data Accum
Accum :: (Map Int Lines, Int, Lines) -> (Map Int Lines, Int, Lines) -> Accum
[_accum_stdout] :: Accum -> (Map Int Lines, Int, Lines)
[_accum_stderr] :: Accum -> (Map Int Lines, Int, Lines)
-- | Accumulate a handle, grouping its output by prompts
accumHandle :: (Int -> ByteString -> Bool) -> ByteString -> (Map Int Lines, Int, Lines) -> (Map Int Lines, Int, Lines)
-- | Accumulate the output of stdout and stderr, grouping the output lines
-- of both by prompt
accumHandles :: (Int -> ByteString -> Bool) -> These ByteString ByteString -> Accum -> Accum
-- | Take all the pending output and consider it complete.
flushAccum :: Accum -> Accum
-- | Run a repl, feed it commands, and produce output grouped by those
-- commands. The repl in question must be able to print its prompt on
-- both stdout and stderr.
repl :: forall t m. (Adjustable t m, MonadFix m, MonadHold t m, MonadIO (Performable m), MonadIO m, NotReady t m, PerformEvent t m, PostBuild t m, TriggerEvent t m) => CreateProcess -> Event t [Command] -> (Int -> ByteString -> Bool) -> m (Repl t)
-- | Accumulator for line-based output that keeps track of any dangling,
-- unterminated line
data Lines
Lines :: Seq ByteString -> Maybe ByteString -> Lines
[_lines_terminated] :: Lines -> Seq ByteString
[_lines_unterminated] :: Lines -> Maybe ByteString
-- | Empty output
emptyLines :: Lines
-- | Add some raw output to a Lines. This will chop the raw output
-- up into lines.
addLines :: ByteString -> Lines -> Lines
-- | Convert a ByteString into a Lines
linesFromBS :: ByteString -> Lines
-- | Convert a Lines back into a ByteString
unLines :: Lines -> ByteString
-- | Convenience accessor for the last whole line received by a
-- Lines. Ignores any unterminated line that may follow.
lastWholeLine :: Lines -> Maybe ByteString
-- | Split lines into two. The sequence that satisfies the predicate is
-- consumed and will not appear in either resulting Lines.
splitLinesOn :: (ByteString -> Bool) -> Lines -> Maybe (Lines, Lines)
-- | A string that will be sent to the repl for evaluation. A newline will
-- be appended to the end of the string. Commands should not
-- themselves contain newlines.
data Command
-- | Constructs a Command without checking for newlines. If there
-- are newlines in the input, things will not work properly.
unsafeCommand :: ByteString -> Command
-- | Convert a ByteString into a set of Commands. Any
-- newlines found in the input are considered Command separators.
command :: ByteString -> [Command]
-- | Convert a ByteString into a set of Commands. Any
-- newlines found in the input are considered Command separators.
commands :: [ByteString] -> [Command]
-- | Turn a command back into a ByteString.
displayCommand :: Command -> ByteString
-- | Convert commands to a format that can be sent over stdin
sendCommands :: [Command] -> Maybe (SendPipe ByteString)
-- | A headless repl test that runs ghci, executes some commands, and
-- checks that the output is as expected.
testRepl :: IO ()
-- | Constructs some testing commands that are fed in on a timer
mkTestCommands :: (PerformEvent t m, PostBuild t m, TriggerEvent t m, MonadIO (Performable m)) => m (Event t [Command])
-- | Check that stdout equals the given value
assertStdoutEq :: MonadIO m => String -> Maybe Cmd -> ByteString -> m Bool
-- | Check that stderr equals the given value
assertStderrEq :: MonadIO m => String -> Maybe Cmd -> ByteString -> m Bool
-- | Test the contents of stderr
assertStderr :: MonadIO m => String -> Maybe Cmd -> (Lines -> Bool) -> m Bool
-- | Test the contents of stdout
assertStdout :: MonadIO m => String -> Maybe Cmd -> (Lines -> Bool) -> m Bool
-- | Check that a handle equals the given value
assertHandleEq :: MonadIO m => (Cmd -> Lines) -> String -> Maybe Cmd -> ByteString -> m Bool
-- | Test the contents of a handle
assertHandle :: MonadIO m => (Cmd -> Lines) -> String -> Maybe Cmd -> (Lines -> Bool) -> m Bool
-- | Test that a repl command and its output satisfy the predicate
assertCmd :: MonadIO m => String -> Maybe Cmd -> (Cmd -> Bool) -> m Bool
instance GHC.Read.Read Reflex.Process.Repl.Lines
instance GHC.Classes.Ord Reflex.Process.Repl.Lines
instance GHC.Classes.Eq Reflex.Process.Repl.Lines
instance GHC.Show.Show Reflex.Process.Repl.Lines
instance GHC.Classes.Ord Reflex.Process.Repl.Command
instance GHC.Classes.Eq Reflex.Process.Repl.Command
instance GHC.Read.Read Reflex.Process.Repl.Command
instance GHC.Show.Show Reflex.Process.Repl.Command
instance GHC.Show.Show Reflex.Process.Repl.Cmd
instance GHC.Classes.Ord Reflex.Process.Repl.Cmd
instance GHC.Classes.Eq Reflex.Process.Repl.Cmd
instance GHC.Base.Semigroup Reflex.Process.Repl.Lines
instance GHC.Base.Monoid Reflex.Process.Repl.Lines
-- |
-- - Module: Reflex.Process.GHCi
-- - Description: Run GHCi processes in a reflex application
--
module Reflex.Process.GHCi
-- | Runs a GHCi process and reloads it whenever the provided event fires
ghci :: (Adjustable t m, MonadFix m, MonadHold t m, MonadIO (Performable m), MonadIO m, NotReady t m, PerformEvent t m, PostBuild t m, TriggerEvent t m) => CreateProcess -> Event t [Command] -> Event t () -> Event t () -> m (Repl t)
-- | Run a GHCi process that watches for changes to Haskell source files in
-- the current directory and reloads if they are modified
ghciWatch :: (TriggerEvent t m, PerformEvent t m, MonadIO (Performable m), PostBuild t m, MonadIO m, MonadFix m, MonadHold t m, Adjustable t m, NotReady t m) => CreateProcess -> Maybe Command -> Event t () -> Event t () -> m (Repl t)
-- | Detect errors reported in stdout or stderr
hasErrors :: Cmd -> Bool
-- |
-- - Module: Reflex.Vty.GHCi
-- - Description: Vty widgets useful when building your own GHCi
-- runner
--
module Reflex.Vty.GHCi
-- | The main reflex-ghci widget
run :: String -> Maybe String -> IO ()