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

import Control.Monad
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Graphics.Vty.Input as V
import Reflex.Network
import Reflex.Process.GHCi
import Reflex.Vty
import qualified System.Process as P
import qualified Reflex.Process.Repl as Repl

-- | The main reflex-ghci widget
run :: String -> Maybe String -> IO ()
run :: String -> Maybe String -> IO ()
run String
cmd Maybe String
expr = (forall t (m :: * -> *).
 (MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
  HasDisplayRegion t m, HasFocusReader t m, HasTheme t m,
  HasInput t m) =>
 m (Event t ()))
-> IO ()
mainWidget ((forall t (m :: * -> *).
  (MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
   HasDisplayRegion t m, HasFocusReader t m, HasTheme t m,
   HasInput t m) =>
  m (Event t ()))
 -> IO ())
-> (forall t (m :: * -> *).
    (MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
     HasDisplayRegion t m, HasFocusReader t m, HasTheme t m,
     HasInput t m) =>
    m (Event t ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Layout t (Focus t m) (Event t ()) -> m (Event t ())
forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m a
initManager_ (Layout t (Focus t m) (Event t ()) -> m (Event t ()))
-> Layout t (Focus t m) (Event t ()) -> m (Event t ())
forall a b. (a -> b) -> a -> b
$ do
  Layout t (Focus t m) ()
forall k (t :: k) (m :: * -> *).
(Reflex t, HasInput t m, HasFocus t m) =>
m ()
tabNavigation
  Event t KeyCombo
exit' <- KeyCombo -> Layout t (Focus t 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])
  Event t KeyCombo
exit <- KeyCombo -> Layout t (Focus t 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
'x', [Modifier
V.MCtrl])
  rec Repl Process t ByteString ByteString
_ Event t (Map Int Cmd)
finished Dynamic t (Int, Maybe Cmd)
started Event t ExitCode
readyToExit <- CreateProcess
-> Maybe Command
-> Event t ()
-> Event t ()
-> Layout t (Focus t m) (Repl t)
forall t (m :: * -> *).
(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)
ghciWatch (String -> CreateProcess
P.shell String
cmd) (ByteString -> Command
Repl.unsafeCommand (ByteString -> Command)
-> (String -> ByteString) -> String -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Command) -> Maybe String -> Maybe Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
expr) Event t ()
reload ((() () -> Event t KeyCombo -> Event t ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
exit) Event t () -> Event t () -> Event t ()
forall a. Semigroup a => a -> a -> a
<> (() () -> Event t KeyCombo -> Event t ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
exit') Event t () -> Event t () -> Event t ()
forall a. Semigroup a => a -> a -> a
<> Event t ()
quit)
      Dynamic t (Map Int Cmd)
oldCommands <- ((Map Int Cmd -> Map Int Cmd) -> Map Int Cmd -> Map Int Cmd)
-> Map Int Cmd
-> Event t (Map Int Cmd -> Map Int Cmd)
-> Layout t (Focus t m) (Dynamic t (Map Int Cmd))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (Map Int Cmd -> Map Int Cmd) -> Map Int Cmd -> Map Int Cmd
forall a b. (a -> b) -> a -> b
($) Map Int Cmd
forall k a. Map k a
Map.empty (Event t (Map Int Cmd -> Map Int Cmd)
 -> Layout t (Focus t m) (Dynamic t (Map Int Cmd)))
-> Event t (Map Int Cmd -> Map Int Cmd)
-> Layout t (Focus t m) (Dynamic t (Map Int Cmd))
forall a b. (a -> b) -> a -> b
$
        (\Map Int Cmd
new Map Int Cmd
old -> [(Int, Cmd)] -> Map Int Cmd
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Cmd)] -> Map Int Cmd) -> [(Int, Cmd)] -> Map Int Cmd
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Cmd)] -> [(Int, Cmd)]
forall a. Int -> [a] -> [a]
take Int
3 ([(Int, Cmd)] -> [(Int, Cmd)]) -> [(Int, Cmd)] -> [(Int, Cmd)]
forall a b. (a -> b) -> a -> b
$ [(Int, Cmd)] -> [(Int, Cmd)]
forall a. [a] -> [a]
reverse ([(Int, Cmd)] -> [(Int, Cmd)]) -> [(Int, Cmd)] -> [(Int, Cmd)]
forall a b. (a -> b) -> a -> b
$ Map Int Cmd -> [(Int, Cmd)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Int Cmd -> [(Int, Cmd)]) -> Map Int Cmd -> [(Int, Cmd)]
forall a b. (a -> b) -> a -> b
$ Map Int Cmd -> Map Int Cmd -> Map Int Cmd
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Int Cmd
old Map Int Cmd
new) (Map Int Cmd -> Map Int Cmd -> Map Int Cmd)
-> Event t (Map Int Cmd) -> Event t (Map Int Cmd -> Map Int Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Map Int Cmd)
finished
      Dynamic t (Maybe (Int, Cmd))
