diff --git a/reflex-dom-core/reflex-dom-core.cabal b/reflex-dom-core/reflex-dom-core.cabal index 1cc9a640..4e2d0c35 100644 --- a/reflex-dom-core/reflex-dom-core.cabal +++ b/reflex-dom-core/reflex-dom-core.cabal @@ -155,7 +155,7 @@ library 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 -fwarn-redundant-constraints -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively ghc-prof-options: -fprof-auto if flag(expose-all-unfoldings) diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs index c75eb501..77e31985 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs @@ -734,7 +734,6 @@ class Monad m => HasDocument m where :: ( m ~ f m' , RawDocument (DomBuilderSpace m) ~ RawDocument (DomBuilderSpace m') , MonadTrans f - , Monad m' , HasDocument m' ) => m (RawDocument (DomBuilderSpace m)) diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs index fce08d03..a7b36830 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs @@ -283,7 +283,7 @@ data HydrationState = HydrationState } {-# 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 }) @@ -293,13 +293,13 @@ localRunner (HydrationRunnerT m) s parent = do {-# 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) @@ -357,7 +357,7 @@ newtype DomRenderHookT t m a = DomRenderHookT { unDomRenderHookT :: RequesterT t {-# 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 @@ -389,7 +389,6 @@ runHydrationDomBuilderT :: ( MonadFix m , PerformEvent t m , MonadReflexCreateTrigger t m - , MonadJSM m , MonadJSM (Performable m) , MonadRef m , Ref m ~ IORef @@ -538,7 +537,7 @@ newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IOR -- | 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 @@ -1036,8 +1035,7 @@ inputElementInternal cfg = getHydrationMode >>= \case {-# 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 () @@ -1236,7 +1234,7 @@ textNodeImmediate (TextNodeConfig !t mSetContents) = do {-# 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 @@ -1304,7 +1302,7 @@ commentNodeImmediate (CommentNodeConfig !t mSetContents) = do {-# 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 @@ -1343,7 +1341,7 @@ hydrateComment doc t mSetContents = do -- 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)) @@ -1393,11 +1391,11 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case 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 @@ -1527,7 +1525,7 @@ instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjus 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 @@ -1689,7 +1687,7 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ra {-# 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 :: * -> *) 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) @@ -1735,7 +1733,7 @@ traverseDMapWithKeyWithAdjust' = do {-# 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) @@ -1797,7 +1795,7 @@ data ChildReadyState a | 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 @@ -1810,13 +1808,8 @@ hoistTraverseWithKeyWithAdjust ( 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')) @@ -1920,12 +1913,9 @@ hoistTraverseIntMapWithKeyWithAdjust :: , 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 ) @@ -2078,7 +2068,7 @@ data TraverseChild t m k a = TraverseChild } 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) @@ -2140,7 +2130,7 @@ drawChildUpdate initialEnv markReady child = do #-} {-# INLINABLE drawChildUpdateInt #-} -drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t) +drawChildUpdateInt :: (MonadIO m, MonadJSM m) => HydrationDomBuilderEnv t m -> (IORef (ChildReadyState k) -> JSM ()) -> HydrationDomBuilderT s t m v diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs index 140c25ae..18c7c162 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs @@ -188,11 +188,9 @@ replaceEnd key = void $ commentNode $ def { _commentNodeConfig_initialContents = 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 @@ -224,7 +222,6 @@ hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p. , 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)) diff --git a/reflex-dom-core/src/Reflex/Dom/Prerender.hs b/reflex-dom-core/src/Reflex/Dom/Prerender.hs index b7e9cbda..73d4fdcb 100644 --- a/reflex-dom-core/src/Reflex/Dom/Prerender.hs +++ b/reflex-dom-core/src/Reflex/Dom/Prerender.hs @@ -74,7 +74,7 @@ type PrerenderBaseConstraints t 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 t m) + :: (Functor m, Prerender t m) => m () -> Client m () -> m () prerender_ server client = void $ prerender server client @@ -256,11 +256,11 @@ instance (Prerender t m, Monad m, Reflex t, MonadFix m, Group q, Commutative q, query = incrementalToDynamic =<< inc -- Can we avoid the incrementalToDynamic? pure a -instance (Prerender t m, Monad m) => Prerender 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 t m, Monad m) => Prerender 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 diff --git a/reflex-dom-core/src/Reflex/Dom/WebSocket.hs b/reflex-dom-core/src/Reflex/Dom/WebSocket.hs index 13e6fedc..a84f41fb 100644 --- a/reflex-dom-core/src/Reflex/Dom/WebSocket.hs +++ b/reflex-dom-core/src/Reflex/Dom/WebSocket.hs @@ -134,10 +134,10 @@ webSocket' url config onRawMessage = do unless success $ atomically $ unGetTQueue payloadQueue payload return $ RawWebSocket eRecv eOpen eError eClose -textWebSocket :: (IsWebSocketMessage a, MonadJSM m, MonadJSM (Performable 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), 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 } diff --git a/reflex-dom-core/src/Reflex/Dom/WebSocket/Query.hs b/reflex-dom-core/src/Reflex/Dom/WebSocket/Query.hs index a8c4266a..8e66d637 100644 --- a/reflex-dom-core/src/Reflex/Dom/WebSocket/Query.hs +++ b/reflex-dom-core/src/Reflex/Dom/WebSocket/Query.hs @@ -12,7 +12,7 @@ import Reflex.Dom.WebSocket import Data.Maybe import Language.Javascript.JSaddle.Types (MonadJSM) -runWebSocketQuery :: (MonadJSM m, MonadJSM (Performable m), PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, Reflex t, ToJSON q, MonadFix m, Query q, FromJSON (QueryResult q), Commutative 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 diff --git a/reflex-dom-core/src/Reflex/Dom/Widget/Input.hs b/reflex-dom-core/src/Reflex/Dom/Widget/Input.hs index 2c67fcd3..0bf0011f 100644 --- a/reflex-dom-core/src/Reflex/Dom/Widget/Input.hs +++ b/reflex-dom-core/src/Reflex/Dom/Widget/Input.hs @@ -289,7 +289,7 @@ newtype CheckboxViewEventResult en = CheckboxViewEventResult { unCheckboxViewEve -- | 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 @@ -335,7 +335,7 @@ instance Reflex t => Default (FileInputConfig t) where 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"