{-|
 - Module: Reflex.Vty.GHCi
 - Description: Vty widgets useful when building your own GHCi runner
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module Reflex.Vty.GHCi where

import Control.Monad ((<=<), void)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.ByteString (ByteString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Reflex.Network
import Reflex.Process
import Reflex.Process.GHCi
import Reflex.Vty
import qualified Graphics.Vty.Input as V
import qualified System.Process as P

-- | Display the overall status of the GHCi session, including exit information in case GHCi has quit
statusDisplay
  :: ( PostBuild t m
     , MonadHold t m
     , HasDisplayRegion t m
     , HasImageWriter t m
     , HasTheme t m
     )
  => Ghci t
  -> m ()
statusDisplay :: Ghci t -> m ()
statusDisplay Ghci t
g = do
  Event t ()
pb <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  Behavior t Text -> m ()
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text (Behavior t Text -> m ())
-> (Event t Text -> m (Behavior t Text)) -> Event t Text -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
"" (Event t Text -> m ()) -> Event t Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Status -> Text
forall a. IsString a => Status -> a
statusMessage (Status -> Text) -> Event t Status -> Event t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Status -> Event t Status
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated (Ghci t -> Dynamic t Status
forall t. Ghci t -> Dynamic t Status
_ghci_status Ghci t
g)
    , Status -> Text
forall a. IsString a => Status -> a
statusMessage (Status -> Text) -> Event t Status -> Event t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Status -> Event t () -> Event t Status
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (Dynamic t Status -> Behavior t Status
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (Dynamic t Status -> Behavior t Status)
-> Dynamic t Status -> Behavior t Status
forall a b. (a -> b) -> a -> b
$ Ghci t -> Dynamic t Status
forall t. Ghci t -> Dynamic t Status
_ghci_status Ghci t
g) Event t ()
pb
    , (Text
"Command exited with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ExitCode -> Text) -> ExitCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ExitCode -> String) -> ExitCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> String
forall a. Show a => a -> String
show (ExitCode -> Text) -> Event t ExitCode -> Event t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process t ByteString ByteString -> Event t ExitCode
forall t o e. Process t o e -> Event t ExitCode
_process_exit (Ghci t -> Process t ByteString ByteString
forall t. Ghci t -> Process t ByteString ByteString
_ghci_process Ghci t
g)
    ]

-- | A scrollable widget that displays a message at the bottom of the widget
-- when there is additional content to view.
scrollableOutput
  :: ( Reflex t
     , HasDisplayRegion t m
     , HasFocus t m
     , HasFocusReader t m
     , HasImageWriter t m
     , HasInput t m
     , HasLayout t m
     , HasTheme t m
     , MonadFix m
     , MonadHold t m
     , MonadNodeId m
     , PostBuild t m
     , HasDisplayRegion t m
     , HasFocus t m
     , HasFocusReader t m
     , HasImageWriter t m
     , HasInput t m
     , HasLayout t m
     )
  => Behavior t ByteString
  -> m ()
scrollableOutput :: Behavior t ByteString -> m ()
scrollableOutput Behavior t ByteString
out = m () -> m ()
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
  Behavior t (Int, Int)
scroll <- Dynamic t Constraint
-> m (Behavior t (Int, Int)) -> m (Behavior t (Int, Int))
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, Reflex t, HasInput t m, HasFocus t m, HasLayout t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile Dynamic t Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex (m (Behavior t (Int, Int)) -> m (Behavior t (Int, Int)))
-> m (Behavior t (Int, Int)) -> m (Behavior t (Int, Int))
forall a b. (a -> b) -> a -> b
$ Event t Int -> Behavior t Text -> m (Behavior t (Int, Int))
forall k (t :: k) (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasTheme t m) =>
Event t Int -> Behavior t Text -> m (Behavior t (Int, Int))
scrollableText Event t Int
forall k (t :: k) a. Reflex t => Event t a
never (Behavior t Text -> m (Behavior t (Int, Int)))
-> Behavior t Text -> m (Behavior t (Int, Int))
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> Behavior t ByteString -> Behavior t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t ByteString
out
  Dynamic t Constraint -> m () -> m ()
forall k (t :: k) (m :: * -> *) a.
(Reflex t, HasLayout t m, HasInput t m, HasImageWriter t m,
 HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout (Dynamic t Int -> Dynamic t Constraint
forall k (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed Dynamic t Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> m ()
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
 HasTheme t m) =>
Behavior t Text -> m ()
text (Behavior t Text -> m ()) -> Behavior t Text -> m ()
forall a b. (a -> b) -> a -> b
$
    let f :: a -> (a, a) -> p
f a
h (a
ix, a
n) = if a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
ix a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
h
          then p
"↓ More ↓"
          else p
""
    in Int -> (Int, Int) -> Text
forall a p. (Ord a, Num a, IsString p) => a -> (a, a) -> p
f (Int -> (Int, Int) -> Text)
-> Behavior t Int -> Behavior t ((Int, Int) -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh Behavior t ((Int, Int) -> Text)
-> Behavior t (Int, Int) -> Behavior t Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t (Int, Int)
scroll

-- | A scrollable widget that scrolls down as output goes past the end of the widget
scrollingOutput
  :: ( Reflex t
     , Monad m
     , MonadHold t m
     , MonadFix m
     , HasDisplayRegion t m
     , HasInput t m
     , HasImageWriter t m
     , HasTheme t m
     )
  => Dynamic t ByteString
  -> m ()
scrollingOutput :: Dynamic t ByteString -> m ()
scrollingOutput Dynamic t ByteString
out = do
  Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
  let scrollBy :: a -> (a, a) -> Maybe a
scrollBy a
h (a
ix, a
n) =
        if | a
ix a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
h -> Maybe a
forall a. Maybe a
Nothing -- Scrolled to the top and we don't have to scroll down
           | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
h Bool -> Bool -> Bool
&& a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
ix a -> a -> a
forall a. Num a => a -> a -> a
- a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 -> a -> Maybe a
forall a. a -> Maybe a
Just a
1
           | Bool
otherwise -> Maybe a
forall a. Maybe a
Nothing
  rec Behavior t (Int, Int)
scroll <- Event t Int -> Behavior t Text -> m (Behavior t (Int, Int))
forall k (t :: k) (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasTheme t m) =>
Event t Int -> Behavior t Text -> m (Behavior t (Int, Int))
scrollableText (Behavior t (Maybe Int) -> Event t ByteString -> Event t Int
forall k (t :: k) b a.
Reflex t =>
Behavior t (Maybe b) -> Event t a -> Event t b
tagMaybe (Int -> (Int, Int) -> Maybe Int
forall a a. (Ord a, Num a, Num a) => a -> (a, a) -> Maybe a
scrollBy (Int -> (Int, Int) -> Maybe Int)
-> Behavior t Int -> Behavior t ((Int, Int) -> Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh Behavior t ((Int, Int) -> Maybe Int)
-> Behavior t (Int, Int) -> Behavior t (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t (Int, Int)
scroll) (Event t ByteString -> Event t Int)
-> Event t ByteString -> Event t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t ByteString -> Event t ByteString
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t ByteString
out) (Behavior t Text -> m (Behavior t (Int, Int)))
-> Behavior t Text -> m (Behavior t (Int, Int))
forall a b. (a -> b) -> a -> b
$
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> Behavior t ByteString -> Behavior t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t ByteString -> Behavior t ByteString
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ByteString
out
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Display the output GHCi produces when it's loading the requested modules (e.g., warnings)
ghciModuleStatus
  :: ( MonadNodeId m
     , PostBuild t m
     , MonadHold t m
     , MonadFix m
     , Adjustable t m
     , HasLayout t m
     , HasImageWriter t m
     , HasFocusReader t m
     , HasDisplayRegion t m
     , HasInput t m
     , HasTheme t m
     , HasFocus t m
     )
  => Ghci t
  -> m ()
ghciModuleStatus :: Ghci t -> m ()
ghciModuleStatus Ghci t
g = m () -> m ()
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let ghciExit :: Event t ExitCode
ghciExit = Process t ByteString ByteString -> Event t ExitCode
forall t o e. Process t o e -> Event t ExitCode
_process_exit (Process t ByteString ByteString -> Event t ExitCode)
-> Process t ByteString ByteString -> Event t ExitCode
forall a b. (a -> b) -> a -> b
$ Ghci t -> Process t ByteString ByteString
forall t. Ghci t -> Process t ByteString ByteString
_ghci_process Ghci t
g
  Behavior t Bool
ghciExited <- Bool -> Event t Bool -> m (Behavior t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Bool
False (Event t Bool -> m (Behavior t Bool))
-> Event t Bool -> m (Behavior t Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Event t ExitCode -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ExitCode
ghciExit
  Dynamic t Constraint -> m () -> m ()
forall k (t :: k) (m :: * -> *) a.
(Reflex t, HasLayout t m, HasInput t m, HasImageWriter t m,
 HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout (Dynamic t Int -> Dynamic t Constraint
forall k (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed Dynamic t Int
3) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ BoxStyle -> m () -> m ()
forall k (m :: * -> *) (t :: k) a.
(Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m,
 HasInput t m, HasFocusReader t m, HasTheme t m) =>
BoxStyle -> m a -> m a
boxStatic BoxStyle
forall a. Default a => a
def (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ghci t -> m ()
forall t (m :: * -> *).
(PostBuild t m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasTheme t m) =>
Ghci t -> m ()
statusDisplay Ghci t
g
  Dynamic t ByteString
out <- Behavior t Bool -> Ghci t -> m (Dynamic t ByteString)
forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Behavior t Bool -> Ghci t -> m (Dynamic t ByteString)
moduleOutput (Bool -> Bool
not (Bool -> Bool) -> Behavior t Bool -> Behavior t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Bool
ghciExited) Ghci t
g
  Dynamic t Constraint -> m () -> m ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, Reflex t, HasInput t m, HasFocus t m, HasLayout t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile Dynamic t Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Dynamic t ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Dynamic t ()) -> m ()) -> m (Dynamic t ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    m () -> Event t (m ()) -> m (Dynamic t ())
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
networkHold (Behavior t ByteString -> m ()
forall t (m :: * -> *).
(Reflex t, HasDisplayRegion t m, HasFocus t m, HasFocusReader t m,
 HasImageWriter t m, HasInput t m, HasLayout t m, HasTheme t m,
 MonadFix m, MonadHold t m, MonadNodeId m, PostBuild t m,
 HasDisplayRegion t m, HasFocus t m, HasFocusReader t m,
 HasImageWriter t m, HasInput t m, HasLayout t m) =>
Behavior t ByteString -> m ()
scrollableOutput (Behavior t ByteString -> m ()) -> Behavior t ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t ByteString -> Behavior t ByteString
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ByteString
out) (Event t (m ()) -> m (Dynamic t ()))
-> Event t (m ()) -> m (Dynamic t ())
forall a b. (a -> b) -> a -> b
$ Event t () -> (() -> m ()) -> Event t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Ghci t -> Event t ()
forall t. Ghci t -> Event t ()
_ghci_reload Ghci t
g) ((() -> m ()) -> Event t (m ())) -> (() -> m ()) -> Event t (m ())
forall a b. (a -> b) -> a -> b
$
      m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ Behavior t ByteString -> m ()
forall t (m :: * -> *).
(Reflex t, HasDisplayRegion t m, HasFocus t m, HasFocusReader t m,
 HasImageWriter t m, HasInput t m, HasLayout t m, HasTheme t m,
 MonadFix m, MonadHold t m, MonadNodeId m, PostBuild t m,
 HasDisplayRegion t m, HasFocus t m, HasFocusReader t m,
 HasImageWriter t m, HasInput t m, HasLayout t m) =>
Behavior t ByteString -> m ()
scrollableOutput (Behavior t ByteString -> m ()) -> Behavior t ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t ByteString -> Behavior t ByteString
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ByteString
out

-- | Display the output of the expression GHCi is evaluating
ghciExecOutput
  :: ( MonadHold t m
     , MonadFix m
     , Adjustable t m
     , HasDisplayRegion t m
     , HasInput t m
     , HasImageWriter t m
     , HasTheme t m
     , HasInput t m
     )
  => Ghci t
  -> m ()
ghciExecOutput :: Ghci t -> m ()
ghciExecOutput Ghci t
g = do
  Behavior t Bool
ghciExited <- Bool -> Event t Bool -> m (Behavior t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Bool
False (Event t Bool -> m (Behavior t Bool))
-> Event t Bool -> m (Behavior t Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Event t ExitCode -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Process t ByteString ByteString -> Event t ExitCode
forall t o e. Process t o e -> Event t ExitCode
_process_exit (Ghci t -> Process t ByteString ByteString
forall t. Ghci t -> Process t ByteString ByteString
_ghci_process Ghci t
g)
  Dynamic t ByteString
out <- Behavior t Bool -> Ghci t -> m (Dynamic t ByteString)
forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Behavior t Bool -> Ghci t -> m (Dynamic t ByteString)
execOutput (Bool -> Bool
not (Bool -> Bool) -> Behavior t Bool -> Behavior t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Bool
ghciExited) Ghci t
g
  -- Rebuild the entire output widget so that we don't have to worry about resetting scroll state
  Dynamic t ()
_ <- m () -> Event t (m ()) -> m (Dynamic t ())
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
networkHold (Dynamic t ByteString -> m ()
forall t (m :: * -> *).
(Reflex t, Monad m, MonadHold t m, MonadFix m,
 HasDisplayRegion t m, HasInput t m, HasImageWriter t m,
 HasTheme t m) =>
Dynamic t ByteString -> m ()
scrollingOutput Dynamic t ByteString
out) (Event t (m ()) -> m (Dynamic t ()))
-> Event t (m ()) -> m (Dynamic t ())
forall a b. (a -> b) -> a -> b
$ Event t () -> (() -> m ()) -> Event t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Ghci t -> Event t ()
forall t. Ghci t -> Event t ()
_ghci_reload Ghci t
g) ((() -> m ()) -> Event t (m ())) -> (() -> m ()) -> Event t (m ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> Dynamic t ByteString -> m ()
forall t (m :: * -> *).
(Reflex t, Monad m, MonadHold t m, MonadFix m,
 HasDisplayRegion t m, HasInput t m, HasImageWriter t m,
 HasTheme t m) =>
Dynamic t ByteString -> m ()
scrollingOutput Dynamic t ByteString
out
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | A widget that displays the module status and the execution status in two stacked, resizable panes
ghciPanes
  :: ( Reflex t
     , MonadFix m
     , MonadHold t m
     , MonadNodeId m
     , PostBuild t m
     , Adjustable t m
     , HasInput t m
     , HasImageWriter t m
     , HasFocusReader t m
     , HasDisplayRegion t m
     , HasTheme t m
     , HasLayout t m
     , HasFocus t m
     )
  => Ghci t
  -> m ()
ghciPanes :: Ghci t -> m ()
ghciPanes Ghci t
g = m ((), ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ((), ()) -> m ()) -> m ((), ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m () -> m () -> m ((), ())
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasFocusReader t m) =>
m () -> m a -> m b -> m (a, b)
splitVDrag
  (BoxStyle -> m ()
forall k (t :: k) (m :: * -> *).
(HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) =>
BoxStyle -> m ()
hRule BoxStyle
doubleBoxStyle)
  (Ghci t -> m ()
forall (m :: * -> *) t.
(MonadNodeId m, PostBuild t m, MonadHold t m, MonadFix m,
 Adjustable t m, HasLayout t m, HasImageWriter t m,
 HasFocusReader t m, HasDisplayRegion t m, HasInput t m,
 HasTheme t m, HasFocus t m) =>
Ghci t -> m ()
ghciModuleStatus Ghci t
g)
  (Ghci t -> m ()
forall t (m :: * -> *).
(MonadHold t m, MonadFix m, Adjustable t m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasTheme t m, HasInput t m) =>
Ghci t -> m ()
ghciExecOutput Ghci t
g)

-- | Listen for ctrl-c (and any other provided exit events) and
-- shutdown the Ghci process upon receipt
getExitEvent
  :: ( PerformEvent t m
     , MonadIO (Performable m)
     , HasInput t m
     )
  => Ghci t
  -> Event t a
  -> m (Event t ())
getExitEvent :: Ghci t -> Event t a -> m (Event t ())
getExitEvent Ghci t
g Event t a
externalExitReq = do
  Event t KeyCombo
exitReq <- KeyCombo -> m (Event t KeyCombo)
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
KeyCombo -> m (Event t KeyCombo)
keyCombo (Char -> Key
V.KChar Char
'c', [Modifier
V.MCtrl])
  let exitReqs :: Event t (Ghci t)
exitReqs = [Event t (Ghci t)] -> Event t (Ghci t)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ Ghci t
g Ghci t -> Event t a -> Event t (Ghci t)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t a
externalExitReq
        , Ghci t
g Ghci t -> Event t KeyCombo -> Event t (Ghci t)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
exitReq
        ]
  Event t (Ghci t) -> m (Event t ())
forall t (m :: * -> *).
(PerformEvent t m, MonadIO (Performable m)) =>
Event t (Ghci t) -> m (Event t ())
shutdown Event t (Ghci t)
exitReqs

-- | Shut down a given Ghci process
shutdown
  :: ( PerformEvent t m
     , MonadIO (Performable m)
     )
  => Event t (Ghci t)
  -> m (Event t ())
shutdown :: Event t (Ghci t) -> m (Event t ())
shutdown Event t (Ghci t)
exitReqs = do
  Event t (Performable m ()) -> m (Event t ())
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent (Event t (Performable m ()) -> m (Event t ()))
-> Event t (Performable m ()) -> m (Event t ())
forall a b. (a -> b) -> a -> b
$ Event t (Ghci t)
-> (Ghci t -> Performable m ()) -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Ghci t)
exitReqs ((Ghci t -> Performable m ()) -> Event t (Performable m ()))
-> (Ghci t -> Performable m ()) -> Event t (Performable m ())
forall a b. (a -> b) -> a -> b
$ \Ghci t
g ->
    IO () -> Performable m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Performable m ()) -> IO () -> Performable m ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
P.terminateProcess (ProcessHandle -> IO ()) -> ProcessHandle -> IO ()
forall a b. (a -> b) -> a -> b
$ Process t ByteString ByteString -> ProcessHandle
forall t o e. Process t o e -> ProcessHandle
_process_handle (Process t ByteString ByteString -> ProcessHandle)
-> Process t ByteString ByteString -> ProcessHandle
forall a b. (a -> b) -> a -> b
$ Ghci t -> Process t ByteString ByteString
forall t. Ghci t -> Process t ByteString ByteString
_ghci_process Ghci t
g