3713927 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge branch 'develop' into jsaddle

3713927Ali Abrar10 years ago

examples/sortableList.hsnew file+82

compare with develop

unifiedsplit

@@ -0,0 +1,82 @@

1+{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE RankNTypes #-}

5+{-# LANGUAGE RecursiveDo #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

7+import Control.Lens

8+import Control.Monad.Identity

9+import Control.Monad.IO.Class

10+import Data.Dependent.Map (DMap)

11+import Data.Functor.Constant

12+import Data.Functor.Misc

13+import Data.List

14+import Data.Map (Map)

15+import qualified Data.Map as Map

16+import Data.Monoid

17+import Data.Ord

18+import qualified Data.Text as T

19+import Data.Time.Clock

20+import Reflex.Dom

21+import System.Random

22+

23+main :: IO ()

24+main = mainWidget $ do

25+ let f _ (a, b, c) = el "tr" $ do

26+ mapM_ (el "td" . text . T.pack . show) [a, b, c]

27+ _ <- el "td" $ inputElement def

28+ return ()

29+ let numKeys = 1000 :: Int

30+ keys = take numKeys [0 :: Int ..]

31+ values :: [(Int, Int, Int)]

32+ values = zip3 (randoms (mkStdGen 0)) (randoms (mkStdGen 1)) (randoms (mkStdGen 2))

33+ testMap = Map.fromList $ zip keys values

34+ resortButtons = el "div" $ leftmost <$> sequence

35+ [ (comparing (view _1) <$) <$> button "A ASC"

36+ , (flip (comparing (view _1)) <$) <$> button "A DESC"

37+ , (comparing (view _2) <$) <$> button "B ASC"

38+ , (flip (comparing (view _2)) <$) <$> button "B DESC"

39+ , (comparing (view _3) <$) <$> button "C ASC"

40+ , (flip (comparing (view _3)) <$) <$> button "C DESC"

41+ ]

42+ el "h1" $ text "Improved list sorting"

43+ el "p" $ text $ "This app shows a table of " <> T.pack (show numKeys) <> " rows, and allows you to re-sort by columns a, b, and c, which are full of pseudorandom numbers. Each row also includes an element with internal state (a textbox) to demonstrate that the state is preserved, only when using the new way."

44+ el "h3" $ text "Re-sort the list the OLD way (by redrawing everything)"

45+ resortSlow <- resortButtons

46+ displayRedrawTime resortSlow

47+ el "h3" $ text "Re-sort the list the NEW way (by reordering existing elements)"

48+ resort <- resortButtons

49+ displayRedrawTime resort

50+ el "hr" blank

51+ el "table" $ do

52+ el "tr" $ do

53+ el "th" $ text "A"

54+ el "th" $ text "B"

55+ el "th" $ text "C"

56+ el "th" $ text "Stateful Element (textbox)"

57+ simpleSortableList f testMap resort resortSlow

58+ return ()

59+

60+displayRedrawTime :: (DomBuilder t m, MonadHold t m, PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) => Event t a -> m ()

61+displayRedrawTime e = do

62+ et1 <- performEvent $ liftIO getCurrentTime <$ e

63+ et1' <- delay 0 et1

64+ diff <- performEvent $ ffor et1' $ \t1 -> do

65+ t2 <- liftIO getCurrentTime

66+ return $ t2 `diffUTCTime` t1

67+ text "Time: "

68+ dynText =<< holdDyn "not yet run" (T.pack . show <$> diff)

69+

70+simpleSortableList :: forall t m k v. (MonadHold t m, MonadFix m, MonadAdjust t m, Ord k) => (k -> v -> m ()) -> Map k v -> Event t (v -> v -> Ordering) -> Event t (v -> v -> Ordering) -> m ()

71+simpleSortableList f m0 resortFunc resortSlowFunc = do

72+ rec let resortPatchFast = attachWith (flip patchThatSortsMapWith) (currentIncremental m) resortFunc

73+ redrawPatch :: Map k v -> (v -> v -> Ordering) -> PatchMapWithMove k v

74+ redrawPatch d cmp = unsafePatchMapWithMove $ fmap (MapEdit_Insert False) $ Map.fromList $ zip (Map.keys d) (sortBy cmp $ Map.elems d)

75+ resortPatchSlow = attachWith redrawPatch (currentIncremental m) resortSlowFunc

76+ resortPatch = leftmost

77+ [ resortPatchFast

78+ , resortPatchSlow

79+ ]

80+ m <- holdIncremental m0 resortPatch

81+ _ <- mapMapWithAdjustWithMove f m0 resortPatch

82+ return ()

reflex-dom-core/reflex-dom-core.cabal+28

@@ -31,6 +31,11 @@ flag expose-all-unfoldings

31 default: False

32 manual: True

34+flag build-examples

35+ description: Build the executables in ./examples

36+ default: False

37+ manual: True

38+

34library

39library

35 hs-source-dirs: src

40 hs-source-dirs: src

36 build-depends:

41 build-depends:

@@ -143,6 +148,29 @@ test-suite gc

143 if !os(linux) || !arch(x86_64)

148 if !os(linux) || !arch(x86_64)

144 buildable: False

149 buildable: False

145

150

151+executable sortableList

152+ build-depends: base

153+ , containers

154+ , dependent-map

155+ , lens

156+ , mtl

157+ , random

158+ , reflex

159+ , reflex-dom

160+ , text

161+ , time

162+ , transformers

163+ hs-source-dirs: examples

164+ main-is: sortableList.hs

165+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

166+ ghc-prof-options: -fprof-auto

167+ if !flag(build-examples)

168+ buildable: False

169+ if flag(expose-all-unfoldings)

170+ ghc-options: -fexpose-all-unfoldings

171+ if flag(use-reflex-optimizer)

172+ ghc-options: -fplugin=Reflex.Optimizer

173+

146source-repository head

174source-repository head

147 type: git

175 type: git

148 location: https://github.com/reflex-frp/reflex-dom

176 location: https://github.com/reflex-frp/reflex-dom

reflex-dom-core/src/Foreign/JavaScript/TH.hs+2−1

@@ -138,7 +138,8 @@ instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where

138

139instance MonadAdjust t m => MonadAdjust t (WithJSContextSingleton x m) where

140 runWithReplace a0 a' = WithJSContextSingleton $ runWithReplace (coerce a0) (coerceEvent a')

141− sequenceDMapWithAdjust dm0 dm' = WithJSContextSingleton $ sequenceDMapWithAdjust (coerce dm0) (coerceEvent dm')

