3383d86 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge pull request #295 from reflex-frp/aa-ghc8

Fixes for ghc 8.0, profiling, darwin, android

commit3383d8628d43001d153d7a79dc6ca52dc2021682 authorAli Abrar <aliabrar@gmail.com> dateSun 17 Mar 2019, 22:00 (8 years ago) parent93479aa a620a29

8 files changed+79−70

compare with develop

unifiedsplit

chrome-test-utils/src/Test/Util/ChromeFlags.hs+1 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+63−65 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+1 reflex-dom-core/src/Reflex/Dom/Main.hs+3 reflex-dom-core/src/Reflex/Dom/Prerender.hs+1 reflex-dom-core/test/hydration.hs+8−3

chrome-test-utils/src/Test/Util/ChromeFlags.hs+1

@@ -1,6 +1,7 @@

11{-# LANGUAGE OverloadedStrings #-}

22module Test.Util.ChromeFlags where

4+import Data.Semigroup

45import Data.Text

56import System.IO.Temp

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+63−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

@@ -138,6 +135,7 @@ import Data.Functor.Product

138135import Data.IORef

139136import Data.IntMap.Strict (IntMap)

140137import Data.Maybe

138+import Data.Monoid ((<>))

141139import Data.Some (Some(..))

142140import Data.Text (Text)

143141import Foreign.JavaScript.Internal.Utils

@@ -162,6 +160,9 @@ import Reflex.PerformEvent.Base (PerformEventT)

162160import Reflex.PerformEvent.Class

163161import Reflex.PostBuild.Base (PostBuildT)

164162import Reflex.PostBuild.Class

163+#ifdef PROFILE_REFLEX

164+import Reflex.Profiled

165+#endif

165166import Reflex.Requester.Base

166167import Reflex.Requester.Class

167168import Reflex.Spider (Spider, SpiderHost, Global)

@@ -198,6 +199,7 @@ import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

198199

199200#ifndef USE_TEMPLATE_HASKELL

200201import Data.Functor.Contravariant (phantom)

202+import Control.Lens (Lens', Getter)

201203#endif

202204

203205#ifndef ghcjs_HOST_OS

@@ -527,17 +529,17 @@ wrap events e cfg = do

527529 return eventTriggerRefs

528530

529531{-# SPECIALIZE wrap

530− :: Chan [DSum (EventTriggerRef Spider) TriggerInvocation]

532+ :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]

531533 -> DOM.Element

532− -> RawElementConfig er Spider HydrationDomSpace

533− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM (DMap EventName (EventFilterTriggerRef Spider er))

534+ -> RawElementConfig er DomTimeline HydrationDomSpace

535+ -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))

534536 #-}

535537

536538{-# SPECIALIZE wrap

537− :: Chan [DSum (EventTriggerRef Spider) TriggerInvocation]

539+ :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]

538540 -> DOM.Element

539− -> RawElementConfig er Spider GhcjsDomSpace

540− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM (DMap EventName (EventFilterTriggerRef Spider er))

541+ -> RawElementConfig er DomTimeline GhcjsDomSpace

542+ -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))

541543 #-}

542544

543545{-# INLINE triggerBody #-}

@@ -573,23 +575,23 @@ triggerBody ctx cfg events eventTriggerRefs e (WrapArg en) t = case DMap.lookup

573575

574576{-# SPECIALIZE triggerBody

575577 :: DOM.JSContextRef

576− -> RawElementConfig er Spider HydrationDomSpace

577− -> Chan [DSum (EventTriggerRef Spider) TriggerInvocation]

578− -> DMap EventName (EventFilterTriggerRef Spider er)

578+ -> RawElementConfig er DomTimeline HydrationDomSpace

579+ -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]

580+ -> DMap EventName (EventFilterTriggerRef DomTimeline er)

579581 -> DOM.Element

580582 -> WrapArg er EventName x

581− -> EventTrigger Spider x

583+ -> EventTrigger DomTimeline x

582584 -> IO (IO ())

583585 #-}

584586

585587{-# SPECIALIZE triggerBody

586588 :: DOM.JSContextRef

587− -> RawElementConfig er Spider GhcjsDomSpace

588− -> Chan [DSum (EventTriggerRef Spider) TriggerInvocation]

589− -> DMap EventName (EventFilterTriggerRef Spider er)

589+ -> RawElementConfig er DomTimeline GhcjsDomSpace

590+ -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]

591+ -> DMap EventName (EventFilterTriggerRef DomTimeline er)

590592 -> DOM.Element

591593 -> WrapArg er EventName x

592− -> EventTrigger Spider x

594+ -> EventTrigger DomTimeline x

593595 -> IO (IO ())

594596 #-}

595597

@@ -638,15 +640,11 @@ data GhcjsEventSpec er = GhcjsEventSpec

638640newtype GhcjsEventHandler er = GhcjsEventHandler { unGhcjsEventHandler :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)) }

