diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for reflex-ghci +## 0.1.4.1 + +* Library: Require at least version 0.7.1 of `reflex`. +* Library: Require at least version 0.3 of `reflex-process`. +* Library: Expand version bounds for `regex-tdfa` and `vty`. +* Tests: Include test fixtures in sdist. +* Tests: Fix some bugs. + ## 0.1.4.0 * Library: Export `shutdown` and `getExitEvent` to make it easier for library users to cleanly exit diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,17 +20,18 @@ ```bash $ reflex-ghci -h -Welcome to reflex-ghci! +Welcome to reflex-ghci 0.1.4.0 -Usage: [-c|--command COMMAND] [-e|--expression EXPR] +Usage: reflex-ghci [-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") + run (default: "cabal repl --repl-options=-Wall") -e,--expression EXPR The optional expression to evaluate once modules have - successfully loaded (default: no expression) + successfully loaded -h,--help Show this help text + ``` Acknowledgements diff --git a/reflex-ghci.cabal b/reflex-ghci.cabal --- a/reflex-ghci.cabal +++ b/reflex-ghci.cabal @@ -1,6 +1,6 @@ -cabal-version: >=1.10 +cabal-version: 2.4 name: reflex-ghci -version: 0.1.4.0 +version: 0.1.4.1 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. @@ -8,7 +8,7 @@ <> . bug-reports: https://github.com/reflex-frp/reflex-ghci/issues -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Obsidian Systems LLC maintainer: maintainer@obsidian.systems @@ -18,6 +18,8 @@ extra-source-files: ChangeLog.md README.md screenshot.png + tests/**/*.hs + tests/**/*.cabal tested-with: GHC ==8.6.5 library @@ -31,14 +33,14 @@ , filepath >= 1.4 && < 1.5 , fsnotify >= 0.3 && < 0.4 , process >= 1.6 && < 1.7 - , reflex >= 0.6.3 && < 0.7 + , reflex >= 0.7.1.0 && < 0.8 , reflex-fsnotify >= 0.2 && < 0.3 - , reflex-process >= 0.2.1 && < 0.3 - , regex-tdfa >= 1.2.3 && < 1.3 + , reflex-process >= 0.3 && < 0.4 + , regex-tdfa >= 1.2.3 && < 1.4 , reflex-vty >= 0.1.3 && < 0.2 , text >= 1.2 && < 1.3 , unix >= 2.7 && < 2.8 - , vty >= 5.25 && < 5.26 + , vty >=5.21 && <5.29 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall @@ -50,12 +52,13 @@ base , optparse-applicative >= 0.14.0 && < 0.16 , process - , reflex + , reflex >= 0.7.1.0 , reflex-ghci , reflex-vty , reflex-process , text , vty + autogen-modules: Paths_reflex_ghci other-modules: Paths_reflex_ghci ghc-options: -threaded -rtsopts default-language: Haskell2010 @@ -70,7 +73,7 @@ , dependent-sum >= 0.6 && < 0.7 , directory , mtl >= 2.2 && < 2.3 - , primitive >= 0.6.4 && < 0.7 + , primitive >= 0.6.4 && < 0.8 , process , ref-tf >= 0.4 && < 0.5 , reflex @@ -79,7 +82,6 @@ , reflex-vty , temporary >= 1.3 && < 1.4 , text - other-modules: HeadlessHost ghc-options: -threaded -rtsopts default-language: Haskell2010 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 @@ -20,7 +20,7 @@ import Reflex import Reflex.FSNotify (watchDirectoryTree) -import Reflex.Process (ProcessConfig(..), Process(..), createProcess) +import Reflex.Process (ProcessConfig(..), Process(..), SendPipe(..), createProcess) import Control.Monad ((<=<)) import Control.Monad.Fix (MonadFix) @@ -55,7 +55,7 @@ ghci cmd mexpr reloadReq = do -- Run the process and feed it some input: rec proc <- createProcess cmd $ ProcessConfig - { _processConfig_stdin = leftmost + { _processConfig_stdin = SendPipe_Message . (<> "\n") <$> leftmost [ reload -- Execute some expression if GHCi is ready to receive it , fforMaybe (updated status) $ \case @@ -91,7 +91,7 @@ -- 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) + requestInterrupt = gate (interruptible <$> current status) (() <$ reloadReq) -- Define some Regex patterns to use to determine GHCi's state based on output let okModulesLoaded = "Ok.*module.*loaded." :: ByteString @@ -114,7 +114,7 @@ else Nothing , const Status_Loading <$ reload , ffor (updated output) $ \out -> case reverse (C8.lines out) of - (lastLine:expectedMessage:_) + lastLine:expectedMessage:_ | lastLine == prompt && expectedMessage Regex.=~ okModulesLoaded -> const Status_LoadSucceeded | lastLine == prompt && expectedMessage Regex.=~ failedNoModulesLoaded -> const Status_LoadFailed | lastLine == prompt -> \case @@ -127,7 +127,7 @@ Just _ -> Status_Executing s -> s - (lastLine:_) + lastLine:_ | lastLine Regex.=~ ghciVersionMessage -> const Status_Loading _ -> id ] diff --git a/tests/HeadlessHost.hs b/tests/HeadlessHost.hs deleted file mode 100644 --- a/tests/HeadlessHost.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ConstraintKinds #-} -module HeadlessHost where - -import Data.Maybe -import Reflex -import Control.Monad.Fix -import Control.Monad.Primitive -import Reflex.Host.Class -import Control.Monad.IO.Class -import Control.Monad.Ref -import Data.IORef -import Data.Dependent.Sum -import Control.Concurrent.Chan (newChan, readChan) -import Control.Monad (forM, forM_) -import Control.Monad.Identity (Identity(..)) - -type HeadlessResult t = Event t () - -type MonadHeadlessApp t m = - ( Reflex t - , MonadHold t m - , MonadFix m - , PrimMonad (HostFrame t) - , ReflexHost t - , MonadIO (HostFrame t) - , Ref m ~ IORef - , Ref (HostFrame t) ~ IORef - , MonadRef (HostFrame t) - , NotReady t m - , TriggerEvent t m - , PostBuild t m - , PerformEvent t m - , MonadIO m - , MonadIO (Performable m) - , Adjustable t m - ) - -runHeadlessApp - :: (forall t m. MonadHeadlessApp t m => m (HeadlessResult t)) - -> IO () -runHeadlessApp guest = - (runSpiderHost :: SpiderHost Global a -> IO a) $ do - (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef - events <- liftIO newChan - (vtyResult, fc@(FireCommand fire)) <- do - hostPerformEventT $ - flip runPostBuildT postBuild $ - flip runTriggerEventT events $ - guest - mPostBuildTrigger <- readRef postBuildTriggerRef - forM_ mPostBuildTrigger $ \postBuildTrigger -> - fire [postBuildTrigger :=> Identity ()] $ return () - shutdown <- subscribeEvent vtyResult - fix $ \loop -> do - ers <- liftIO $ readChan events - stop <- fireEventTriggerRefs fc ers $ readEvent shutdown >>= \case - Nothing -> return False - Just _ -> return True - if or stop - then return () - else loop - where - -- TODO Some part of this is probably general enough to belong in reflex - -- | Use the given 'FireCommand' to fire events that have subscribers - -- and call the callback for the 'TriggerInvocation' of each. - fireEventTriggerRefs - :: (Monad (ReadPhase m), MonadIO m) - => FireCommand t m - -> [DSum (EventTriggerRef t) TriggerInvocation] - -> ReadPhase m a - -> m [a] - fireEventTriggerRefs (FireCommand fire) ers rcb = do - mes <- liftIO $ - forM ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do - me <- readIORef er - return $ fmap (\e -> e :=> Identity a) me - a <- fire (catMaybes mes) rcb - liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb - return a diff --git a/tests/exe-pkg/Main.hs b/tests/exe-pkg/Main.hs new file mode 100644 --- /dev/null +++ b/tests/exe-pkg/Main.hs @@ -0,0 +1,10 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" + +err :: IO () +err = error "This is an error" + +done :: IO () +done = putStrLn "Done" diff --git a/tests/exe-pkg/Setup.hs b/tests/exe-pkg/Setup.hs new file mode 100644 --- /dev/null +++ b/tests/exe-pkg/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/exe-pkg/tests.cabal b/tests/exe-pkg/tests.cabal new file mode 100644 --- /dev/null +++ b/tests/exe-pkg/tests.cabal @@ -0,0 +1,26 @@ +cabal-version: >=1.10 +-- Initial package description 'tests.cabal' generated by 'cabal init'. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: tests +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +-- license: +license-file: LICENSE +author: Ali Abrar +maintainer: aliabrar@gmail.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md + +executable tests + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base + , reflex-ghci + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/tests/lib-pkg-err/Setup.hs b/tests/lib-pkg-err/Setup.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/lib-pkg-err/src/MyLib.hs b/tests/lib-pkg-err/src/MyLib.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/src/MyLib.hs @@ -0,0 +1,8 @@ +module MyLib (someFunc) where + +import MyLib.One +import MyLib.Two +import MyLib.Three + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/tests/lib-pkg-err/src/MyLib/One.hs b/tests/lib-pkg-err/src/MyLib/One.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/src/MyLib/One.hs @@ -0,0 +1,4 @@ +module MyLib.One where + +data One = One + deriving Show diff --git a/tests/lib-pkg-err/src/MyLib/Three.hs b/tests/lib-pkg-err/src/MyLib/Three.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/src/MyLib/Three.hs @@ -0,0 +1,6 @@ +module MyLib.Three where + +data Three = Three + deriving Show + +data Three = Four diff --git a/tests/lib-pkg-err/src/MyLib/Two.hs b/tests/lib-pkg-err/src/MyLib/Two.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/src/MyLib/Two.hs @@ -0,0 +1,4 @@ +module MyLib.Two where + +data Two = Two + deriving Show diff --git a/tests/lib-pkg-err/test-pkg2.cabal b/tests/lib-pkg-err/test-pkg2.cabal new file mode 100644 --- /dev/null +++ b/tests/lib-pkg-err/test-pkg2.cabal @@ -0,0 +1,28 @@ +cabal-version: >=1.10 +-- Initial package description 'test-pkg2.cabal' generated by 'cabal init'. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: test-pkg2 +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD3 +license-file: LICENSE +author: Ali Abrar +maintainer: aliabrar@gmail.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md + +library + exposed-modules: MyLib + MyLib.One + MyLib.Two + MyLib.Three + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/tests/lib-pkg/Setup.hs b/tests/lib-pkg/Setup.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/lib-pkg/dist-newstyle/build/x86_64-linux/ghc-8.8.3/test-pkg2-0.1.0.0/build/autogen/Paths_test_pkg2.hs b/tests/lib-pkg/dist-newstyle/build/x86_64-linux/ghc-8.8.3/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.8.3/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/elliot/.cabal/bin" +libdir = "/home/elliot/.cabal/lib/x86_64-linux-ghc-8.8.3/test-pkg2-0.1.0.0-inplace" +dynlibdir = "/home/elliot/.cabal/lib/x86_64-linux-ghc-8.8.3" +datadir = "/home/elliot/.cabal/share/x86_64-linux-ghc-8.8.3/test-pkg2-0.1.0.0" +libexecdir = "/home/elliot/.cabal/libexec/x86_64-linux-ghc-8.8.3/test-pkg2-0.1.0.0" +sysconfdir = "/home/elliot/.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/src/MyLib.hs b/tests/lib-pkg/src/MyLib.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/src/MyLib.hs @@ -0,0 +1,16 @@ +module MyLib (someFunc) where + +import MyLib.One +import MyLib.Two +import MyLib.Three + +someFunc :: IO () +someFunc = putStrLn "someFunc" + +err :: IO () +err = do + Just a <- return Nothing + putStrLn a + +done :: IO () +done = putStrLn "done" diff --git a/tests/lib-pkg/src/MyLib/One.hs b/tests/lib-pkg/src/MyLib/One.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/src/MyLib/One.hs @@ -0,0 +1,4 @@ +module MyLib.One where + +data One = One + deriving Show diff --git a/tests/lib-pkg/src/MyLib/Three.hs b/tests/lib-pkg/src/MyLib/Three.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/src/MyLib/Three.hs @@ -0,0 +1,4 @@ +module MyLib.Three where + +data Three = Three + deriving Show diff --git a/tests/lib-pkg/src/MyLib/Two.hs b/tests/lib-pkg/src/MyLib/Two.hs new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/src/MyLib/Two.hs @@ -0,0 +1,4 @@ +module MyLib.Two where + +data Two = Two + deriving Show diff --git a/tests/lib-pkg/test-pkg2.cabal b/tests/lib-pkg/test-pkg2.cabal new file mode 100644 --- /dev/null +++ b/tests/lib-pkg/test-pkg2.cabal @@ -0,0 +1,28 @@ +cabal-version: >=1.10 +-- Initial package description 'test-pkg2.cabal' generated by 'cabal init'. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: test-pkg2 +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD3 +license-file: LICENSE +author: Ali Abrar +maintainer: aliabrar@gmail.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md + +library + exposed-modules: MyLib + MyLib.One + MyLib.Two + MyLib.Three + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -2,9 +2,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -import HeadlessHost + import Reflex +import Reflex.Host.Headless import Reflex.Process.GHCi import Reflex.Vty import Reflex.Vty.GHCi @@ -188,13 +188,14 @@ let loadFailed = fforMaybe (updated $ _ghci_status g) $ \case Status_LoadFailed -> Just () _ -> Nothing - numFailures :: Dynamic t Int <- count loadFailed - performEvent_ $ ffor loadFailed $ \_ -> liftIO $ do + + loadFailedDelayed <- delay 1 loadFailed -- If we respond too quickly, fsnotify won't deliver the change. + performEvent_ $ ffor loadFailedDelayed $ \_ -> liftIO $ do putStrLn "copying fixed file" - P.callProcess "cp" - [ src <> "/tests/lib-pkg/src/MyLib/Three.hs" - , p <> "/lib-pkg-err/src/MyLib/Three.hs" - ] + copyFile (src <> "/tests/lib-pkg/src/MyLib/Three.hs") + (p <> "/lib-pkg-err/src/MyLib/Three.hs") + + numFailures :: Dynamic t Int <- count loadFailed let loadSucceeded = fforMaybe (updated $ _ghci_status g) $ \case Status_LoadSucceeded -> Just () _ -> Nothing @@ -202,7 +203,7 @@ if x > 1 then Just $ error "Too many failures." else Nothing - return loadSucceeded + return $ gate ((>= 1) <$> current numFailures) loadSucceeded testModuleLoadFailed :: ( MonadIO m