reflex-dom-core 0.6.3.0 → 0.8.1.4

raw patch · 29 files changed

Files

• ChangeLog.md +43/−0
• reflex-dom-core.cabal +38/−29
• src-ghcjs/Foreign/JavaScript/Internal/Utils.hs +7/−0
• src/Foreign/JavaScript/TH.hs +8/−435
• src/Reflex/Dom/Builder/Class.hs +29/−27
• src/Reflex/Dom/Builder/Class/Events.hs +5/−3
• src/Reflex/Dom/Builder/Hydratable.hs +1/−10
• src/Reflex/Dom/Builder/Immediate.hs +34/−41
• src/Reflex/Dom/Builder/InputDisabled.hs +0/−10
• src/Reflex/Dom/Builder/Static.hs +5/−7
• src/Reflex/Dom/Location.hs +23/−3
• src/Reflex/Dom/Main.hs +4/−5
• src/Reflex/Dom/Old.hs +2/−4
• src/Reflex/Dom/Prerender.hs +50/−78
• src/Reflex/Dom/WebSocket.hs +6/−10
• src/Reflex/Dom/WebSocket/Foreign.hs +2/−3
• src/Reflex/Dom/WebSocket/Query.hs +3/−3
• src/Reflex/Dom/Widget/Basic.hs +4/−8
• src/Reflex/Dom/Widget/Input.hs +9/−11
• src/Reflex/Dom/Widget/Lazy.hs +2/−2
• src/Reflex/Dom/Widget/Resize.hs +1/−2
• src/Reflex/Dom/Xhr.hs +14/−16
• src/Reflex/Dom/Xhr/Exception.hs +1/−4
• src/Reflex/Dom/Xhr/Foreign.hs +0/−1
• src/Reflex/Dom/Xhr/FormData.hs +15/−4
• src/Reflex/Dom/Xhr/ResponseType.hs +1/−4
• test/gc.hs +1/−2
• test/hlint.hs +3/−0
• test/hydration.hs +27/−26

@@ -1,5 +1,48 @@ # Revision history for reflex-dom-core +## 0.8.1.4+* Support hashable 1.5 in JS backend++## 0.8.1.3+* Fixes for JS backend FFI++## 0.8.1.2+* Support GHC 9.12++## 0.8.1.1+* Support GHC 9.10++## 0.8.1.0++* Add functions for managing history (popHistoryState and manageHistoryExposingExternalUpdates)++## 0.8.0.0-r1++* Loosen lens version bounds++## 0.8.0.0++* Support reflex 0.9+* *Breaking change*: tableDynAttr now requires an `Eq` constraint on the row value type+* *Breaking change*: all of the virtualList functions in Reflex.Dom.Widget.Lazy now require an `Eq` constraint on the row value type++## 0.7.0.3++* Loosen version bounds of aeson, ref-tf and constraints++## 0.7.0.2++* Require reflex >= 0.8.2.1 and switch to `commutative-semigroups`++## 0.7.0.1++* Add a variant of `postForms` that allows the `XhrRequestConfig` to be specified.++## 0.7.0.0++* ([#429](https://github.com/reflex-frp/reflex-dom/pull/429)) **(Breaking change)** Remove HasJS, HasJSContext and MonadJS. This change also removes the `js` type parameter from `Prerender`. Change `Prerender js t m` to `Prerender t m`.+  * `Reflex.Dom.WebSocket.Foreign.newWebSocket` takes one fewer argument: the first argument used to be a js context+ ## 0.6.3.0  * Remove calls to `eval` in Reflex.Dom.Builder.Immediate when compiling with ghcjs

@@ -1,6 +1,6 @@ cabal-version: 1.24 Name: reflex-dom-core-Version: 0.6.3.0+Version: 0.8.1.4 Synopsis: Functional Reactive Web Apps with Reflex Description:   Web applications without callbacks or side-effects.@@ -64,60 +64,66 @@   default: True   manual: True +flag hlint-tests+  description: Whether to run the hlint tests+  default: False+  manual: True+ library   hs-source-dirs: src   build-depends:-    aeson >= 0.8 && < 1.6,-    base >= 4.7 && < 4.15,+    aeson >= 0.8 && < 2.3,+    base >= 4.7 && < 4.22,     bifunctors >= 4.2 && < 6,-    bimap >= 0.3 && < 0.5,+    bimap >= 0.3 && < 0.6,     blaze-builder >= 0.4.1 && < 0.5,-    bytestring == 0.10.*,+    bytestring >= 0.10 && < 0.13,     case-insensitive < 1.3,-    containers >= 0.6 && < 0.7,-    constraints >= 0.9 && < 0.13,+    commutative-semigroups >=0.1 && <0.3,+    containers >= 0.6 && < 0.8,+    constraints >= 0.9 && < 0.15,     contravariant >= 1.4 && < 1.6,-    data-default >= 0.5 && < 0.8,+    data-default >= 0.5 && < 0.9,     dependent-map >= 0.3 && < 0.5,     dependent-sum >= 0.6 && < 0.8,-    dependent-sum-template >= 0.1 && < 0.2,+    dependent-sum-template >= 0.1 && < 0.3,     directory >= 1.2 && < 1.4,     exception-transformers == 0.4.*,     ghcjs-dom >= 0.9.1.0 && < 0.10,     jsaddle >= 0.9.0.0 && < 0.10,     -- keycode-0.2 has a bug on firefox     keycode >= 0.2.1 && < 0.3,-    lens >= 4.7 && < 5,+    lens >= 4.7 && < 5.4,     monad-control >= 1.0.1 && < 1.1,-    mtl >= 2.1 && < 2.3,-    primitive >= 0.5 && < 0.8,-    random >= 1.1 && < 1.2,-    ref-tf == 0.4.*,-    reflex >= 0.8 && < 0.9,-    semigroups >= 0.16 && < 0.20,+    mtl >= 2.1 && < 2.4,+    primitive >= 0.5 && < 0.10,+    random >= 1.1 && < 1.4,+    ref-tf >= 0.4 && < 0.6,+    reflex >= 0.8.2.1 && < 1,+    semigroups >= 0.16 && < 0.21,     stm >= 2.4 && < 2.6,-    text == 1.2.*,-    transformers >= 0.3 && < 0.6,+    text >= 1.2 && < 2.2,+    transformers >= 0.3 && < 0.7,     network-uri >= 2.6.1 && < 2.7,     zenc == 0.1.* -  if impl(ghcjs)+  if impl(ghcjs) || arch(javascript)     hs-source-dirs: src-ghcjs     build-depends:       ghcjs-base,-      hashable >= 1.2 && < 1.4+      hashable >= 1.2 && < 1.6   else     hs-source-dirs: src-ghc     if !os(windows)-      build-depends: unix == 2.7.*+      build-depends: unix >= 2.7 && <2.9    if flag(split-these)     build-depends:-      semialign >= 1 && < 1.2,-      these >= 1 && < 1.2+      semialign >= 1 && < 1.4,+      these >= 1 && < 1.3   else     build-depends:-      these >= 0.4 && < 0.9+      these >= 0.4 && < 1.0    exposed-modules:     Foreign.JavaScript.TH@@ -154,7 +160,7 @@     Reflex.Dom.Xhr.Exception    default-language: Haskell98-  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively+  ghc-options: -Wall -fwarn-tabs -Wredundant-constraints -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively   ghc-prof-options: -fprof-auto    if flag(expose-all-unfoldings)@@ -168,8 +174,8 @@    if flag(use-template-haskell)     build-depends:-      dependent-sum-template >= 0.1 && < 0.2,-      template-haskell >= 2.12.0 && < 2.17+      dependent-sum-template >= 0.1 && < 0.3,+      template-haskell >= 2.12.0 && < 2.24     other-extensions: TemplateHaskell     cpp-options: -DUSE_TEMPLATE_HASKELL     other-modules:@@ -178,11 +184,14 @@ test-suite hlint   build-depends:     base,-    hlint >= 2.0 && < 4.0+    hlint >= 2.0 && < 4.0,+    reflex-dom-core   hs-source-dirs: test   main-is: hlint.hs   type: exitcode-stdio-1.0   default-language: Haskell98+  if !flag(hlint-tests)+    buildable: False  test-suite hydration   build-depends: base@@ -225,7 +234,7 @@                , websockets                , which   hs-source-dirs: test-  ghc-options: -rtsopts -with-rtsopts=-T -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans+  ghc-options: -rtsopts "-with-rtsopts=-T -V0" -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans   ghc-prof-options: -fprof-auto -optP-DPROFILING   main-is: hydration.hs   type: exitcode-stdio-1.0

@@ -1,5 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-}+#ifdef __ghcjs_HOST_OS {-# LANGUAGE JavaScriptFFI #-}+#endif  module Foreign.JavaScript.Internal.Utils   ( synchronously@@ -9,7 +12,11 @@  import GHCJS.Concurrent import GHCJS.DOM.Types (JSM, JSVal, RequestAnimationFrameCallback (..))+#if __GLASGOW_HASKELL__ < 900 import GHCJS.Foreign.Callback (releaseCallback)+#else+import GHC.JS.Foreign.Callback (releaseCallback)+#endif  freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM () freeRequestAnimationFrameCallback (RequestAnimationFrameCallback cb) = releaseCallback cb