141+ traverseDMapWithKeyWithAdjust f dm0 dm' = WithJSContextSingleton $ traverseDMapWithKeyWithAdjust (\k v -> unWithJSContextSingleton $ f k v) (coerce dm0) (coerceEvent dm')

142+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = WithJSContextSingleton $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unWithJSContextSingleton $ f k v) (coerce dm0) (coerceEvent dm')

142

143

143instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithJSContextSingleton x m) where

144instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithJSContextSingleton x m) where

144 {-# INLINABLE newEventWithTrigger #-}

145 {-# INLINABLE newEventWithTrigger #-}

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+75−27

@@ -46,13 +46,13 @@ import Data.Default

46import Data.Dependent.Map (DMap)

47import qualified Data.Dependent.Map as DMap

48import Data.Dependent.Sum

49+import Data.Functor.Compose

50+import Data.Functor.Constant

49import Data.Functor.Misc

51import Data.Functor.Misc

50import Data.IORef

52import Data.IORef

51−import Data.Map (Map)

52import qualified Data.Map as Map

53import qualified Data.Map as Map

53import Data.Maybe

54import Data.Maybe

54import Data.Monoid

55import Data.Monoid

55−import Data.Some (Some)

56import qualified Data.Some as Some

57import Data.Text (Text)

58import qualified Data.Text as T

@@ -70,8 +70,7 @@ import GHCJS.DOM.MouseEvent

70import qualified GHCJS.DOM.Touch as Touch

71import qualified GHCJS.DOM.TouchEvent as TouchEvent

72import qualified GHCJS.DOM.TouchList as TouchList

73−import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked,

73+import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)

74− setNodeValue, toNode)

75import qualified GHCJS.DOM.Node as DOM (insertBefore_)

74import qualified GHCJS.DOM.Node as DOM (insertBefore_)

76import GHCJS.DOM.Types

75import GHCJS.DOM.Types

77 (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),

76 (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),

@@ -190,6 +189,20 @@ extractUpTo df s e = liftJSM $ do

190

189

191type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadJSM (Performable m), MonadHold t m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m)

190type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadJSM (Performable m), MonadHold t m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m)

192

191