command <- Maybe (Int, Cmd)
-> Event t (Maybe (Int, Cmd))
-> Layout t (Focus t m) (Dynamic t (Maybe (Int, Cmd)))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Maybe (Int, Cmd)
forall a. Maybe a
Nothing (Event t (Maybe (Int, Cmd))
 -> Layout t (Focus t m) (Dynamic t (Maybe (Int, Cmd))))
-> Event t (Maybe (Int, Cmd))
-> Layout t (Focus t m) (Dynamic t (Maybe (Int, Cmd)))
forall a b. (a -> b) -> a -> b
$ ((Int, Cmd) -> Maybe (Int, Cmd))
-> Event t (Int, Cmd) -> Event t (Maybe (Int, Cmd))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Cmd) -> Maybe (Int, Cmd)
forall a. a -> Maybe a
Just (Event t (Int, Cmd) -> Event t (Maybe (Int, Cmd)))
-> Event t (Int, Cmd) -> Event t (Maybe (Int, Cmd))
forall a b. (a -> b) -> a -> b
$ [Event t (Int, Cmd)] -> Event t (Int, Cmd)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ Event t (Int, Maybe Cmd)
-> ((Int, Maybe Cmd) -> Maybe (Int, Cmd)) -> Event t (Int, Cmd)
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (Dynamic t (Int, Maybe Cmd) -> Event t (Int, Maybe Cmd)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Int, Maybe Cmd)
started) (((Int, Maybe Cmd) -> Maybe (Int, Cmd)) -> Event t (Int, Cmd))
-> ((Int, Maybe Cmd) -> Maybe (Int, Cmd)) -> Event t (Int, Cmd)
forall a b. (a -> b) -> a -> b
$ \(Int
ix, Maybe Cmd
x) -> (Int
ix,) (Cmd -> (Int, Cmd)) -> Maybe Cmd -> Maybe (Int, Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Cmd
x
        , (Maybe (Int, Cmd) -> Maybe (Int, Cmd))
-> Event t (Maybe (Int, Cmd)) -> Event t (Int, Cmd)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe (Int, Cmd) -> Maybe (Int, Cmd)
forall a. a -> a
id (Event t (Maybe (Int, Cmd)) -> Event t (Int, Cmd))
-> Event t (Maybe (Int, Cmd)) -> Event t (Int, Cmd)
forall a b. (a -> b) -> a -> b
$ (((Int, Cmd), Map Int Cmd) -> (Int, Cmd))
-> Maybe ((Int, Cmd), Map Int Cmd) -> Maybe (Int, Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Cmd), Map Int Cmd) -> (Int, Cmd)
forall a b. (a, b) -> a
fst (Maybe ((Int, Cmd), Map Int Cmd) -> Maybe (Int, Cmd))
-> (Map Int Cmd -> Maybe ((Int, Cmd), Map Int Cmd))
-> Map Int Cmd
-> Maybe (Int, Cmd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int Cmd -> Maybe ((Int, Cmd), Map Int Cmd)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey (Map Int Cmd -> Maybe (Int, Cmd))
-> Event t (Map Int Cmd) -> Event t (Maybe (Int, Cmd))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Map Int Cmd)
finished
        ]
      let atPrompt :: Dynamic t Bool
atPrompt = Dynamic t (Int, Maybe Cmd)
-> ((Int, Maybe Cmd) -> Bool) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Int, Maybe Cmd)
started (((Int, Maybe Cmd) -> Bool) -> Dynamic t Bool)
-> ((Int, Maybe Cmd) -> Bool) -> Dynamic t Bool
forall a b. (a -> b) -> a -> b
$ Maybe Cmd -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Cmd -> Bool)
-> ((Int, Maybe Cmd) -> Maybe Cmd) -> (Int, Maybe Cmd) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Cmd) -> Maybe Cmd
forall a b. (a, b) -> b
snd
          errors :: Dynamic t Bool
