diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for reflex-ghci +## 0.1.2.0 + +* Extract console GHCi widgets from the executable into a library module +* Executable: Run with -Wall when repl command is unspecified + ## 0.1.1.0 * Executable: Fix option parser so that there is no expression to evaluate by default diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,14 +3,18 @@ [![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. diff --git a/reflex-ghci.cabal b/reflex-ghci.cabal --- a/reflex-ghci.cabal +++ b/reflex-ghci.cabal @@ -1,11 +1,11 @@ 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. . - <> + <> . bug-reports: https://github.com/reflex-frp/reflex-ghci/issues license: BSD3 @@ -21,7 +21,9 @@ 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 @@ , 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 diff --git a/src-bin/ghci.hs b/src-bin/ghci.hs --- a/src-bin/ghci.hs +++ b/src-bin/ghci.hs @@ -1,18 +1,11 @@ -{-# 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, (<=<)) import qualified Graphics.Vty.Input as V import qualified Data.Text as T import qualified Data.Text.Encoding as T -import System.Environment (getArgs) import System.Process (shell) import Options.Applicative @@ -29,7 +22,7 @@ short 'c' <> help "The ghci/cabal repl command to run" <> showDefault <> - value "cabal repl" <> + value "cabal repl --repl-options=-Wall" <> metavar "COMMAND" ) <*> optional (strOption @@ -50,44 +43,29 @@ 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 = error "This is an error" + +err2 :: IO () +err2 = do + Just _ <- return (Nothing :: Maybe Int) + test + +done :: IO () +done = putStrLn "Done" diff --git a/src/Reflex/Vty/GHCi.hs b/src/Reflex/Vty/GHCi.hs new file mode 100644 --- /dev/null +++ b/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)