192+{-# INLINABLE collectUpTo #-}

193+collectUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m DOM.DocumentFragment

194+collectUpTo s e = do

195+ currentParent <- getParentNodeUnchecked e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment

196+ collectUpToGivenParent currentParent s e

197+

198+{-# INLINABLE collectUpToGivenParent #-}

199+collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment

200+collectUpToGivenParent currentParent s e = do

201+ doc <- getOwnerDocumentUnchecked currentParent

202+ df <- createDocumentFragmentUnchecked doc

203+ extractUpTo df s e

204+ return df

205+

193newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

206newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

194

207

195wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

208wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

@@ -450,37 +463,72 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m

450 insertBefore df after

463 insertBefore df after

451 return result

464 return result

452 return (result0, result')

465 return (result0, result')

453− sequenceDMapWithAdjust (dm0 :: DMap k (ImmediateDomBuilderT t m)) dm' = do

466+ traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do

454 initialEnv <- ImmediateDomBuilderT ask

467 initialEnv <- ImmediateDomBuilderT ask

455− let drawChildInitial :: ImmediateDomBuilderT t m a -> m (DOM.DocumentFragment, DOM.Text, a)

468+ (children0, children') <- lift $ traverseDMapWithKeyWithAdjust (\k v -> drawChildUpdate initialEnv $ f k v) dm0 dm'

456− drawChildInitial child = runImmediateDomBuilderT ((,,) <$> pure (error "sequenceDMapWithAdjust{ImmediateDomBuilderT}: drawChildInitial: DocumentFragment evaluated") <*> textNodeInternal ("" :: Text) <*> child) initialEnv --TODO: Don't return a DocumentFragment at all here; this will require that sequenceDMapWithAdjust accept differently-typed values for the constant and Event arguments.

457− drawChildUpdate :: ImmediateDomBuilderT t m a -> m (DOM.DocumentFragment, DOM.Text, a)

458− drawChildUpdate child = do

459− df <- createDocumentFragmentUnchecked $ _immediateDomBuilderEnv_document initialEnv

460− runImmediateDomBuilderT ((,,) <$> pure df <*> textNodeInternal ("" :: Text) <*> child) $ initialEnv

461− { _immediateDomBuilderEnv_parent = toNode df

462− }

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

464− mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (fmap drawChildUpdate mv)) p

465− (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

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

469+ let result0 = DMap.map (\(Compose (_, _, v)) -> v) children0

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

470+ placeholders0 = weakenDMapWith (\(Compose (_, ph, _)) -> ph) children0

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

471+ result' = ffor children' $ mapPatchDMap $ \(Compose (_, _, r)) -> r

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

472+ placeholders' = fforCheap children' $ weakenPatchDMapWith $ \(Compose (_, ph, _)) -> ph

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

471− dmapToMap $ mapKeyValuePairsMonotonic (\(WrapArg k :=> v) -> Const2 (Some.This k) :=> Identity (fmap ((\(_, ph, _) -> ph) . runIdentity) (getComposeMaybe v))) p

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

473+ placeholders <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'

474+ _ <- DMap.traverseWithKey (\_ (Compose (df, _, _)) -> Constant () <$ append df) children0

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

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

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

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

475 phs <- sample placeholders

477 phs <- sample placeholders

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

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

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

479+ let g :: DSum k (ComposeMaybe (Compose ((,,) DOM.DocumentFragment DOM.Text) v')) -> Performable m ()

478− f (WrapArg k :=> ComposeMaybe mv) = do

480+ g (k :=> ComposeMaybe mv) = do

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

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

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

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

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

483+ forM_ mv $ \(Compose (df, _, _)) -> df `insertBefore` nextPlaceholder

482− mapM_ f $ DMap.toList p

484+ mapM_ g $ DMap.toList p

483 return (result0, result')

485 return (result0, result')

486+ traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do

487+ initialEnv <- ImmediateDomBuilderT ask

488+ (children0, children') <- lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> drawChildUpdate initialEnv $ f k v) dm0 dm'

489+ let result0 = DMap.map (\(Compose (_, _, v)) -> v) children0

490+ placeholders0 = weakenDMapWith (\(Compose (_, ph, _)) -> ph) children0

491+ result' = ffor children' $ mapPatchDMapWithMove $ \(Compose (_, _, r)) -> r

492+ placeholders' = fforCheap children' $ weakenPatchDMapWithMoveWith $ \(Compose (_, ph, _)) -> ph

493+ placeholders <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'

494+ _ <- DMap.traverseWithKey (\_ (Compose (df, _, _)) -> Constant () <$ append df) children0

495+ lastPlaceholder <- textNodeInternal ("" :: Text)

496+ performEvent_ $ flip push children' $ \p_ -> do

497+ let p = unPatchDMapWithMove p_

498+ phsBefore <- sample placeholders

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

500+ let collectIfMoved :: forall a. k a -> DMapEdit k (Compose ((,,) DOM.DocumentFragment DOM.Text) v') a -> Performable m (Constant (Maybe DOM.DocumentFragment) a)

501+ collectIfMoved k e = do

502+ let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before

503+ nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore

504+ case dmapEditMoved e of

505+ False -> do

506+ mapM_ (`deleteUpTo` nextPlaceholder) mThisPlaceholder

507+ return $ Constant Nothing

508+ True -> do

509+ Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder

510+ collected <- DMap.traverseWithKey collectIfMoved p

511+ let phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, ph, _)) -> ph) p_) phsBefore --TODO: Don't recompute this

512+ let placeFragment :: forall a. k a -> DMapEdit k (Compose ((,,) DOM.DocumentFragment DOM.Text) v') a -> Performable m (Constant () a)

513+ placeFragment k e = do

514+ let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter

515+ case e of

516+ DMapEdit_Insert _ (Compose (df, _, _)) -> do

517+ df `insertBefore` nextPlaceholder

518+ DMapEdit_Delete _ -> do

519+ return ()

520+ DMapEdit_Move _ fromKey -> do

521+ Just (Constant mdf) <- return $ DMap.lookup fromKey collected

522+ mapM_ (`insertBefore` nextPlaceholder) mdf

523+ return $ Constant ()

524+ mapM_ (\(k :=> v) -> void $ placeFragment k v) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time

525+ return ()

526+ return (result0, result')

527+

528+drawChildUpdate :: MonadJSM m => ImmediateDomBuilderEnv t -> ImmediateDomBuilderT t m (v' a) -> m (Compose ((,,) DOM.DocumentFragment DOM.Text) v' a)

529+drawChildUpdate initialEnv child = do

530+ df <- createDocumentFragmentUnchecked $ _immediateDomBuilderEnv_document initialEnv

531+ runImmediateDomBuilderT (Compose <$> ((,,) <$> pure df <*> textNodeInternal ("" :: Text) <*> child)) $ initialEnv { _immediateDomBuilderEnv_parent = toNode df }

484

532

485mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)

533mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)

486mkHasFocus e = do

534mkHasFocus e = do

reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+2−1

@@ -68,7 +68,8 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (InputDisabl

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

70 runWithReplace a0 a' = InputDisabledT $ runWithReplace (coerce a0) (coerceEvent a')

71− sequenceDMapWithAdjust dm0 dm' = InputDisabledT $ sequenceDMapWithAdjust (coerce dm0) (coerceEvent dm')

71+ traverseDMapWithKeyWithAdjust f dm0 dm' = InputDisabledT $ traverseDMapWithKeyWithAdjust (\k v -> runInputDisabledT $ f k v) (coerce dm0) (coerceEvent dm')

72+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = InputDisabledT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runInputDisabledT $ f k v) (coerce dm0) (coerceEvent dm')

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

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

74 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m

75 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+7−12

@@ -31,8 +31,8 @@ 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

34import Data.Functor.Constant

35import Data.Functor.Constant

35−import Data.Functor.Misc

36import qualified Data.Map as Map

37import Data.Monoid

38import qualified Data.Set as Set

@@ -150,20 +150,15 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB

150 o <- hold (snd result0) $ fmapCheap snd result'

151 StaticDomBuilderT $ modify $ (:) $ join o

152 return (fst result0, fmapCheap fst result')

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

153+ traverseDMapWithKeyWithAdjust f (dm0 :: DMap k v) dm' = do

154 e <- StaticDomBuilderT ask

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

155+ (children0, children') <- lift $ traverseDMapWithKeyWithAdjust (\k v -> fmap (Compose . swap) (runStaticDomBuilderT (f k v) e)) dm0 dm'

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

156+ let result0 = DMap.map (snd . getCompose) children0

157− mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (fmap (fmap swap . flip runStaticDomBuilderT e) mv)) p

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

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

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

157+ result' = ffor children' $ mapPatchDMap $ snd . getCompose

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

162 outputs0 :: DMap k (Constant (Behavior t Builder))

158 outputs0 :: DMap k (Constant (Behavior t Builder))

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

159+ outputs0 = DMap.map (Constant . fst . getCompose) children0

164 outputs' :: Event t (PatchDMap k (Constant (Behavior t Builder)))

160 outputs' :: Event t (PatchDMap k (Constant (Behavior t Builder)))

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

161+ outputs' = ffor children' $ mapPatchDMap $ Constant . fst . getCompose

166− mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mv) -> k :=> ComposeMaybe (fmap (Constant . fst . runIdentity) mv)) p

167 outputs <- holdIncremental outputs0 outputs'

162 outputs <- holdIncremental outputs0 outputs'

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

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

169 os <- sample $ currentIncremental outputs

164 os <- sample $ currentIncremental outputs

reflex-dom-core/test/hlint.hs+2

@@ -14,6 +14,8 @@ main = do

14 , "--ignore=Use >=>"

15 , "--ignore=Use ."

16 , "--ignore=Use unless"

17+ , "--ignore=Use if"

18+ , "--ignore=Reduce duplication" --TODO: Re-enable this test

17 , "--cpp-define=USE_TEMPLATE_HASKELL"

19 , "--cpp-define=USE_TEMPLATE_HASKELL"

18 ]

20 ]

19 if null ideas then exitSuccess else exitFailure

21 if null ideas then exitSuccess else exitFailure