022ff15 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge branch 'master' into develop

commit022ff1581dfa63338ab139d8c021fb3ec60c577d authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 28 Feb 2015, 19:48 (12 years ago) parent1675465 5244968

4 files changed+44−17

compare with develop

unifiedsplit

src/Reflex/Dom/Class.hs+4 src/Reflex/Dom/Internal.hs+7 src/Reflex/Dom/Widget/Basic.hs+16−11 src/Reflex/Dom/Widget/Input.hs+17−6

src/Reflex/Dom/Class.hs+4

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

5757 type GuiAction m :: * -> *

5858 askParent :: m Node

5959 subWidget :: Node -> m a -> m a

60+ subWidgetWithVoidActions :: Node -> m a -> m (a, Event t (WidgetHost m()))

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

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

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

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

9293 subWidget n w = do

9394 r <- ask

9495 lift $ subWidget n $ runReaderT w r

96+ subWidgetWithVoidActions n w = do

97+ r <- ask

98+ lift $ subWidgetWithVoidActions n $ runReaderT w r

9599 liftWidgetHost = lift . liftWidgetHost

96100 schedulePostBuild = lift . schedulePostBuild

97101 addVoidAction = lift . addVoidAction

src/Reflex/Dom/Internal.hs+7

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

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

151151 addVoidAction a = Widget $ widgetStateVoidActions %= (a:)

152152 subWidget n child = Widget $ local (widgetEnvParent .~ toNode n) $ unWidget child

153+ subWidgetWithVoidActions n child = Widget $ do

154+ oldActions <- use widgetStateVoidActions

155+ widgetStateVoidActions .= []

156+ result <- local (widgetEnvParent .~ toNode n) $ unWidget child

157+ actions <- use widgetStateVoidActions

158+ widgetStateVoidActions .= oldActions

159+ return (result, mergeWith (>>) actions)

153160-- runWidget :: (Monad m, IsNode n, Reflex t) => n -> Widget t m a -> m (a, Event t (m ()))

154161 getRunWidget = return runWidget

155162

src/Reflex/Dom/Widget/Basic.hs+16−11

@@ -6,6 +6,7 @@ import Reflex.Dom.Class

77import Reflex

88import Reflex.Host.Class

9+import Data.Functor.Misc

910import Data.Map (Map)

1011import qualified Data.Map as Map

1112import Data.Set (Set)

@@ -198,7 +199,7 @@ listWithKey vals mkChild = do

198199 liftIO $ putStrLn "Triggering newChildren done"

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

200201

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' :: forall t m k v a. (Ord k, MonadWidget t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))

202203listWithKey' initialVals valsChanged mkChild = do

203204 doc <- askDocument

204205 startPlaceholder <- text' ""

@@ -206,20 +207,23 @@ listWithKey' initialVals valsChanged mkChild = do

206207 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

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

208209 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

210+ let childValChangedSelector :: EventSelector t (Const2 k v)

211+ childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged

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

213+ buildChild df k v = runWidget df $ wrapChild k v

214+ wrapChild k v = do

211215 childStart <- text' ""

212− result <- mkChild k v

216+ result <- mkChild k v $ select childValChangedSelector $ Const2 k

213217 childEnd <- text' ""

214218 return (result, (childStart, childEnd))

215219 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

220+ initialState <- iforM initialVals $ \k v -> subWidgetWithVoidActions (toNode df) $ wrapChild k v --Note: we have to use subWidgetWithVoidActions rather than runWidget here, because running post-build actions during build can cause not-yet-constructed values to be read

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

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

219223 Just p <- liftIO $ nodeGetParentNode endPlaceholder

220224 liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

221225 addVoidAction $ flip fmap valsChanged $ \newVals -> do

222− curState <- sample children

226+ curState <- sample $ current children

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

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

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

@@ -248,7 +252,7 @@ listWithKey' initialVals valsChanged mkChild = do

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

