@@ -6,6 +6,7 @@
66{-# LANGUAGE FlexibleInstances #-}
77{-# LANGUAGE MultiParamTypeClasses #-}
88import Control.Monad
9+import Control.Monad.Identity
910import Control.Monad.Trans
1011import Reflex.Dom
1112import qualified Data.Text as T
@@ -23,9 +24,9 @@ import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
2324main :: IO ()
2425main = mainWidget w
2526
26−w :: forall t m. (MonadWidget t m, MountableDomBuilder t m) => m ()
27+w :: forall t m. (MonadWidget t m, DomRenderHook t m, MountableDomBuilder t m) => m ()
2728w = do
28− let slow :: forall m'. MonadWidget t m' => m' ()
29+ let slow :: forall m'. (MonadWidget t m', DomRenderHook t m') => m' ()
2930 {-
3031 performEventChain = do
3132 postBuild <- delay 0 =<< getPostBuild
@@ -82,6 +83,7 @@ w = do
8283 text ". "
8384 return ()
8485 -}
86+ {-
8587 slow = do
8688 let f :: forall a. EitherTag () () a -> Const2 () () a -> m' (Const2 () () a)
8789 f _ (Const2 ()) = do
@@ -91,6 +93,23 @@ w = do
9193 postBuild <- getPostBuild
9294 traverseDMapWithKeyWithAdjustWithMove f (DMap.singleton LeftTag $ Const2 ()) $ (PatchDMapWithMove.moveDMapKey LeftTag RightTag) <$ postBuild
9395 return ()
96+ -}
97+ slow = do
98+ let h x = do
99+ liftIO $ putStrLn "render hook"
100+ result <- x
101+ liftIO $ putStrLn "render hook done"
102+ return result
103+ f :: forall a. Const2 () () a -> Identity a -> m' (Identity a)
104+ f (Const2 ()) (Identity ()) = do
105+ liftIO $ putStrLn "f"
106+ widgetHold notReady . (blank <$) =<< delay 0.1 =<< getPostBuild
107+ liftIO $ putStrLn "f done"
108+ return $ Identity ()
109+ withRenderHook h $ do
110+ postBuild <- getPostBuild
111+ _ <- traverseDMapWithKeyWithAdjust f mempty $ PatchDMap (DMap.singleton (Const2 () :: Const2 () () ()) (ComposeMaybe $ Just $ Identity ())) <$ postBuild
112+ return ()
94113 el "div" $ do
95114 draw <- button "Draw"
96115 widgetHold blank $ ffor draw $ \_ -> do