@@ -1,18 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-#ifdef USE_TEMPLATE_HASKELL-{-# LANGUAGE TemplateHaskell #-}-#endif #ifdef ghcjs_HOST_OS {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-}@@ -27,27 +22,25 @@ import Prelude hiding ((!!)) import Reflex.Class import Reflex.Adjustable.Class-import Reflex.DynamicWriter.Base-import Reflex.EventWriter.Base import Reflex.Host.Class-import Reflex.PerformEvent.Base import Reflex.PerformEvent.Class-import Reflex.PostBuild.Base-import Reflex.Requester.Base-import Reflex.Query.Base (QueryT (..))  #ifdef USE_TEMPLATE_HASKELL import Language.Haskell.TH #endif -import GHCJS.DOM.Types (JSContextRef, Node (..), askJSM)+import GHCJS.DOM.Types (JSContextRef, askJSM) #ifdef ghcjs_HOST_OS import qualified GHCJS.Buffer as JS import GHCJS.DOM.Types (MonadJSM) import qualified GHCJS.DOM.Types as JS import qualified GHCJS.Foreign as JS+#if __GLASGOW_HASKELL__ < 900 import qualified GHCJS.Foreign.Callback as JS import qualified GHCJS.Foreign.Callback.Internal (Callback (..))+#else+import qualified GHC.JS.Foreign.Callback as JS+#endif import qualified JavaScript.Array as JS import qualified JavaScript.Array.Internal (SomeJSArray (..)) import qualified JavaScript.Object as JS@@ -60,75 +53,18 @@ import Foreign.Ptr import Text.Encoding.Z #else-import Control.Lens.Operators ((^.))-import Data.Word (Word8)-import GHCJS.DOM.Types (JSVal, MonadJSM (..), liftJSM, runJSM, toJSString, toJSVal)-import Language.Javascript.JSaddle (Function (..), array, eval, freeFunction, function, js, js1, jss, valBool,-                                    valIsNull, valIsUndefined, valMakeNumber, valMakeString, valToBool,-                                    valToNumber, valToText, valUndefined, (!!))+import GHCJS.DOM.Types (MonadJSM (..), runJSM) #endif -import Control.Concurrent-import Control.Monad import Control.Monad.Exception import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Primitive import Control.Monad.Reader import Control.Monad.Ref-import Control.Monad.State-import qualified Control.Monad.State.Strict as Strict import Control.Monad.Trans.Control-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS import Data.Coerce (coerce)-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T -class Monad m => HasJSContext m where-  type JSContextPhantom m :: *-  askJSContext :: m (JSContextSingleton (JSContextPhantom m))--type HasWebView = HasJSContext--- Not sure if we should deprecate this {-# DEPRECATED HasWebView "Use HasJSContext" #-}--instance HasJSContext m => HasJSContext (ReaderT r m) where-  type JSContextPhantom (ReaderT r m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (StateT r m) where-  type JSContextPhantom (StateT r m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (Strict.StateT r m) where-  type JSContextPhantom (Strict.StateT r m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (PostBuildT t m) where-  type JSContextPhantom (PostBuildT t m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance (ReflexHost t, HasJSContext (HostFrame t)) => HasJSContext (PerformEventT t m) where-  type JSContextPhantom (PerformEventT t m) = JSContextPhantom (HostFrame t)-  askJSContext = PerformEventT $ lift askJSContext--instance HasJSContext m => HasJSContext (EventWriterT t w m) where-  type JSContextPhantom (EventWriterT t w m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (DynamicWriterT t w m) where-  type JSContextPhantom (DynamicWriterT t w m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (RequesterT t request response m) where-  type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJSContext m => HasJSContext (QueryT t q m) where-  type JSContextPhantom (QueryT t q m) = JSContextPhantom m-  askJSContext = QueryT askJSContext- newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)  instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where@@ -191,10 +127,6 @@ runWithJSContextSingleton :: WithJSContextSingleton x m a -> JSContextSingleton x -> m a runWithJSContextSingleton = runReaderT . unWithJSContextSingleton -instance (Monad m) => HasJSContext (WithJSContextSingleton x m) where-  type JSContextPhantom (WithJSContextSingleton x m) = x-  askJSContext = WithJSContextSingleton ask- instance MonadRef m => MonadRef (WithJSContextSingleton x m) where   type Ref (WithJSContextSingleton x m) = Ref m   newRef = lift . newRef@@ -214,368 +146,9 @@ -- | A singleton type for a given JSContext; we use this to statically guarantee that different JSContexts don't get mixed up newtype JSContextSingleton x = JSContextSingleton { unJSContextSingleton :: JSContextRef } -#ifdef ghcjs_HOST_OS-type JSFFI_Internal = JS.MutableJSArray -> IO JS.JSVal-newtype JSFFI = JSFFI JSFFI_Internal-#else-newtype JSFFI = JSFFI String-#endif--data JSFun x = JSFun { unJSFun :: JSRef x #ifndef ghcjs_HOST_OS-    , unJSFunction :: Function-#endif-    }--instance ToJS x (JSFun x) where-  withJS r f = f (unJSFun r)--class IsJSContext x where-  data JSRef x--class (Monad m, MonadJSM (JSX m), MonadFix (JSX m), MonadJS x (JSX m)) => HasJS x m | m -> x where-  type JSX m :: * -> *-  liftJS :: JSX m a -> m a--instance HasJS x m => HasJS x (ReaderT r m) where-  type JSX (ReaderT r m) = JSX m-  liftJS = lift . liftJS--instance HasJS x m => HasJS x (PostBuildT t m) where-  type JSX (PostBuildT t m) = JSX m-  liftJS = lift . liftJS--instance (HasJS x (HostFrame t), ReflexHost t) => HasJS x (PerformEventT t m) where-  type JSX (PerformEventT t m) = JSX (HostFrame t)-  liftJS = PerformEventT . lift . liftJS--instance HasJS x m => HasJS x (DynamicWriterT t w m) where-  type JSX (DynamicWriterT t w m) = JSX m-  liftJS = lift . liftJS--instance HasJS x m => HasJS x (EventWriterT t w m) where-  type JSX (EventWriterT t w m) = JSX m-  liftJS = lift . liftJS--instance HasJS x m => HasJS x (RequesterT t request response m) where-  type JSX (RequesterT t request response m) = JSX m-  liftJS = lift . liftJS--instance HasJS x m => HasJS x (QueryT t q m) where-  type JSX (QueryT t q m) = JSX m-  liftJS = lift . liftJS---- | A Monad that is capable of executing JavaScript-class Monad m => MonadJS x m | m -> x where-  runJS :: JSFFI -> [JSRef x] -> m (JSRef x)-  forkJS :: m () -> m ThreadId-  mkJSUndefined :: m (JSRef x)-  isJSNull :: JSRef x -> m Bool-  isJSUndefined :: JSRef x -> m Bool-  fromJSBool :: JSRef x -> m Bool-  fromJSString :: JSRef x -> m String-  fromJSArray :: JSRef x -> m [JSRef x]-  fromJSUint8Array :: JSRef x -> m ByteString-  fromJSNumber :: JSRef x -> m Double-  withJSBool :: Bool -> (JSRef x -> m r) -> m r-  withJSString :: String -> (JSRef x -> m r) -> m r-  withJSNumber :: Double -> (JSRef x -> m r) -> m r-  withJSArray :: [JSRef x] -> (JSRef x -> m r) -> m r-  withJSUint8Array :: ByteString -> (JSUint8Array x -> m r) -> m r-  -- | Create a JSFun with zero arguments; should be equilvant to `syncCallback AlwaysRetain True` in GHCJS-  mkJSFun :: ([JSRef x] -> m (JSRef x)) -> m (JSFun x) --TODO: Support 'this', exceptions-  freeJSFun :: JSFun x -> m ()-  setJSProp :: String -> JSRef x -> JSRef x -> m ()-  getJSProp :: String -> JSRef x -> m (JSRef x)-  withJSNode :: Node -> (JSRef x -> m r) -> m r--#ifdef ghcjs_HOST_OS--data JSCtx_IO-type JS' = JSCtx_IO--instance MonadIO m => HasJS JSCtx_IO (WithJSContextSingleton x m) where-  type JSX (WithJSContextSingleton x m) = IO-  liftJS = liftIO--instance IsJSContext JSCtx_IO where-  newtype JSRef JSCtx_IO = JSRef_IO { unJSRef_IO :: JS.JSVal }--instance MonadJS JSCtx_IO IO where-  runJS (JSFFI f) l = fmap JSRef_IO . f =<< JS.fromListIO (coerce l)-  forkJS = forkIO-  mkJSUndefined = return $ JSRef_IO JS.jsUndefined-  isJSNull (JSRef_IO r) = return $ JS.isNull r-  isJSUndefined (JSRef_IO r) = return $ JS.isUndefined r-  fromJSBool (JSRef_IO r) = return $ JS.fromJSBool r-  fromJSString (JSRef_IO r) = return $ JS.fromJSString $ JS.pFromJSVal r-  fromJSArray (JSRef_IO r) = fmap coerce $ JS.toListIO $ coerce r-  fromJSUint8Array (JSRef_IO r) = fmap (JS.toByteString 0 Nothing . JS.createFromArrayBuffer) $ JSArrayBuffer.unsafeFreeze $ JS.pFromJSVal r --TODO: Assert that this is immutable-  fromJSNumber (JSRef_IO r) = JS.fromJSValUnchecked r-  withJSBool b f = f $ JSRef_IO $ JS.toJSBool b-  withJSString s f = f $ JSRef_IO $ JS.pToJSVal $ JS.toJSString s-  withJSNumber n f = do-    r <- JS.toJSVal n-    f $ JSRef_IO r-  withJSArray l f = do-    r <- JS.fromListIO $ coerce l-    f $ JSRef_IO $ coerce r-  withJSUint8Array payload f = BS.useAsCString payload $ \cStr -> do-    ba <- extractByteArray cStr $ BS.length payload-    f $ JSUint8Array $ JSRef_IO ba-  mkJSFun f = do-    cb <- JS.syncCallback1' $ \args -> do-      l <- JS.toListIO $ coerce args-      JSRef_IO result <- f $ coerce l-      return result-    fmap (JSFun . JSRef_IO) $ funWithArguments $ coerce cb-  freeJSFun (JSFun (JSRef_IO r)) = JS.releaseCallback $ coerce r-  setJSProp s (JSRef_IO v) (JSRef_IO o) = JS.setProp (JS.toJSString s) v $ coerce o-  getJSProp s (JSRef_IO o) = do-    r <- JS.getProp (JS.toJSString s) $ coerce o-    return $ JSRef_IO r-  withJSNode n f = f $ JSRef_IO $ unNode n--foreign import javascript unsafe "new Uint8Array($1_1.buf, $1_2, $2)" extractByteArray :: Ptr CChar -> Int -> IO JS.JSVal--foreign import javascript unsafe "function(){ return $1(arguments); }" funWithArguments :: JS.Callback (JS.MutableJSArray -> IO a) -> IO JS.JSVal--#else--data JSCtx_JavaScriptCore x-type JS' = JSCtx_JavaScriptCore ()--instance IsJSContext (JSCtx_JavaScriptCore x) where-  newtype JSRef (JSCtx_JavaScriptCore x) = JSRef_JavaScriptCore { unJSRef_JavaScriptCore :: JSVal }--instance MonadIO m => HasJS (JSCtx_JavaScriptCore x) (WithJSContextSingleton x m) where-  type JSX (WithJSContextSingleton x m) = WithJSContextSingleton x IO-  liftJS a = do-    wv <- askJSContext-    liftIO $ runWithJSContextSingleton a wv--newtype WithJSContext x m a = WithJSContext { unWithJSContext :: ReaderT JSContextRef m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)--runWithJSContext :: WithJSContext x m a -> JSContextRef -> m a-runWithJSContext = runReaderT . unWithJSContext- instance MonadIO m => MonadJSM (WithJSContextSingleton x m) where   liftJSM' f = do-    wv <- askJSContext+    wv <- WithJSContextSingleton ask     runJSM f $ unJSContextSingleton wv--instance MonadIO m => MonadJSM (WithJSContext x m) where-  liftJSM' f =-    runJSM f =<< WithJSContext ask--lowerWithJSContext :: MonadJSM m => WithJSContext x IO a -> m a-lowerWithJSContext a = do-  c <- askJSM-  liftIO $ runWithJSContext a c--liftWithJSContextSingletonThroughWithJSContext :: (HasJSContext m, MonadJSM m, MonadTrans t, Monad m1)-                                    => ((t1 -> t m1 a) -> WithJSContext x IO b)-                                    -> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a)-                                    -> m b-liftWithJSContextSingletonThroughWithJSContext f a = do-  wv <- askJSContext-  lowerWithJSContext $ f $ \b' -> lift $ runWithJSContextSingleton (a b') wv--instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContextSingleton x IO) where-  forkJS a = do-    wv <- askJSContext-    liftIO $ forkIO $ runWithJSContextSingleton a wv-  mkJSFun a = do-    wv <- askJSContext-    lowerWithJSContext $ mkJSFun $ \args -> lift $ runWithJSContextSingleton (a args) wv-  runJS expr args = lowerWithJSContext $ runJS expr args-  mkJSUndefined = lowerWithJSContext mkJSUndefined-  isJSNull = lowerWithJSContext . isJSNull-  isJSUndefined = lowerWithJSContext . isJSUndefined-  fromJSBool = lowerWithJSContext . fromJSBool-  fromJSString = lowerWithJSContext . fromJSString-  fromJSArray = lowerWithJSContext . fromJSArray-  fromJSUint8Array = lowerWithJSContext . fromJSUint8Array-  fromJSNumber = lowerWithJSContext . fromJSNumber-  freeJSFun = lowerWithJSContext . freeJSFun-  withJSBool = liftWithJSContextSingletonThroughWithJSContext . withJSBool-  withJSString = liftWithJSContextSingletonThroughWithJSContext . withJSString-  withJSNumber = liftWithJSContextSingletonThroughWithJSContext . withJSNumber-  withJSArray = liftWithJSContextSingletonThroughWithJSContext . withJSArray-  withJSUint8Array = liftWithJSContextSingletonThroughWithJSContext . withJSUint8Array-  withJSNode = liftWithJSContextSingletonThroughWithJSContext . withJSNode-  setJSProp propName valRef objRef = lowerWithJSContext $ setJSProp propName valRef objRef-  getJSProp propName objRef = lowerWithJSContext $ getJSProp propName objRef--instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContext x IO) where-  runJS (JSFFI body) args =-    withJSArray args $ \(JSRef_JavaScriptCore this) -> do-      result <- liftJSM $ eval ("(function(){ return (" <> body <> "); })") ^. js1 "apply" this-      return $ JSRef_JavaScriptCore result-  forkJS a = do-    c <- askJSM-    liftIO . forkIO $ runWithJSContext a c-  mkJSUndefined = return $ JSRef_JavaScriptCore valUndefined-  isJSNull (JSRef_JavaScriptCore r) = liftJSM $ valIsNull r-  isJSUndefined (JSRef_JavaScriptCore r) = liftJSM $ valIsUndefined r-  fromJSBool (JSRef_JavaScriptCore r) = liftJSM $ valToBool r-  fromJSString (JSRef_JavaScriptCore r) = liftJSM (T.unpack <$> valToText r)-  withJSBool b a = a $ JSRef_JavaScriptCore (valBool b)-  withJSString str a = a . JSRef_JavaScriptCore =<< liftJSM (valMakeString $ toJSString str)-  withJSNumber n a = a . JSRef_JavaScriptCore =<< liftJSM (valMakeNumber n)-  withJSArray elems a = a . JSRef_JavaScriptCore =<< liftJSM-    (toJSVal =<< array (map (\(JSRef_JavaScriptCore r) -> r) elems))-  withJSUint8Array payload f = withJSArrayFromList (BS.unpack payload) $ \x -> do-    payloadRef <- runJS (JSFFI "new Uint8Array(this[0])") [x]-    f $ JSUint8Array payloadRef-  fromJSArray (JSRef_JavaScriptCore a) = liftJSM $ do-    len <- round <$> (valToNumber =<< (a ^. js "length"))-    forM [0..len-1] $ fmap JSRef_JavaScriptCore . (a !!)-  fromJSUint8Array a = do-    vals <- fromJSArray a-    doubles <- mapM fromJSNumber vals-    return $ BS.pack $ map round doubles-  fromJSNumber (JSRef_JavaScriptCore val) = liftJSM $ valToNumber val-  mkJSFun a = liftJSM $ do-    ctx <- askJSM-    f <- function $ \_ _ args -> liftIO $ void $ runWithJSContext (a $ map JSRef_JavaScriptCore args) ctx-    fRef <- toJSVal f-    return $ JSFun (JSRef_JavaScriptCore fRef) f-  freeJSFun (JSFun _ f) = liftJSM $ freeFunction f-  setJSProp propName (JSRef_JavaScriptCore valRef) (JSRef_JavaScriptCore objRef) =-    liftJSM $ objRef ^. jss propName valRef-  getJSProp propName (JSRef_JavaScriptCore objRef) =-    JSRef_JavaScriptCore <$> liftJSM (objRef ^. js propName)-  withJSNode n f = f . JSRef_JavaScriptCore =<< liftJSM (toJSVal n)--#endif--class FromJS x a where-  fromJS :: MonadJS x m => JSRef x -> m a--instance FromJS x () where-  fromJS _ = return () --TODO: Should this do some kind of checking for the js value?--instance FromJS x Bool where-  fromJS = fromJSBool--instance ToJS x Bool where-  withJS = withJSBool--instance FromJS x String where-  fromJS = fromJSString--instance FromJS x Text where-  fromJS s = T.pack <$> fromJSString s--instance FromJS x a => FromJS x (Maybe a) where-  fromJS x = do-    n <- isJSNull x-    if n then return Nothing else Just <$> fromJS x--class ToJS x a where-  withJS :: MonadJS x m => a -> (JSRef x -> m r) -> m r--instance ToJS x (JSRef x) where-  withJS r = ($ r)--instance FromJS x (JSRef x) where-  fromJS = return--instance ToJS x String where-  withJS = withJSString--instance ToJS x Text where-  withJS = withJSString . T.unpack--newtype JSArray a = JSArray { unJSArray :: [a] }--instance ToJS x a => ToJS x (JSArray a) where-  withJS = withJSArrayFromList . unJSArray--instance FromJS x a => FromJS x (JSArray a) where-  fromJS = fmap JSArray . mapM fromJS <=< fromJSArray--withJSArrayFromList :: (ToJS x a, MonadJS x m) => [a] -> (JSRef x -> m r) -> m r-withJSArrayFromList as f = go as []-  where go [] jsRefs = withJSArray (reverse jsRefs) f-        go (h:t) jsRefs = withJS h $ \hRef -> go t (hRef : jsRefs)--newtype JSUint8Array x = JSUint8Array { unJSUint8Array :: JSRef x }--instance ToJS x (JSUint8Array x) where-  withJS (JSUint8Array r) = ($ r)--instance FromJS x (JSUint8Array x) where-  fromJS = return . JSUint8Array--instance ToJS x Word8 where-  withJS n = withJSNumber $ fromIntegral n --TODO: Check things; throw exceptions--instance ToJS x Int where-  withJS n = withJSNumber $ fromIntegral n --TODO: Check things; throw exceptions--instance FromJS x Int where-  fromJS = fmap round . fromJSNumber --TODO: Check things; throw exceptions--instance ToJS x Double where-  withJS = withJSNumber--instance FromJS x Double where-  fromJS = fromJSNumber--instance ToJS x Node where-  withJS = withJSNode---#ifdef USE_TEMPLATE_HASKELL--importJS :: Safety -> String -> String -> Q Type -> Q [Dec]-importJS safety body name qt = do-  t <- qt-  let (argTypes, _) = parseType t-  argNames <- forM argTypes $ \_ -> do-    arg <- newName "arg"-    argRef <- newName "argRef"-    return (arg, argRef)-  (jsffiDecs, jsffiExp) <- mkJSFFI safety body-  let go [] = [| runJS $(return jsffiExp) $(listE $ map (varE . snd) argNames) >>= fromJS-               |]-      go ((arg, argRef) : args) = [| withJS $(varE arg) $ $(lamE [varP argRef] $ go args) |]-  e <- lamE (map (varP. fst) argNames) $ go argNames-  let n = mkName name-  return $ jsffiDecs ++-    [ SigD n t-    , ValD (VarP n) (NormalB e) []-    ]--mkJSFFI :: Safety -> String -> Q ([Dec], Exp)-#ifdef ghcjs_HOST_OS-mkJSFFI safety body = do-  -- n <- newName "jsffi" --TODO: Should use newName, but that doesn't seem to work with ghcjs-  l <- location-  n <- newName $ "jsffi_" <> zEncodeString (loc_package l <> ":" <> loc_module l) <> "_" <> show (abs (hash (show safety, body)))-  t <- [t| JSFFI_Internal |]-  let wrappedBody = "(function(){ return (" <> body <> "); }).apply($1)"-  let decs = [ForeignD $ ImportF JavaScript safety wrappedBody n t]-  e <- [| JSFFI $(varE n) |]-  return (decs, e)-#else-mkJSFFI _ body = do-  e <- [| JSFFI body |]-  return ([], e)-#endif--parseType :: Type -> ([Type], Type)-parseType (ForallT _ [AppT (AppT (ConT monadJs) (VarT _)) (VarT m)] funType)-  | monadJs == ''MonadJS = go funType-  where go t = case t of-          AppT (AppT ArrowT arg) t' ->-            let (args, result) = go t'-            in (arg : args, result)-          AppT (VarT m') result-            | m' == m -> ([], result)-          _ -> error $ "parseType: can't parse type " <> show t-parseType t = error $ "parseType: can't parse type " <> show t- #endif

