a1d69e9 · reflex-dom · git.iko.soy

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

compare with develop

unifiedsplit

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

71 stm == 2.4.*,

72 text == 1.2.*,

73 these >= 0.4 && < 0.8,

74− time >= 1.4 && < 1.8,

74+ time >= 1.4 && < 1.9,

75 transformers >= 0.3 && < 0.6,

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

77 zenc == 0.1.*

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

119 Reflex.Dom.Xhr.ResponseType

120 Reflex.Dom.Xhr.Exception

121

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

123 ghc-prof-options: -fprof-auto

124

125 if flag(expose-all-unfoldings)

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

145 dependent-sum == 0.4.*

146

147test-suite hlint

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

148+ build-depends: base, hlint

149 hs-source-dirs: test

150 main-is: hlint.hs

151 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

170 holdDyn v0 = lift . holdDyn v0

171 {-# INLINABLE holdIncremental #-}

172 holdIncremental v0 = lift . holdIncremental v0

173+ {-# INLINABLE buildDynamic #-}

174+ buildDynamic a0 = lift . buildDynamic a0

175+ {-# INLINABLE headE #-}

176+ headE = lift . headE

173

177

174instance MonadTransControl (WithJSContextSingleton x) where

178instance MonadTransControl (WithJSContextSingleton x) where

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

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

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

423 f $ JSUint8Array payloadRef

427 f $ JSUint8Array payloadRef

424 fromJSArray (JSRef_JavaScriptCore a) = liftJSM $ do

428 fromJSArray (JSRef_JavaScriptCore a) = liftJSM $ do

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

429 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 !!)

427 fromJSUint8Array a = do

431 fromJSUint8Array a = do

428 vals <- fromJSArray a

432 vals <- fromJSArray a

429 doubles <- mapM fromJSNumber vals

433 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

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

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

612 {-# 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)

614

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

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

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

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

650

651liftWithStateless :: 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

653

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

655liftTextNode = lift . textNode

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

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

22{-# LANGUAGE TypeFamilies #-}

23{-# LANGUAGE TypeOperators #-}

24{-# LANGUAGE UndecidableInstances #-}

25+#ifdef ghcjs_HOST_OS

26+{-# LANGUAGE ForeignFunctionInterface #-}

27+{-# LANGUAGE JavaScriptFFI #-}

28+#endif

25module Reflex.Dom.Builder.Immediate

29module Reflex.Dom.Builder.Immediate

26 ( EventTriggerRef (..)

30 ( EventTriggerRef (..)

27 , ImmediateDomBuilderEnv (..)

31 , ImmediateDomBuilderEnv (..)

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

297-- and e will not be moved

301-- and e will not be moved

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

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

299extractBetweenExclusive df s e = liftJSM $ do

303extractBetweenExclusive df s e = liftJSM $ do

300− f <- eval $ T.unlines

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

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− ]

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

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

311

306

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

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

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

318 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

313 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

319

314

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

315extractUpTo :: (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

321extractUpTo df s e = liftJSM $ do

323extractUpTo df s e = liftJSM $ do

322− f <- eval $ T.unlines

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)

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− ]

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

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

326+#endif

335

327

336type 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)

328type 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)

337

329

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

1567 holdDyn v0 v' = lift $ holdDyn v0 v'

1559 holdDyn v0 v' = lift $ holdDyn v0 v'

1568 {-# INLINABLE holdIncremental #-}

1560 {-# INLINABLE holdIncremental #-}

1569 holdIncremental v0 v' = lift $ holdIncremental v0 v'

1561 holdIncremental v0 v' = lift $ holdIncremental v0 v'

1562+ {-# INLINABLE buildDynamic #-}

1563+ buildDynamic a0 = lift . buildDynamic a0

1564+ {-# INLINABLE headE #-}

1565+ headE = lift . headE

1570

1566

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

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

1572

1568

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

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

100 holdDyn v0 v' = lift $ holdDyn v0 v'

101 {-# INLINABLE holdIncremental #-}

102 holdIncremental v0 v' = lift $ holdIncremental v0 v'

103+ {-# INLINABLE buildDynamic #-}

104+ buildDynamic a0 = lift . buildDynamic a0

105+ {-# INLINABLE headE #-}

106+ headE = lift . headE

103

107

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

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

105 {-# INLINABLE newTriggerEvent #-}

109 {-# INLINABLE newTriggerEvent #-}

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

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

12{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE UndecidableInstances #-}

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

15module Reflex.Dom.Main where

16module Reflex.Dom.Main where

16

17

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

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

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

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

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE Rank2Types #-}

3{-# LANGUAGE Rank2Types #-}

5{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

6module Reflex.Dom.Specializations where

5module 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

80 return $ JSWebSocket ws

81

82onBSMessage :: 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 @@

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RecursiveDo #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

5import Control.Concurrent

6import Control.Concurrent

7+import Control.Exception

6import Control.Monad

8import Control.Monad

7import Control.Monad.IO.Class

9import Control.Monad.IO.Class

8import Data.Int

10import Data.Int

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

36main :: IO ()

38main :: IO ()

37main = do

39main = do

38 uid <- getEffectiveUserID

40 uid <- getEffectiveUserID

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

39− unshare [User, Network]

42+ unshare [User, Network]

40− writeUserMappings Nothing [UserMapping 0 uid 1]

43+ writeUserMappings Nothing [UserMapping 0 uid 1]

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

41 mainThread <- myThreadId

45 mainThread <- myThreadId

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

46 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'"

44 let finishTest result = do

48 let finishTest result = do

45 interruptProcessGroupOf browserProcess

49 interruptProcessGroupOf browserProcess

46 throwTo mainThread result

50 throwTo mainThread result

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

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

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4{-# 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 #-}

6import Control.Monad.State

7import Data.Monoid

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

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

56

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

58

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

60+

59 blank

61 blank

60

62

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

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

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

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

115 , transformers

116 hs-source-dirs: examples

117 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

119 ghc-prof-options: -fprof-auto

120 if !flag(build-examples)

121 buildable: False

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

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

137 hs-source-dirs: benchmarks

138 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

140 type: exitcode-stdio-1.0

142 type: exitcode-stdio-1.0

141

143

142source-repository head

144source-repository head