Merge pull request #6 from reflex-frp/aa-vty-widgets

Extract vty widgets into a library module

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for reflex-ghci
 
+## 0.1.2.0
+
+* Extract console GHCi widgets from the executable into a library module
+
 ## 0.1.1.0
 
 * Executable: Fix option parser so that there is no expression to evaluate by default

README.md

@@ -3,15 +3,19 @@ reflex-ghci
 
 [![hackage](https://img.shields.io/hackage/v/reflex-ghci.svg)](https://hackage.haskell.org/package/reflex-ghci) [![hackage-ci](https://matrix.hackage.haskell.org/api/v2/packages/reflex-ghci/badge)](https://matrix.hackage.haskell.org/#/package/reflex-ghci) [![travis-ci](https://api.travis-ci.org/reflex-frp/reflex-ghci.svg?branch=develop)](https://travis-ci.org/reflex-frp/reflex-ghci)
 
+![screenshot](screenshot.png)
+
 Library
 -------
 A functional-reactive wrapper around GHCi that uses filesystem notifications to automatically reload haskell source files.
 
+`Reflex.Process.GHCi` provides the core GHCi process-running infrastructure. If you want to run your own GHCi, directly control when it reloads, or build your own custom interface, look there.
+
+`Reflex.Vty.GHCi` provides a few widgets that are useful when building a console GHCi interface. Use these components to assemble your own vty GHCi runner.
+
 Executable
 ----------
 
-![screenshot](screenshot.png)
-
 This package includes a [reflex-vty](https://github.com/reflex-frp/reflex-vty)-based executable, shown above. Module information (errors, warnings, etc) is shown in a scrollable pane on the top half of the screen and the output of any expression you (optionally) choose to evaluate is shown in a scrollable pane on the bottom half. The panes are resizable using the mouse.
 
 ```bash

reflex-ghci.cabal

@@ -1,6 +1,6 @@
 cabal-version: >=1.10
 name: reflex-ghci
-version: 0.1.1.0
+version: 0.1.2.0
 synopsis: A GHCi widget library for use in reflex applications
 description:
   Run GHCi from within a reflex application and interact with it using a functional-reactive interface.
@@ -21,7 +21,9 @@ extra-source-files: ChangeLog.md
 tested-with: GHC ==8.6.5
 
 library
-  exposed-modules: Reflex.Process.GHCi
+  exposed-modules:
+    Reflex.Process.GHCi
+    Reflex.Vty.GHCi
   build-depends:
       base >= 4.12 && < 4.13
     , bytestring >= 0.10 && < 0.11
@@ -33,6 +35,8 @@ library
     , reflex-fsnotify >= 0.1 && < 0.2
     , reflex-process >= 0.1 && < 0.2
     , regex-tdfa >= 1.2.3 && < 1.3
+    , reflex-vty >= 0.1.3 && < 0.2
+    , text >= 1.2 && < 1.3
     , unix >= 2.7 && < 2.8
   hs-source-dirs: src
   default-language: Haskell2010

src-bin/ghci.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
 import Reflex.Network
 import Reflex.Process
 import Reflex.Process.GHCi
 import Reflex.Vty
+import Reflex.Vty.GHCi
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (void, (<=<))
@@ -50,44 +49,31 @@ main = do
   mainWidget $ do
     exit <- keyCombo (V.KChar 'c', [V.MCtrl])
     g <- ghciWatch (shell cmd) $ T.encodeUtf8 . T.pack <$> expr
-    pb <- getPostBuild
-    let ghciExit = _process_exit (_ghci_process g)
-    ghciExited <- hold False $ True <$ ghciExit
-    let ghciLoadStatus = col $ do
-          fixed 3 $ boxStatic def $ text <=< hold "" $ leftmost
-            [ statusMessage <$> updated (_ghci_status g)
-            , statusMessage <$> tag (current $ _ghci_status g) pb
-            , ("Command exited with " <>) . T.pack . show <$> ghciExit
-            ]
-          out <- moduleOutput (not <$> ghciExited) g
-          (dh, scroll) <- stretch $ do
-            dh <- displayHeight
-            scroll <- scrollableText never $ T.decodeUtf8 <$> current out
-            return (dh, scroll)
-          fixed 1 $ text $ (\h (ix, n) -> if n - ix + 1 > h then "↓ More ↓" else "") <$> current dh <*> scroll
-        ghciExecOutput = do
-          out <- (T.decodeUtf8 <$>) <$> execOutput (not <$> ghciExited) g
-          let scrollingOutput = do
-                dh <- displayHeight
-                rec scroll <- scrollableText (tagMaybe (scrollBy <$> current dh <*> scroll) $ updated out) $ current out
-                    let scrollBy h (ix, n) =
-                          if | ix == 0 && n <= h -> Nothing -- Scrolled to the top and we don't have to scroll down
-                             | n > h && n - ix - h == 0 -> Just 1
-                             | otherwise -> Nothing
-                return ()
-          -- Rebuild the entire output widget so that we don't have to worry about resetting scroll state
-          _ <- networkHold scrollingOutput $ ffor (_ghci_reload g) $ \_ -> scrollingOutput
-          return ()
     case expr of
-      Nothing -> ghciLoadStatus
-      Just _ -> void $ splitVDrag (hRule doubleBoxStyle) ghciLoadStatus ghciExecOutput
+      Nothing -> ghciModuleStatus g
+      Just _ -> ghciPanes g
     return $ () <$ exit
 
+-- Some rudimentary test expressions
+-- Run these to test different scenarios like so:
+--
+-- > reflex-ghci "cabal repl exe:reflex-ghci" "test"
+--
 test :: IO ()
 test = do
   let go :: Int -> IO ()
       go n = putStrLn ("Iteration No. " <> show n) >> threadDelay 1000000 >> go (n+1)
-  -- error "asdf"
-  -- Just n <- return (Nothing :: Maybe Int)
   go 1
-  -- putStrLn "Done"
+
+err :: IO ()
+err = do
+  error "This is an error"
+  test
+
+err2 :: IO ()
+err2 = do
+  Just n <- return (Nothing :: Maybe Int)
+  test
+
+done :: IO ()
+done = putStrLn "Done"

src/Reflex/Vty/GHCi.hs

@@ -0,0 +1,120 @@
+{-|
+ - 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 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
+
+-- | Display the overall status of the GHCi session, including exit information in case GHCi has quit
+statusDisplay
+  :: ( PostBuild t m
+     , MonadHold t m
+     )
+  => Ghci t
+  -> VtyWidget t m ()
+statusDisplay g = do
+  pb <- getPostBuild
+  text <=< hold "" $ leftmost
+    [ statusMessage <$> updated (_ghci_status g)
+    , statusMessage <$> tag (current $ _ghci_status g) pb
+    , ("Command exited with " <>) . T.pack . show <$> _process_exit (_ghci_process g)
+    ]
+
+-- | A scrollable widget that displays a message at the bottom of the widget
+-- when there is additional content to view.
+scrollableOutput
+  :: ( Reflex t
+     , MonadNodeId m
+     , MonadHold t m
+     , MonadFix m
+     , PostBuild t m
+     )
+  => Behavior t ByteString
+  -> VtyWidget t m ()
+scrollableOutput out = col $ do
+  dh <- displayHeight
+  scroll <- stretch $ scrollableText never $ T.decodeUtf8 <$> out
+  fixed 1 $ text $
+    let f h (ix, n) = if n - ix + 1 > h
+          then "↓ More ↓"
+          else ""
+    in f <$> current dh <*> 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
+     )
+  => Dynamic t ByteString
+  -> VtyWidget t m ()
+scrollingOutput out = do
+  dh <- displayHeight
+  let scrollBy h (ix, n) =
+        if | ix == 0 && n <= h -> Nothing -- Scrolled to the top and we don't have to scroll down
+           | n > h && n - ix - h == 0 -> Just 1
+           | otherwise -> Nothing
+  rec scroll <- scrollableText (tagMaybe (scrollBy <$> current dh <*> scroll) $ updated out) $
+        T.decodeUtf8 <$> current out
+  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
+     )
+  => Ghci t
+  -> VtyWidget t m ()
+ghciModuleStatus g = col $ do
+  let ghciExit = _process_exit $ _ghci_process g
+  ghciExited <- hold False $ True <$ ghciExit
+  fixed 3 $ boxStatic def $ statusDisplay g
+  out <- moduleOutput (not <$> ghciExited) g
+  stretch $ scrollableOutput $ current out
+
+-- | Display the output of the expression GHCi is evaluating
+ghciExecOutput
+  :: ( MonadHold t m
+     , MonadFix m
+     , Adjustable t m
+     )
+  => Ghci t
+  -> VtyWidget t m ()
+ghciExecOutput g = do
+  ghciExited <- hold False $ True <$ _process_exit (_ghci_process g)
+  out <- execOutput (not <$> ghciExited) g
+  -- Rebuild the entire output widget so that we don't have to worry about resetting scroll state
+  _ <- networkHold (scrollingOutput out) $ ffor (_ghci_reload g) $ \_ -> scrollingOutput out
+  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
+     )
+  => Ghci t
+  -> VtyWidget t m ()
+ghciPanes g = void $ splitVDrag
+  (hRule doubleBoxStyle)
+  (ghciModuleStatus g)
+  (ghciExecOutput g)