639641

640642#ifndef USE_TEMPLATE_HASKELL

641−phantom2 :: (Functor f, Contravariant f) => f a -> f b

642−phantom2 = phantom

643−{-# INLINE phantom2 #-}

644−

645643ghcjsEventSpec_filters :: forall er . Lens' (GhcjsEventSpec er) (DMap EventName (GhcjsEventFilter er))

646644ghcjsEventSpec_filters f (GhcjsEventSpec a b) = (\a' -> GhcjsEventSpec a' b) <$> f a

647645{-# INLINE ghcjsEventSpec_filters #-}

648646ghcjsEventSpec_handler :: forall er en . Getter (GhcjsEventSpec er) ((EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))

649−ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom2 (f b)

647+ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom (f b)

650648{-# INLINE ghcjsEventSpec_handler #-}

651649#endif

652650

@@ -694,16 +692,16 @@ elementImmediate elementTag cfg child = do

694692

695693{-# SPECIALIZE elementImmediate

696694 :: Text

697− -> ElementConfig er Spider HydrationDomSpace

698− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a

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

700698 #-}

701699

702700{-# SPECIALIZE elementImmediate

703701 :: Text

704− -> ElementConfig er Spider GhcjsDomSpace

705− -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM a

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

707705 #-}

708706

709707-- For specialisation

@@ -740,9 +738,9 @@ elementInternal elementTag cfg child = getHydrationMode >>= \case

740738

741739{-# SPECIALIZE elementInternal

742740 :: Text

743− -> ElementConfig er Spider HydrationDomSpace

744− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a

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

746744 #-}

747745

748746{-# INLINE hydrateElement #-}

@@ -830,9 +828,9 @@ hydrateElement elementTag cfg child = do

830828

831829{-# SPECIALIZE hydrateElement

832830 :: Text

833− -> ElementConfig er Spider HydrationDomSpace

834− -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM a

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

836834 #-}

837835

838836{-# INLINE inputElementImmediate #-}

@@ -1699,17 +1697,17 @@ traverseIntMapWithKeyWithAdjust' = do

16991697 liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs

17001698

17011699{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'

1702− :: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM v')

1700+ :: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')

17031701 -> IntMap v

1704− -> Event Spider (PatchIntMap v)

1705− -> 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'))

17061704 #-}

17071705

17081706{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'

1709− :: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM v')

1707+ :: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')

17101708 -> IntMap v

1711− -> Event Spider (PatchIntMap v)

1712− -> 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'))

17131711 #-}

17141712

17151713data ChildReadyState a

@@ -1944,39 +1942,39 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

19441942 return (result0, result')

19451943

19461944{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust

1947− :: ((IntMap.Key -> v -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM Int v'))

1945+ :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))

19481946 -> IntMap v

1949− -> Event Spider (PatchIntMap v)

1950− -> DomRenderHookT Spider HydrationM (IntMap (TraverseChild Spider HydrationM Int v'), Event Spider (PatchIntMap (TraverseChild Spider HydrationM Int v'))))

1951− -> (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')

19521950 -> IntMap (IORef (ChildReadyState Int))

19531951 -> IO (IntMap (IORef (ChildReadyState Int))))

19541952 -> (IORef (IntMap DOM.Text)

19551953 -> DOM.Text

1956− -> PatchIntMap (TraverseChild Spider HydrationM Int v')

1954+ -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')

19571955 -> JSM ())

1958− -> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace Spider HydrationM v')

1956+ -> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')

19591957 -> IntMap v

1960− -> Event Spider (PatchIntMap v)

1961− -> 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'))

19621960 #-}

19631961

19641962{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust

1965− :: ((IntMap.Key -> v -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM Int v'))

1963+ :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))

19661964 -> IntMap v

1967− -> Event Spider (PatchIntMap v)

1968− -> DomRenderHookT Spider HydrationM (IntMap (TraverseChild Spider HydrationM Int v'), Event Spider (PatchIntMap (TraverseChild Spider HydrationM Int v'))))

1969− -> (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')

19701968 -> IntMap (IORef (ChildReadyState Int))

19711969 -> IO (IntMap (IORef (ChildReadyState Int))))

19721970 -> (IORef (IntMap DOM.Text)

19731971 -> DOM.Text

1974− -> PatchIntMap (TraverseChild Spider HydrationM Int v')

1972+ -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')

19751973 -> JSM ())

1976− -> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace Spider HydrationM v')

1974+ -> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')

19771975 -> IntMap v

1978− -> Event Spider (PatchIntMap v)

1979− -> 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'))

19801978 #-}

19811979

19821980data TraverseChildImmediate k = TraverseChildImmediate

@@ -2046,17 +2044,17 @@ drawChildUpdate initialEnv markReady child = do

20462044 }

20472045

20482046{-# SPECIALIZE drawChildUpdate

2049− :: HydrationDomBuilderEnv Spider HydrationM

2047+ :: HydrationDomBuilderEnv DomTimeline HydrationM

20502048 -> (IORef (ChildReadyState Int) -> JSM ())

2051− -> HydrationDomBuilderT s Spider HydrationM (Identity a)

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

20532051 #-}

20542052

20552053{-# SPECIALIZE drawChildUpdate

2056− :: HydrationDomBuilderEnv Spider HydrationM

2054+ :: HydrationDomBuilderEnv DomTimeline HydrationM

20572055 -> (IORef (ChildReadyState (Some k)) -> JSM ())

2058− -> HydrationDomBuilderT s Spider HydrationM (f a)

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

20602058 #-}

20612059

20622060{-# INLINABLE drawChildUpdateInt #-}

@@ -2068,10 +2066,10 @@ drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

20682066drawChildUpdateInt env mark m = fmap runIdentity . getCompose <$> drawChildUpdate env mark (Identity <$> m)

20692067

20702068{-# SPECIALIZE drawChildUpdateInt

2071− :: HydrationDomBuilderEnv Spider HydrationM

2069+ :: HydrationDomBuilderEnv DomTimeline HydrationM

20722070 -> (IORef (ChildReadyState k) -> JSM ())

2073− -> HydrationDomBuilderT s Spider HydrationM v

2074− -> DomRenderHookT Spider HydrationM (TraverseChild Spider HydrationM k v)

2071+ -> HydrationDomBuilderT s DomTimeline HydrationM v

2072+ -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM k v)

20752073 #-}

20762074

20772075{-# INLINE mkHasFocus #-}

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+1

@@ -37,6 +37,7 @@ import Data.IntMap (IntMap)

3737import qualified Data.IntMap as IntMap

3838import qualified Data.Map as Map

3939import Data.Map.Misc (applyMap)

40+import Data.Monoid ((<>))

4041import qualified Data.Set as Set

4142import Data.Text (Text)

4243import qualified Data.Text as T

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

reflex-dom-core/src/Reflex/Dom/Prerender.hs+1

@@ -25,6 +25,7 @@ import Control.Monad.Primitive (PrimMonad)

2525import Control.Monad.Reader

2626import Control.Monad.Ref (MonadRef(..))

2727import Data.IORef (IORef, newIORef)

28+import Data.Semigroup (Semigroup)

2829import Data.Text (Text)

2930import Foreign.JavaScript.TH

3031import GHCJS.DOM.Types (MonadJSM)

reflex-dom-core/test/hydration.hs+8−3

@@ -35,6 +35,7 @@ import Data.GADT.Compare.TH

3535import Data.GADT.Show.TH

3636import Data.IORef (IORef)

3737import Data.Maybe

38+import Data.Monoid

3839import Data.Proxy

3940import Data.Text (Text)

4041import Language.Javascript.JSaddle (syncPoint, liftJSM)

@@ -54,9 +55,9 @@ import System.Process

5455import qualified Test.HUnit as HUnit (assertEqual, assertFailure)

5556import qualified Test.Hspec as H

5657import Test.Hspec (xit)

57−import Test.Hspec.WebDriver hiding (runWD, click, uploadFile)

58+import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)

5859import qualified Test.Hspec.WebDriver as WD

59−import Test.WebDriver (WD)

60+import Test.WebDriver (WD(..))

6061

6162import qualified Data.ByteString.Lazy as LBS

6263import qualified Data.Dependent.Map as DMap

@@ -77,7 +78,11 @@ seleniumPort = 8000

7778jsaddlePort = 8001

7879

7980-- TODO Remove orphan

80−deriving instance MonadRef WD

81+instance MonadRef WD where

82+ type Ref WD = Ref IO

83+ newRef = WD . newRef

84+ readRef = WD . readRef

85+ writeRef r = WD . writeRef r

8186

8287assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()

8388assertEqual a b = liftIO . HUnit.assertEqual a b