@@ -22,6 +22,7 @@ {-# LANGUAGE TemplateHaskell #-} #endif {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Reflex.Dom.Builder.Class        ( module Reflex.Dom.Builder.Class@@ -47,17 +48,19 @@  import qualified Control.Category import Control.Lens hiding (element)+import Control.Monad.Fix import Control.Monad.Reader import qualified Control.Monad.State as Lazy import Control.Monad.State.Strict import Control.Monad.Trans.Control import Data.Default import Data.Functor.Misc+import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Proxy-import Data.Semigroup+import Data.Semigroup.Commutative import Data.String import Data.Text (Text) import Data.Type.Coercion@@ -65,20 +68,20 @@ import qualified GHCJS.DOM.Types as DOM  class Default (EventSpec d EventResult) => DomSpace d where-  type EventSpec d :: (EventTag -> *) -> *-  type RawDocument d :: *-  type RawTextNode d :: *-  type RawCommentNode d :: *-  type RawElement d :: *-  type RawInputElement d :: *-  type RawTextAreaElement d :: *-  type RawSelectElement d :: *+  type EventSpec d :: (EventTag -> Type) -> Type+  type RawDocument d :: Type+  type RawTextNode d :: Type+  type RawCommentNode d :: Type+  type RawElement d :: Type+  type RawInputElement d :: Type+  type RawTextAreaElement d :: Type+  type RawSelectElement d :: Type   addEventSpecFlags :: proxy d -> EventName en -> (Maybe (er en) -> EventFlags) -> EventSpec d er -> EventSpec d er  -- | @'DomBuilder' t m@ indicates that @m@ is a 'Monad' capable of building -- dynamic DOM in the 'Reflex' timeline @t@ class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), NotReady t m, Adjustable t m) => DomBuilder t m | m -> t where-  type DomBuilderSpace m :: *+  type DomBuilderSpace m :: Type   textNode :: TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)   default textNode :: ( MonadTrans f                       , m ~ f m'@@ -158,7 +161,7 @@   {-# INLINABLE wrapRawElement #-}  class DomBuilder t m => MountableDomBuilder t m where-  type DomFragment m :: *+  type DomFragment m :: Type   buildDomFragment :: m a -> m (DomFragment m, a)   mountDomFragment :: DomFragment m -> Event t (DomFragment m) -> m () @@ -306,6 +309,15 @@ {-# INLINE inputElementConfig_elementConfig #-} #endif +instance (Reflex t, er ~ EventResult, DomSpace s) => Default (ElementConfig er t s) where+  {-# INLINABLE def #-}+  def = ElementConfig+    { _elementConfig_namespace = Nothing+    , _elementConfig_initialAttributes = mempty+    , _elementConfig_modifyAttributes = Nothing+    , _elementConfig_eventSpec = def+    }+ instance (Reflex t, er ~ EventResult, DomSpace s) => Default (InputElementConfig er t s) where   {-# INLINABLE def #-}   def = InputElementConfig@@ -541,15 +553,6 @@   {-# INLINABLE namespace #-}   namespace = elementConfig_namespace -instance (Reflex t, er ~ EventResult, DomSpace s) => Default (ElementConfig er t s) where-  {-# INLINABLE def #-}-  def = ElementConfig-    { _elementConfig_namespace = Nothing-    , _elementConfig_initialAttributes = mempty-    , _elementConfig_modifyAttributes = Nothing-    , _elementConfig_eventSpec = def-    }- instance (DomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => DomBuilder t (PostBuildT t m) where   type DomBuilderSpace (PostBuildT t m) = DomBuilderSpace m   wrapRawElement e = lift . wrapRawElement e@@ -559,7 +562,7 @@   buildDomFragment = liftThrough buildDomFragment   mountDomFragment f0 f' = lift $ mountDomFragment f0 f' -instance (DomBuilder t m, Monoid w, MonadHold t m, MonadFix m) => DomBuilder t (DynamicWriterT t w m) where+instance (DomBuilder t m, MonadFix m, Monoid w, MonadHold t m) => DomBuilder t (DynamicWriterT t w m) where   type DomBuilderSpace (DynamicWriterT t w m) = DomBuilderSpace m   textNode = liftTextNode   commentNode = liftCommentNode@@ -599,7 +602,7 @@   placeRawElement = lift . placeRawElement   wrapRawElement e = lift . wrapRawElement e -instance (DomBuilder t m, MonadHold t m, MonadFix m, Semigroup w) => DomBuilder t (EventWriterT t w m) where+instance (DomBuilder t m, MonadHold t m, Semigroup w) => DomBuilder t (EventWriterT t w m) where   type DomBuilderSpace (EventWriterT t w m) = DomBuilderSpace m   textNode = liftTextNode   commentNode = liftCommentNode@@ -618,7 +621,7 @@   placeRawElement = lift . placeRawElement   wrapRawElement e = lift . wrapRawElement e -instance (DomBuilder t m, MonadFix m, MonadHold t m, Group q, Query q, Additive q, Eq q) => DomBuilder t (QueryT t q m) where+instance (DomBuilder t m, MonadFix m, MonadHold t m, Group q, Query q, Commutative q, Eq q) => DomBuilder t (QueryT t q m) where   type DomBuilderSpace (QueryT t q m) = DomBuilderSpace m   textNode = liftTextNode   commentNode = liftCommentNode@@ -640,7 +643,7 @@ -- * Convenience functions  class HasDomEvent t target eventName | target -> t where-  type DomEventType target eventName :: *+  type DomEventType target eventName :: Type   domEvent :: EventName eventName -> target -> Event t (DomEventType target eventName)  instance Reflex t => HasDomEvent t (Element EventResult d t) en where@@ -733,7 +736,6 @@     :: ( m ~ f m'        , RawDocument (DomBuilderSpace m) ~ RawDocument (DomBuilderSpace m')        , MonadTrans f-       , Monad m'        , HasDocument m'        )     => m (RawDocument (DomBuilderSpace m))@@ -747,9 +749,9 @@ instance HasDocument m => HasDocument (QueryT t q m)  class HasSetValue a where-  type SetValue a :: *+  type SetValue a :: Type   setValue :: Lens' a (SetValue a)-  + instance Reflex t => HasSetValue (TextAreaElementConfig er t m) where   type SetValue (TextAreaElementConfig er t m) = Event t Text   setValue = textAreaElementConfig_setValue

@@ -11,9 +11,11 @@ #ifdef USE_TEMPLATE_HASKELL import Data.GADT.Compare.TH #else+import Data.Type.Equality ((:~:)(..)) import Data.GADT.Compare-       (GOrdering(..), (:~:)(..), GEq(..), GCompare(..))+       (GOrdering(..), GEq(..), GCompare(..)) #endif+import Data.Kind (Type) import Data.Text (Text)  data EventTag@@ -64,7 +66,7 @@    | TouchendTag    | TouchcancelTag -data EventName :: EventTag -> * where+data EventName :: EventTag -> Type where   Abort :: EventName 'AbortTag   Blur :: EventName 'BlurTag   Change :: EventName 'ChangeTag@@ -114,7 +116,7 @@  newtype EventResult en = EventResult { unEventResult :: EventResultType en } -type family EventResultType (en :: EventTag) :: * where+type family EventResultType (en :: EventTag) :: Type where   EventResultType 'ClickTag = ()   EventResultType 'DblclickTag = (Int, Int)   EventResultType 'KeypressTag = Word

@@ -15,13 +15,12 @@ import Control.Monad.Trans.Control import Data.Coerce import qualified Data.Map as Map-import Foreign.JavaScript.TH #ifndef ghcjs_HOST_OS import GHCJS.DOM.Types (MonadJSM (..)) #endif import Reflex import Reflex.Dom.Builder.Class-import Reflex.Dom.Builder.Immediate (HasDocument (..), hydratableAttribute)+import Reflex.Dom.Builder.Immediate (hydratableAttribute) import Reflex.Host.Class  -- | A DomBuilder transformer that adds an attribute to all elements such that the@@ -101,14 +100,6 @@     lift $ selectElement cfg' $ runHydratableT child  instance HasDocument m => HasDocument (HydratableT m)--instance HasJSContext m => HasJSContext (HydratableT m) where-  type JSContextPhantom (HydratableT m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJS js m => HasJS js (HydratableT m) where-  type JSX (HydratableT m) = JSX m-  liftJS = lift . liftJS  instance DomRenderHook t m => DomRenderHook t (HydratableT m) where   withRenderHook f = HydratableT . withRenderHook f . runHydratableT

@@ -120,7 +120,9 @@ import Control.Concurrent import Control.Exception (bracketOnError) import Control.Lens (Identity(..), imapM_, iforM_, (^.), makeLenses)+import Control.Monad import Control.Monad.Exception+import Control.Monad.Fix import Control.Monad.Primitive import Control.Monad.Reader import Control.Monad.Ref@@ -129,7 +131,6 @@ import Data.Default import Data.Dependent.Map (DMap) import Data.Dependent.Sum-import Data.FastMutableIntMap (PatchIntMap (..)) import Data.Foldable (for_, traverse_) import Data.Functor.Compose import Data.Functor.Constant@@ -138,10 +139,9 @@ import Data.GADT.Compare (GCompare) import Data.IORef import Data.IntMap.Strict (IntMap)+import Data.Kind (Type) import Data.Maybe-import Data.Monoid ((<>)) import Data.Some (Some(..))-import Data.GADT.Compare (GCompare) import Data.String (IsString) import Data.Text (Text) import Foreign.JavaScript.Internal.Utils@@ -153,7 +153,7 @@ import GHCJS.DOM.KeyboardEvent as KeyboardEvent import GHCJS.DOM.MouseEvent import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)-import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)+import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, Node, TouchEvent, WheelEvent, uncheckedCastTo) import GHCJS.DOM.UIEvent #ifndef ghcjs_HOST_OS import Language.Javascript.JSaddle (call, eval) -- Avoid using eval in ghcjs. Use ffi instead@@ -163,7 +163,6 @@ import Reflex.Dom.Builder.Class import Reflex.Dynamic import Reflex.Host.Class-import Reflex.Patch.DMapWithMove (PatchDMapWithMove(..)) import Reflex.Patch.MapWithMove (PatchMapWithMove(..)) import Reflex.PerformEvent.Base (PerformEventT) import Reflex.PerformEvent.Class@@ -284,7 +283,7 @@   }  {-# INLINABLE localRunner #-}-localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a+localRunner :: MonadJSM m => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a localRunner (HydrationRunnerT m) s parent = do   s0 <- HydrationRunnerT get   (a, s') <- HydrationRunnerT $ lift $ local (\_ -> parent) $ runStateT m (s0 { _hydrationState_previousNode = s })@@ -294,13 +293,13 @@  {-# INLINABLE runHydrationRunnerT #-} runHydrationRunnerT-  :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))+  :: (MonadRef m, Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))   => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a runHydrationRunnerT m = runHydrationRunnerTWithFailure m (pure ())  {-# INLINABLE runHydrationRunnerTWithFailure #-} runHydrationRunnerTWithFailure-  :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))+  :: (MonadRef m, Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))   => HydrationRunnerT t m a -> IO () -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a runHydrationRunnerTWithFailure (HydrationRunnerT m) onFailure s parent events = flip runDomRenderHookT events $ flip runReaderT parent $ do   (a, s') <- runStateT m (HydrationState s False)@@ -358,7 +357,7 @@  {-# INLINABLE runDomRenderHookT #-} runDomRenderHookT-  :: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)+  :: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)   => DomRenderHookT t m a   -> Chan [DSum (EventTriggerRef t) TriggerInvocation]   -> m a@@ -390,7 +389,6 @@   :: ( MonadFix m      , PerformEvent t m      , MonadReflexCreateTrigger t m-     , MonadJSM m      , MonadJSM (Performable m)      , MonadRef m      , Ref m ~ IORef@@ -465,7 +463,11 @@ #ifdef ghcjs_HOST_OS --NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2021-11-06) foreign import javascript unsafe+#if __GLASGOW_HASKELL__ < 900   "(function() { var n = $1; while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })()"+#else+  "(function(n) { while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })"+#endif   removeSubsequentNodes_ :: DOM.Node -> IO () removeSubsequentNodes n = liftJSM $ removeSubsequentNodes_ (toNode n) #else@@ -488,7 +490,11 @@ #ifdef ghcjs_HOST_OS --NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2021-11-06) foreign import javascript unsafe+#if __GLASGOW_HASKELL__ < 900   "(function() { var df = $1; var s = $2; var e = $3; var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })()"+#else+  "(function(df, s, e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })"+#endif   extractBetweenExclusive_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO () extractBetweenExclusive df s e = liftJSM $ extractBetweenExclusive_ df (toNode s) (toNode e) #else@@ -509,7 +515,11 @@ #ifdef ghcjs_HOST_OS --NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2017-09-04) foreign import javascript unsafe+#if __GLASGOW_HASKELL__ < 900   "(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"+#else+  "(function($1, x, $3) { while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })"+#endif   extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO () extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e) #else@@ -539,7 +549,7 @@ -- | This 'wrap' is only partial: it doesn't create the 'EventSelector' itself {-# INLINE wrap #-} wrap-  :: forall s m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m, EventSpec s ~ GhcjsEventSpec)+  :: forall s m er t. (MonadJSM m, DomRenderHook t m, EventSpec s ~ GhcjsEventSpec)   => Chan [DSum (EventTriggerRef t) TriggerInvocation]   -> DOM.Element   -> RawElementConfig er t s@@ -663,7 +673,7 @@  newtype GhcjsEventFilter er en = GhcjsEventFilter (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))) -data Pair1 (f :: k -> *) (g :: k -> *) (a :: k) = Pair1 (f a) (g a)+data Pair1 (f :: k -> Type) (g :: k -> Type) (a :: k) = Pair1 (f a) (g a)  data Maybe1 f a = Nothing1 | Just1 (f a) @@ -1037,8 +1047,7 @@ {-# INLINE textAreaElementImmediate #-} textAreaElementImmediate   :: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec-     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m-     , MonadRef m, Ref m ~ IORef )+     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m)   => TextAreaElementConfig er t s -> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t) textAreaElementImmediate cfg = do   (e@(Element eventSelector domElement), _) <- elementImmediate "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()@@ -1237,7 +1246,7 @@  {-# INLINE textNodeInternal #-} textNodeInternal-  :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t)+  :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m)   => TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (TextNode HydrationDomSpace t) textNodeInternal tc@(TextNodeConfig !t mSetContents) = do   doc <- askDocument@@ -1305,7 +1314,7 @@  {-# INLINE commentNodeInternal #-} commentNodeInternal-  :: (Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m, MonadFix m, Reflex t, Adjustable t m, MonadHold t m, MonadSample t m)+  :: (Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m, MonadFix m, Adjustable t m, MonadHold t m)   => CommentNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (CommentNode HydrationDomSpace t) commentNodeInternal tc@(CommentNodeConfig t0 mSetContents) = do   doc <- askDocument@@ -1344,7 +1353,7 @@ -- out at hydration time, replacing them with empty text nodes. {-# INLINABLE skipToAndReplaceComment #-} skipToAndReplaceComment-  :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)+  :: (MonadJSM m, MonadFix m, Adjustable t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)   => Text   -> IORef (Maybe Text)   -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))@@ -1394,11 +1403,11 @@     pure (switchComment, textNodeRef, keyRef)  {-# INLINABLE skipToReplaceStart #-}-skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))+skipToReplaceStart :: (MonadJSM m, MonadFix m, Adjustable t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text)) skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef $ Just "") -- TODO: Don't rely on clever usage @""@ to make this work.  {-# INLINABLE skipToReplaceEnd #-}-skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)+skipToReplaceEnd :: (MonadJSM m, MonadFix m, Adjustable t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text) skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key  instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where@@ -1528,7 +1537,7 @@   traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m   traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m -instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => Adjustable t (HydrationDomBuilderT s t m) where+instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => Adjustable t (HydrationDomBuilderT s t m) where   {-# INLINABLE runWithReplace #-}   runWithReplace a0 a' = do     initialEnv <- HydrationDomBuilderT ask@@ -1690,7 +1699,7 @@  {-# INLINABLE traverseDMapWithKeyWithAdjust' #-} traverseDMapWithKeyWithAdjust'-  :: forall s t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)+  :: forall s t m (k :: Type -> Type) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)   => (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))   -> DMap k v   -> Event t (PatchDMap k v)@@ -1736,7 +1745,7 @@  {-# INLINABLE traverseIntMapWithKeyWithAdjust' #-} traverseIntMapWithKeyWithAdjust'-  :: forall s t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)+  :: forall s t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)   => (IntMap.Key -> v -> HydrationDomBuilderT s t m v')   -> IntMap v   -> Event t (PatchIntMap v)@@ -1798,7 +1807,7 @@    | ChildReadyState_Unready !(Maybe a)    deriving (Show, Read, Eq, Ord) -insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()+insertAfterPreviousNode :: MonadJSM m => DOM.IsNode node => node -> HydrationRunnerT t m () insertAfterPreviousNode node = do   parent <- askParent   nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode@@ -1811,13 +1820,8 @@   ( Adjustable t m   , MonadHold t m   , GCompare k-  , MonadIO m   , MonadJSM m-  , PrimMonad m   , MonadFix m-  , Patch (p k v)-  , Patch (p k (Constant Int))-  , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)   , Patch (p k (Compose (TraverseChild t m (Some k)) v'))   , PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')) ~ DMap k (Compose (TraverseChild t m (Some k)) v')   , Monoid (p k (Compose (TraverseChild t m (Some k)) v'))@@ -1921,12 +1925,9 @@   , MonadHold t m   , MonadJSM m   , MonadFix m-  , PrimMonad m   , Monoid (p (TraverseChild t m Int v'))   , Functor p-  , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())   , PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')-  , Patch (p (HydrationRunnerT t m ()))   , Patch (p (TraverseChild t m Int v'))   , RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document   )@@ -2079,7 +2080,7 @@   } deriving Functor  {-# INLINABLE drawChildUpdate #-}-drawChildUpdate :: (MonadJSM m, Reflex t)+drawChildUpdate :: MonadJSM m   => HydrationDomBuilderEnv t m   -> (IORef (ChildReadyState k) -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready   -> HydrationDomBuilderT s t m (f a)@@ -2141,7 +2142,7 @@   #-}  {-# INLINABLE drawChildUpdateInt #-}-drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)+drawChildUpdateInt :: MonadJSM m   => HydrationDomBuilderEnv t m   -> (IORef (ChildReadyState k) -> JSM ())   -> HydrationDomBuilderT s t m v@@ -2207,10 +2208,6 @@   {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}   newEventWithLazyTriggerWithOnComplete f = DomRenderHookT . lift $ newEventWithLazyTriggerWithOnComplete f -instance HasJSContext m => HasJSContext (HydrationDomBuilderT s t m) where-  type JSContextPhantom (HydrationDomBuilderT s t m) = JSContextPhantom m-  askJSContext = lift askJSContext- instance MonadRef m => MonadRef (HydrationDomBuilderT s t m) where   type Ref (HydrationDomBuilderT s t m) = Ref m   {-# INLINABLE newRef #-}@@ -2223,10 +2220,6 @@ instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT s t m) where   {-# INLINABLE atomicModifyRef #-}   atomicModifyRef r = lift . atomicModifyRef r--instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT s t m) where-  type JSX (HydrationDomBuilderT s t m) = JSX m-  liftJS = lift . liftJS  type family EventType en where   EventType 'AbortTag = UIEvent

