d4be4a9 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Use safe coercions for Events

d4be4a9Ryan Trinkle10 years ago

src/Foreign/JavaScript/TH.hs+1−3

compare with develop

unifiedsplit

@@ -81,8 +81,6 @@ import Data.Monoid

81import Data.Text (Text)

82import qualified Data.Text as T

84−import Unsafe.Coerce

85−

86class Monad m => HasWebView m where

84class Monad m => HasWebView m where

87 type WebViewPhantom m :: *

85 type WebViewPhantom m :: *

88 askWebView :: m (WebViewSingleton (WebViewPhantom m))

86 askWebView :: m (WebViewSingleton (WebViewPhantom m))

@@ -122,7 +120,7 @@ instance PrimMonad m => PrimMonad (WithWebView x m) where

122 primitive = lift . primitive

120 primitive = lift . primitive

123

121

124instance MonadAdjust t m => MonadAdjust t (WithWebView x m) where

122instance 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')

126

124

127instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView x m) where

125instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView x m) where

128 {-# INLINABLE newEventWithTrigger #-}

126 {-# INLINABLE newEventWithTrigger #-}

src/Reflex/Dom/Builder/Immediate.hs+5−6

@@ -37,7 +37,6 @@ import Data.Default

37import Data.Dependent.Map (DMap)

38import qualified Data.Dependent.Map as DMap

39import Data.Dependent.Sum

40−import Data.Functor.Compose

41import Data.Functor.Misc

40import Data.Functor.Misc

42import Data.IORef

41import Data.IORef

43import Data.Map (Map)

42import Data.Map (Map)

@@ -393,21 +392,21 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, PerformEvent t m,

393 { _immediateDomBuilderEnv_parent = toNode df

392 { _immediateDomBuilderEnv_parent = toNode df

394 }

393 }

395 updateChildren = ffor dm' $ \(PatchDMap p) -> PatchDMap $

394 updateChildren = ffor dm' $ \(PatchDMap p) -> PatchDMap $

396− mapKeyValuePairsMonotonic (\(k :=> Compose mv) -> WrapArg k :=> Compose (fmap drawChildUpdate mv)) p

395+ mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (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

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

398 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, _, v)) -> k :=> Identity v) children0

397 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, _, v)) -> k :=> Identity v) children0

399 placeholders0 = dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, ph, _)) -> Const2 (Some.This k) :=> Identity ph) children0

398 placeholders0 = dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, ph, _)) -> Const2 (Some.This k) :=> Identity ph) children0

400 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $

399 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $

401 mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> k :=> fmap (\(_, _, r) -> r) v) p

400 mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> k :=> fmap (\(_, _, r) -> r) v) p

402 placeholders' = ffor children' $ \(PatchDMap p) -> PatchMap $

401 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

404 placeholders :: Behavior t (Map (Some k) DOM.Text) <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'

403 placeholders :: Behavior t (Map (Some k) DOM.Text) <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'

405 lastPlaceholder <- textNodeInternal ("" :: Text)

404 lastPlaceholder <- textNodeInternal ("" :: Text)

406 performEvent_ $ flip push children' $ \(PatchDMap p) -> do

405 performEvent_ $ flip push children' $ \(PatchDMap p) -> do

407 phs <- sample placeholders

406 phs <- sample placeholders

408 if DMap.null p then return Nothing else return $ Just $ do

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

408+ let f :: DSum (WrapArg ((,,) DOM.DocumentFragment DOM.Text) k) (ComposeMaybe Identity) -> Performable m ()

410− f (WrapArg k :=> Compose mv) = do

409+ f (WrapArg k :=> ComposeMaybe mv) = do

411 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs

410 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs

412 forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder

411 forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder

413 forM_ mv $ \(Identity (df, _, _)) -> df `insertBefore` nextPlaceholder

412 forM_ mv $ \(Identity (df, _, _)) -> df `insertBefore` nextPlaceholder

src/Reflex/Dom/Builder/InputDisabled.hs+1−3

@@ -18,8 +18,6 @@ import Reflex

18import Reflex.Dom.Builder.Class

19import Reflex.Host.Class

21−import Unsafe.Coerce

22−

23-- | A DomBuilder transformer that disables all 'inputElement's,

21-- | A DomBuilder transformer that disables all 'inputElement's,

24-- 'textAreaElement's, and 'selectElement's by adding the "disabled" HTML

22-- 'textAreaElement's, and 'selectElement's by adding the "disabled" HTML

25-- attribute. Note that 'element's that happen to have "input", "textarea", or

23-- attribute. Note that 'element's that happen to have "input", "textarea", or