errors = Bool -> ((Int, Cmd) -> Bool) -> Maybe (Int, Cmd) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Cmd -> Bool
hasErrors (Cmd -> Bool) -> ((Int, Cmd) -> Cmd) -> (Int, Cmd) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Cmd) -> Cmd
forall a b. (a, b) -> b
snd) (Maybe (Int, Cmd) -> Bool)
-> Dynamic t (Maybe (Int, Cmd)) -> Dynamic t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Maybe (Int, Cmd))
command
      (Event t ()
reload, Event t ()
quit) <- Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col (Layout t (Focus t m) (Event t (), Event t ())
 -> Layout t (Focus t m) (Event t (), Event t ()))
-> Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall a b. (a -> b) -> a -> b
$ do
        (Event t (), Event t ())
r <- Dynamic t Constraint
-> Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 Int -> Dynamic t Constraint
forall k (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed Dynamic t Int
3) (Layout t (Focus t m) (Event t (), Event t ())
 -> Layout t (Focus t m) (Event t (), Event t ()))
-> Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall a b. (a -> b) -> a -> b
$ Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row (Layout t (Focus t m) (Event t (), Event t ())
 -> Layout t (Focus t m) (Event t (), Event t ()))
-> Layout t (Focus t m) (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall a b. (a -> b) -> a -> b
$ do
          Dynamic t Constraint
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ BoxStyle -> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> Layout t (Focus t 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 -> Layout t (Focus t m) ())
-> Behavior t Text -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ (\Bool
x -> if Bool
x then Text
"Ready" else Text
"Busy") (Bool -> Text) -> Behavior t Bool -> Behavior t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Bool -> Behavior t Bool
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
atPrompt
          Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ())
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (Dynamic t (Layout t (Focus t m) ())
 -> Layout t (Focus t m) (Event t ()))
-> Dynamic t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ Dynamic t Bool
-> (Bool -> Layout t (Focus t m) ())
-> Dynamic t (Layout t (Focus t m) ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Bool
errors ((Bool -> Layout t (Focus t m) ())
 -> Dynamic t (Layout t (Focus t m) ()))
-> (Bool -> Layout t (Focus t m) ())
-> Dynamic t (Layout t (Focus t m) ())
forall a b. (a -> b) -> a -> b
$ \case
            Bool
True -> Dynamic t Constraint
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ BoxStyle -> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> Layout t (Focus t 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
"Error!"
            Bool
False -> Dynamic t Constraint
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 Constraint
forall k (t :: k). Reflex t => Dynamic t Constraint
flex (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ BoxStyle -> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Layout t (Focus t m) () -> Layout t (Focus t m) ())
-> Layout t (Focus t m) () -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> Layout t (Focus t 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
"All Good!"
          Event t ()
r <- Dynamic t Constraint
-> Layout t (Focus t m) (Event t ())
-> Layout t (Focus t m) (Event t ())
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Layout t (Focus t m) (Event t ())
 -> Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) (Event t ())
-> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ ButtonConfig t
-> Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ())
forall k (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasFocusReader t m, HasTheme t m,
 HasDisplayRegion t m, HasImageWriter t m, HasInput t m) =>
ButtonConfig t -> m () -> m (Event t ())
button ButtonConfig t
forall a. Default a => a
def (Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> Layout t (Focus t 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
"Reload"
          Event t ()
q <- Dynamic t Constraint
-> Layout t (Focus t m) (Event t ())
-> Layout t (Focus t m) (Event t ())
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Layout t (Focus t m) (Event t ())
 -> Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) (Event t ())
-> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ ButtonConfig t
-> Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ())
forall k (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasFocusReader t m, HasTheme t m,
 HasDisplayRegion t m, HasImageWriter t m, HasInput t m) =>
ButtonConfig t -> m () -> m (Event t ())
button ButtonConfig t
forall a. Default a => a
def (Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) () -> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> Layout t (Focus t 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
"Quit"
          (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event t ()
r, Event t ()
q)
        let cmdbtn :: a -> Cmd -> m (Event t ())
cmdbtn a
ix Cmd
c = Dynamic t Constraint -> m (Event t ()) -> m (Event t ())
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 Int -> Dynamic t Constraint
forall k (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed Dynamic t Int
3) (m (Event t ()) -> m (Event t ()))
-> m (Event t ()) -> m (Event t ())
forall a b. (a -> b) -> a -> b
$ ButtonConfig t -> m () -> m (Event t ())
forall k (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasFocusReader t m, HasTheme t m,
 HasDisplayRegion t m, HasImageWriter t m, HasInput t m) =>
ButtonConfig t -> m () -> m (Event t ())
button ButtonConfig t
forall a. Default a => a
def (m () -> m (Event t ())) -> m () -> m (Event t ())
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
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Behavior t Text) -> Text -> Behavior t Text
forall a b. (a -> b) -> a -> b
$
              String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
ix) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Command -> ByteString
displayCommand (Command -> ByteString) -> Command -> ByteString
forall a b. (a -> b) -> a -> b
$ Cmd -> Command
_cmd_stdin Cmd
c)
        Event t Int