@@ -15,13 +15,11 @@ import Control.Monad.Trans.Control import Data.Coerce import qualified Data.Map as Map-import Foreign.JavaScript.TH #ifndef ghcjs_HOST_OS import GHCJS.DOM.Types (MonadJSM (..)) #endif import Reflex import Reflex.Dom.Builder.Class-import Reflex.Dom.Builder.Immediate (HasDocument (..)) import Reflex.Host.Class  -- | A DomBuilder transformer that disables all 'inputElement's,@@ -101,14 +99,6 @@     lift $ selectElement cfg' $ runInputDisabledT child  instance HasDocument m => HasDocument (InputDisabledT m)--instance HasJSContext m => HasJSContext (InputDisabledT m) where-  type JSContextPhantom (InputDisabledT m) = JSContextPhantom m-  askJSContext = lift askJSContext--instance HasJS js m => HasJS js (InputDisabledT m) where-  type JSX (InputDisabledT m) = JSX m-  liftJS = lift . liftJS  instance DomRenderHook t m => DomRenderHook t (InputDisabledT m) where   withRenderHook f = InputDisabledT . withRenderHook f . runInputDisabledT

@@ -18,8 +18,9 @@ import Data.IORef (IORef) import Blaze.ByteString.Builder.Html.Utf8 import Control.Lens hiding (element)+import Control.Monad import Control.Monad.Exception-import Control.Monad.Identity+import Control.Monad.Fix import Control.Monad.Primitive import Control.Monad.Ref import Control.Monad.State.Strict@@ -38,7 +39,7 @@ import qualified Data.Map as Map import Data.Map.Misc (applyMap) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))+import Data.Kind (Type) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T@@ -144,7 +145,7 @@ -- | Static documents don't process events, so all handlers are equivalent data StaticDomHandler (a :: k) (b :: k) = StaticDomHandler -data StaticEventSpec (er :: EventTag -> *) = StaticEventSpec deriving (Generic)+data StaticEventSpec (er :: EventTag -> Type) = StaticEventSpec deriving (Generic)  instance Default (StaticEventSpec er) @@ -188,11 +189,9 @@ hoistIntMapWithKeyWithAdjust :: forall t m p a b.   ( Adjustable t m   , MonadHold t m-  , Patch (p a)   , Functor p   , Patch (p (Behavior t Builder))   , PatchTarget (p (Behavior t Builder)) ~ IntMap (Behavior t Builder)-  , Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m -- TODO remove   )   => (forall x. (IntMap.Key -> a -> m x)       -> IntMap a@@ -219,12 +218,11 @@       sample o   return (result0, result') -hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.+hoistDMapWithKeyWithAdjust :: forall (k :: Type -> Type) v v' t m p.   ( Adjustable t m   , MonadHold t m   , PatchTarget (p k (Constant (Behavior t Builder))) ~ DMap k (Constant (Behavior t Builder))   , Patch (p k (Constant (Behavior t Builder)))-  , Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m -- TODO remove   )   => (forall vv vv'.          (forall a. k a -> vv a -> m (vv' a))

@@ -13,10 +13,12 @@   , getLocationUrl   , manageHistory   , manageHistory'+  , manageHistoryExposingExternalUpdates   , HistoryCommand (..)   , HistoryStateUpdate (..)   , HistoryItem (..)   , getLocationUri+  , popHistoryState   ) where  import Reflex@@ -26,7 +28,6 @@ import Control.Monad ((>=>)) import Control.Monad.Fix (MonadFix) import Data.Align (align)-import Data.Monoid import Data.Text (Text) import Data.These (These(..)) import qualified GHCJS.DOM as DOM@@ -170,7 +171,15 @@   -- ^ Don't do anything until this event has fired   -> Event t HistoryCommand   -> m (Dynamic t HistoryItem)-manageHistory' switchover runCmd = do+manageHistory' switchover runCmd = fst <$> manageHistoryExposingExternalUpdates switchover runCmd++manageHistoryExposingExternalUpdates+  :: (MonadFix m, MonadJSM m, TriggerEvent t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m))+  => Event t ()+  -- ^ Don't do anything until this event has fired+  -> Event t HistoryCommand+  -> m (Dynamic t HistoryItem, Event t HistoryItem)+manageHistoryExposingExternalUpdates switchover runCmd = do   window <- DOM.currentWindowUnchecked   location <- Window.getLocation window   history <- Window.getHistory window@@ -196,5 +205,16 @@   itemSetInternal <- performEvent $ ffor itemSetInternal' $ \cmd -> liftJSM $ do     runHistoryCommand history cmd     getCurrentHistoryItem-  holdDyn item0 $ leftmost [itemSetInternal, itemSetExternal]+  currentHistoryItem <- holdDyn item0 $ leftmost [itemSetInternal, itemSetExternal]+  pure (currentHistoryItem, itemSetExternal) --TODO: Handle title setting better++popHistoryState+  :: (PerformEvent t m, MonadJSM (Performable m))+  => Event t ()+  -> m ()+popHistoryState evt =+  performEvent_ $ ffor evt $ \_ -> do+    window <- DOM.currentWindowUnchecked+    history <- Window.getHistory window+    History.back history

@@ -33,14 +33,13 @@ import Control.Concurrent import Control.Lens import Control.Monad-import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)+import Control.Monad.Reader import Control.Monad.Ref import Data.ByteString (ByteString) import Data.Dependent.Sum (DSum (..)) import Data.Foldable (for_) import Data.IORef import Data.Maybe-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding@@ -58,7 +57,7 @@  {-# INLINE mainHydrationWidgetWithHead #-} mainHydrationWidgetWithHead :: (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()-mainHydrationWidgetWithHead = mainHydrationWidgetWithHead'+mainHydrationWidgetWithHead head' body = mainHydrationWidgetWithHead' head' body  {-# INLINABLE mainHydrationWidgetWithHead' #-} -- | Warning: `mainHydrationWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.@@ -67,7 +66,7 @@  {-# INLINE mainHydrationWidgetWithSwitchoverAction #-} mainHydrationWidgetWithSwitchoverAction :: JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()-mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverAction'+mainHydrationWidgetWithSwitchoverAction switchoverAction head' body = mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body  {-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-} -- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.@@ -187,7 +186,7 @@  {-# INLINE mainWidget #-} mainWidget :: (forall x. Widget x ()) -> JSM ()-mainWidget = mainWidget'+mainWidget w = mainWidget' w  {-# INLINABLE mainWidget' #-} -- | Warning: `mainWidget'` is provided only as performance tweak. It is expected to disappear in future releases.

@@ -11,6 +11,7 @@ #ifdef USE_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} #endif+{-# LANGUAGE TypeOperators #-} module Reflex.Dom.Old        ( MonadWidget        , El@@ -63,7 +64,6 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text)-import Foreign.JavaScript.TH import qualified GHCJS.DOM.Element as Element import GHCJS.DOM.EventM (EventM) import GHCJS.DOM.NamedNodeMap as NNM@@ -118,8 +118,6 @@   , DOM.MonadJSM (Performable m) #endif   , TriggerEvent t m-  , HasJSContext m-  , HasJSContext (Performable m)   , HasDocument m   , MonadRef m   , Ref m ~ Ref IO@@ -267,7 +265,7 @@         & elementConfig_eventSpec . ghcjsEventSpec_filters %~ DMap.insert en f   snd <$> element elementTag cfg child -elDynHtmlAttr' :: (DOM.MonadJSM m, MonadWidget t m) => Text -> Map Text Text -> Dynamic t Text -> m (Element EventResult GhcjsDomSpace t)+elDynHtmlAttr' :: MonadWidget t m => Text -> Map Text Text -> Dynamic t Text -> m (Element EventResult GhcjsDomSpace t) elDynHtmlAttr' elementTag attrs html = do   let cfg = def & initialAttributes .~ Map.mapKeys (AttributeName Nothing) attrs   (e, _) <- element elementTag cfg $ return ()

@@ -11,6 +11,7 @@ {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} @@ -22,14 +23,16 @@        , PrerenderBaseConstraints        ) where +import Control.Monad+import Control.Monad.Fix import Control.Monad.Primitive (PrimMonad(..)) import Control.Monad.Reader import Control.Monad.Ref (MonadRef(..), MonadAtomicRef(..)) import Data.IORef (IORef, newIORef)-import Data.Semigroup (Semigroup)+import Data.Kind (Type)+import Data.Semigroup.Commutative import Data.Text (Text) import Data.Void-import Foreign.JavaScript.TH import GHCJS.DOM.Types (MonadJSM) import Reflex hiding (askEvents) import Reflex.Dom.Builder.Class@@ -45,19 +48,17 @@ import qualified GHCJS.DOM.Node as Node import qualified GHCJS.DOM.Types as DOM -type PrerenderClientConstraint js t m =+type PrerenderClientConstraint t m =   ( DomBuilder t m   , DomBuilderSpace m ~ GhcjsDomSpace   , DomRenderHook t m   , HasDocument m   , TriggerEvent t m-  , PrerenderBaseConstraints js t m+  , PrerenderBaseConstraints t m   ) -type PrerenderBaseConstraints js t m =-  ( HasJSContext (Performable m)-  , HasJSContext m-  , MonadFix m+type PrerenderBaseConstraints t m =+  ( MonadFix m   , MonadHold t m   , MonadJSM (Performable m)   , MonadJSM m@@ -70,30 +71,28 @@   , PrimMonad m   , Ref (Performable m) ~ IORef   , Ref m ~ IORef-  , HasJS js m-  , HasJS js (Performable m)   )  -- | Render the first widget on the server, and the second on the client. The -- hydration builder will run *both* widgets. prerender_-  :: (Functor m, Reflex t, Prerender js t m)+  :: (Functor m, Prerender t m)   => m () ->  Client m () -> m () prerender_ server client = void $ prerender server client -class (PrerenderClientConstraint js t (Client m), Client (Client m) ~ Client m, Prerender js t (Client m)) => Prerender js t m | m -> t js where+class (PrerenderClientConstraint t (Client m), Client (Client m) ~ Client m, Prerender t (Client m)) => Prerender t m | m -> t where   -- | Monad in which the client widget is built-  type Client m :: * -> *+  type Client m :: Type -> Type   -- | Render the first widget on the server, and the second on the client. The   -- hydration builder will run *both* widgets, updating the result dynamic at   -- switchover time.   prerender :: m a -> Client m a -> m (Dynamic t a) -instance (ReflexHost t, Adjustable t m, PrerenderBaseConstraints js t m) => Prerender js t (HydrationDomBuilderT GhcjsDomSpace t m) where+instance (ReflexHost t, Adjustable t m, PrerenderBaseConstraints t m) => Prerender t (HydrationDomBuilderT GhcjsDomSpace t m) where   type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m   prerender _ client = pure <$> client -instance (Adjustable t m, PrerenderBaseConstraints js t m, ReflexHost t) => Prerender js t (HydrationDomBuilderT HydrationDomSpace t m) where+instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerender t (HydrationDomBuilderT HydrationDomSpace t m) where   -- | PostBuildT is needed here because we delay running the client builder   -- until after switchover, at which point the postBuild of @m@ has already fired   type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)@@ -132,14 +131,14 @@         insertBefore df =<< deleteToPrerenderEnd doc     holdDyn a0 a' -newtype UnrunnableT js t m a = UnrunnableT (ReaderT Void m a)+newtype UnrunnableT t m a = UnrunnableT (ReaderT Void m a)   deriving (Functor, Applicative, Monad, MonadTrans) -unrunnable :: UnrunnableT js t m a+unrunnable :: UnrunnableT t m a unrunnable = UnrunnableT $ ReaderT $ \case {} -instance (Reflex t, Monad m) => DomBuilder t (UnrunnableT js t m) where-  type DomBuilderSpace (UnrunnableT js t m) = GhcjsDomSpace+instance (Reflex t, Monad m) => DomBuilder t (UnrunnableT t m) where+  type DomBuilderSpace (UnrunnableT t m) = GhcjsDomSpace   textNode _ = unrunnable   commentNode _ = unrunnable   element _ _ _ = unrunnable@@ -148,106 +147,79 @@   selectElement _ _ = unrunnable   placeRawElement _ = unrunnable   wrapRawElement _ _ = unrunnable-instance (Reflex t, Monad m) => NotReady t (UnrunnableT js t m) where+instance (Reflex t, Monad m) => NotReady t (UnrunnableT t m) where   notReadyUntil _ = unrunnable   notReady = unrunnable-instance (Reflex t, Monad m) => Adjustable t (UnrunnableT js t m) where+instance (Reflex t, Monad m) => Adjustable t (UnrunnableT t m) where   runWithReplace _ _ = unrunnable   traverseIntMapWithKeyWithAdjust _ _ _ = unrunnable   traverseDMapWithKeyWithAdjust _ _ _ = unrunnable   traverseDMapWithKeyWithAdjustWithMove _ _ _ = unrunnable-instance (Reflex t, Monad m) => PerformEvent t (UnrunnableT js t m) where-  type Performable (UnrunnableT js t m) = UnrunnableT js t m+instance (Reflex t, Monad m) => PerformEvent t (UnrunnableT t m) where+  type Performable (UnrunnableT t m) = UnrunnableT t m   performEvent _ = unrunnable   performEvent_ _ = unrunnable-instance Monad m => MonadRef (UnrunnableT js t m) where-  type Ref (UnrunnableT js t m) = Ref IO+instance Monad m => MonadRef (UnrunnableT t m) where+  type Ref (UnrunnableT t m) = Ref IO   newRef _ = unrunnable   readRef _ = unrunnable   writeRef _ _ = unrunnable-instance Monad m => MonadAtomicRef (UnrunnableT js t m) where+instance Monad m => MonadAtomicRef (UnrunnableT t m) where   atomicModifyRef _ _ = unrunnable-instance Monad m => HasDocument (UnrunnableT js t m) where+instance Monad m => HasDocument (UnrunnableT t m) where   askDocument = unrunnable-instance Monad m => HasJSContext (UnrunnableT js t m) where-  type JSContextPhantom (UnrunnableT js t m) = ()-  askJSContext = unrunnable-instance Monad m => HasJS JS' (UnrunnableT js t m) where-  type JSX (UnrunnableT js t m) = UnrunnableT js t m-  liftJS _ = unrunnable-instance Monad m => MonadJS JS' (UnrunnableT js t m) where-  runJS _ _ = unrunnable-  forkJS _ = unrunnable-  mkJSUndefined = unrunnable-  isJSNull _ = unrunnable-  isJSUndefined _ = unrunnable-  fromJSBool _ = unrunnable-  fromJSString _ = unrunnable-  fromJSArray _ = unrunnable-  fromJSUint8Array _ = unrunnable-  fromJSNumber _ = unrunnable-  withJSBool _ _ = unrunnable-  withJSString _ _ = unrunnable-  withJSNumber _ _ = unrunnable-  withJSArray _ _ = unrunnable-  withJSUint8Array _ _ = unrunnable-  mkJSFun _ = unrunnable-  freeJSFun _ = unrunnable-  setJSProp _ _ _ = unrunnable-  getJSProp _ _ = unrunnable-  withJSNode _ _ = unrunnable-instance Monad m => TriggerEvent t (UnrunnableT js t m) where+instance Monad m => TriggerEvent t (UnrunnableT t m) where   newTriggerEvent = unrunnable   newTriggerEventWithOnComplete = unrunnable   newEventWithLazyTriggerWithOnComplete _ = unrunnable-instance Monad m => MonadReflexCreateTrigger t (UnrunnableT js t m) where+instance Monad m => MonadReflexCreateTrigger t (UnrunnableT t m) where   newEventWithTrigger _ = unrunnable   newFanEventWithTrigger _ = unrunnable-instance Monad m => MonadFix (UnrunnableT js t m) where+instance Monad m => MonadFix (UnrunnableT t m) where   mfix _ = unrunnable-instance (Monad m, MonadHold t m) => MonadHold t (UnrunnableT js t m) where+instance (Monad m, MonadHold t m) => MonadHold t (UnrunnableT t m) where   hold _ _ = unrunnable   holdDyn _ _ = unrunnable   holdIncremental _ _ = unrunnable   buildDynamic _ _ = unrunnable   headE _ = unrunnable   now = unrunnable-instance Monad m => MonadSample t (UnrunnableT js t m) where+instance Monad m => MonadSample t (UnrunnableT t m) where   sample _ = unrunnable-instance Monad m => MonadIO (UnrunnableT js t m) where+instance Monad m => MonadIO (UnrunnableT t m) where   liftIO _ = unrunnable #ifndef ghcjs_HOST_OS-instance Monad m => MonadJSM (UnrunnableT js t m) where+instance Monad m => MonadJSM (UnrunnableT t m) where   liftJSM' _ = unrunnable #endif-instance (Reflex t, Monad m) => PostBuild t (UnrunnableT js t m) where+instance (Reflex t, Monad m) => PostBuild t (UnrunnableT t m) where   getPostBuild = unrunnable-instance Monad m => PrimMonad (UnrunnableT js t m) where-  type PrimState (UnrunnableT js t m) = PrimState IO+instance Monad m => PrimMonad (UnrunnableT t m) where+  type PrimState (UnrunnableT t m) = PrimState IO   primitive _ = unrunnable-instance (Reflex t, Monad m) => DomRenderHook t (UnrunnableT js t m) where+instance (Reflex t, Monad m) => DomRenderHook t (UnrunnableT t m) where   withRenderHook _ _ = unrunnable   requestDomAction _ = unrunnable   requestDomAction_ _ = unrunnable-instance (Reflex t, Monad m, MonadHold t m) => Prerender JS' t (UnrunnableT js t m) where-  type Client (UnrunnableT js t m) = UnrunnableT js t m+instance (Reflex t, Monad m, MonadHold t m) => Prerender t (UnrunnableT t m) where+  type Client (UnrunnableT t m) = UnrunnableT t m   prerender _ _ = unrunnable -instance (SupportsStaticDomBuilder t m) => Prerender JS' t (StaticDomBuilderT t m) where-  type Client (StaticDomBuilderT t m) = UnrunnableT JS' t m+instance (SupportsStaticDomBuilder t m) => Prerender t (StaticDomBuilderT t m) where+  type Client (StaticDomBuilderT t m) = UnrunnableT t m   prerender server _ = do     _ <- commentNode $ CommentNodeConfig startMarker Nothing     a <- server     _ <- commentNode $ CommentNodeConfig endMarker Nothing     pure $ pure a -instance (Prerender js t m, Monad m) => Prerender js t (ReaderT r m) where+instance (Prerender t m, Monad m) => Prerender t (ReaderT r m) where   type Client (ReaderT r m) = ReaderT r (Client m)   prerender server client = do     r <- ask     lift $ prerender (runReaderT server r) (runReaderT client r) -instance (Prerender js t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender js t (DynamicWriterT t w m) where+instance (Prerender t m, Monad m, MonadFix m, Reflex t, Monoid w) => Prerender t (DynamicWriterT t w m) where   type Client (DynamicWriterT t w m) = DynamicWriterT t w (Client m)   prerender server client = do     x <- lift $ prerender (runDynamicWriterT server) (runDynamicWriterT client)@@ -256,7 +228,7 @@     tellDyn w     pure a -instance (Prerender js t m, Monad m, Reflex t, Semigroup w) => Prerender js t (EventWriterT t w m) where+instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWriterT t w m) where   type Client (EventWriterT t w m) = EventWriterT t w (Client m)   prerender server client = do     x <- lift $ prerender (runEventWriterT server) (runEventWriterT client)@@ -265,7 +237,7 @@     tellEvent w     pure a -instance (Prerender js t m, MonadFix m, Reflex t) => Prerender js t (RequesterT t request response m) where+instance (Prerender t m, MonadFix m, Reflex t) => Prerender t (RequesterT t request response m) where   type Client (RequesterT t request response m) = RequesterT t request response (Client m)   prerender server client = mdo     let fannedResponses = fanInt responses@@ -277,7 +249,7 @@     responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requestsDyn     return result -instance (Prerender js t m, Monad m, Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q) => Prerender js t (QueryT t q m) where+instance (Prerender t m, Monad m, Reflex t, MonadFix m, Group q, Commutative q, Query q, Eq q) => Prerender t (QueryT t q m) where   type Client (QueryT t q m) = QueryT t q (Client m)   prerender server client = mdo     result <- queryDyn query@@ -286,15 +258,15 @@         query = incrementalToDynamic =<< inc -- Can we avoid the incrementalToDynamic?     pure a -instance (Prerender js t m, Monad m) => Prerender js t (InputDisabledT m) where+instance Prerender t m => Prerender t (InputDisabledT m) where   type Client (InputDisabledT m) = InputDisabledT (Client m)   prerender (InputDisabledT server) (InputDisabledT client) = InputDisabledT $ prerender server client -instance (Prerender js t m, Monad m) => Prerender js t (HydratableT m) where+instance Prerender t m => Prerender t (HydratableT m) where   type Client (HydratableT m) = HydratableT (Client m)   prerender (HydratableT server) (HydratableT client) = HydratableT $ prerender server client -instance (Prerender js t m, Monad m, ReflexHost t) => Prerender js t (PostBuildT t m) where+instance (Prerender t m, Monad m, ReflexHost t) => Prerender t (PostBuildT t m) where   type Client (PostBuildT t m) = PostBuildT t (Client m)   prerender server client = PostBuildT $ do     pb <- ask@@ -304,7 +276,7 @@ startMarker = "prerender/start" endMarker = "prerender/end" -deleteToPrerenderEnd :: (MonadIO m, MonadJSM m, Reflex t, MonadFix m) => DOM.Document -> HydrationRunnerT t m DOM.Comment+deleteToPrerenderEnd :: (MonadJSM m, Reflex t, MonadFix m) => DOM.Document -> HydrationRunnerT t m DOM.Comment deleteToPrerenderEnd doc = do   startNode <- hydrateComment doc startMarker Nothing   let go (n :: Int) lastNode = Node.getNextSibling lastNode >>= \case

