a1d69e9 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge branch 'fast-weak-partial-requester' of github.com:reflex-frp/reflex-dom into fast-weak-partial-requester

commita1d69e9cc8d9fd848ae039116dd2d928fb7a5712 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 23 Sep 2017, 21:19 (9 years ago) parent6ac1193 482a9bb

11 files changed+48−36

compare with develop

unifiedsplit

reflex-dom-core/reflex-dom-core.cabal+3−3 reflex-dom-core/src/Foreign/JavaScript/TH.hs+5−1 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+2−2 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+18−22 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+4 reflex-dom-core/src/Reflex/Dom/Main.hs+1 reflex-dom-core/src/Reflex/Dom/Specializations.hs−1 reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+1−1 reflex-dom-core/test/gc.hs+7−3 reflex-dom/benchmarks/krausest.hs+3−1 reflex-dom/reflex-dom.cabal+4−2

reflex-dom-core/reflex-dom-core.cabal+3−3

@@ -71,7 +71,7 @@ library

7171 stm == 2.4.*,

7272 text == 1.2.*,

7373 these >= 0.4 && < 0.8,

74− time >= 1.4 && < 1.8,

74+ time >= 1.4 && < 1.9,

7575 transformers >= 0.3 && < 0.6,

7676 unbounded-delays >= 0.1.0.9 && < 0.2,

7777 zenc == 0.1.*

@@ -119,7 +119,7 @@ library

119119 Reflex.Dom.Xhr.ResponseType

120120 Reflex.Dom.Xhr.Exception

121121

122− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

122+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo

123123 ghc-prof-options: -fprof-auto

124124

125125 if flag(expose-all-unfoldings)

@@ -145,7 +145,7 @@ library

145145 dependent-sum == 0.4.*

146146

147147test-suite hlint

148− build-depends: base, hlint == 1.9.*

148+ build-depends: base, hlint

149149 hs-source-dirs: test

150150 main-is: hlint.hs

151151 type: exitcode-stdio-1.0

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

@@ -170,6 +170,10 @@ instance MonadHold t m => MonadHold t (WithJSContextSingleton x m) where

170170 holdDyn v0 = lift . holdDyn v0