249253 runFrameWithTriggerRef newChildrenTriggerRef newState

250254 liftIO $ putStrLn "Triggering newChildren done"

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

255+ mapDyn (fmap (fst . fst)) children

252256

253257selectViewListWithKey_ :: 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)

254258selectViewListWithKey_ selection vals mkChild = do

@@ -306,6 +310,7 @@ wrapElement e = do

306310 scrolled <- wrapDomEvent e elementOnscroll $ liftIO $ elementGetScrollTop e

307311 return $ El e clicked keypress scrolled

308312

313+elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a)

309314elDynAttr' elementTag attrs child = do

310315 (e, result) <- buildElement elementTag attrs child

311316 e' <- wrapElement e

@@ -318,11 +323,11 @@ elAttr elementTag attrs child = do

318323 return result

319324

320325{-# INLINABLE el' #-}

321−--el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)

326+el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)

322327el' tag child = elAttr' tag (Map.empty :: AttributeMap) child

323328

324329{-# INLINABLE elAttr' #-}

325−--elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)

330+elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)

326331elAttr' elementTag attrs child = do

327332 (e, result) <- buildElement elementTag attrs child

328333 e' <- wrapElement e

src/Reflex/Dom/Widget/Input.hs+17−6

@@ -144,6 +144,16 @@ instance HasStateModeWitness View where

144144 stateModeWitness = ViewWitness

145145-}

146146

147+data CheckboxConfig t

148+ = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool

149+ , _checkboxConfig_attributes :: Map String String

150+ }

151+

152+instance Reflex t => Default (CheckboxConfig t) where

153+ def = CheckboxConfig { _checkboxConfig_setValue = never

154+ , _checkboxConfig_attributes = Map.empty

155+ }

156+

147157data Checkbox t

148158 = Checkbox { _checkbox_value :: Dynamic t Bool

149159 }

@@ -151,11 +161,12 @@ data Checkbox t

151161--TODO: Make attributes possibly dynamic

152162-- | Create an editable checkbox

153163-- Note: if the "type" or "checked" attributes are provided as attributes, they will be ignored

154−checkbox :: MonadWidget t m => Bool -> Map String String -> m (Checkbox t)

155−checkbox checked attrs = do

156− e <- liftM castToHTMLInputElement $ buildEmptyElement "input" $ Map.insert "type" "checkbox" $ (if checked then Map.insert "checked" "checked" else Map.delete "checked") attrs

157− eChange <- wrapDomEvent e elementOnclick $ liftIO $ htmlInputElementGetChecked e

158− dValue <- holdDyn checked eChange

164+checkbox :: MonadWidget t m => Bool -> CheckboxConfig t -> m (Checkbox t)

165+checkbox checked config = do

166+ e <- liftM castToHTMLInputElement $ buildEmptyElement "input" $ Map.insert "type" "checkbox" $ (if checked then Map.insert "checked" "checked" else Map.delete "checked") (_checkboxConfig_attributes config)

167+ eClick <- wrapDomEvent e elementOnclick $ liftIO $ htmlInputElementGetChecked e

168+ performEvent_ $ fmap (liftIO . htmlInputElementSetChecked e) $ _checkboxConfig_setValue config

169+ dValue <- holdDyn checked $ leftmost [_checkboxConfig_setValue config, eClick]

159170 return $ Checkbox dValue

160171

161172checkboxView :: MonadWidget t m => Dynamic t (Map String String) -> Dynamic t Bool -> m (Event t Bool)

@@ -175,7 +186,7 @@ checkboxWithLabel l = checkboxWithLabelAttrs l Map.empty

175186

176187checkboxWithLabelAttrs :: forall t m. MonadWidget t m => String -> Map String String -> m (Checkbox t)

177188checkboxWithLabelAttrs l attrs = elAttr "label" attrs $ do

178− c <- checkbox False Map.empty

189+ c <- checkbox False def

179190 text $ " " <> l

180191 return c

181192