@@ -8,7 +8,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE JavaScriptFFI #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -31,7 +30,6 @@ import Prelude hiding (all, concat, concatMap, div, mapM, mapM_, sequence, span)  import Reflex.Class-import Reflex.Dom.Class import Reflex.Dom.WebSocket.Foreign import Reflex.PerformEvent.Class import Reflex.PostBuild.Class@@ -41,9 +39,8 @@ import Control.Concurrent.STM import Control.Exception import Control.Lens-import Control.Monad hiding (forM, forM_, mapM, mapM_, sequence)+import Control.Monad hiding (forM, mapM, mapM_, sequence) import Control.Monad.IO.Class-import Control.Monad.State import Data.Aeson import Data.ByteString (ByteString) import Data.ByteString.Lazy (toStrict)@@ -83,12 +80,11 @@                                                 )                   } -webSocket :: (MonadJSM m, MonadJSM (Performable m), HasJSContext m, PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> m (WebSocket t)+webSocket :: (MonadJSM m, MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> m (WebSocket t) webSocket url config = webSocket' url config onBSMessage -webSocket' :: (MonadJSM m, MonadJSM (Performable m), HasJSContext m, PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> (Either ByteString JSVal -> JSM b) -> m (RawWebSocket t b)+webSocket' :: (MonadJSM m, MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> (Either ByteString JSVal -> JSM b) -> m (RawWebSocket t b) webSocket' url config onRawMessage = do-  wv <- fmap unJSContextSingleton askJSContext   (eRecv, onMessage) <- newTriggerEvent   currentSocketRef <- liftIO $ newIORef Nothing   (eOpen, triggerEOpen) <- newTriggerEventWithOnComplete@@ -106,7 +102,7 @@           liftIO $ threadDelay 1000000           start       start = do-        ws <- newWebSocket wv url (_webSocketConfig_protocols config) (onRawMessage >=> liftIO . onMessage) (liftIO onOpen) (liftIO onError) onClose+        ws <- newWebSocket url (_webSocketConfig_protocols config) (onRawMessage >=> liftIO . onMessage) (liftIO onOpen) (liftIO onError) onClose         liftIO $ writeIORef currentSocketRef $ Just ws         return ()   performEvent_ . (liftJSM start <$) =<< getPostBuild@@ -136,10 +132,10 @@     unless success $ atomically $ unGetTQueue payloadQueue payload   return $ RawWebSocket eRecv eOpen eError eClose -textWebSocket :: (IsWebSocketMessage a, MonadJSM m, MonadJSM (Performable m), HasJSContext m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, Reflex t) => Text -> WebSocketConfig t a -> m (RawWebSocket t Text)+textWebSocket :: (IsWebSocketMessage a, MonadJSM m, MonadJSM (Performable m), PostBuild t m, TriggerEvent t m, PerformEvent t m) => Text -> WebSocketConfig t a -> m (RawWebSocket t Text) textWebSocket url cfg = webSocket' url cfg (either (return . decodeUtf8) fromJSValUnchecked) -jsonWebSocket :: (ToJSON a, FromJSON b, MonadJSM m, MonadJSM (Performable m), HasJSContext m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, Reflex t) => Text -> WebSocketConfig t a -> m (RawWebSocket t (Maybe b))+jsonWebSocket :: (ToJSON a, FromJSON b, MonadJSM m, MonadJSM (Performable m), PostBuild t m, TriggerEvent t m, PerformEvent t m) => Text -> WebSocketConfig t a -> m (RawWebSocket t (Maybe b)) jsonWebSocket url cfg = do   ws <- textWebSocket url $ cfg { _webSocketConfig_send = fmap (decodeUtf8 . toStrict . encode) <$> _webSocketConfig_send cfg }   return ws { _webSocket_recv = jsonDecode . textToJSString <$> _webSocket_recv ws }

