git.iko.soy/reflex-dom
on develop help sign in
Use safe coercions for Events
commitd4be4a98c3f5c421a70295e2ab310ed2b367eb27 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 3 Oct 2016, 10:12 (10 years ago) parent0594fe4
5 files changed+13−23
compare with develop
unifiedsplit
src/Foreign/JavaScript/TH.hs+1−3 src/Reflex/Dom/Builder/Immediate.hs+5−6 src/Reflex/Dom/Builder/InputDisabled.hs+1−3 src/Reflex/Dom/Builder/Static.hs+3−4 src/Reflex/Dom/Widget/Basic.hs+3−7
src/Foreign/JavaScript/TH.hs+1−3
@@ -81,8 +81,6 @@ import Data.Monoid
8181import Data.Text (Text)
8282import qualified Data.Text as T
8383
84−import Unsafe.Coerce
85−
8684class Monad m => HasWebView m where
8785 type WebViewPhantom m :: *
8886 askWebView :: m (WebViewSingleton (WebViewPhantom m))
@@ -122,7 +120,7 @@ instance PrimMonad m => PrimMonad (WithWebView x m) where
122120 primitive = lift . primitive
123121
124122instance MonadAdjust t m => MonadAdjust t (WithWebView x m) where
125− sequenceDMapWithAdjust dm0 dm' = WithWebView $ sequenceDMapWithAdjust (coerce dm0) (unsafeCoerce dm')
123+ sequenceDMapWithAdjust dm0 dm' = WithWebView $ sequenceDMapWithAdjust (coerce dm0) (coerceEvent dm')
126124
127125instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView x m) where
128126 {-# INLINABLE newEventWithTrigger #-}
src/Reflex/Dom/Builder/Immediate.hs+5−6
@@ -37,7 +37,6 @@ import Data.Default
3737import Data.Dependent.Map (DMap)
3838import qualified Data.Dependent.Map as DMap
3939import Data.Dependent.Sum
40−import Data.Functor.Compose
4140import Data.Functor.Misc
4241import Data.IORef
4342import Data.Map (Map)
@@ -393,21 +392,21 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, PerformEvent t m,
393392 { _immediateDomBuilderEnv_parent = toNode df
394393 }
395394 updateChildren = ffor dm' $ \(PatchDMap p) -> PatchDMap $
396− mapKeyValuePairsMonotonic (\(k :=> Compose mv) -> WrapArg k :=> Compose (fmap drawChildUpdate mv)) p
397− (children0, children') <- lift $ sequenceDMapWithAdjust (mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> drawChildInitial v) dm0) (updateChildren :: Event t (PatchDMap (DMap (WrapArg ((,,) DOM.DocumentFragment DOM.Text) k) m))) --TODO: Update stuff
395+ mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (fmap drawChildUpdate mv)) p
396+ (children0, children') <- lift $ sequenceDMapWithAdjust (mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> drawChildInitial v) dm0) (updateChildren :: Event t (PatchDMap (WrapArg ((,,) DOM.DocumentFragment DOM.Text) k) m)) --TODO: Update stuff
398397 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, _, v)) -> k :=> Identity v) children0
399398 placeholders0 = dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, ph, _)) -> Const2 (Some.This k) :=> Identity ph) children0
400399 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $
401400 mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> k :=> fmap (\(_, _, r) -> r) v) p
402401 placeholders' = ffor children' $ \(PatchDMap p) -> PatchMap $
403− dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> Const2 (Some.This k) :=> Identity (fmap ((\(_, ph, _) -> ph) . runIdentity) (getCompose v))) p
402+ dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> Const2 (Some.This k) :=> Identity (fmap ((\(_, ph, _) -> ph) . runIdentity) (getComposeMaybe v))) p
404403 placeholders :: Behavior t (Map (Some k) DOM.Text) <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'
405404 lastPlaceholder <- textNodeInternal ("" :: Text)
406405 performEvent_ $ flip push children' $ \(PatchDMap p) -> do
407406 phs <- sample placeholders
408407 if DMap.null p then return Nothing else return $ Just $ do
409− let f :: DSum (WrapArg ((,,) DOM.DocumentFragment DOM.Text) k) (Compose Maybe Identity) -> Performable m ()
410− f (WrapArg k :=> Compose mv) = do
408+ let f :: DSum (WrapArg ((,,) DOM.DocumentFragment DOM.Text) k) (ComposeMaybe Identity) -> Performable m ()
409+ f (WrapArg k :=> ComposeMaybe mv) = do
411410 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs
412411 forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder
413412 forM_ mv $ \(Identity (df, _, _)) -> df `insertBefore` nextPlaceholder
src/Reflex/Dom/Builder/InputDisabled.hs+1−3
@@ -18,8 +18,6 @@ import Reflex
1818import Reflex.Dom.Builder.Class
1919import Reflex.Host.Class
2020
21−import Unsafe.Coerce
22−
2321-- | A DomBuilder transformer that disables all 'inputElement's,
2422-- 'textAreaElement's, and 'selectElement's by adding the "disabled" HTML
2523-- attribute. Note that 'element's that happen to have "input", "textarea", or
@@ -64,7 +62,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (InputDisabl
6462 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
6563
6664instance MonadAdjust t m => MonadAdjust t (InputDisabledT m) where
67− sequenceDMapWithAdjust dm0 dm' = InputDisabledT $ sequenceDMapWithAdjust (coerce dm0) (unsafeCoerce dm') --TODO: Eliminate unsafeCoerce
65+ sequenceDMapWithAdjust dm0 dm' = InputDisabledT $ sequenceDMapWithAdjust (coerce dm0) (coerceEvent dm')
6866
6967instance DomBuilder t m => DomBuilder t (InputDisabledT m) where
7068 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m
src/Reflex/Dom/Builder/Static.hs+3−4
@@ -31,7 +31,6 @@ import Data.Default
3131import Data.Dependent.Map (DMap)
3232import qualified Data.Dependent.Map as DMap
3333import Data.Dependent.Sum (DSum (..))
34−import Data.Functor.Compose
3534import Data.Functor.Constant
3635import Data.Functor.Misc
3736import qualified Data.Map as Map
@@ -139,16 +138,16 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB
139138 sequenceDMapWithAdjust (dm0 :: DMap k (StaticDomBuilderT t m)) dm' = do
140139 let loweredDm0 = mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> fmap swap (runStaticDomBuilderT v)) dm0
141140 loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
142− mapKeyValuePairsMonotonic (\(k :=> Compose mv) -> WrapArg k :=> Compose (fmap (fmap swap . runStaticDomBuilderT) mv)) p
141+ mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (fmap (fmap swap . runStaticDomBuilderT) mv)) p
143142 (children0, children') <- lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'
144143 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, v)) -> k :=> Identity v) children0
145144 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $
146145 mapKeyValuePairsMonotonic (\(WrapArg k :=> mv) -> k :=> fmap snd mv) p
147146 outputs0 :: DMap k (Constant (Behavior t ByteString))
148147 outputs0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (o, _)) -> k :=> Constant o) children0
149− outputs' :: Event t (PatchDMap (DMap k (Constant (Behavior t ByteString))))
148+ outputs' :: Event t (PatchDMap k (Constant (Behavior t ByteString)))
150149 outputs' = ffor children' $ \(PatchDMap p) -> PatchDMap $
151− mapKeyValuePairsMonotonic (\(WrapArg k :=> Compose mv) -> k :=> Compose (fmap (Constant . fst . runIdentity) mv)) p
150+ mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mv) -> k :=> ComposeMaybe (fmap (Constant . fst . runIdentity) mv)) p
152151 outputs <- holdIncremental outputs0 outputs'
153152 StaticDomBuilderT $ modify $ (:) $ pull $ do
154153 os <- sample $ currentIncremental outputs
src/Reflex/Dom/Widget/Basic.hs+3−7
@@ -91,19 +91,15 @@ import Control.Lens hiding (children, element)
9191import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
9292import Data.Align
9393import Data.Default
94−import Data.Dependent.Map (DMap, GCompare)
9594import qualified Data.Dependent.Map as DMap
9695import Data.Either
9796import Data.Foldable
98−import Data.Functor.Compose
9997import Data.Functor.Misc
10098import Data.Map (Map)
10199import qualified Data.Map as Map
102100import Data.Maybe
103101import Data.Set (Set)
104102import qualified Data.Set as Set
105−import Data.Some (Some)
106−import qualified Data.Some as Some
107103import Data.Text (Text)
108104import qualified Data.Text as T
109105import Data.These
@@ -113,11 +109,11 @@ import Prelude hiding (mapM, mapM_, sequence, sequence_)
113109--TODO: Implement this specially
114110widgetHoldInternal :: forall t m a b. DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)
115111widgetHoldInternal child0 child' = do
116− (result0, result') <- sequenceDMapWithAdjust (DMap.singleton LeftTag child0) $ fmap (PatchDMap . DMap.insert LeftTag (Compose Nothing) . DMap.singleton RightTag . Compose . Just) child'
112+ (result0, result') <- sequenceDMapWithAdjust (DMap.singleton LeftTag child0) $ fmap (PatchDMap . DMap.insert LeftTag (ComposeMaybe Nothing) . DMap.singleton RightTag . ComposeMaybe . Just) child'
117113 let e :: forall x. x
118114 e = error "widgetHoldInternal: missing child (should be impossible)"
119115 return ( runIdentity $ DMap.findWithDefault e LeftTag result0
120− , ffor result' $ \(PatchDMap p) -> runIdentity $ fromMaybe e $ getCompose $ DMap.findWithDefault e RightTag p
116+ , ffor result' $ \(PatchDMap p) -> runIdentity $ fromMaybe e $ getComposeMaybe $ DMap.findWithDefault e RightTag p
121117 )
122118
123119-- | Breaks the given Map into pieces based on the given Set. Each piece will contain only keys that are less than the key of the piece, and greater than or equal to the key of the piece with the next-smaller key. There will be one additional piece containing all keys from the original Map that are larger or equal to the largest key in the Set.
@@ -155,7 +151,7 @@ newtype ChildResult t k a = ChildResult { unChildResult :: (a, Event t (Map k (M
155151listHoldWithKey :: forall t m k v a. (Ord k, DomBuilder t m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))
156152listHoldWithKey m0 m' f = do
157153 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
158− dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> Compose $ fmap (f k) v)) m'
154+ dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> ComposeMaybe $ fmap (f k) v)) m'
159155 (a0, a') <- sequenceDMapWithAdjust dm0 dm'
160156 fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time
161157