oldE <- Event t Int
-> Event t (Event t Int) -> Layout t (Focus t m) (Event t Int)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold Event t Int
forall k (t :: k) a. Reflex t => Event t a
never (Event t (Event t Int) -> Layout t (Focus t m) (Event t Int))
-> (Layout t (Focus t m) (Event t [Event t Int])
    -> Layout t (Focus t m) (Event t (Event t Int)))
-> Layout t (Focus t m) (Event t [Event t Int])
-> Layout t (Focus t m) (Event t Int)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Event t [Event t Int] -> Event t (Event t Int))
-> Layout t (Focus t m) (Event t [Event t Int])
-> Layout t (Focus t m) (Event t (Event t Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Event t Int] -> Event t Int)
-> Event t [Event t Int] -> Event t (Event t Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost) (Layout t (Focus t m) (Event t [Event t Int])
 -> Layout t (Focus t m) (Event t Int))
-> Layout t (Focus t m) (Event t [Event t Int])
-> Layout t (Focus t m) (Event t Int)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Layout t (Focus t m) [Event t Int])
-> Layout t (Focus t m) (Event t [Event t Int])
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (Dynamic t (Layout t (Focus t m) [Event t Int])
 -> Layout t (Focus t m) (Event t [Event t Int]))
-> Dynamic t (Layout t (Focus t m) [Event t Int])
-> Layout t (Focus t m) (Event t [Event t Int])
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map Int Cmd)
-> (Map Int Cmd -> Layout t (Focus t m) [Event t Int])
-> Dynamic t (Layout t (Focus t m) [Event t Int])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Map Int Cmd)
oldCommands ((Map Int Cmd -> Layout t (Focus t m) [Event t Int])
 -> Dynamic t (Layout t (Focus t m) [Event t Int]))
-> (Map Int Cmd -> Layout t (Focus t m) [Event t Int])
-> Dynamic t (Layout t (Focus t m) [Event t Int])
forall a b. (a -> b) -> a -> b
$ \Map Int Cmd
old -> [(Int, Cmd)]
-> ((Int, Cmd) -> Layout t (Focus t m) (Event t Int))
-> Layout t (Focus t m) [Event t Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Int Cmd -> [(Int, Cmd)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int Cmd
old) (((Int, Cmd) -> Layout t (Focus t m) (Event t Int))
 -> Layout t (Focus t m) [Event t Int])
-> ((Int, Cmd) -> Layout t (Focus t m) (Event t Int))
-> Layout t (Focus t m) [Event t Int]
forall a b. (a -> b) -> a -> b
$ \(Int
ix, Cmd
c) -> do
          Event t ()
go <- Int -> Cmd -> Layout t (Focus t m) (Event t ())
forall t (m :: * -> *) a.
(HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
 HasFocus t m, HasLayout t m, HasImageWriter t m, HasTheme t m,
 Show a, MonadHold t m, MonadFix m) =>
a -> Cmd -> m (Event t ())
cmdbtn Int
ix Cmd
c
          Event t Int -> Layout t (Focus t m) (Event t Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event t Int -> Layout t (Focus t m) (Event t Int))
-> Event t Int -> Layout t (Focus t m) (Event t Int)
forall a b. (a -> b) -> a -> b
$ Int
ix Int -> Event t () -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
go
        Event t ()
currentCommand <- Event t ()
-> Event t (Event t ()) -> Layout t (Focus t m) (Event t ())
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold Event t ()
forall k (t :: k) a. Reflex t => Event t a
never (Event t (Event t ()) -> Layout t (Focus t m) (Event t ()))
-> (Dynamic t (Layout t (Focus t m) (Event t ()))
    -> Layout t (Focus t m) (Event t (Event t ())))
-> Dynamic t (Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) (Event t ())
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Dynamic t (Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) (Event t (Event t ()))
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (Dynamic t (Layout t (Focus t m) (Event t ()))
 -> Layout t (Focus t m) (Event t ()))
-> Dynamic t (Layout t (Focus t m) (Event t ()))
-> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ Dynamic t (Int, Maybe Cmd)
-> ((Int, Maybe Cmd) -> Layout t (Focus t m) (Event t ()))
-> Dynamic t (Layout t (Focus t m) (Event t ()))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Int, Maybe Cmd)
started (((Int, Maybe Cmd) -> Layout t (Focus t m) (Event t ()))
 -> Dynamic t (Layout t (Focus t m) (Event t ())))