@@ -53,15 +53,14 @@ closeWebSocket (JSWebSocket ws) code reason = DOM.close ws (Just code) (Just reason)  newWebSocket-  :: a-  -> Text -- url+  :: Text -- url   -> [Text] -- protocols   -> (Either ByteString JSVal -> JSM ()) -- onmessage   -> JSM () -- onopen   -> JSM () -- onerror   -> ((Bool, Word, Text) -> JSM ()) -- onclose   -> JSM JSWebSocket-newWebSocket _ url protocols onMessage onOpen onError onClose = do+newWebSocket url protocols onMessage onOpen onError onClose = do   let onOpenWrapped = fun $ \_ _ _ -> onOpen       onErrorWrapped = fun $ \_ _ _ -> onError       onCloseWrapped = fun $ \_ _ (e:_) -> do

@@ -4,15 +4,15 @@  import Data.Default import Control.Monad.Fix+import Data.Semigroup.Commutative import Data.Text (Text) import Data.Aeson import Reflex import Reflex.Dom.WebSocket-import Foreign.JavaScript.TH import Data.Maybe import Language.Javascript.JSaddle.Types (MonadJSM) -runWebSocketQuery :: (MonadJSM m, MonadJSM (Performable m), HasJSContext m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, Reflex t, ToJSON q, MonadFix m, Query q, FromJSON (QueryResult q), Additive q, Group q, Eq q)+runWebSocketQuery :: (MonadJSM m, MonadJSM (Performable m), PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, ToJSON q, MonadFix m, Query q, FromJSON (QueryResult q), Commutative q, Group q, Eq q)                   => QueryT t q m a                   -> Text -- ^ WebSocket url                   -> m a@@ -23,7 +23,7 @@       let updatedRequest = leftmost [updated request, tag (current request) postBuild]   return a -cropQueryT :: (Reflex t, MonadHold t m, MonadFix m, Query q, Additive q, Group q, Eq q)+cropQueryT :: (Reflex t, MonadHold t m, MonadFix m, Query q, Commutative q, Group q, Eq q)            => QueryT t q m a            -> Event t (QueryResult q)            -> m (a, Dynamic t q)

