reflex-ghci (empty) → 0.1.0.0

raw patch · 8 files changed

+504/−0 lines, 8 filesdep +basedep +bytestringdep +directorysetup-changedbinary-added

Dependencies added: base, bytestring, directory, filepath, fsnotify, optparse-applicative, process, reflex, reflex-fsnotify, reflex-ghci, reflex-process, reflex-vty, regex-tdfa, text, unix, vty

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +34/−0
• Setup.hs +2/−0
• reflex-ghci.cabal +59/−0
• screenshot.png binary
• src-bin/ghci.hs +97/−0
• src/Reflex/Process/GHCi.hs +277/−0

@@ -0,0 +1,5 @@+# Revision history for reflex-ghci++## 0.1.0.0++* Initial release. A reflex-process wrapper for GHCi and cabal repl commands and a reflex-vty-based executable.

@@ -0,0 +1,30 @@+Copyright (c) 2018, Obsidian Systems LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Obsidian Systems LLC nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,34 @@+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)++Library+-------+A functional-reactive wrapper around GHCi that uses filesystem notifications to automatically reload haskell source files.++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 -h+Welcome to reflex-ghci!++Usage: <interactive> [-c|--command COMMAND] [-e|--expression EXPR]+  Run a Haskell REPL that automatically reloads when source files change.++Available options:+  -c,--command COMMAND     The ghci/cabal repl command to+                           run (default: "cabal repl")+  -e,--expression EXPR     The optional expression to evaluate once modules have+                           successfully loaded (default: no expression)+  -h,--help                Show this help text+```++Acknowledgements+----------------+Inspired by the fantastic [ghcid](https://github.com/ndmitchell/ghcid) project.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,59 @@+cabal-version: >=1.10+name: reflex-ghci+version: 0.1.0.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.+  .+  <<https://imgur.com/a/bAT39zr>>+  .+bug-reports: https://github.com/reflex-frp/reflex-ghci/issues+license: BSD3+license-file: LICENSE+author: Obsidian Systems LLC+maintainer: maintainer@obsidian.systems+copyright: 2020 Obsidian Systems LLC+category: FRP, Development,+build-type: Simple+extra-source-files: ChangeLog.md+                    README.md+                    screenshot.png+tested-with: GHC ==8.6.5++library+  exposed-modules: Reflex.Process.GHCi+  build-depends:+      base >= 4.12 && < 4.13+    , bytestring >= 0.10 && < 0.11+    , directory >= 1.3 && < 1.4+    , filepath >= 1.4 && < 1.5+    , fsnotify >= 0.3 && < 0.4+    , process >= 1.6 && < 1.7+    , reflex >= 0.6.3 && < 0.7+    , reflex-fsnotify >= 0.1 && < 0.2+    , reflex-process >= 0.1 && < 0.2+    , regex-tdfa >= 1.2.3 && < 1.3+    , unix >= 2.7 && < 2.8+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall++executable reflex-ghci+  hs-source-dirs: src-bin+  main-is: ghci.hs+  build-depends:+      base >= 4.12 && < 4.13+    , optparse-applicative >= 0.14.0 && < 0.16+    , process >= 1.6 && < 1.7+    , reflex >= 0.6.3 && < 0.7+    , reflex-ghci+    , reflex-vty >= 0.1.3 && < 0.2+    , reflex-process >= 0.1 && < 0.2+    , text >= 1.2 && < 1.3+    , vty >= 5.25 && < 5.26+  ghc-options: -threaded+  default-language: Haskell2010++source-repository head+  type: git+  location: https://github.com/reflex-frp/reflex-ghci

binary file changed (absent → 118766 bytes)

@@ -0,0 +1,97 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo #-}+import Reflex.Network+import Reflex.Process+import Reflex.Process.GHCi+import Reflex.Vty++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++data GhciArg = GhciArg+  { _ghciArg_replCommand :: String+  , _ghciArg_execCommand :: Maybe String+  }++ghciArg :: Parser GhciArg+ghciArg = GhciArg+  <$> strOption+    ( long "command" <>+      short 'c' <>+      help "The ghci/cabal repl command to run" <>+      showDefault <>+      value "cabal repl" <>+      metavar "COMMAND"+    )+  <*> optional (strOption+    ( long "expression" <>+      short 'e' <>+      help "The optional expression to evaluate once modules have successfully loaded" <>+      showDefaultWith (\case+        "" -> "no expression"+        expr -> expr) <>+      value "" <>+      metavar "EXPR"+    ))++main :: IO ()+main = do+  let opts = info (ghciArg <**> helper) $ mconcat+        [ fullDesc+        , progDesc "Run a Haskell REPL that automatically reloads when source files change."+        , header "Welcome to reflex-ghci!"+        ]+  GhciArg { _ghciArg_replCommand = cmd, _ghciArg_execCommand = expr } <- execParser opts+  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+    return $ () <$ exit++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"

@@ -0,0 +1,277 @@+{-|+ - Module: Reflex.Process.GHCi+ - Description: Run GHCi processes in a reflex application+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Reflex.Process.GHCi+  ( ghci+  , ghciWatch+  , Ghci(..)+  , Status(..)+  , moduleOutput+  , execOutput+  , collectOutput+  , statusMessage+  ) where++import Reflex+import Reflex.FSNotify (watchDirectory)+import Reflex.Process (ProcessConfig(..), Process(..), createProcess)++import Control.Monad ((<=<))+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C8+import Data.String (IsString)+import System.Directory (getCurrentDirectory)+import qualified System.FSNotify as FS+import System.FilePath.Posix (takeExtension)+import qualified System.Process as P+import qualified Text.Regex.TDFA as Regex ((=~))++-- | Runs a GHCi process and reloads it whenever the provided event fires+ghci+  :: ( TriggerEvent t m+     , PerformEvent t m+     , MonadIO (Performable m)+     , PostBuild t m+     , MonadIO m+     , MonadFix m+     , MonadHold t m+     )+  => P.CreateProcess+  -- ^ Command to run to enter GHCi+  -> Maybe ByteString+  -- ^ Expression to evaluate whenever GHCi successfully loads modules+  -> Event t ()+  -- ^ Ask GHCi to reload+  -> m (Ghci t)+ghci p mexpr reloadReq = do++  let cmd = p { P.create_group = True } -- Need to set this so that group interrupts don't impact parent++  -- Run the process and feed it some input:+  rec proc <- createProcess cmd $ ProcessConfig+        { _processConfig_stdin = leftmost+            [ reload+            -- Execute some expression if GHCi is ready to receive it+            , fforMaybe (updated status) $ \case+                Status_LoadSucceeded -> mexpr+                _ -> Nothing+            -- On first load, set the prompt+            , let f old new = if old == Status_Initializing && new == Status_Loading+                    then Just $ C8.intercalate "\n"+                      [ "Prelude.putStrLn \"Initialized. Setting up reflex-ghci...\""+                      , ":set prompt ..."+                      , ":set -fno-break-on-exception"+                      , ":set -fno-break-on-error"+                      , ":set prompt \"\""+                      , "Prelude.putStrLn \"\""+                      , ":set prompt " <> prompt+                      , ":r"+                      ]+                    else Nothing+              in attachWithMaybe f (current status) (updated status)+            ]+        , _processConfig_signal = never+        }++      -- Reload+      let reload = leftmost+            [ ":r" <$ reloadReq+            ]++      -- Capture and accumulate stdout and stderr between reloads.+      -- We'll inspect these values to determine GHCi's state+      output <- collectOutput (() <$ reload) $ _process_stdout proc+      errors <- collectOutput (() <$ reload) $ _process_stderr proc++     -- Only interrupt when there's a file change and we're ready and not in an idle state+      let interruptible s = s `elem` [Status_Loading, Status_Executing]+          requestInterrupt = gate (interruptible <$> current status) $ (() <$ reloadReq)+      performEvent_ $ ffor requestInterrupt $+        const $ liftIO $ P.interruptProcessGroupOf $ _process_handle proc++      -- Define some Regex patterns to use to determine GHCi's state based on output+      let okModulesLoaded = "Ok.*module.*loaded." :: ByteString+          failedNoModulesLoaded = "Failed, no modules loaded." :: ByteString+          -- TODO: Is there a way to distinguish GHCi's actual exception output+          -- from someone printing "*** Exception:" to stderr?+          -- TODO: Are there other exception patterns to watch out for?+          exceptionMessage = "\\*\\*\\* Exception:.*" :: ByteString+          interactiveErrorMessage = "<interactive>:.*:.*:.error:.*" :: ByteString+          -- We need to know when ghci is initialized enough that it won't die when+          -- it receives an interrupt. We wait to see the version line in the output as+          -- a proxy for GHCi's readiness to be interrupted+          ghciVersionMessage = "GHCi, version.*: http://www.haskell.org/ghc/" :: ByteString+++      -- Inspect the output and determine what state GHCi is in+      status :: Dynamic t Status <- holdUniqDyn <=< foldDyn ($) Status_Initializing $ leftmost+        [ fforMaybe (updated errors) $ \err -> if err Regex.=~ exceptionMessage || err Regex.=~ interactiveErrorMessage+          then Just $ const Status_ExecutionFailed+          else Nothing+        , const Status_Loading <$ reload+        , ffor (updated output) $ \out -> case reverse (C8.lines out) of+            (lastLine:expectedMessage:_)+              | lastLine == prompt && expectedMessage Regex.=~ okModulesLoaded -> const Status_LoadSucceeded+              | lastLine == prompt && expectedMessage Regex.=~ failedNoModulesLoaded -> const Status_LoadFailed+              | lastLine == prompt -> \case+                  Status_Executing -> Status_ExecutionSucceeded+                  s -> s+              | lastLine Regex.=~ ghciVersionMessage -> const Status_Loading+              | otherwise -> \case+                  Status_LoadSucceeded -> case mexpr of+                    Nothing -> Status_LoadSucceeded+                    Just _ -> Status_Executing+                  s -> s+            _ -> id+        ]++  -- Determine when to switch output stream from GHCi module output to execution output+  execStream <- hold False $ leftmost+      [ False <$ reload+      , fforMaybe (updated status) $ \case+          Status_LoadSucceeded -> Just True+          Status_LoadFailed -> Just False+          Status_Executing -> Just True+          _ -> Nothing+      ]++  -- Below, we split up the output of the GHCi process into things that GHCi itself+  -- produces (e.g., errors, warnings, loading messages) and the output of the expression+  -- it is evaluating+  return $ Ghci+    { _ghci_moduleOut = gate (not <$> execStream) $ _process_stdout proc+    , _ghci_moduleErr = gate (not <$> execStream) $ _process_stderr proc+    , _ghci_execOut = gate execStream $ _process_stdout proc+    , _ghci_execErr = gate execStream $ _process_stderr proc+    , _ghci_reload = () <$ reload+    , _ghci_status = status+    , _ghci_process = proc+    }+  where+    prompt :: IsString a => a+    prompt = "<| Waiting |>"++-- | 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+     )+  => P.CreateProcess+  -> Maybe ByteString+  -> m (Ghci t)+ghciWatch p mexec = do+  -- Get the current directory so we can observe changes in it+  dir <- liftIO getCurrentDirectory++  -- TODO: Separate the filesystem event logic into its own function+  -- Watch the project directory for changes+  pb <- getPostBuild+  fsEvents <- watchDirectory (noDebounce FS.defaultConfig) (dir <$ pb)++  -- TODO Handle changes to "src" and ".cabal" differently. ":r" is only really appropriate+  -- when there are changes to loaded modules.+  -- We could use ":show modules" to see which hs files are loaded and determine what to do based+  -- on that, but we'll need to parse that output.+  let filteredFsEvents = flip ffilter fsEvents $ \e -> +        takeExtension (FS.eventPath e) `elem` [".hs", ".lhs"]++  -- Events are batched because otherwise we'd get several updates corresponding to one+  -- user-level change. For example, saving a file in vim results in an event claiming+  -- the file was removed followed almost immediately by an event adding the file+  batchedFsEvents <- batchOccurrences 0.1 filteredFsEvents++  -- Call GHCi and request a reload every time the files we're watching change+  ghci p mexec $ () <$ batchedFsEvents+  where+    noDebounce :: FS.WatchConfig -> FS.WatchConfig+    noDebounce cfg = cfg { FS.confDebounce = FS.NoDebounce }++-- | The output of the GHCi process+data Ghci t = Ghci+  { _ghci_moduleOut :: Event t ByteString+  -- ^ stdout output produced when loading modules+  , _ghci_moduleErr :: Event t ByteString+  -- ^ stderr output produced when loading modules+  , _ghci_execOut :: Event t ByteString+  -- ^ stdout output produced while evaluating an expression+  , _ghci_execErr :: Event t ByteString+  -- ^ stderr output produced while evaluating an expression+  , _ghci_reload :: Event t ()+  -- ^ Event that fires when GHCi is reloading+  , _ghci_status :: Dynamic t Status+  -- ^ The current status of the GHCi process+  , _ghci_process :: Process t+  }++-- | The state of the GHCi process+data Status+  = Status_Initializing+  | Status_Loading+  | Status_LoadFailed+  | Status_LoadSucceeded+  | Status_Executing+  | Status_ExecutionFailed+  | Status_ExecutionSucceeded+  deriving (Show, Read, Eq, Ord)++-- | Collect all the GHCi module output (i.e., errors, warnings, etc) and optionally clear+-- every time GHCi reloads+moduleOutput+  :: (Reflex t, MonadFix m, MonadHold t m)+  => Behavior t Bool+  -- ^ Whether to clear the output on reload+  -> Ghci t+  -> m (Dynamic t ByteString)+moduleOutput clear g = collectOutput+  (gate clear $ () <$ _ghci_reload g) $+    leftmost [_ghci_moduleOut g, _ghci_moduleErr g]++-- | Collect all the GHCi expression output (i.e., the output of the called function) and optionally clear+-- every time GHCi reloads+execOutput+  :: (Reflex t, MonadFix m, MonadHold t m)+  => Behavior t Bool+  -- ^ Whether to clear the output on reload+  -> Ghci t+  -> m (Dynamic t ByteString)+execOutput clear g = collectOutput+  (gate clear $ () <$ _ghci_reload g) $+    leftmost [_ghci_execOut g, _ghci_execErr g]++-- | Collect output, appending new output to the end of the accumulator+collectOutput+  :: (Reflex t, MonadFix m, MonadHold t m)+  => Event t ()+  -- ^ Clear output+  -> Event t ByteString+  -- ^ Output to add+  -> m (Dynamic t ByteString)+collectOutput clear out = foldDyn ($) "" $ leftmost+  [ flip mappend <$> out+  , const "" <$ clear+  ]++-- | Describe the current status of GHCi in a human-readable way+statusMessage :: IsString a => Status -> a+statusMessage = \case+  Status_Initializing -> "Initializing..."+  Status_Loading -> "Loading Modules..."+  Status_LoadFailed -> "Failed to Load Modules!"+  Status_LoadSucceeded -> "Successfully Loaded Modules!"+  Status_Executing -> "Executing Command..."+  Status_ExecutionFailed -> "Command Failed!"+  Status_ExecutionSucceeded -> "Command Succeeded!"