Merge in develop again

default.nix

@@ -1,6 +1,6 @@
 haskellPackages: nixpkgs: {
   reflex-dom = haskellPackages.callPackage ./reflex-dom {};
   reflex-dom-core = haskellPackages.callPackage ./reflex-dom-core {
-    inherit (nixpkgs) xvfb_run chromium;
+    inherit (nixpkgs) iproute chromium;
   };
 }

reflex-dom-core/default.nix

@@ -4,12 +4,12 @@
 , exception-transformers, ghcjs-dom, hlint, jsaddle, keycode, lens
 , monad-control, mtl, primitive, random, ref-tf, reflex, semigroups
 , stdenv, stm, template-haskell, temporary, text, these, time
-, transformers, unbounded-delays, unix, zenc, hashable, xvfb_run
-, chromium, process, jsaddle-warp
+, transformers, unbounded-delays, unix, zenc, hashable
+, chromium, process, jsaddle-warp, linux-namespaces, iproute
 }:
 let addGcTestDepends = drv: if stdenv.system != "x86_64-linux" then drv else drv // {
-      testHaskellDepends = (drv.testHaskellDepends or []) ++ [ temporary jsaddle-warp process ];
-      testSystemDepends = (drv.testSystemDepends or []) ++ [ xvfb_run chromium ];
+      testHaskellDepends = (drv.testHaskellDepends or []) ++ [ temporary jsaddle-warp process linux-namespaces ];
+      testSystemDepends = (drv.testSystemDepends or []) ++ [ chromium iproute ];
     };
 in mkDerivation (addGcTestDepends {
   pname = "reflex-dom-core";
@@ -31,6 +31,9 @@ in mkDerivation (addGcTestDepends {
     export HOME="$PWD"
   '';
 
+  # Show some output while running tests, so we might notice what's wrong
+  testTarget = "--show-details=streaming";
+
   testHaskellDepends = [ base hlint ];
   description = "Functional Reactive Web Apps with Reflex";
   license = stdenv.lib.licenses.bsd3;

reflex-dom-core/reflex-dom-core.cabal

@@ -146,8 +146,10 @@ test-suite gc
                , reflex-dom-core
                , jsaddle
                , jsaddle-warp
+               , linux-namespaces
                , process
                , temporary
+               , unix
   hs-source-dirs: test
   ghc-options: -rtsopts -with-rtsopts=-T -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans
   ghc-prof-options: -fprof-auto

reflex-dom-core/src/Foreign/JavaScript/TH.hs

@@ -284,6 +284,7 @@ class Monad m => MonadJS x m | m -> x where
 #ifdef ghcjs_HOST_OS
 
 data JSCtx_IO
+type HasJS' = HasJS JSCtx_IO
 
 instance MonadIO m => HasJS JSCtx_IO (WithJSContextSingleton x m) where
   type JSX (WithJSContextSingleton x m) = IO
@@ -334,6 +335,7 @@ foreign import javascript unsafe "function(){ return $1(arguments); }" funWithAr
 #else
 
 data JSCtx_JavaScriptCore x
+type HasJS' = HasJS (JSCtx_JavaScriptCore ())
 
 instance IsJSContext (JSCtx_JavaScriptCore x) where
   newtype JSRef (JSCtx_JavaScriptCore x) = JSRef_JavaScriptCore { unJSRef_JavaScriptCore :: JSVal }

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs

@@ -665,7 +665,7 @@ type LiftDomBuilder t f m =
 
 class MonadTransControl t => MonadTransControlStateless t where
   stTCoercion :: proxy t -> Coercion (StT t a) a
-  default stTCoercion :: proxy t -> Coercion a a
+  default stTCoercion :: (a ~ StT t a) => proxy t -> Coercion (StT t a) a
   stTCoercion _ = Control.Category.id
 
 toStT :: MonadTransControlStateless t => proxy t -> a -> StT t a

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs

@@ -242,7 +242,7 @@ runImmediateDomBuilderT (ImmediateDomBuilderT a) env eventChan = do
 
 class Monad m => HasDocument m where
   askDocument :: m Document
-  default askDocument :: (m ~ f m', MonadTrans f, Monad m', HasDocument m') => f m' Document
+  default askDocument :: (m ~ f m', MonadTrans f, Monad m', HasDocument m') => m Document
   askDocument = lift askDocument
 
 instance HasDocument m => HasDocument (ReaderT r m)

reflex-dom-core/src/Reflex/Dom/Modals/Base.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Reflex.Dom.Modals.Base
   ( ModalsT (..)
   , ModalLayerConfig (..)
@@ -142,6 +143,11 @@ instance (DomBuilder t m) => Default (ModalLayerConfig t m) where
         & initialAttributes .~ ("style" =: "background-color:white;opacity:1;padding:1em")
     }
 
+instance (MonadQuery t q m, Monad m) => MonadQuery t q (ModalsT t m) where
+  tellQueryIncremental = lift . tellQueryIncremental
+  askQueryResult = lift askQueryResult
+  queryIncremental = lift . queryIncremental
+
 withModalLayer :: forall t m a. (Reflex t, MonadFix m, DomBuilder t m, MonadHold t m)
                => ModalLayerConfig t m
                -> ModalsT t m a

reflex-dom-core/test/gc.hs

@@ -10,7 +10,9 @@ import Language.Javascript.JSaddle.Warp
 import Reflex.Dom.Core
 import System.Exit
 import System.IO.Temp
+import System.Linux.Namespaces
 import System.Mem
+import System.Posix
 import System.Process
 
 -- In initial testing, the minimum live bytes count was 233128 and maximum was
@@ -32,12 +34,16 @@ failureLimit = 0
 
 main :: IO ()
 main = do
+  uid <- getEffectiveUserID
+  unshare [User, Network]
+  writeUserMappings Nothing [UserMapping 0 uid 1]
   mainThread <- myThreadId
   withSystemTempDirectory "reflex-dom-core_test_gc" $ \tmp -> do
-    browserProcess <- spawnCommand $ "xvfb-run -a chromium --disable-gpu --user-data-dir=" ++ tmp ++ " http://localhost:3911"
+    browserProcess <- spawnCommand $ "ip link set lo up ; ip addr ; sleep 1 ; echo 'Starting Chromium' ; chromium --headless --disable-gpu --no-sandbox --remote-debugging-port=9222 --user-data-dir=" ++ tmp ++ " http://localhost:3911 ; echo 'Chromium exited'"
     let finishTest result = do
           interruptProcessGroupOf browserProcess
           throwTo mainThread result
+    putStrLn "About to start the server"
     run 3911 $ do
       -- enableLogging True
       liftIO $ putStrLn "Running..."