@@ -70,14 +70,12 @@ import Reflex.PostBuild.Class import Reflex.Workflow -import Control.Arrow import Control.Lens hiding (children, element)-import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)+import Control.Monad.Fix import Data.Align import Data.Default-import Data.Either-import Data.Foldable import Data.Functor (void)+import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Map.Misc@@ -87,8 +85,6 @@ import Data.Text (Text) import qualified Data.Text as T import Data.These-import Data.Traversable-import Prelude hiding (mapM, mapM_, sequence, sequence_)  -- | Breaks the given Map into pieces based on the given Set.  Each piece will contain only keys that are less than the key of the piece, and greater than or equal to the key of the piece with the next-smaller key.  There will be one additional piece containing all keys from the original Map that are larger or equal to the largest key in the Set. -- Either k () is used instead of Maybe k so that the resulting map of pieces is sorted so that the additional piece has the largest key.@@ -296,7 +292,7 @@  -- TODO: Move to an example project. -- | A widget to display a table with static columns and dynamic rows.-tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)+tableDynAttr :: forall t m r k v. (Ord k, Eq r, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)   => Text                                   -- ^ Class applied to <table> element   -> [(Text, k -> Dynamic t r -> m v)]      -- ^ Columns of (header, row key -> row value -> child widget)   -> Dynamic t (Map k r)                      -- ^ Map from row key to row value@@ -341,5 +337,5 @@         return $ fmap (const k) (_link_clicked a)  class HasAttributes a where-  type Attrs a :: *+  type Attrs a :: Type   attributes :: Lens' a (Attrs a)