-> ((Int, Maybe Cmd) -> Layout t (Focus t m) (Event t ()))
-> Dynamic t (Layout t (Focus t m) (Event t ()))
forall a b. (a -> b) -> a -> b
$ \case
          (Int
_, Maybe Cmd
Nothing) -> Event t () -> Layout t (Focus t m) (Event t ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event t ()
forall k (t :: k) a. Reflex t => Event t a
never
          (Int
ix, Just Cmd
c) -> Int -> Cmd -> Layout t (Focus t m) (Event t ())
forall t (m :: * -> *) a.
(HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
 HasFocus t m, HasLayout t m, HasImageWriter t m, HasTheme t m,
 Show a, MonadHold t m, MonadFix m) =>
a -> Cmd -> m (Event t ())
cmdbtn Int
ix Cmd
c

        let showOutput :: Cmd -> m ()
showOutput (Cmd Command
_ Lines
out Lines
err) = do
              let scrollCfg :: ScrollableConfig t
scrollCfg = ScrollableConfig t
forall a. Default a => a
def
                    { _scrollableConfig_startingPosition :: ScrollPos
_scrollableConfig_startingPosition = ScrollPos
ScrollPos_Bottom
                    , _scrollableConfig_scrollToBottom :: Behavior t (Maybe ScrollToBottom)
_scrollableConfig_scrollToBottom = Maybe ScrollToBottom -> Behavior t (Maybe ScrollToBottom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScrollToBottom -> Maybe ScrollToBottom
forall a. a -> Maybe a
Just ScrollToBottom
ScrollToBottom_Maintain)
                    }
              Scrollable t
_ <- Dynamic t Constraint -> m (Scrollable t) -> m (Scrollable t)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Scrollable t) -> m (Scrollable t))
-> m (Scrollable t) -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ BoxStyle -> m (Scrollable t) -> m (Scrollable t)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Scrollable t) -> m (Scrollable t))
-> m (Scrollable t) -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ ScrollableConfig t -> Dynamic t Text -> m (Scrollable t)
forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasTheme t m, PostBuild t m) =>
ScrollableConfig t -> Dynamic t Text -> m (Scrollable t)
scrollableText ScrollableConfig t
scrollCfg (Dynamic t Text -> m (Scrollable t))
-> Dynamic t Text -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ Text -> Dynamic t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Dynamic t Text) -> Text -> Dynamic t Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Lines -> ByteString) -> Lines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> ByteString
unLines (Lines -> Text) -> Lines -> Text
forall a b. (a -> b) -> a -> b
$ Lines
out
              Scrollable t
_ <- Dynamic t Constraint -> m (Scrollable t) -> m (Scrollable t)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Scrollable t) -> m (Scrollable t))
-> m (Scrollable t) -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ BoxStyle -> m (Scrollable t) -> m (Scrollable t)
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, 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 (Scrollable t) -> m (Scrollable t))
-> m (Scrollable t) -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ ScrollableConfig t -> Dynamic t Text -> m (Scrollable t)
forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasTheme t m, PostBuild t m) =>
ScrollableConfig t -> Dynamic t Text -> m (Scrollable t)
scrollableText ScrollableConfig t
scrollCfg (Dynamic t Text -> m (Scrollable t))
-> Dynamic t Text -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ Text -> Dynamic t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Dynamic t Text) -> Text -> Dynamic t Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Lines -> ByteString) -> Lines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> ByteString
unLines (Lines -> Text) -> Lines -> Text
forall a b. (a -> b) -> a -> b
$ Lines
err
              () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        Layout t (Focus t m) (Dynamic t ()) -> Layout t (Focus t m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout t (Focus t m) (Dynamic t ()) -> Layout t (Focus t m) ())