@@ -64,7 +62,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (InputDisabl

64 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

62 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

66instance MonadAdjust t m => MonadAdjust t (InputDisabledT m) where

64instance 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')

69instance DomBuilder t m => DomBuilder t (InputDisabledT m) where

67instance DomBuilder t m => DomBuilder t (InputDisabledT m) where

70 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m

68 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m

src/Reflex/Dom/Builder/Static.hs+3−4

@@ -31,7 +31,6 @@ import Data.Default

31import Data.Dependent.Map (DMap)

32import qualified Data.Dependent.Map as DMap

33import Data.Dependent.Sum (DSum (..))

34−import Data.Functor.Compose

35import Data.Functor.Constant

34import Data.Functor.Constant

36import Data.Functor.Misc

35import Data.Functor.Misc

37import qualified Data.Map as Map

36import qualified Data.Map as Map

@@ -139,16 +138,16 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB

139 sequenceDMapWithAdjust (dm0 :: DMap k (StaticDomBuilderT t m)) dm' = do

138 sequenceDMapWithAdjust (dm0 :: DMap k (StaticDomBuilderT t m)) dm' = do

140 let loweredDm0 = mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> fmap swap (runStaticDomBuilderT v)) dm0

139 let loweredDm0 = mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> fmap swap (runStaticDomBuilderT v)) dm0

141 loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $

140 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

143 (children0, children') <- lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'

142 (children0, children') <- lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'

144 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, v)) -> k :=> Identity v) children0

143 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, v)) -> k :=> Identity v) children0

145 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $

144 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $

146 mapKeyValuePairsMonotonic (\(WrapArg k :=> mv) -> k :=> fmap snd mv) p

145 mapKeyValuePairsMonotonic (\(WrapArg k :=> mv) -> k :=> fmap snd mv) p

147 outputs0 :: DMap k (Constant (Behavior t ByteString))

146 outputs0 :: DMap k (Constant (Behavior t ByteString))

148 outputs0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (o, _)) -> k :=> Constant o) children0

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

150 outputs' = ffor children' $ \(PatchDMap p) -> PatchDMap $

149 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

152 outputs <- holdIncremental outputs0 outputs'

151 outputs <- holdIncremental outputs0 outputs'

153 StaticDomBuilderT $ modify $ (:) $ pull $ do

152 StaticDomBuilderT $ modify $ (:) $ pull $ do

154 os <- sample $ currentIncremental outputs

153 os <- sample $ currentIncremental outputs

src/Reflex/Dom/Widget/Basic.hs+3−7

@@ -91,19 +91,15 @@ import Control.Lens hiding (children, element)

91import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

92import Data.Align

93import Data.Default

94−import Data.Dependent.Map (DMap, GCompare)

95import qualified Data.Dependent.Map as DMap

94import qualified Data.Dependent.Map as DMap

96import Data.Either

95import Data.Either

97import Data.Foldable

96import Data.Foldable

98−import Data.Functor.Compose

99import Data.Functor.Misc

97import Data.Functor.Misc

100import Data.Map (Map)

98import Data.Map (Map)

101import qualified Data.Map as Map

99import qualified Data.Map as Map

102import Data.Maybe

100import Data.Maybe

103import Data.Set (Set)

101import Data.Set (Set)

104import qualified Data.Set as Set

102import qualified Data.Set as Set

105−import Data.Some (Some)

106−import qualified Data.Some as Some

107import Data.Text (Text)

103import Data.Text (Text)

108import qualified Data.Text as T

104import qualified Data.Text as T

109import Data.These

105import Data.These

@@ -113,11 +109,11 @@ import Prelude hiding (mapM, mapM_, sequence, sequence_)

113--TODO: Implement this specially

109--TODO: Implement this specially

114widgetHoldInternal :: forall t m a b. DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)

110widgetHoldInternal :: forall t m a b. DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)

115widgetHoldInternal child0 child' = do

111widgetHoldInternal 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'

117 let e :: forall x. x

113 let e :: forall x. x

118 e = error "widgetHoldInternal: missing child (should be impossible)"

114 e = error "widgetHoldInternal: missing child (should be impossible)"

119 return ( runIdentity $ DMap.findWithDefault e LeftTag result0

115 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

121 )

117 )

122

118

123-- | 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.

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

155listHoldWithKey :: 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))

151listHoldWithKey :: 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))

156listHoldWithKey m0 m' f = do

152listHoldWithKey m0 m' f = do

157 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0

153 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'

159 (a0, a') <- sequenceDMapWithAdjust dm0 dm'

155 (a0, a') <- sequenceDMapWithAdjust dm0 dm'

160 fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time

156 fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time

161

157