@@ -13,12 +13,14 @@ {-# LANGUAGE TemplateHaskell #-} #endif {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Reflex.Dom.Widget.Input (module Reflex.Dom.Widget.Input, def, (&), (.~)) where  import Prelude  import Control.Lens hiding (element, ix)+import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader@@ -27,18 +29,15 @@ import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap import Data.Functor.Misc+import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe-import Data.Semigroup import Data.Text (Text) import qualified Data.Text as T-import qualified GHCJS.DOM.GlobalEventHandlers as Events-import GHCJS.DOM.EventM (on)-import qualified GHCJS.DOM.FileList as FileList import GHCJS.DOM.HTMLInputElement (HTMLInputElement) import GHCJS.DOM.HTMLTextAreaElement (HTMLTextAreaElement)-import GHCJS.DOM.Types (MonadJSM, File, uncheckedCastTo)+import GHCJS.DOM.Types (File, uncheckedCastTo) import qualified GHCJS.DOM.Types as DOM (HTMLElement(..), EventTarget(..)) import Reflex.Class import Reflex.Collection@@ -48,7 +47,6 @@ import Reflex.Dom.Widget.Basic import Reflex.Dynamic import Reflex.PostBuild.Class-import Reflex.TriggerEvent.Class import qualified Text.Read as T  import qualified GHCJS.DOM.Event as Event@@ -235,7 +233,7 @@     , _checkbox_change = _inputElement_checkedChange i     } -type family CheckboxViewEventResultType (en :: EventTag) :: * where+type family CheckboxViewEventResultType (en :: EventTag) :: Type where   CheckboxViewEventResultType 'ClickTag = Bool   CheckboxViewEventResultType t = EventResultType t @@ -292,7 +290,7 @@  -- | Create a view only checkbox {-# INLINABLE checkboxView #-}-checkboxView :: forall t m. (DomBuilder t m, DomBuilderSpace m ~ GhcjsDomSpace, PostBuild t m, MonadHold t m) => Dynamic t (Map Text Text) -> Dynamic t Bool -> m (Event t Bool)+checkboxView :: forall t m. (DomBuilder t m, DomBuilderSpace m ~ GhcjsDomSpace, PostBuild t m) => Dynamic t (Map Text Text) -> Dynamic t Bool -> m (Event t Bool) checkboxView dAttrs dValue = do   let permanentAttrs = "type" =: "checkbox"   modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.union permanentAttrs) dAttrs@@ -338,7 +336,7 @@   def = FileInputConfig { _fileInputConfig_attributes = constDyn mempty                         } -fileInput :: forall t m. (MonadIO m, MonadJSM m, MonadFix m, MonadHold t m, TriggerEvent t m, DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace)+fileInput :: forall t m. (MonadIO m, DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace)           => FileInputConfig t -> m (FileInput (DomBuilderSpace m) t) fileInput config = do   let insertType = Map.insert "type" "file"@@ -371,7 +369,7 @@                        , _dropdownConfig_attributes = constDyn mempty                        } -type family DropdownViewEventResultType (en :: EventTag) :: * where+type family DropdownViewEventResultType (en :: EventTag) :: Type where   DropdownViewEventResultType 'ChangeTag = Text   DropdownViewEventResultType t = EventResultType t @@ -651,7 +649,7 @@   setValue = checkboxConfig_setValue  class HasValue a where-  type Value a :: *+  type Value a :: Type   value :: a -> Value a  instance HasValue (InputElement er d t) where

@@ -4,6 +4,7 @@ {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Reflex.Dom.Widget.Lazy where  import Reflex.Class@@ -20,14 +21,13 @@ import Data.Fixed import Data.Map (Map) import qualified Data.Map as Map-import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import GHCJS.DOM.Element import GHCJS.DOM.Types (MonadJSM)  -- |A list view for long lists. Creates a scrollable element and only renders child row elements near the current scroll position.-virtualListWithSelection :: forall t m k v. (DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace, MonadFix m, Ord k)+virtualListWithSelection :: forall t m k v. (DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace, MonadFix m, Ord k, Eq v)   => Dynamic t Int -- ^ The height of the visible region in pixels   -> Int -- ^ The height of each row in pixels   -> Dynamic t Int -- ^ The total number of items

@@ -4,6 +4,7 @@ {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Reflex.Dom.Widget.Resize where  import Reflex.Class@@ -16,12 +17,10 @@ import Reflex.PostBuild.Class import Reflex.TriggerEvent.Class -import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Data.Map (Map) import qualified Data.Map as Map-import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import GHCJS.DOM.Element

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -8,6 +7,7 @@ #ifdef USE_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} #endif+{-# LANGUAGE TypeOperators #-}  -- | A module for performing asynchronous HTTP calls from JavaScript -- using the@@ -173,7 +173,6 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as B import Data.Traversable-import Data.Typeable  import Language.Javascript.JSaddle.Monad (JSM, askJSM, runJSM, MonadJSM, liftJSM) @@ -182,7 +181,7 @@                 , _xhrRequest_url :: Text                 , _xhrRequest_config :: XhrRequestConfig a                 }-   deriving (Show, Read, Eq, Ord, Typeable, Functor)+   deriving (Show, Read, Eq, Ord, Functor)  data XhrRequestConfig a    = XhrRequestConfig { _xhrRequestConfig_headers :: Map Text Text@@ -193,7 +192,7 @@                       , _xhrRequestConfig_withCredentials :: Bool                       , _xhrRequestConfig_responseHeaders :: XhrResponseHeaders                       }-   deriving (Show, Read, Eq, Ord, Typeable, Functor)+   deriving (Show, Read, Eq, Ord, Functor)  data XhrResponse    = XhrResponse { _xhrResponse_status :: Word@@ -202,12 +201,11 @@                  , _xhrResponse_responseText :: Maybe Text                  , _xhrResponse_headers :: Map (CI Text) Text                  }-   deriving (Typeable)  data XhrResponseHeaders =     OnlyHeaders (Set.Set (CI Text)) -- ^ Parse a subset of headers from the XHR Response   | AllHeaders -- ^ Parse all headers from the XHR Response-  deriving (Show, Read, Eq, Ord, Typeable)+  deriving (Show, Read, Eq, Ord)  instance Default XhrResponseHeaders where   def = OnlyHeaders mempty@@ -239,7 +237,7 @@ -- the XHR connection), and will pass an exception ('XhrException') to the -- continuation if the connection cannot be made (or is aborted). newXMLHttpRequestWithError-    :: (HasJSContext m, MonadJSM m, IsXhrPayload a)+    :: (MonadJSM m, IsXhrPayload a)     => XhrRequest a     -- ^ The request to make.     -> (Either XhrException XhrResponse -> JSM ())@@ -295,7 +293,7 @@   L.dropWhileEnd T.null $ T.splitOn (T.pack "\r\n") s   where stripBoth (txt1, txt2) = (CI.mk $ T.strip txt1, T.strip $ T.drop 1 txt2) -newXMLHttpRequest :: (HasJSContext m, MonadJSM m, IsXhrPayload a) => XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest+newXMLHttpRequest :: (MonadJSM m, IsXhrPayload a) => XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest newXMLHttpRequest req cb = newXMLHttpRequestWithError req $ mapM_ cb  -- | Given Event of requests, issue them when the Event fires.@@ -304,20 +302,20 @@ -- The request is processed asynchronously, therefore handling does -- not block or cause a delay while creating the connection. performRequestAsyncWithError-    :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a)+    :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a)     => Event t (XhrRequest a)     -> m (Event t (Either XhrException XhrResponse)) performRequestAsyncWithError = performRequestAsync' newXMLHttpRequestWithError . fmap return  -- | Given Event of request, issue them when the Event fires.  Returns Event of corresponding response.-performRequestAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (XhrRequest a) -> m (Event t XhrResponse)+performRequestAsync :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (XhrRequest a) -> m (Event t XhrResponse) performRequestAsync = performRequestAsync' newXMLHttpRequest . fmap return  -- | Given Event with an action that creates a request, build and issue the request when the Event fires.  Returns Event of corresponding response.-performMkRequestAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (Performable m (XhrRequest a)) -> m (Event t XhrResponse)+performMkRequestAsync :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (Performable m (XhrRequest a)) -> m (Event t XhrResponse) performMkRequestAsync = performRequestAsync' newXMLHttpRequest -performRequestAsync' :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m) => (XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest) -> Event t (Performable m (XhrRequest p)) -> m (Event t a)+performRequestAsync' :: (PerformEvent t m, TriggerEvent t m) => (XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest) -> Event t (Performable m (XhrRequest p)) -> m (Event t a) performRequestAsync' newXhr req = performEventAsync $ ffor req $ \hr cb -> do   r <- hr   _ <- newXhr r $ liftIO . cb@@ -333,16 +331,16 @@ -- Order of request execution and completion is not guaranteed, but -- order of creation and the collection result is preserved. performRequestsAsyncWithError-    :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a)+    :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a)     => Event t (f (XhrRequest a)) -> m (Event t (f (Either XhrException XhrResponse))) performRequestsAsyncWithError = performRequestsAsync' newXMLHttpRequestWithError . fmap return  -- | Issues a collection of requests when the supplied Event fires.  When ALL requests from a given firing complete, the results are collected and returned via the return Event.-performRequestsAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (f (XhrRequest a)) -> m (Event t (f XhrResponse))+performRequestsAsync :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (f (XhrRequest a)) -> m (Event t (f XhrResponse)) performRequestsAsync = performRequestsAsync' newXMLHttpRequest . fmap return  -- | Builds and issues a collection of requests when the supplied Event fires.  When ALL requests from a given firing complete, the results are collected and returned via the return Event.-performMkRequestsAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (Performable m (f (XhrRequest a))) -> m (Event t (f XhrResponse))+performMkRequestsAsync :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (Performable m (f (XhrRequest a))) -> m (Event t (f XhrResponse)) performMkRequestsAsync = performRequestsAsync' newXMLHttpRequest  performRequestsAsync' :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f) => (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest) -> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))@@ -356,7 +354,7 @@   return ()  -- | Simplified interface to "GET" URLs and return decoded results.-getAndDecode :: (MonadIO m, MonadJSM (Performable m), PerformEvent t m, HasJSContext (Performable m), TriggerEvent t m, FromJSON a) => Event t Text -> m (Event t (Maybe a))+getAndDecode :: (MonadIO m, MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, FromJSON a) => Event t Text -> m (Event t (Maybe a)) getAndDecode url = do   r <- performRequestAsync $ fmap (\x -> XhrRequest "GET" x def) url   return $ fmap decodeXhrResponse r

@@ -1,12 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}- module Reflex.Dom.Xhr.Exception where  import Control.Exception (Exception (..))-import Data.Typeable  data XhrException = XhrException_Error                   | XhrException_Aborted-     deriving (Show, Read, Eq, Ord, Typeable)+     deriving (Show, Read, Eq, Ord)  instance Exception XhrException

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE JavaScriptFFI #-} {-# LANGUAGE OverloadedStrings #-}  module Reflex.Dom.Xhr.Foreign (

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} module Reflex.Dom.Xhr.FormData   ( postForms+  , postForms'   , FormValue (..)   , fileToFormValue   )@@ -13,7 +14,6 @@ import Data.Text (Text) import Data.Traversable import qualified GHCJS.DOM.FormData as FD-import Foreign.JavaScript.TH import GHCJS.DOM.File (getName) import GHCJS.DOM.Types (File, IsBlob) import Language.Javascript.JSaddle.Monad (MonadJSM, liftJSM)@@ -26,19 +26,30 @@  -- | Performs a POST request with the provided FormData payload postForms-  :: ( IsBlob blob, HasJSContext (Performable m), MonadJSM (Performable m)+  :: ( IsBlob blob, MonadJSM (Performable m)      , PerformEvent t m, TriggerEvent t m      , Traversable f)   => Text -- ^ The target url   -> Event t (f (Map Text (FormValue blob))) -- ^ Maps of text keys and values that will be sent as "FormData"   -> m (Event t (f XhrResponse))-postForms url payload = do+postForms t = postForms' t def++-- | Like 'postForms' but doesn't use a default 'XhrRequestConfig', so a custom one can be provided.+postForms'+  :: ( IsBlob blob, MonadJSM (Performable m)+     , PerformEvent t m, TriggerEvent t m+     , Traversable f)+  => Text -- ^ The target url+  -> XhrRequestConfig a+  -> Event t (f (Map Text (FormValue blob))) -- ^ Maps of text keys and values that will be sent as "FormData"+  -> m (Event t (f XhrResponse))+postForms' url cfg payload = do   performMkRequestsAsync $ ffor payload $ \fs -> for fs $ \u -> liftJSM $ do     fd <- FD.newFormData Nothing     iforM_ u $ \k v -> case v of       FormValue_Text t -> FD.append fd k t       FormValue_File b fn -> FD.appendBlob fd k b fn-    return $ xhrRequest "POST" url $ def & xhrRequestConfig_sendData .~ fd+    return $ xhrRequest "POST" url $ cfg & xhrRequestConfig_sendData .~ fd  -- | Converts a File (e.g., the output of a 'FileInput') into a 'FormValue'. The filename will be included if it is available. fileToFormValue :: MonadJSM m => File -> m (FormValue File)

@@ -1,10 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- module Reflex.Dom.Xhr.ResponseType where  import Data.ByteString (ByteString) import Data.Text (Text)-import Data.Typeable import GHCJS.DOM.Blob (Blob)  data XhrResponseType@@ -12,7 +9,7 @@   | XhrResponseType_ArrayBuffer   | XhrResponseType_Blob   | XhrResponseType_Text-  deriving (Show, Read, Eq, Ord, Typeable)+  deriving (Show, Read, Eq, Ord)  data XhrResponseBody   = XhrResponseBody_Default Text

@@ -11,7 +11,6 @@ import Data.Text as T import Language.Javascript.JSaddle.Warp import Reflex.Dom.Core-import Reflex.Time import System.Exit import System.Mem import System.Process@@ -20,7 +19,7 @@ import Test.Util.UnshareNetwork  #if MIN_VERSION_base(4,11,0)-import GHC.Stats (getRTSStatsEnabled, getRTSStats, RTSStats(..), gcdetails_live_bytes, gc)+import GHC.Stats (getRTSStats, RTSStats(..), gcdetails_live_bytes, gc) currentBytesUsed :: RTSStats -> Int64 currentBytesUsed = fromIntegral . gcdetails_live_bytes . gc #else

@@ -5,6 +5,7 @@ main = do   ideas <- hlint     [ "."+    , "--ignore=Functor law"     , "--ignore=Redundant do"     , "--ignore=Use camelCase"     , "--ignore=Redundant $"@@ -20,7 +21,9 @@     , "--ignore=Unnecessary hiding" -- Interferes with cross-version compatibility     , "--ignore=Use <$>"     , "--ignore=Reduce duplication" --TODO: Re-enable this test+    , "--ignore=Eta reduce" -- simplified subsumption     , "--ignore=Use list comprehension"+    , "--ignore=Evaluate"     , "--cpp-define=USE_TEMPLATE_HASKELL"     ]   if null ideas then exitSuccess else exitFailure

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -58,7 +59,6 @@ import Network.Wai import Network.WebSockets import Reflex.Dom.Core-import Reflex.Dom.Widget.Input (dropdown) import Reflex.Patch.DMapWithMove import System.Directory import System.Environment@@ -89,8 +89,10 @@ import Test.Util.ChromeFlags import Test.Util.UnshareNetwork --- ORPHAN: https://github.com/kallisti-dev/hs-webdriver/pull/167++#if !MIN_VERSION_webdriver(0,10,0) deriving instance MonadMask WD+#endif  chromium :: FilePath chromium = $(staticWhich "chromium")@@ -118,18 +120,11 @@ chromeConfig :: Text -> [Text] -> WD.WDConfig chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig -keyMap :: DMap DKey Identity-keyMap = DMap.fromList-  [ Key_Int ==> 0-  , Key_Char ==> 'A'-  ]- data DKey a where   Key_Int :: DKey Int   Key_Char :: DKey Char   Key_Bool :: DKey Bool - textKey :: DKey a -> Text textKey = \case   Key_Int -> "Key_Int"@@ -141,6 +136,21 @@ deriveGCompare ''DKey deriveGShow ''DKey +keyMap :: DMap DKey Identity+keyMap = DMap.fromList+  [ Key_Int ==> 0+  , Key_Char ==> 'A'+  ]++data Key2 a where+  Key2_Int :: Int -> Key2 Int+  Key2_Char :: Char -> Key2 Char++deriveGEq ''Key2+deriveGCompare ''Key2+deriveGShow ''Key2+deriveArgDict ''Key2+ deriving instance MonadFail WD  main :: IO ()@@ -166,11 +176,11 @@         r <- m         putStrLnDebug "after"         return r-      testWidgetStatic :: WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b+      testWidgetStatic :: WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b       testWidgetStatic = testWidgetStaticDebug withDebugging-      testWidget :: WD () -> WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b+      testWidget :: WD () -> WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b       testWidget = testWidgetDebug True withDebugging-      testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b+      testWidget' :: WD a -> (a -> WD b) -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b       testWidget' = testWidgetDebug' True withDebugging   session' "text" $ do     it "works" $ runWD $ do@@ -1653,7 +1663,7 @@     , _selenium_stopServer = stopServer     } -triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender js t m) => Chan a -> m (Event t a)+triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a) triggerEventWithChan chan = do   (e, trigger) <- newTriggerEvent   -- In prerender because we only want to do this on the client@@ -1716,13 +1726,13 @@ divId :: DomBuilder t m => Text -> m a -> m a divId i = elAttr "div" ("id" =: i) -type TestWidget js t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender js t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)+type TestWidget t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)  testWidgetStaticDebug   :: Bool   -> WD b   -- ^ Webdriver commands to run before JS runs and after hydration switchover-  -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())+  -> (forall m. TestWidget (SpiderTimeline Global) m => m ())   -- ^ Widget we are testing   -> WD b testWidgetStaticDebug withDebugging w = testWidgetDebug True withDebugging (void w) w@@ -1735,7 +1745,7 @@   -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)   -> WD b   -- ^ Webdriver commands to run after hydration switchover-  -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())+  -> (forall m. TestWidget (SpiderTimeline Global) m => m ())   -- ^ Widget we are testing   -> WD b testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =@@ -1752,7 +1762,7 @@   -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)   -> (a -> WD b)   -- ^ Webdriver commands to run after hydration switchover-  -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())+  -> (forall m. TestWidget (SpiderTimeline Global) m => m ())   -- ^ Widget we are testing (contents of body)   -> WD b testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do@@ -1817,12 +1827,3 @@   (liftIO $ Async.async f)   (liftIO . Async.uninterruptibleCancel)   (const g)--data Key2 a where-  Key2_Int :: Int -> Key2 Int-  Key2_Char :: Char -> Key2 Char--deriveGEq ''Key2-deriveGCompare ''Key2-deriveGShow ''Key2-deriveArgDict ''Key2