-> Layout t (Focus t m) (Dynamic t ()) -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Layout t (Focus t m) ()
-> Event t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Dynamic t ())
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
networkHold (Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ()) -> Layout t (Focus t m) ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ())
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (Dynamic t (Layout t (Focus t m) ())
 -> Layout t (Focus t m) (Event t ()))
-> Dynamic t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ Layout t (Focus t m) ()
-> ((Int, Cmd) -> Layout t (Focus t m) ())
-> Maybe (Int, Cmd)
-> Layout t (Focus t m) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Layout t (Focus t m) ()
forall (m :: * -> *). Monad m => m ()
blank (Cmd -> Layout t (Focus t m) ()
forall t (m :: * -> *).
(HasDisplayRegion t m, HasFocus t m, HasLayout t m,
 HasImageWriter t m, HasFocusReader t m, HasTheme t m,
 PostBuild t m, HasInput t m, MonadHold t m, MonadFix m) =>
Cmd -> m ()
showOutput (Cmd -> Layout t (Focus t m) ())
-> ((Int, Cmd) -> Cmd) -> (Int, Cmd) -> Layout t (Focus t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Cmd) -> Cmd
forall a b. (a, b) -> b
snd) (Maybe (Int, Cmd) -> Layout t (Focus t m) ())
-> Dynamic t (Maybe (Int, Cmd))
-> Dynamic t (Layout t (Focus t m) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Maybe (Int, Cmd))
command) (Event t (Layout t (Focus t m) ())
 -> Layout t (Focus t m) (Dynamic t ()))
-> Event t (Layout t (Focus t m) ())
-> Layout t (Focus t m) (Dynamic t ())
forall a b. (a -> b) -> a -> b
$ [Event t (Layout t (Focus t m) ())]
-> Event t (Layout t (Focus t m) ())
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
          [ Event t Cmd
-> (Cmd -> Layout t (Focus t m) ())
-> Event t (Layout t (Focus t m) ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor ((Map Int Cmd -> Int -> Maybe Cmd)
-> Behavior t (Map Int Cmd) -> Event t Int -> Event t Cmd
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
attachWithMaybe ((Int -> Map Int Cmd -> Maybe Cmd)
-> Map Int Cmd -> Int -> Maybe Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int Cmd -> Maybe Cmd
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup) (Dynamic t (Map Int Cmd) -> Behavior t (Map Int Cmd)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map Int Cmd)
oldCommands) Event t Int
oldE) Cmd -> Layout t (Focus t m) ()
forall t (m :: * -> *).
(HasDisplayRegion t m, HasFocus t m, HasLayout t m,
 HasImageWriter t m, HasFocusReader t m, HasTheme t m,
 PostBuild t m, HasInput t m, MonadHold t m, MonadFix m) =>
Cmd -> m ()
showOutput
          , Event t Cmd
-> (Cmd -> Layout t (Focus t m) ())
-> Event t (Layout t (Focus t m) ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor ((Maybe (Int, Cmd) -> () -> Maybe Cmd)
-> Behavior t (Maybe (Int, Cmd)) -> Event t () -> Event t Cmd
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
attachWithMaybe (\Maybe (Int, Cmd)
a ()
_ -> ((Int, Cmd) -> Cmd) -> Maybe (Int, Cmd) -> Maybe Cmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Cmd) -> Cmd
forall a b. (a, b) -> b
snd Maybe (Int, Cmd)
a) (Dynamic t (Maybe (Int, Cmd)) -> Behavior t (Maybe (Int, Cmd))
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe (Int, Cmd))
command) Event t ()
currentCommand) Cmd -> Layout t (Focus t m) ()
forall t (m :: * -> *).
(HasDisplayRegion t m, HasFocus t m, HasLayout t m,
 HasImageWriter t m, HasFocusReader t m, HasTheme t m,
 PostBuild t m, HasInput t m, MonadHold t m, MonadFix m) =>
Cmd -> m ()
showOutput
          ]
        (Event t (), Event t ())
-> Layout t (Focus t m) (Event t (), Event t ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event t (), Event t ())
r
  Event t () -> Layout t (Focus t m) (Event t ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t () -> Layout t (Focus t m) (Event t ()))
-> Event t () -> Layout t (Focus t m) (Event t ())
forall a b. (a -> b) -> a -> b
$ () () -> Event t ExitCode -> Event t ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ExitCode
readyToExit