171171 {-# INLINABLE holdIncremental #-}

172172 holdIncremental v0 = lift . holdIncremental v0

173+ {-# INLINABLE buildDynamic #-}

174+ buildDynamic a0 = lift . buildDynamic a0

175+ {-# INLINABLE headE #-}

176+ headE = lift . headE

173177

174178instance MonadTransControl (WithJSContextSingleton x) where

175179 type StT (WithJSContextSingleton x) a = StT (ReaderT (JSContextSingleton x)) a

@@ -423,7 +427,7 @@ instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContext x IO) where

423427 f $ JSUint8Array payloadRef

424428 fromJSArray (JSRef_JavaScriptCore a) = liftJSM $ do

425429 len <- round <$> (valToNumber =<< (a ^. js "length"))

426− forM [0..len-1] $ \i -> JSRef_JavaScriptCore <$> a !! i

430+ forM [0..len-1] $ fmap JSRef_JavaScriptCore . (a !!)

427431 fromJSUint8Array a = do

428432 vals <- fromJSArray a

429433 doubles <- mapM fromJSNumber vals

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

@@ -610,7 +610,7 @@ class HasDomEvent t target eventName where

610610instance Reflex t => HasDomEvent t (Element EventResult d t) en where

611611 type DomEventType (Element EventResult d t) en = EventResultType en

612612 {-# INLINABLE domEvent #-}

613− domEvent en e = unEventResult <$> Reflex.select (_element_events e) (WrapArg en)

613+ domEvent en e = coerceEvent $ Reflex.select (_element_events e) (WrapArg en)

614614

615615instance Reflex t => HasDomEvent t (InputElement EventResult d t) en where

616616 type DomEventType (InputElement EventResult d t) en = EventResultType en

@@ -649,7 +649,7 @@ instance MonadTransControlStateless (ReaderT r)

649649type RunStateless t = forall n b. Monad n => t n b -> n b

650650

651651liftWithStateless :: forall m t a. (Monad m, MonadTransControlStateless t) => (RunStateless t -> m a) -> t m a

652−liftWithStateless a = liftWith $ \run -> a $ \x -> fromStT (Proxy :: Proxy t) <$> run x

652+liftWithStateless a = liftWith $ \run -> a $ fmap (fromStT (Proxy :: Proxy t)) . run

653653

654654liftTextNode :: (MonadTrans f, DomBuilder t m) => TextNodeConfig t -> f m (TextNode (DomBuilderSpace m) t)

655655liftTextNode = lift . textNode

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+18−22

@@ -22,6 +22,10 @@

2222{-# LANGUAGE TypeFamilies #-}

2323{-# LANGUAGE TypeOperators #-}

2424{-# LANGUAGE UndecidableInstances #-}

25+#ifdef ghcjs_HOST_OS

26+{-# LANGUAGE ForeignFunctionInterface #-}

27+{-# LANGUAGE JavaScriptFFI #-}

28+#endif

2529module Reflex.Dom.Builder.Immediate

2630 ( EventTriggerRef (..)

2731 , ImmediateDomBuilderEnv (..)

@@ -297,16 +301,7 @@ deleteBetweenExclusive s e = liftJSM $ do

297301-- and e will not be moved

298302extractBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()

299303extractBetweenExclusive df s e = liftJSM $ do

300− f <- eval $ T.unlines

301− [ "(function(df,s,e){"

302− , " var x;"

303− , " for(;;){"

304− , " x = s.nextSibling;"

305− , " if(e===x) break;"

306− , " df.appendChild(x);"

307− , " }"

308− , "})"

309− ]

304+ f <- eval ("(function(df,s,e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })" :: Text)

310305 void $ call f f (df, s, e)

311306

312307-- | s and e must both be children of the same node and s must precede e;

@@ -318,20 +313,17 @@ deleteUpTo s e = do

318313 extractUpTo df s e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

319314

320315extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()

316+#ifdef ghcjs_HOST_OS

317+--NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2017-09-04)

318+foreign import javascript unsafe

319+ "(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"

320+ extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()

321+extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)

322+#else

321323extractUpTo df s e = liftJSM $ do

322− f <- eval $ T.unlines

323− [ "(function(df,s,e){"

324− , " var x = s;"

325− , " var y;"

326− , " for(;;) {"

327− , " y = x.nextSibling;"

328− , " df.appendChild(x);"

329− , " if(e===y) break;"

330− , " x = y;"

331− , " }"

332− , "})"

333− ]

324+ f <- eval ("(function(df,s,e){ var x = s; var y; for(;;) { y = x['nextSibling']; df['appendChild'](x); if(e===y) { break; } x = y; } })" :: Text)

334325 void $ call f f (df, s, e)

326+#endif

335327

336328type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m, PrimMonad m)

337329

@@ -1567,6 +1559,10 @@ instance MonadHold t m => MonadHold t (ImmediateDomBuilderT t m) where

15671559 holdDyn v0 v' = lift $ holdDyn v0 v'

15681560 {-# INLINABLE holdIncremental #-}

15691561 holdIncremental v0 v' = lift $ holdIncremental v0 v'

1562+ {-# INLINABLE buildDynamic #-}

1563+ buildDynamic a0 = lift . buildDynamic a0

1564+ {-# INLINABLE headE #-}

1565+ headE = lift . headE

15701566

15711567data WindowConfig t = WindowConfig -- No config options yet

15721568

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

@@ -100,6 +100,10 @@ instance MonadHold t m => MonadHold t (StaticDomBuilderT t m) where

100100 holdDyn v0 v' = lift $ holdDyn v0 v'

101101 {-# INLINABLE holdIncremental #-}

102102 holdIncremental v0 v' = lift $ holdIncremental v0 v'

103+ {-# INLINABLE buildDynamic #-}

104+ buildDynamic a0 = lift . buildDynamic a0

105+ {-# INLINABLE headE #-}

106+ headE = lift . headE

103107

104108instance (Monad m, Ref m ~ Ref IO, Reflex t) => TriggerEvent t (StaticDomBuilderT t m) where

105109 {-# INLINABLE newTriggerEvent #-}

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

@@ -12,6 +12,7 @@

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE TypeOperators #-}

1414{-# LANGUAGE UndecidableInstances #-}

15+{-# OPTIONS_GHC -fspecialise-aggressively #-}

1516module Reflex.Dom.Main where

1617

1718import Prelude hiding (concat, mapM, mapM_, sequence, sequence_)

reflex-dom-core/src/Reflex/Dom/Specializations.hs−1

@@ -1,6 +1,5 @@

11{-# LANGUAGE FlexibleContexts #-}

22{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE OverloadedStrings #-}

43{-# LANGUAGE Rank2Types #-}

54{-# LANGUAGE ScopedTypeVariables #-}

65module Reflex.Dom.Specializations where

reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+1−1

@@ -80,4 +80,4 @@ newWebSocket _ url onMessage onOpen onError onClose = do

8080 return $ JSWebSocket ws

8181

8282onBSMessage :: Either ByteString JSVal -> JSM ByteString

83−onBSMessage = either return (\v -> encodeUtf8 <$> fromJSValUnchecked v)

83+onBSMessage = either return $ fmap encodeUtf8 . fromJSValUnchecked

reflex-dom-core/test/gc.hs+7−3

@@ -2,7 +2,9 @@

22{-# LANGUAGE CPP #-}

33{-# LANGUAGE OverloadedStrings #-}

44{-# LANGUAGE RecursiveDo #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

56import Control.Concurrent

7+import Control.Exception

68import Control.Monad

79import Control.Monad.IO.Class

810import Data.Int

@@ -36,11 +38,13 @@ failureLimit = 0

3638main :: IO ()

3739main = do

3840 uid <- getEffectiveUserID

39− unshare [User, Network]

40− writeUserMappings Nothing [UserMapping 0 uid 1]

41+ handle (\(_ :: IOError) -> return ()) $ do -- If we run into an exception with sandboxing, just don't bother

42+ unshare [User, Network]

43+ writeUserMappings Nothing [UserMapping 0 uid 1]

44+ callCommand "ip link set lo up ; ip addr"

4145 mainThread <- myThreadId

4246 withSystemTempDirectory "reflex-dom-core_test_gc" $ \tmp -> do

43− browserProcess <- spawnCommand $ "ip link set lo up ; ip addr ; sleep 1 ; echo 'Starting Chromium' ; chromium --headless --disable-gpu --no-sandbox --remote-debugging-port=9222 --user-data-dir=" ++ tmp ++ " http://localhost:3911 ; echo 'Chromium exited'"

47+ browserProcess <- spawnCommand $ "echo 'Starting Chromium' ; chromium --headless --disable-gpu --no-sandbox --remote-debugging-port=9222 --user-data-dir=" ++ tmp ++ " http://localhost:3911 ; echo 'Chromium exited'"

4448 let finishTest result = do

4549 interruptProcessGroupOf browserProcess

4650 throwTo mainThread result

reflex-dom/benchmarks/krausest.hs+3−1

@@ -2,7 +2,7 @@

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE ScopedTypeVariables #-}

44{-# LANGUAGE FlexibleContexts #-}

5−{-# OPTIONS_GHC -ddump-simpl -ddump-rules -ddump-spec -ddump-to-file -dsuppress-coercions -dsuppress-idinfo #-}

5+{-# OPTIONS_GHC -fmax-simplifier-iterations=5 -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo #-}

66import Control.Monad.State

77import Data.Monoid

88import Data.IntMap (IntMap, assocs, elems, empty, fromList, size, singleton)

@@ -56,6 +56,8 @@ bodyW seed = divClass "main" $ divClass "container" $ mdo

5656

5757 dynMT <- mapAccum_ step (initial, empty) events

5858

59+ elAttr "span" ("class" =: "preloadicon glyphicon glyphicon-remove" <> "aria-hidden" =: "true") blank

60+

5961 blank

6062

6163type Step = (Model, Table) -> (Model, TableDiff)

reflex-dom/reflex-dom.cabal+4−2

@@ -115,7 +115,7 @@ executable sortableList

115115 , transformers

116116 hs-source-dirs: examples

117117 main-is: sortableList.hs

118− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

118+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

119119 ghc-prof-options: -fprof-auto

120120 if !flag(build-examples)

121121 buildable: False

@@ -136,7 +136,9 @@ benchmark krausest

136136 build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum, vector

137137 hs-source-dirs: benchmarks

138138 main-is: krausest.hs

139− ghc-options: -O2 -fspecialise-aggressively

139+ ghc-options: -O2 -fspecialise-aggressively -DGHCJS_GC_INTERVAL=60000

140+ if impl(ghcjs)

141+ ghc-options: -dedupe

140142 type: exitcode-stdio-1.0

141143

142144source-repository head