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

git.iko.soy/reflex-dom

on develop help sign in

Merge branch 'master' into develop

022ff15Ryan Trinkle12 years ago

src/Reflex/Dom/Class.hs+4

compare with develop

unifiedsplit

@@ -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+ subWidgetWithVoidActions :: Node -> m a -> m (a, Event t (WidgetHost m()))

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

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

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

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

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

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

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

92 subWidget n w = do

93 subWidget n w = do

93 r <- ask

94 r <- ask

94 lift $ subWidget n $ runReaderT w r

95 lift $ subWidget n $ runReaderT w r

96+ subWidgetWithVoidActions n w = do

97+ r <- ask

98+ lift $ subWidgetWithVoidActions n $ runReaderT w r

95 liftWidgetHost = lift . liftWidgetHost

99 liftWidgetHost = lift . liftWidgetHost

96 schedulePostBuild = lift . schedulePostBuild

100 schedulePostBuild = lift . schedulePostBuild

97 addVoidAction = lift . addVoidAction

101 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

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

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

152 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)

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

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

154 getRunWidget = return runWidget

161 getRunWidget = return runWidget

155

162

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

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

7import Reflex

8import Reflex.Host.Class

9+import Data.Functor.Misc

9import Data.Map (Map)

10import Data.Map (Map)

10import qualified Data.Map as Map

11import qualified Data.Map as Map

11import Data.Set (Set)

12import Data.Set (Set)

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

198 liftIO $ putStrLn "Triggering newChildren done"

199 liftIO $ putStrLn "Triggering newChildren done"

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

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

200

201

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))

202listWithKey' initialVals valsChanged mkChild = do

203listWithKey' initialVals valsChanged mkChild = do

203 doc <- askDocument

204 doc <- askDocument

204 startPlaceholder <- text' ""

205 startPlaceholder <- text' ""

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

206 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

207 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

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

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

208 runWidget <- getRunWidget

209 runWidget <- getRunWidget

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

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

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

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

210− buildChild df k v = runWidget df $ do

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

214+ wrapChild k v = do

211 childStart <- text' ""

215 childStart <- text' ""

212− result <- mkChild k v

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

213 childEnd <- text' ""

217 childEnd <- text' ""

214 return (result, (childStart, childEnd))

218 return (result, (childStart, childEnd))

215 Just df <- liftIO $ documentCreateDocumentFragment doc

219 Just df <- liftIO $ documentCreateDocumentFragment doc

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

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

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

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

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

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

219 Just p <- liftIO $ nodeGetParentNode endPlaceholder

223 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

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

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

222− curState <- sample children

226+ curState <- sample $ current children

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

227 --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

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

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

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

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

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

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

249 runFrameWithTriggerRef newChildrenTriggerRef newState

253 runFrameWithTriggerRef newChildrenTriggerRef newState

250 liftIO $ putStrLn "Triggering newChildren done"

254 liftIO $ putStrLn "Triggering newChildren done"

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

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

252

256

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)

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

254selectViewListWithKey_ selection vals mkChild = do

258selectViewListWithKey_ selection vals mkChild = do

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

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

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

307 return $ El e clicked keypress scrolled

311 return $ El e clicked keypress scrolled

308

312

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

309elDynAttr' elementTag attrs child = do

314elDynAttr' elementTag attrs child = do

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

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

311 e' <- wrapElement e

316 e' <- wrapElement e

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

318 return result

323 return result

319

324

320{-# INLINABLE el' #-}

325{-# 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)

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

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

323

328

324{-# INLINABLE elAttr' #-}

329{-# 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)

326elAttr' elementTag attrs child = do

331elAttr' elementTag attrs child = do

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

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

328 e' <- wrapElement e

333 e' <- wrapElement e

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

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

144 stateModeWitness = ViewWitness

145-}

146

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+

147data Checkbox t

157data Checkbox t

148 = Checkbox { _checkbox_value :: Dynamic t Bool

158 = Checkbox { _checkbox_value :: Dynamic t Bool

149 }

159 }

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

151--TODO: Make attributes possibly dynamic

161--TODO: Make attributes possibly dynamic

152-- | Create an editable checkbox

162-- | Create an editable checkbox

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

163-- 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)

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

155−checkbox checked attrs = do

165+checkbox checked config = do

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

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

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

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

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

158− dValue <- holdDyn checked eChange

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

159 return $ Checkbox dValue

170 return $ Checkbox dValue

160

171

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

172checkboxView :: 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

175

186

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

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

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

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

178− c <- checkbox False Map.empty

189+ c <- checkbox False def

179 text $ " " <> l

190 text $ " " <> l

180 return c

191 return c

181

192