on develop help sign in
Ensure specialize pragmas work with profiling; Fix profiled builds
commita620a29b0743ed53d5c346ea07bedd6a87965de6 authorAli Abrar <aliabrar@gmail.com> dateFri 15 Mar 2019, 22:58 (8 years ago) parentfd14629
4 files changed+67−67
reflex-dom-core/reflex-dom-core.cabal+1−1 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−1 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+62−65 reflex-dom-core/src/Reflex/Dom/Main.hs+3
reflex-dom-core/reflex-dom-core.cabal+1−1
@@ -191,7 +191,7 @@ test-suite hydration
191191 ghc-prof-options: -fprof-auto -optP-DPROFILING
192192 main-is: hydration.hs
193193 type: exitcode-stdio-1.0
194− if !os(linux) || !arch(x86_64)
194+ if !os(linux) || !arch(x86_64) || flag(profile-reflex)
195195 buildable: False
196196
197197-- broken test on base 4.11 & ghc 8.4.3
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−1
@@ -192,7 +192,7 @@ data CommentNodeConfig t
192192 }
193193
194194#ifndef USE_TEMPLATE_HASKELL
195−commentNodeConfig_initialContents :: Lens' (CommentNodeConfig t) Comment
195+commentNodeConfig_initialContents :: Lens' (CommentNodeConfig t) Text
196196commentNodeConfig_initialContents f (CommentNodeConfig a b) = (\a' -> CommentNodeConfig a' b) <$> f a
197197{-# INLINE commentNodeConfig_initialContents #-}
198198#endif
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+62−65
@@ -86,9 +86,6 @@ module Reflex.Dom.Builder.Immediate
8686 , ghcjsEventSpec_filters
8787 , ghcjsEventSpec_handler
8888 , GhcjsEventHandler (..)
89−#ifndef USE_TEMPLATE_HASKELL
90− , phantom2
91−#endif
9289 , drawChildUpdate
9390 , ChildReadyState (..)
9491 , mkHasFocus
@@ -163,6 +160,9 @@ import Reflex.PerformEvent.Base (PerformEventT)
163160import Reflex.PerformEvent.Class
164161import Reflex.PostBuild.Base (PostBuildT)
165162import Reflex.PostBuild.Class
163+#ifdef PROFILE_REFLEX
164+import Reflex.Profiled
165+#endif
166166import Reflex.Requester.Base
167167import Reflex.Requester.Class
168168import Reflex.Spider (Spider, SpiderHost, Global)
@@ -199,6 +199,7 @@ import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
199199
200200#ifndef USE_TEMPLATE_HASKELL
201201import Data.Functor.Contravariant (phantom)
202+import Control.Lens (Lens', Getter)
202203#endif
203204
204205#ifndef ghcjs_HOST_OS
@@ -528,17 +529,17 @@ wrap events e cfg = do
528529 return eventTriggerRefs
529530
530531{-# SPECIALIZE wrap
531− :: Chan [DSum (EventTriggerRef Spider) TriggerInvocation]
532+ :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
532533 -> DOM.Element
533− -> RawElementConfig er Spider HydrationDomSpace
534− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (DMap EventName (EventFilterTriggerRef Spider er))
534+ -> RawElementConfig er DomTimeline HydrationDomSpace
535+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
535536 #-}
536537
537538{-# SPECIALIZE wrap
538− :: Chan [DSum (EventTriggerRef Spider) TriggerInvocation]
539+ :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
539540 -> DOM.Element
540− -> RawElementConfig er Spider GhcjsDomSpace
541− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM (DMap EventName (EventFilterTriggerRef Spider er))
541+ -> RawElementConfig er DomTimeline GhcjsDomSpace
542+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
542543 #-}
543544
544545{-# INLINE triggerBody #-}
@@ -574,23 +575,23 @@ triggerBody ctx cfg events eventTriggerRefs e (WrapArg en) t = case DMap.lookup
574575
575576{-# SPECIALIZE triggerBody
576577 :: DOM.JSContextRef
577− -> RawElementConfig er Spider HydrationDomSpace
578− -> Chan [DSum (EventTriggerRef Spider) TriggerInvocation]
579− -> DMap EventName (EventFilterTriggerRef Spider er)
578+ -> RawElementConfig er DomTimeline HydrationDomSpace
579+ -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
580+ -> DMap EventName (EventFilterTriggerRef DomTimeline er)
580581 -> DOM.Element
581582 -> WrapArg er EventName x
582− -> EventTrigger Spider x
583+ -> EventTrigger DomTimeline x
583584 -> IO (IO ())
584585 #-}
585586
586587{-# SPECIALIZE triggerBody
587588 :: DOM.JSContextRef
588− -> RawElementConfig er Spider GhcjsDomSpace
589− -> Chan [DSum (EventTriggerRef Spider) TriggerInvocation]
590− -> DMap EventName (EventFilterTriggerRef Spider er)
589+ -> RawElementConfig er DomTimeline GhcjsDomSpace
590+ -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
591+ -> DMap EventName (EventFilterTriggerRef DomTimeline er)
591592 -> DOM.Element
592593 -> WrapArg er EventName x
593− -> EventTrigger Spider x
594+ -> EventTrigger DomTimeline x
594595 -> IO (IO ())
595596 #-}
596597
@@ -639,15 +640,11 @@ data GhcjsEventSpec er = GhcjsEventSpec
639640newtype GhcjsEventHandler er = GhcjsEventHandler { unGhcjsEventHandler :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)) }
640641
641642#ifndef USE_TEMPLATE_HASKELL
642−phantom2 :: (Functor f, Contravariant f) => f a -> f b
643−phantom2 = phantom
644−{-# INLINE phantom2 #-}
645−
646643ghcjsEventSpec_filters :: forall er . Lens' (GhcjsEventSpec er) (DMap EventName (GhcjsEventFilter er))
647644ghcjsEventSpec_filters f (GhcjsEventSpec a b) = (\a' -> GhcjsEventSpec a' b) <$> f a
648645{-# INLINE ghcjsEventSpec_filters #-}
649646ghcjsEventSpec_handler :: forall er en . Getter (GhcjsEventSpec er) ((EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
650−ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom2 (f b)
647+ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom (f b)
651648{-# INLINE ghcjsEventSpec_handler #-}
652649#endif
653650
@@ -695,16 +692,16 @@ elementImmediate elementTag cfg child = do
695692
696693{-# SPECIALIZE elementImmediate
697694 :: Text
698− -> ElementConfig er Spider HydrationDomSpace
699− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a
700− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (Element er GhcjsDomSpace Spider, a)
695+ -> ElementConfig er DomTimeline HydrationDomSpace
696+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
697+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
701698 #-}
702699
703700{-# SPECIALIZE elementImmediate
704701 :: Text
705− -> ElementConfig er Spider GhcjsDomSpace
706− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM a
707− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM (Element er GhcjsDomSpace Spider, a)
702+ -> ElementConfig er DomTimeline GhcjsDomSpace
703+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM a
704+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
708705 #-}
709706
710707-- For specialisation
@@ -741,9 +738,9 @@ elementInternal elementTag cfg child = getHydrationMode >>= \case
741738
742739{-# SPECIALIZE elementInternal
743740 :: Text
744− -> ElementConfig er Spider HydrationDomSpace
745− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a
746− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (Element er HydrationDomSpace Spider, a)
741+ -> ElementConfig er DomTimeline HydrationDomSpace
742+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
743+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er HydrationDomSpace DomTimeline, a)
747744 #-}
748745
749746{-# INLINE hydrateElement #-}
@@ -831,9 +828,9 @@ hydrateElement elementTag cfg child = do
831828
832829{-# SPECIALIZE hydrateElement
833830 :: Text
834− -> ElementConfig er Spider HydrationDomSpace
835− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a
836− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM ((Element er HydrationDomSpace Spider, a), IORef DOM.Element)
831+ -> ElementConfig er DomTimeline HydrationDomSpace
832+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
833+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM ((Element er HydrationDomSpace DomTimeline, a), IORef DOM.Element)
837834 #-}
838835
839836{-# INLINE inputElementImmediate #-}
@@ -1700,17 +1697,17 @@ traverseIntMapWithKeyWithAdjust' = do
17001697 liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
17011698
17021699{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
1703− :: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM v')
1700+ :: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
17041701 -> IntMap v
1705− -> Event Spider (PatchIntMap v)
1706− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM (IntMap v', Event Spider (PatchIntMap v'))
1702+ -> Event DomTimeline (PatchIntMap v)
1703+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
17071704 #-}
17081705
17091706{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
1710− :: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM v')
1707+ :: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
17111708 -> IntMap v
1712− -> Event Spider (PatchIntMap v)
1713− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (IntMap v', Event Spider (PatchIntMap v'))
1709+ -> Event DomTimeline (PatchIntMap v)
1710+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
17141711 #-}
17151712
17161713data ChildReadyState a
@@ -1945,39 +1942,39 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
19451942 return (result0, result')
19461943
19471944{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
1948− :: ((IntMap.Key -> v -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM Int v'))
1945+ :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
19491946 -> IntMap v
1950− -> Event Spider (PatchIntMap v)
1951− -> DomRenderHookT Spider HydrationM (IntMap (TraverseChild Spider HydrationM Int v'), Event Spider (PatchIntMap (TraverseChild Spider HydrationM Int v'))))
1952− -> (PatchIntMap (TraverseChild Spider HydrationM Int v')
1947+ -> Event DomTimeline (PatchIntMap v)
1948+ -> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
1949+ -> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
19531950 -> IntMap (IORef (ChildReadyState Int))
19541951 -> IO (IntMap (IORef (ChildReadyState Int))))
19551952 -> (IORef (IntMap DOM.Text)
19561953 -> DOM.Text
1957− -> PatchIntMap (TraverseChild Spider HydrationM Int v')
1954+ -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
19581955 -> JSM ())
1959− -> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM v')
1956+ -> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
19601957 -> IntMap v
1961− -> Event Spider (PatchIntMap v)
1962− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (IntMap v', Event Spider (PatchIntMap v'))
1958+ -> Event DomTimeline (PatchIntMap v)
1959+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
19631960 #-}
19641961
19651962{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
1966− :: ((IntMap.Key -> v -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM Int v'))
1963+ :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
19671964 -> IntMap v
1968− -> Event Spider (PatchIntMap v)
1969− -> DomRenderHookT Spider HydrationM (IntMap (TraverseChild Spider HydrationM Int v'), Event Spider (PatchIntMap (TraverseChild Spider HydrationM Int v'))))
1970− -> (PatchIntMap (TraverseChild Spider HydrationM Int v')
1965+ -> Event DomTimeline (PatchIntMap v)
1966+ -> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
1967+ -> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
19711968 -> IntMap (IORef (ChildReadyState Int))
19721969 -> IO (IntMap (IORef (ChildReadyState Int))))
19731970 -> (IORef (IntMap DOM.Text)
19741971 -> DOM.Text
1975− -> PatchIntMap (TraverseChild Spider HydrationM Int v')
1972+ -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
19761973 -> JSM ())
1977− -> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM v')
1974+ -> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
19781975 -> IntMap v
1979− -> Event Spider (PatchIntMap v)
1980− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM (IntMap v', Event Spider (PatchIntMap v'))
1976+ -> Event DomTimeline (PatchIntMap v)
1977+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
19811978 #-}
19821979
19831980data TraverseChildImmediate k = TraverseChildImmediate
@@ -2047,17 +2044,17 @@ drawChildUpdate initialEnv markReady child = do
20472044 }
20482045
20492046{-# SPECIALIZE drawChildUpdate
2050− :: HydrationDomBuilderEnv Spider HydrationM
2047+ :: HydrationDomBuilderEnv DomTimeline HydrationM
20512048 -> (IORef (ChildReadyState Int) -> JSM ())
2052− -> HydrationDomBuilderT s Spider HydrationM (Identity a)
2053− -> DomRenderHookT Spider HydrationM (Compose (TraverseChild Spider HydrationM Int) Identity a)
2049+ -> HydrationDomBuilderT s DomTimeline HydrationM (Identity a)
2050+ -> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM Int) Identity a)
20542051 #-}
20552052
20562053{-# SPECIALIZE drawChildUpdate
2057− :: HydrationDomBuilderEnv Spider HydrationM
2054+ :: HydrationDomBuilderEnv DomTimeline HydrationM
20582055 -> (IORef (ChildReadyState (Some k)) -> JSM ())
2059− -> HydrationDomBuilderT s Spider HydrationM (f a)
2060− -> DomRenderHookT Spider HydrationM (Compose (TraverseChild Spider HydrationM (Some k)) f a)
2056+ -> HydrationDomBuilderT s DomTimeline HydrationM (f a)
2057+ -> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM (Some k)) f a)
20612058 #-}
20622059
20632060{-# INLINABLE drawChildUpdateInt #-}
@@ -2069,10 +2066,10 @@ drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
20692066drawChildUpdateInt env mark m = fmap runIdentity . getCompose <$> drawChildUpdate env mark (Identity <$> m)
20702067
20712068{-# SPECIALIZE drawChildUpdateInt
2072− :: HydrationDomBuilderEnv Spider HydrationM
2069+ :: HydrationDomBuilderEnv DomTimeline HydrationM
20732070 -> (IORef (ChildReadyState k) -> JSM ())
2074− -> HydrationDomBuilderT s Spider HydrationM v
2075− -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM k v)
2071+ -> HydrationDomBuilderT s DomTimeline HydrationM v
2072+ -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM k v)
20762073 #-}
20772074
20782075{-# INLINE mkHasFocus #-}
reflex-dom-core/src/Reflex/Dom/Main.hs+3
@@ -27,6 +27,9 @@ import Reflex.PostBuild.Base
2727import Reflex.Spider (Global, Spider, SpiderHost, runSpiderHost)
2828import Reflex.TriggerEvent.Base
2929import Reflex.TriggerEvent.Class
30+#ifdef PROFILE_REFLEX
31+import Reflex.Profiled
32+#endif
3033
3134import Control.Concurrent
3235import Control.Lens