diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for reflex-ghci +## 0.1.5.0 + +* Fix various circumstances under which reflex-ghci would hang due to failure to properly parse GHCi output or failure to detect filesystem changes (the latter particularly on macOS) + ## 0.1.4.2 * Tests: Ensure proper shutdown. diff --git a/reflex-ghci.cabal b/reflex-ghci.cabal --- a/reflex-ghci.cabal +++ b/reflex-ghci.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: reflex-ghci -version: 0.1.4.2 +version: 0.1.5.0 synopsis: A GHCi widget library for use in reflex applications description: Run GHCi from within a Reflex FRP () application and interact with it using a functional reactive interface. diff --git a/src/Reflex/Process/GHCi.hs b/src/Reflex/Process/GHCi.hs --- a/src/Reflex/Process/GHCi.hs +++ b/src/Reflex/Process/GHCi.hs @@ -31,10 +31,14 @@ import System.Directory (getCurrentDirectory) import qualified System.FSNotify as FS import System.FilePath.Posix (takeExtension) +import qualified System.Info as Sys import System.Posix.Signals (sigINT) import qualified System.Process as P import qualified Text.Regex.TDFA as Regex ((=~)) +msg :: (IsString a, Semigroup a) => a -> a +msg = (<>) ": " + -- | Runs a GHCi process and reloads it whenever the provided event fires ghci :: ( TriggerEvent t m @@ -54,22 +58,33 @@ -> m (Ghci t) ghci cmd mexpr reloadReq = do -- Run the process and feed it some input: + let msgInit = msg "performing setup..." + msgExprStarted = msg "evaluating expression..." + msgExprFinished = msg "expression evaluation ended." + putMsgLn :: ByteString -> ByteString + putMsgLn m = "Prelude.putStrLn \"" <> m <> "\"\n" rec proc <- createProcess cmd $ ProcessConfig { _processConfig_stdin = SendPipe_Message . (<> "\n") <$> leftmost [ reload -- Execute some expression if GHCi is ready to receive it , fforMaybe (updated status) $ \case - Status_LoadSucceeded -> mexpr + Status_LoadSucceeded -> ffor mexpr $ \expr -> + C8.intercalate "\n" + [ putMsgLn msgExprStarted + , putMsgLn expr + , expr + , putMsgLn msgExprFinished + ] _ -> 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...\"" + [ putMsgLn msgInit , ":set prompt ..." , ":set -fno-break-on-exception" , ":set -fno-break-on-error" , ":set prompt \"\"" - , "Prelude.putStrLn \"\"" + , putMsgLn "" , ":set prompt " <> prompt , ":r" ] @@ -106,7 +121,6 @@ -- a proxy for GHCi's readiness to be interrupted ghciVersionMessage = "GHCi, version.*: https?://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 @@ -117,9 +131,8 @@ 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 == prompt && expectedMessage == msgExprStarted -> const Status_Executing + | lastLine Regex.=~ (prompt :: String) && expectedMessage Regex.=~ msgExprFinished -> const Status_ExecutionSucceeded | lastLine Regex.=~ ghciVersionMessage -> const Status_Loading | otherwise -> \case Status_LoadSucceeded -> case mexpr of @@ -184,7 +197,13 @@ -- 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. - fsEvents <- watchDirectoryTree (noDebounce FS.defaultConfig) (dir <$ pb) $ \e -> + -- On macOS, use the polling backend due to https://github.com/luite/hfsevents/issues/13 + -- TODO check if this is an issue with nixpkgs + let fsConfig = noDebounce $ FS.defaultConfig + { FS.confUsePolling = Sys.os == "darwin" + , FS.confPollInterval = 250000 + } + fsEvents <- watchDirectoryTree fsConfig (dir <$ pb) $ \e -> takeExtension (FS.eventPath e) `elem` [".hs", ".lhs"] -- Events are batched because otherwise we'd get several updates corresponding to one diff --git a/tests/exe-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/tests-0.1.0.0/x/tests/build/tests/autogen/Paths_tests.hs b/tests/exe-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/tests-0.1.0.0/x/tests/build/tests/autogen/Paths_tests.hs new file mode 100644 --- /dev/null +++ b/tests/exe-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/tests-0.1.0.0/x/tests/build/tests/autogen/Paths_tests.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} +module Paths_tests ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +version :: Version +version = Version [0,1,0,0] [] +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath + +bindir = "/home/ali/.cabal/bin" +libdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5/tests-0.1.0.0-inplace-tests" +dynlibdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5" +datadir = "/home/ali/.cabal/share/x86_64-linux-ghc-8.6.5/tests-0.1.0.0" +libexecdir = "/home/ali/.cabal/libexec/x86_64-linux-ghc-8.6.5/tests-0.1.0.0" +sysconfdir = "/home/ali/.cabal/etc" + +getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath +getBinDir = catchIO (getEnv "tests_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "tests_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "tests_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "tests_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "tests_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "tests_sysconfdir") (\_ -> return sysconfdir) + +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir ++ "/" ++ name) diff --git a/tests/lib-pkg-err/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs b/tests/lib-pkg-err/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} +module Paths_test_pkg2 ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +version :: Version +version = Version [0,1,0,0] [] +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath + +bindir = "/home/ali/.cabal/bin" +libdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0-inplace" +dynlibdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5" +datadir = "/home/ali/.cabal/share/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0" +libexecdir = "/home/ali/.cabal/libexec/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0" +sysconfdir = "/home/ali/.cabal/etc" + +getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath +getBinDir = catchIO (getEnv "test_pkg2_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "test_pkg2_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "test_pkg2_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "test_pkg2_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "test_pkg2_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "test_pkg2_sysconfdir") (\_ -> return sysconfdir) + +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir ++ "/" ++ name) diff --git a/tests/lib-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs b/tests/lib-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/dist-newstyle/build/x86_64-linux/ghc-8.6.5/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} +module Paths_test_pkg2 ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +version :: Version +version = Version [0,1,0,0] [] +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath + +bindir = "/home/ali/.cabal/bin" +libdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0-inplace" +dynlibdir = "/home/ali/.cabal/lib/x86_64-linux-ghc-8.6.5" +datadir = "/home/ali/.cabal/share/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0" +libexecdir = "/home/ali/.cabal/libexec/x86_64-linux-ghc-8.6.5/test-pkg2-0.1.0.0" +sysconfdir = "/home/ali/.cabal/etc" + +getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath +getBinDir = catchIO (getEnv "test_pkg2_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "test_pkg2_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "test_pkg2_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "test_pkg2_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "test_pkg2_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "test_pkg2_sysconfdir") (\_ -> return sysconfdir) + +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir ++ "/" ++ name) diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -233,3 +233,11 @@ eValue <- hold Nothing $ Just <$> e after <- shutdown $ g <$ e pure $ fmapMaybe id $ tag eValue after + +debug :: (Reflex t, PerformEvent t m, MonadIO (Performable m)) => Ghci t -> m () +debug g = do + performEvent_ $ ffor (updated $ _ghci_status g) $ liftIO . print + performEvent_ $ ffor (_ghci_moduleOut g) $ liftIO . print + performEvent_ $ ffor (_ghci_moduleErr g) $ liftIO . print + performEvent_ $ ffor (_ghci_execOut g) $ liftIO . print + performEvent_ $ ffor (_ghci_execErr g) $ liftIO . print