git.iko.soy/reflex-dom
on develop help sign in
Add another test case to prebuild.hs
3349a8eRyan Trinkle
test/prebuild.hs+21−2
compare with develop
unifiedsplit
@@ -6,6 +6,7 @@
6{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8import Control.Monad
8import Control.Monad
9+import Control.Monad.Identity
9import Control.Monad.Trans
10import Control.Monad.Trans
10import Reflex.Dom
11import Reflex.Dom
11import qualified Data.Text as T
12import qualified Data.Text as T
@@ -23,9 +24,9 @@ import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
23main :: IO ()
24main :: IO ()
24main = mainWidget w
25main = mainWidget w
25
26
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 ()
27w = do
28w = do
28− let slow :: forall m'. MonadWidget t m' => m' ()
29+ let slow :: forall m'. (MonadWidget t m', DomRenderHook t m') => m' ()
29 {-
30 {-
30 performEventChain = do
31 performEventChain = do
31 postBuild <- delay 0 =<< getPostBuild
32 postBuild <- delay 0 =<< getPostBuild
@@ -82,6 +83,7 @@ w = do
82 text ". "
83 text ". "
83 return ()
84 return ()
84 -}
85 -}
86+ {-
85 slow = do
87 slow = do
86 let f :: forall a. EitherTag () () a -> Const2 () () a -> m' (Const2 () () a)
88 let f :: forall a. EitherTag () () a -> Const2 () () a -> m' (Const2 () () a)
87 f _ (Const2 ()) = do
89 f _ (Const2 ()) = do
@@ -91,6 +93,23 @@ w = do
91 postBuild <- getPostBuild
93 postBuild <- getPostBuild
92 traverseDMapWithKeyWithAdjustWithMove f (DMap.singleton LeftTag $ Const2 ()) $ (PatchDMapWithMove.moveDMapKey LeftTag RightTag) <$ postBuild
94 traverseDMapWithKeyWithAdjustWithMove f (DMap.singleton LeftTag $ Const2 ()) $ (PatchDMapWithMove.moveDMapKey LeftTag RightTag) <$ postBuild
93 return ()
95 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 ()
94 el "div" $ do
113 el "div" $ do
95 draw <- button "Draw"
114 draw <- button "Draw"
96 widgetHold blank $ ffor draw $ \_ -> do
115 widgetHold blank $ ffor draw $ \_ -> do