8e3bba9 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge branch 'master' into develop

8e3bba9Doug Beardsley12 years ago

default.nix+1−1

compare with develop

unifiedsplit

@@ -6,7 +6,7 @@

6mkDerivation {

7 pname = "reflex-dom";

8 version = "0.1";

9− src = ./.;

9+ src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;

10 buildDepends = [

11 reflex

12 dependent-map

src/Reflex/Dom/Class.hs+2

@@ -57,6 +57,7 @@ class ( Reflex t, MonadHold t m, MonadIO m, Functor m, MonadReflexCreateTrigger

57 type GuiAction m :: * -> *

58 askParent :: m Node

59 subWidget :: Node -> m a -> m a

60+ liftWidgetHost :: WidgetHost m a -> m a --TODO: Is this a good idea?

60 schedulePostBuild :: WidgetHost m () -> m ()

61 schedulePostBuild :: WidgetHost m () -> m ()

61 addVoidAction :: Event t (WidgetHost m ()) -> m ()

62 addVoidAction :: Event t (WidgetHost m ()) -> m ()

62 getRunWidget :: IsNode n => m (n -> m a -> WidgetHost m (a, Event t (WidgetHost m ())))

63 getRunWidget :: IsNode n => m (n -> m a -> WidgetHost m (a, Event t (WidgetHost m ())))

@@ -91,6 +92,7 @@ instance MonadWidget t m => MonadWidget t (ReaderT r m) where

91 subWidget n w = do

92 subWidget n w = do

92 r <- ask

93 r <- ask

93 lift $ subWidget n $ runReaderT w r

94 lift $ subWidget n $ runReaderT w r

95+ liftWidgetHost = lift . liftWidgetHost

94 schedulePostBuild = lift . schedulePostBuild

96 schedulePostBuild = lift . schedulePostBuild

95 addVoidAction = lift . addVoidAction

97 addVoidAction = lift . addVoidAction

96 getRunWidget = do

98 getRunWidget = do

src/Reflex/Dom/Internal.hs+1

@@ -144,6 +144,7 @@ instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Should

144 --TODO: Use types to separate cohorts of possibly-recursive events/behaviors

145 -- | Schedule an action to occur after the current cohort has been built; this is necessary because Behaviors built in the current cohort may not be read until after it is complete

146 --schedulePostBuild :: Monad m => m () -> WidgetInternal t m ()

147+ liftWidgetHost = Widget . lift . lift

147 schedulePostBuild a = Widget $ widgetStatePostBuild %= (a>>) --TODO: Can this >> be made strict?

148 schedulePostBuild a = Widget $ widgetStatePostBuild %= (a>>) --TODO: Can this >> be made strict?

148

149

149 --addVoidAction :: Monad m => Event t (m ()) -> WidgetInternal t m ()

150 --addVoidAction :: Monad m => Event t (m ()) -> WidgetInternal t m ()

src/Reflex/Dom/Widget/Basic.hs+52

@@ -198,6 +198,58 @@ listWithKey vals mkChild = do

198 liftIO $ putStrLn "Triggering newChildren done"

199 holdDyn Map.empty $ fmap (fmap (fst . fst)) newChildren

200

201+listWithKey' :: forall t m k v a. (Ord k, MonadWidget t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))

202+listWithKey' initialVals valsChanged mkChild = do

203+ doc <- askDocument

204+ startPlaceholder <- text' ""

205+ endPlaceholder <- text' ""

206+ (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

207+-- performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack

208+ runWidget <- getRunWidget

209+ let buildChild :: DocumentFragment -> k -> v -> WidgetHost m ((a, (Text, Text)), Event t (WidgetHost m ()))

210+ buildChild df k v = runWidget df $ do

211+ childStart <- text' ""

212+ result <- mkChild k v

213+ childEnd <- text' ""

214+ return (result, (childStart, childEnd))

215+ Just df <- liftIO $ documentCreateDocumentFragment doc

216+ initialState <- liftWidgetHost $ iforM initialVals $ buildChild df

217+ children <- hold initialState $ traceEventWith (\x -> "newChildren: " <> show (Map.size x)) newChildren

218+ addVoidAction $ switch $ fmap (mergeWith (>>) . map snd . Map.elems) children

219+ Just p <- liftIO $ nodeGetParentNode endPlaceholder

220+ liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

221+ addVoidAction $ flip fmap valsChanged $ \newVals -> do

222+ curState <- sample children

223+ --TODO: Should we remove the parent from the DOM first to avoid reflows?

224+ newState <- liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

225+ These ((_, (start, end)), _) Nothing -> do -- Deleting child

226+ liftIO $ deleteBetweenInclusive start end

227+ return Nothing

228+ These ((_, (start, end)), _) (Just v) -> do -- Replacing existing child

229+ liftIO $ deleteBetweenExclusive start end

230+ Just df <- liftIO $ documentCreateDocumentFragment doc

231+ s <- buildChild df k v

232+ Just p <- liftIO $ nodeGetParentNode end

233+ liftIO $ nodeInsertBefore p (Just df) (Just end)

234+ return $ Just s

235+ That Nothing -> return Nothing -- Deleting non-existent child

236+ That (Just v) -> do -- Creating new child

237+ Just df <- liftIO $ documentCreateDocumentFragment doc

238+ s <- buildChild df k v

239+ let placeholder = case Map.lookupGT k curState of

240+ Nothing -> endPlaceholder

241+ Just (_, ((_, (start, _)), _)) -> start

242+ Just p <- liftIO $ nodeGetParentNode placeholder

243+ liftIO $ nodeInsertBefore p (Just df) (Just placeholder)

244+ return $ Just s

245+ This state -> do -- No change

246+ return $ Just state

247+ liftIO $ putStrLn "Triggering newChildren"

248+ liftIO $ putStrLn . ("newChildrenTriggerRef is Just? " <>) . show . isJust =<< readRef newChildrenTriggerRef

249+ runFrameWithTriggerRef newChildrenTriggerRef newState

250+ liftIO $ putStrLn "Triggering newChildren done"

251+ holdDyn Map.empty $ fmap (fmap (fst . fst)) newChildren

252+

201selectViewListWithKey_ :: forall t m k v a. (MonadWidget t m, Ord k) => Dynamic t k -> Dynamic t (Map k v) -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -> m (Event t k)

253selectViewListWithKey_ :: forall t m k v a. (MonadWidget t m, Ord k) => Dynamic t k -> Dynamic t (Map k v) -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -> m (Event t k)

202selectViewListWithKey_ selection vals mkChild = do

254selectViewListWithKey_ selection vals mkChild = do

203 let selectionDemux = demux selection -- For good performance, this value must be shared across all children

255 let selectionDemux = demux selection -- For good performance, this value must be shared across all children